Back to home page

MITgcm
 
 

    

File indexing completed on 2024-06-06 05:10:59 UTC

view on githubraw file Latest commit af61e5eb on 2024-06-06 03:30:35 UTC
0f64a7d6fb Dimi*0001 #include "OBCS_OPTIONS.h"
9b4f2a04e2 Jean*0002 #ifdef ALLOW_SEAICE
                0003 # include "SEAICE_OPTIONS.h"
                0004 #endif
0f64a7d6fb Dimi*0005 
f44c38859d Jean*0006 CBOP
                0007 C     !ROUTINE: OBCS_APPLY_SEAICE
                0008 C     !INTERFACE:
                0009 
0f64a7d6fb Dimi*0010       SUBROUTINE OBCS_APPLY_SEAICE( myThid )
f44c38859d Jean*0011 
                0012 C     !DESCRIPTION:
                0013 C     *==========================================================*
                0014 C     | S/R OBCS_APPLY_SEAICE
                0015 C     *==========================================================*
                0016 
                0017 C     !USES:
0f64a7d6fb Dimi*0018       IMPLICIT NONE
                0019 C     == Global variables ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
9b4f2a04e2 Jean*0024 c#include "OBCS_PARAMS.h"
                0025 #include "OBCS_GRID.h"
                0026 #include "OBCS_SEAICE.h"
0f64a7d6fb Dimi*0027 #ifdef ALLOW_SEAICE
a34cef4f76 Jean*0028 # include "SEAICE_SIZE.h"
0f64a7d6fb Dimi*0029 # include "SEAICE_PARAMS.h"
a34cef4f76 Jean*0030 # include "SEAICE.h"
0f64a7d6fb Dimi*0031 #endif
                0032 
f44c38859d Jean*0033 C     !INPUT/OUTPUT PARAMETERS:
0f64a7d6fb Dimi*0034 C     == Routine Arguments ==
f44c38859d Jean*0035 C    myThid   :: my Thread Id number
0f64a7d6fb Dimi*0036       INTEGER myThid
f44c38859d Jean*0037 CEOP
0f64a7d6fb Dimi*0038 
af61e5eb16 Mart*0039 #if ( defined ALLOW_OBCS && defined ALLOW_SEAICE )
0f64a7d6fb Dimi*0040 
f44c38859d Jean*0041 C     !LOCAL VARIABLES:
0f64a7d6fb Dimi*0042 C     == Local variables ==
f44c38859d Jean*0043       INTEGER bi, bj
                0044       INTEGER i, j
                0045       INTEGER Iobc, Jobc
8d129534f3 Jean*0046 #ifdef OBCS_SEAICE_SMOOTH_EDGE
f44c38859d Jean*0047       INTEGER k
330efc3489 Dimi*0048       _RL edge_val
8d129534f3 Jean*0049 #endif
0f64a7d6fb Dimi*0050 
                0051       DO bj=myByLo(myThid),myByHi(myThid)
                0052        DO bi=myBxLo(myThid),myBxHi(myThid)
                0053 
                0054 #ifdef ALLOW_OBCS_NORTH
f44c38859d Jean*0055         IF ( tileHasOBN(bi,bj) ) THEN
                0056 C     Set model variables to OB values on Northern Boundary
a34cef4f76 Jean*0057          DO i=1-OLx,sNx+OLx
af61e5eb16 Mart*0058           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0059           IF ( Jobc.NE.OB_indexNone ) THEN
af61e5eb16 Mart*0060            IF ( useSeaiceNeumann ) THEN
                0061 C     Neumann boundary conditions
                0062             HEFF (i,Jobc,bi,bj) = HEFF (i,Jobc-1,bi,bj)
                0063             AREA (i,Jobc,bi,bj) = AREA (i,Jobc-1,bi,bj)
                0064             HSNOW(i,Jobc,bi,bj) = HSNOW(i,Jobc-1,bi,bj)
                0065 #  ifdef SEAICE_VARIABLE_SALINITY
                0066             HSALT(i,Jobc,bi,bj) = HSALT(i,Jobc-1,bi,bj)
                0067 #  endif
                0068            ELSE
3c51c78c8c Jean*0069             HEFF (i,Jobc,bi,bj) = OBNh (i,bi,bj)
                0070             AREA (i,Jobc,bi,bj) = OBNa (i,bi,bj)
                0071             HSNOW(i,Jobc,bi,bj) = OBNsn(i,bi,bj)
