Changeset 12119 for NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90
- Timestamp:
- 2019-12-09T11:55:22+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90
r11868 r12119 43 43 PUBLIC interptsn, interpsshn, interpavm 44 44 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 45 PUBLIC interpe3t , interpumsk, interpvmsk45 PUBLIC interpe3t 46 46 #if defined key_vertical 47 47 PUBLIC interpht0, interpmbkt … … 1132 1132 1133 1133 1134 SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before , nb, ndir)1134 SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before ) 1135 1135 !!---------------------------------------------------------------------- 1136 1136 !! *** ROUTINE interpe3t *** … … 1139 1139 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1140 1140 LOGICAL , INTENT(in ) :: before 1141 INTEGER , INTENT(in ) :: nb , ndir1142 1141 ! 1143 1142 INTEGER :: ji, jj, jk 1144 LOGICAL :: western_side, eastern_side, northern_side, southern_side1145 1143 !!---------------------------------------------------------------------- 1146 1144 ! … … 1148 1146 ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 1149 1147 ELSE 1150 western_side = (nb == 1).AND.(ndir == 1)1151 eastern_side = (nb == 1).AND.(ndir == 2)1152 southern_side = (nb == 2).AND.(ndir == 1)1153 northern_side = (nb == 2).AND.(ndir == 2)1154 1148 ! 1155 1149 DO jk = k1, k2 1156 1150 DO jj = j1, j2 1157 1151 DO ji = i1, i2 1158 !1159 1152 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 1160 IF (western_side.AND.(ptab(i1+nbghostcells-1,jj,jk)>0._wp)) THEN 1161 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1162 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1163 kindic_agr = kindic_agr + 1 1164 ELSEIF (eastern_side.AND.(ptab(i2-nbghostcells+1,jj,jk)>0._wp)) THEN 1165 WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1166 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1167 kindic_agr = kindic_agr + 1 1168 ELSEIF (southern_side.AND.(ptab(ji,j1+nbghostcells-1,jk)>0._wp)) THEN 1169 WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1170 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1171 kindic_agr = kindic_agr + 1 1172 ELSEIF (northern_side.AND.(ptab(ji,j2-nbghostcells+1,jk)>0._wp)) THEN 1173 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1174 WRITE(numout,*) ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1175 kindic_agr = kindic_agr + 1 1176 ENDIF 1153 WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ', & 1154 & ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 1155 & ji+nimpp-1, jj+njmpp-1, jk 1156 kindic_agr = kindic_agr + 1 1177 1157 ENDIF 1178 1158 END DO … … 1183 1163 ! 1184 1164 END SUBROUTINE interpe3t 1185 1186 1187 SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )1188 !!----------------------------------------------------------------------1189 !! *** ROUTINE interpumsk ***1190 !!----------------------------------------------------------------------1191 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k21192 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1193 LOGICAL , INTENT(in ) :: before1194 INTEGER , INTENT(in ) :: nb , ndir1195 !1196 INTEGER :: ji, jj, jk1197 LOGICAL :: western_side, eastern_side1198 !!----------------------------------------------------------------------1199 !1200 IF( before ) THEN1201 ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2)1202 ELSE1203 western_side = (nb == 1).AND.(ndir == 1)1204 eastern_side = (nb == 1).AND.(ndir == 2)1205 DO jk = k1, k21206 DO jj = j1, j21207 DO ji = i1, i21208 ! Velocity mask at boundary edge points:1209 IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN1210 IF (western_side) THEN1211 WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1212 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)1213 kindic_agr = kindic_agr + 11214 ELSEIF (eastern_side) THEN1215 WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1216 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)1217 kindic_agr = kindic_agr + 11218 ENDIF1219 ENDIF1220 END DO1221 END DO1222 END DO1223 !1224 ENDIF1225 !1226 END SUBROUTINE interpumsk1227 1228 1229 SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )1230 !!----------------------------------------------------------------------1231 !! *** ROUTINE interpvmsk ***1232 !!----------------------------------------------------------------------1233 INTEGER , INTENT(in ) :: i1,i2,j1,j2,k1,k21234 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1235 LOGICAL , INTENT(in ) :: before1236 INTEGER , INTENT(in ) :: nb , ndir1237 !1238 INTEGER :: ji, jj, jk1239 LOGICAL :: northern_side, southern_side1240 !!----------------------------------------------------------------------1241 !1242 IF( before ) THEN1243 ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2)1244 ELSE1245 southern_side = (nb == 2).AND.(ndir == 1)1246 northern_side = (nb == 2).AND.(ndir == 2)1247 DO jk = k1, k21248 DO jj = j1, j21249 DO ji = i1, i21250 ! Velocity mask at boundary edge points:1251 IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN1252 IF (southern_side) THEN1253 WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1254 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)1255 kindic_agr = kindic_agr + 11256 ELSEIF (northern_side) THEN1257 WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk1258 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)1259 kindic_agr = kindic_agr + 11260 ENDIF1261 ENDIF1262 END DO1263 END DO1264 END DO1265 !1266 ENDIF1267 !1268 END SUBROUTINE interpvmsk1269 1165 1270 1166
Note: See TracChangeset
for help on using the changeset viewer.