** Warning **
Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.
Last-Modified: Fri, 16 May 2024 05:11:24 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/pkg/streamice/streamice_velmask_upd.F
File indexing completed on 2023-09-21 05:10:52 UTC
view on github raw file Latest commit 96b00645 on 2023-09-20 15:15:14 UTC
5ca83cd8f7 Dani* 0001 #include "STREAMICE_OPTIONS.h "
9d8b0af494 Jean* 0002 #ifdef ALLOW_AUTODIFF
0003 # include "AUTODIFF_OPTIONS.h "
0004 #endif
5ca83cd8f7 Dani* 0005
0006
0007
0008
0009 SUBROUTINE STREAMICE_VELMASK_UPD ( myThid )
0010
0011
a786b53e82 Jean* 0012
5ca83cd8f7 Dani* 0013
0014
0015
0016
0017 IMPLICIT NONE
0018
0019
0020 #include "SIZE.h "
0021 #include "GRID.h "
0022 #include "EEPARAMS.h "
0023 #include "PARAMS.h "
0024 #include "STREAMICE.h "
96b006450c dngo* 0025
0026
0027
0028
0029
0030
5ca83cd8f7 Dani* 0031
9ffe7276d5 Dani* 0032 #ifdef ALLOW_AUTODIFF_TAMC
0033 # include "tamc.h "
0034 #endif
0035
5ca83cd8f7 Dani* 0036 INTEGER myThid
0037
0038 #ifdef ALLOW_STREAMICE
0039
0040 INTEGER i , j , bi , bj , ki , kj
96b006450c dngo* 0041 INTEGER maskFlag
5ca83cd8f7 Dani* 0042 #ifdef ALLOW_USE_MPI
0043 integer mpiRC , mpiMyWid
0044 #endif
0045 #ifdef ALLOW_PETSC
96b006450c dngo* 0046 INTEGER myThidCopy
5ca83cd8f7 Dani* 0047 _RS DoFCount
0048 integer n_dofs_proc_loc (0:nPx *nPy -1)
0049 integer n_dofs_cum_sum (0:nPx *nPy -1)
0050 #endif
0051
0052 _EXCH_XY_RL ( H_streamice , myThid )
0053 _EXCH_XY_RL ( area_shelf_streamice , myThid )
f1d1cc05cd Dani* 0054 _EXCH_XY_RS ( STREAMICE_hmask , myThid )
5ca83cd8f7 Dani* 0055
0056 DO bj =myByLo (myThid ),myByHi (myThid )
0057 DO bi =myBxLo (myThid ),myBxHi (myThid )
0058 DO j =1-OLy ,sNy +OLy
0059 DO i =1-OLx ,sNx +OLx
bdd8102d3e Dani* 0060 STREAMICE_umask (i ,j ,bi ,bj ) = -1. _d 0
0061 STREAMICE_vmask (i ,j ,bi ,bj ) = -1. _d 0
5ca83cd8f7 Dani* 0062 STREAMICE_ufacemask (i ,j ,bi ,bj ) = 0. _d 0
0063 STREAMICE_vfacemask (i ,j ,bi ,bj ) = 0. _d 0
0064 ENDDO
0065 ENDDO
0066 ENDDO
0067 ENDDO
0068
0069 DO bj =myByLo (myThid ),myByHi (myThid )
0070 DO bi =myBxLo (myThid ),myBxHi (myThid )
0071 DO j =0,sNy +1
0072 DO i =0,sNx +1
bdd8102d3e Dani* 0073 IF (STREAMICE_hmask (i ,j ,bi ,bj ) .eq. 1.0) THEN
5ca83cd8f7 Dani* 0074
0075 DO kj =0,1
0076 DO ki =0,1
bdd8102d3e Dani* 0077 if (STREAMICE_umask (i +ki ,j +kj ,bi ,bj ).eq. -1.0) then
0078 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 1.0
0079 endif
0080 if (STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ).eq. -1.0) then
0081 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 1.0
0082 endif
5ca83cd8f7 Dani* 0083 ENDDO
0084 ENDDO
0085
0086 DO ki =0,1
0087 maskFlag =INT(STREAMICE_ufacemask_bdry (i +ki ,j ,bi ,bj ))
0088 IF (maskFlag .EQ. 3) THEN
0089 DO kj =0,1
bdd8102d3e Dani* 0090 if (STREAMICE_umask (i +ki ,j +kj ,bi ,bj ).ne. 0.0) then
0091 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 3.0
0092 endif
0093 if (STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ).ne. 0.0) then
0094 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 3.0
0095 endif
5ca83cd8f7 Dani* 0096 ENDDO
0097 STREAMICE_ufacemask (i +ki ,j ,bi ,bj ) = 3.0
0098 ELSE IF (maskFlag .EQ. 2) THEN
96b006450c dngo* 0099
5ca83cd8f7 Dani* 0100 STREAMICE_ufacemask (i +ki ,j ,bi ,bj ) = 2.0
96b006450c dngo* 0101
5ca83cd8f7 Dani* 0102 ELSE IF (maskFlag .EQ. 4) THEN
0103 DO kj =0,1
0104 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 0.0
a786b53e82 Jean* 0105 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 0.0
5ca83cd8f7 Dani* 0106 ENDDO
0107 STREAMICE_ufacemask (i +ki ,j ,bi ,bj ) = 4.0
0108 ELSE IF (maskFlag .EQ. 0) THEN
0109 DO kj =0,1
0110 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 0.0
a786b53e82 Jean* 0111 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 0.0
5ca83cd8f7 Dani* 0112 ENDDO
0113 STREAMICE_ufacemask (i +ki ,j ,bi ,bj ) = 0.0
0114 ELSE IF (maskFlag .EQ. 1) THEN
0115 DO kj =0,1
0116 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 0.0
0117 ENDDO
0118 END IF
0119 ENDDO
0120
0121 DO kj =0,1
0122 maskFlag =INT(STREAMICE_vfacemask_bdry (i ,j +kj ,bi ,bj ))
0123 IF (maskFlag .EQ. 3) THEN
0124 DO ki =0,1
bdd8102d3e Dani* 0125 if (STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ).ne. 0.0) then
0126 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 3.0
0127 endif
0128 if (STREAMICE_umask (i +ki ,j +kj ,bi ,bj ).ne. 0.0) then
0129 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 3.0
0130 endif
5ca83cd8f7 Dani* 0131 ENDDO
0132 STREAMICE_vfacemask (i ,j +kj ,bi ,bj ) = 3.0
0133 ELSE IF (maskFlag .EQ. 2) THEN
96b006450c dngo* 0134
5ca83cd8f7 Dani* 0135 STREAMICE_vfacemask (i ,j +kj ,bi ,bj ) = 2.0
96b006450c dngo* 0136
5ca83cd8f7 Dani* 0137 ELSE IF (maskFlag .EQ. 4) THEN
0138 DO ki =0,1
0139 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 0.0
a786b53e82 Jean* 0140 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 0.0
5ca83cd8f7 Dani* 0141 ENDDO
0142 STREAMICE_vfacemask (i ,j +kj ,bi ,bj ) = 4.0
0143 ELSE IF (maskFlag .EQ. 0) THEN
0144 DO ki =0,1
0145 STREAMICE_umask (i +ki ,j +kj ,bi ,bj ) = 0.0
a786b53e82 Jean* 0146 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 0.0
5ca83cd8f7 Dani* 0147 ENDDO
0148 STREAMICE_vfacemask (i +ki ,j ,bi ,bj ) = 0.0
0149 ELSE IF (maskFlag .EQ. 1) THEN
0150 DO ki =0,1
0151 STREAMICE_vmask (i +ki ,j +kj ,bi ,bj ) = 0.0
0152 ENDDO
0153 ENDIF
0154 ENDDO
0155
0156 IF (i .lt. sNx +OLx ) THEN
0157 IF ((STREAMICE_hmask (i +1,j ,bi ,bj ) .eq. 0.0) .OR.
0158 & (STREAMICE_hmask (i +1,j ,bi ,bj ) .eq. 2.0)) THEN
96b006450c dngo* 0159
5ca83cd8f7 Dani* 0160 STREAMICE_ufacemask (i +1,j ,bi ,bj ) = 2.0
0161 ENDIF
0162 ENDIF
0163
0164 IF (i .gt. 1-OLx ) THEN
0165 IF ((STREAMICE_hmask (i -1,j ,bi ,bj ) .eq. 0.0) .OR.
0166 & (STREAMICE_hmask (i -1,j ,bi ,bj ) .eq. 2.0)) THEN
96b006450c dngo* 0167
5ca83cd8f7 Dani* 0168 STREAMICE_ufacemask (i ,j ,bi ,bj ) = 2
0169 ENDIF
0170 ENDIF
0171
0172 IF (j .lt. sNy +OLy ) THEN
0173 IF ((STREAMICE_hmask (i ,j +1,bi ,bj ) .eq. 0.0) .OR.
0174 & (STREAMICE_hmask (i ,j +1,bi ,bj ) .eq. 2.0)) THEN
96b006450c dngo* 0175
5ca83cd8f7 Dani* 0176 STREAMICE_vfacemask (i ,j +1,bi ,bj ) = 2
0177 ENDIF
0178 ENDIF
0179
0180 IF (j .gt. 1-OLy ) THEN
0181 IF ((STREAMICE_hmask (i ,j -1,bi ,bj ) .eq. 0.0) .OR.
0182 & (STREAMICE_hmask (i ,j -1,bi ,bj ) .eq. 2.0)) THEN
96b006450c dngo* 0183
5ca83cd8f7 Dani* 0184 STREAMICE_vfacemask (i ,j ,bi ,bj ) = 2.0
0185 ENDIF
0186 ENDIF
0187
0188 ENDIF
0189 ENDDO
0190 ENDDO
0191 ENDDO
0192 ENDDO
0193
96b006450c dngo* 0194
0195
9ffe7276d5 Dani* 0196
bdd8102d3e Dani* 0197 DO bj =myByLo (myThid ),myByHi (myThid )
0198 DO bi =myBxLo (myThid ),myBxHi (myThid )
9ffe7276d5 Dani* 0199 DO j =1,sNy
0200 DO i =1,sNx
bdd8102d3e Dani* 0201 IF (streamice_umask (i ,j ,bi ,bj ).eq. -1.0) THEN
9ffe7276d5 Dani* 0202 streamice_umask (i ,j ,bi ,bj )=0.0
bdd8102d3e Dani* 0203 ENDIF
0204 IF (streamice_vmask (i ,j ,bi ,bj ).eq. -1.0) THEN
9ffe7276d5 Dani* 0205 streamice_vmask (i ,j ,bi ,bj )=0.0
bdd8102d3e Dani* 0206 ENDIF
0207 ENDDO
0208 ENDDO
0209 ENDDO
0210 ENDDO
0211
f1d1cc05cd Dani* 0212 _EXCH_XY_RS ( STREAMICE_ufacemask , myThid )
0213 _EXCH_XY_RS ( STREAMICE_vfacemask , myThid )
0214 _EXCH_XY_RS ( STREAMICE_umask , myThid )
0215 _EXCH_XY_RS ( STREAMICE_vmask , myThid )
5ca83cd8f7 Dani* 0216
96b006450c dngo* 0217
0218
0219
0220
0221
0222
5ca83cd8f7 Dani* 0223
0224 #ifdef ALLOW_PETSC
8514c76b91 Dani* 0225 myThidCopy = myThid
18a089944d Dani* 0226 if (streamice_use_petsc ) then
8514c76b91 Dani* 0227 call streamice_petsc_numerate (myThidCopy )
18a089944d Dani* 0228 endif
67b4a2b594 Dani* 0229 #endif
5ca83cd8f7 Dani* 0230
0231 #endif
0232 RETURN
0233 END