af61e5eb16 Mart*0072 #  ifdef SEAICE_VARIABLE_SALINITY
3c51c78c8c Jean*0073             HSALT(i,Jobc,bi,bj) = OBNsl(i,bi,bj)
af61e5eb16 Mart*0074 #  endif
                0075            ENDIF
330efc3489 Dimi*0076           ENDIF
f44c38859d Jean*0077          ENDDO
                0078         ENDIF
0f64a7d6fb Dimi*0079 #endif /* ALLOW_OBCS_NORTH */
                0080 
                0081 #ifdef ALLOW_OBCS_SOUTH
f44c38859d Jean*0082         IF ( tileHasOBS(bi,bj) ) THEN
                0083 C     Set model variables to OB values on Southern Boundary
a34cef4f76 Jean*0084          DO i=1-OLx,sNx+OLx
af61e5eb16 Mart*0085           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0086           IF ( Jobc.NE.OB_indexNone ) THEN
af61e5eb16 Mart*0087            IF ( useSeaiceNeumann ) THEN
                0088 C     Neumann boundary conditions
                0089             HEFF (i,Jobc,bi,bj) = HEFF (i,Jobc+1,bi,bj)
                0090             AREA (i,Jobc,bi,bj) = AREA (i,Jobc+1,bi,bj)
                0091             HSNOW(i,Jobc,bi,bj) = HSNOW(i,Jobc+1,bi,bj)
                0092 #  ifdef SEAICE_VARIABLE_SALINITY
                0093             HSALT(i,Jobc,bi,bj) = HSALT(i,Jobc+1,bi,bj)
                0094 #  endif
                0095            ELSE
3c51c78c8c Jean*0096             HEFF (i,Jobc,bi,bj) = OBSh (i,bi,bj)
                0097             AREA (i,Jobc,bi,bj) = OBSa (i,bi,bj)
                0098             HSNOW(i,Jobc,bi,bj) = OBSsn(i,bi,bj)
af61e5eb16 Mart*0099 #  ifdef SEAICE_VARIABLE_SALINITY
3c51c78c8c Jean*0100             HSALT(i,Jobc,bi,bj) = OBSsl(i,bi,bj)
af61e5eb16 Mart*0101 #  endif
                0102            ENDIF
330efc3489 Dimi*0103           ENDIF
f44c38859d Jean*0104          ENDDO
                0105         ENDIF
0f64a7d6fb Dimi*0106 #endif /* ALLOW_OBCS_SOUTH */
                0107 
                0108 #ifdef ALLOW_OBCS_EAST
f44c38859d Jean*0109         IF ( tileHasOBE(bi,bj) ) THEN
                0110 C     Set model variables to OB values on Eastern Boundary
a34cef4f76 Jean*0111          DO j=1-OLy,sNy+OLy
af61e5eb16 Mart*0112           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0113           IF ( Iobc.NE.OB_indexNone ) THEN
af61e5eb16 Mart*0114            IF ( useSeaiceNeumann ) THEN
                0115 C     Neumann boundary conditions
                0116             HEFF (Iobc,j,bi,bj) = HEFF (Iobc-1,j,bi,bj)
                0117             AREA (Iobc,j,bi,bj) = AREA (Iobc-1,j,bi,bj)
                0118             HSNOW(Iobc,j,bi,bj) = HSNOW(Iobc-1,j,bi,bj)
                0119 #  ifdef SEAICE_VARIABLE_SALINITY
                0120             HSALT(Iobc,j,bi,bj) = HSALT(Iobc-1,j,bi,bj)
                0121 #  endif
                0122            ELSE
3c51c78c8c Jean*0123             HEFF (Iobc,j,bi,bj) = OBEh (j,bi,bj)
                0124             AREA (Iobc,j,bi,bj) = OBEa (j,bi,bj)
                0125             HSNOW(Iobc,j,bi,bj) = OBEsn(j,bi,bj)
af61e5eb16 Mart*0126 #  ifdef SEAICE_VARIABLE_SALINITY
3c51c78c8c Jean*0127             HSALT(Iobc,j,bi,bj) = OBEsl(j,bi,bj)
af61e5eb16 Mart*0128 #  endif
                0129            ENDIF
330efc3489 Dimi*0130           ENDIF
f44c38859d Jean*0131          ENDDO
                0132         ENDIF
0f64a7d6fb Dimi*0133 #endif /* ALLOW_OBCS_EAST */
                0134 
                0135 #ifdef ALLOW_OBCS_WEST
f44c38859d Jean*0136         IF ( tileHasOBW(bi,bj) ) THEN
                0137 C     Set model variables to OB values on Western Boundary
a34cef4f76 Jean*0138          DO j=1-OLy,sNy+OLy
74019f026d Jean*0139           Iobc = OB_Iw(j,bi,bj)
                0140           IF ( Iobc.NE.OB_indexNone ) THEN
af61e5eb16 Mart*0141            IF ( useSeaiceNeumann ) THEN
                0142 C     Neumann boundary conditions
                0143             HEFF (Iobc,j,bi,bj) = HEFF (Iobc+1,j,bi,bj)
                0144             AREA (Iobc,j,bi,bj) = AREA (Iobc+1,j,bi,bj)
                0145             HSNOW(Iobc,j,bi,bj) = HSNOW(Iobc+1,j,bi,bj)
                0146 #  ifdef SEAICE_VARIABLE_SALINITY
                0147             HSALT(Iobc,j,bi,bj) = HSALT(Iobc+1,j,bi,bj)
                0148 #  endif
                0149            ELSE
3c51c78c8c Jean*0150             HEFF (Iobc,j,bi,bj) = OBWh (j,bi,bj)
                0151             AREA (Iobc,j,bi,bj) = OBWa (j,bi,bj)
                0152             HSNOW(Iobc,j,bi,bj) = OBWsn(j,bi,bj)
af61e5eb16 Mart*0153 #  ifdef SEAICE_VARIABLE_SALINITY
3c51c78c8c Jean*0154             HSALT(Iobc,j,bi,bj) = OBWsl(j,bi,bj)
af61e5eb16 Mart*0155 #  endif
                0156            ENDIF
f44c38859d Jean*0157           ENDIF
                0158          ENDDO
                0159         ENDIF
                0160 #endif /* ALLOW_OBCS_WEST */
                0161 
                0162 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0163 
                0164 #ifdef OBCS_SEAICE_SMOOTH_EDGE
                0165         k = 1
                0166 
                0167 #ifdef ALLOW_OBCS_NORTH
                0168         IF ( tileHasOBN(bi,bj) ) THEN
                0169 C     Northern Boundary
a34cef4f76 Jean*0170          DO i=1-OLx,sNx+OLx
af61e5eb16 Mart*0171           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0172           IF ( Jobc.NE.OB_indexNone ) THEN
f44c38859d Jean*0173            IF ( _maskS(i,Jobc-1,k,bi,bj) .NE. 0. ) THEN
                0174             IF ( SEAICEadvHeff .AND. OBNhfile .NE. ' ' ) THEN
                0175              edge_val = 0.5 _d 0 *
                0176      &           (HEFF(i,Jobc-1,bi,bj)+HEFF(i,Jobc-2,bi,bj))
                0177              HEFF(i,Jobc-1,bi,bj) = edge_val
                0178              HEFF(i,Jobc-2,bi,bj) = edge_val
                0179             ENDIF
                0180             IF ( SEAICEadvArea .AND. OBNafile .NE. ' ' ) THEN
                0181              edge_val = 0.5 _d 0 *
                0182      &           (AREA(i,Jobc-1,bi,bj)+AREA(i,Jobc-2,bi,bj))
                0183              AREA(i,Jobc-1,bi,bj) = edge_val
                0184              AREA(i,Jobc-2,bi,bj) = edge_val
                0185             ENDIF
                0186             IF ( SEAICEadvSNOW .AND. OBNsnfile .NE. ' ' ) THEN
                0187              edge_val = 0.5 _d 0 *
                0188      &           (HSNOW(i,Jobc-1,bi,bj)+HSNOW(i,Jobc-2,bi,bj))
                0189              HSNOW(i,Jobc-1,bi,bj) = edge_val
                0190              HSNOW(i,Jobc-2,bi,bj) = edge_val
                0191             ENDIF
a98c4b8072 Ian *0192 #  ifdef SEAICE_VARIABLE_SALINITY
f44c38859d Jean*0193             IF ( SEAICEadvSALT .AND. OBNslfile .NE. ' ' ) THEN
                0194              edge_val = 0.5 _d 0 *
                0195      &           (HSALT(i,Jobc-1,bi,bj)+HSALT(i,Jobc-2,bi,bj))
                0196              HSALT(i,Jobc-1,bi,bj) = edge_val
                0197              HSALT(i,Jobc-2,bi,bj) = edge_val
                0198             ENDIF
                0199 #  endif
330efc3489 Dimi*0200            ENDIF
f44c38859d Jean*0201           ENDIF
                0202          ENDDO
                0203         ENDIF
                0204 #endif /* ALLOW_OBCS_NORTH */
                0205 
                0206 #ifdef ALLOW_OBCS_SOUTH
                0207         IF ( tileHasOBS(bi,bj) ) THEN
                0208 C     Southern Boundary
a34cef4f76 Jean*0209          DO i=1-OLx,sNx+OLx
af61e5eb16 Mart*0210           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0211           IF ( Jobc.NE.OB_indexNone ) THEN
f44c38859d Jean*0212            IF ( _maskS(i,Jobc+2,k,bi,bj) .NE. 0. ) THEN
                0213             IF ( SEAICEadvHeff .AND. OBNhfile .NE. ' ' ) THEN
                0214              edge_val = 0.5 _d 0 *
                0215      &           (HEFF(i,Jobc+1,bi,bj)+HEFF(i,Jobc+2,bi,bj))
                0216              HEFF(i,Jobc+1,bi,bj) = edge_val
                0217              HEFF(i,Jobc+2,bi,bj) = edge_val
                0218             ENDIF
                0219             IF ( SEAICEadvArea .AND. OBNafile .NE. ' ' ) THEN
                0220              edge_val = 0.5 _d 0 *
                0221      &           (AREA(i,Jobc+1,bi,bj)+AREA(i,Jobc+2,bi,bj))
                0222              AREA(i,Jobc+1,bi,bj) = edge_val
                0223              AREA(i,Jobc+2,bi,bj) = edge_val
                0224             ENDIF
                0225             IF ( SEAICEadvSNOW .AND. OBNsnfile .NE. ' ' ) THEN
                0226              edge_val = 0.5 _d 0 *
                0227      &           (HSNOW(i,Jobc+1,bi,bj)+HSNOW(i,Jobc+2,bi,bj))
                0228              HSNOW(i,Jobc+1,bi,bj) = edge_val
                0229              HSNOW(i,Jobc+2,bi,bj) = edge_val
                0230             ENDIF
a98c4b8072 Ian *0231 #  ifdef SEAICE_VARIABLE_SALINITY
f44c38859d Jean*0232             IF ( SEAICEadvSALT .AND. OBNslfile .NE. ' ' ) THEN
                0233              edge_val = 0.5 _d 0 *
                0234      &           (HSALT(i,Jobc+1,bi,bj)+HSALT(i,Jobc+2,bi,bj))
                0235              HSALT(i,Jobc+1,bi,bj) = edge_val
                0236              HSALT(i,Jobc+2,bi,bj) = edge_val
                0237             ENDIF
                0238 #  endif
330efc3489 Dimi*0239            ENDIF
f44c38859d Jean*0240           ENDIF
                0241          ENDDO
                0242         ENDIF
                0243 #endif /* ALLOW_OBCS_SOUTH */
                0244 
                0245 #ifdef ALLOW_OBCS_EAST
                0246         IF ( tileHasOBE(bi,bj) ) THEN
                0247 C     Eastern Boundary
a34cef4f76 Jean*0248          DO j=1-OLy,sNy+OLy
af61e5eb16 Mart*0249           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0250           IF ( Iobc.NE.OB_indexNone ) THEN
f44c38859d Jean*0251            IF ( _maskW(Iobc-1,j,k,bi,bj) .NE. 0. ) THEN
                0252             IF ( SEAICEadvHeff .AND. OBNhfile .NE. ' ' ) THEN
                0253              edge_val = 0.5 _d 0 *
                0254      &           (HEFF(Iobc-1,j,bi,bj)+HEFF(Iobc-2,j,bi,bj))
                0255              HEFF(Iobc-1,j,bi,bj) = edge_val
                0256              HEFF(Iobc-2,j,bi,bj) = edge_val
                0257             ENDIF
                0258             IF ( SEAICEadvArea .AND. OBNafile .NE. ' ' ) THEN
                0259              edge_val = 0.5 _d 0 *
                0260      &           (AREA(Iobc-1,j,bi,bj)+AREA(Iobc-2,j,bi,bj))
                0261              AREA(Iobc-1,j,bi,bj) = edge_val
                0262              AREA(Iobc-2,j,bi,bj) = edge_val
                0263             ENDIF
                0264             IF ( SEAICEadvSNOW .AND. OBNsnfile .NE. ' ' ) THEN
                0265              edge_val = 0.5 _d 0 *
                0266      &           (HSNOW(Iobc-1,j,bi,bj)+HSNOW(Iobc-2,j,bi,bj))
                0267              HSNOW(Iobc-1,j,bi,bj) = edge_val
                0268              HSNOW(Iobc-2,j,bi,bj) = edge_val
                0269             ENDIF
a98c4b8072 Ian *0270 #  ifdef SEAICE_VARIABLE_SALINITY
f44c38859d Jean*0271             IF ( SEAICEadvSALT .AND. OBNslfile .NE. ' ' ) THEN
                0272              edge_val = 0.5 _d 0 *
                0273      &           (HSALT(Iobc-1,j,bi,bj)+HSALT(Iobc-2,j,bi,bj))
                0274              HSALT(Iobc-1,j,bi,bj) = edge_val
                0275              HSALT(Iobc-2,j,bi,bj) = edge_val
                0276             ENDIF
                0277 #  endif
330efc3489 Dimi*0278            ENDIF
f44c38859d Jean*0279           ENDIF
                0280          ENDDO
                0281         ENDIF
                0282 #endif /* ALLOW_OBCS_EAST */
                0283 
                0284 #ifdef ALLOW_OBCS_WEST
                0285         IF ( tileHasOBW(bi,bj) ) THEN
                0286 C     Western Boundary
a34cef4f76 Jean*0287          DO j=1-OLy,sNy+OLy
74019f026d Jean*0288           Iobc = OB_Iw(j,bi,bj)
                0289           IF ( Iobc.NE.OB_indexNone ) THEN
f44c38859d Jean*0290            IF ( _maskW(Iobc+2,j,k,bi,bj) .NE. 0. ) THEN
                0291             IF ( SEAICEadvHeff .AND. OBNhfile .NE. ' ' ) THEN
                0292              edge_val = 0.5 _d 0 *
                0293      &           (HEFF(Iobc+1,j,bi,bj)+HEFF(Iobc+2,j,bi,bj))
                0294              HEFF(Iobc+1,j,bi,bj) = edge_val
                0295              HEFF(Iobc+2,j,bi,bj) = edge_val
                0296             ENDIF
                0297             IF ( SEAICEadvArea .AND. OBNafile .NE. ' ' ) THEN
                0298              edge_val = 0.5 _d 0 *
                0299      &           (AREA(Iobc+1,j,bi,bj)+AREA(Iobc+2,j,bi,bj))
                0300              AREA(Iobc+1,j,bi,bj) = edge_val
                0301              AREA(Iobc+2,j,bi,bj) = edge_val
                0302             ENDIF
                0303             IF ( SEAICEadvSNOW .AND. OBNsnfile .NE. ' ' ) THEN
                0304              edge_val = 0.5 _d 0 *
                0305      &           (HSNOW(Iobc+1,j,bi,bj)+HSNOW(Iobc+2,j,bi,bj))
                0306              HSNOW(Iobc+1,j,bi,bj) = edge_val
                0307              HSNOW(Iobc+2,j,bi,bj) = edge_val
                0308             ENDIF
a98c4b8072 Ian *0309 #  ifdef SEAICE_VARIABLE_SALINITY
f44c38859d Jean*0310             IF ( SEAICEadvSALT .AND. OBNslfile .NE. ' ' ) THEN
                0311              edge_val = 0.5 _d 0 *
                0312      &           (HSALT(Iobc+1,j,bi,bj)+HSALT(Iobc+2,j,bi,bj))
                0313              HSALT(Iobc+1,j,bi,bj) = edge_val
                0314              HSALT(Iobc+2,j,bi,bj) = edge_val
                0315             ENDIF
330efc3489 Dimi*0316 #  endif
f44c38859d Jean*0317            ENDIF
330efc3489 Dimi*0318           ENDIF
f44c38859d Jean*0319          ENDDO
                0320         ENDIF
0f64a7d6fb Dimi*0321 #endif /* ALLOW_OBCS_WEST */
                0322 
f44c38859d Jean*0323 #endif /* OBCS_SEAICE_SMOOTH_EDGE */
                0324 
0f64a7d6fb Dimi*0325        ENDDO
                0326       ENDDO
                0327 
c7c4b57180 Dimi*0328 #ifdef ALLOW_OBCS_SEAICE_SPONGE
                0329       IF ( useSeaiceSponge ) THEN
                0330        CALL OBCS_SEAICE_SPONGE_A( myThid )
                0331        CALL OBCS_SEAICE_SPONGE_H( myThid )
                0332       ENDIF
                0333 #endif /* ALLOW_OBCS_SEAICE_SPONGE */
                0334 
af61e5eb16 Mart*0335 #endif /* defined ALLOW_OBCS and defined ALLOW_SEAICE */
0f64a7d6fb Dimi*0336 
                0337       RETURN
                0338       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!