Changeset 4984 for branches/2014
- Timestamp:
- 2014-12-12T17:58:00+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 3 edited
-
agrif_oce.F90 (modified) (1 diff)
-
agrif_opa_interp.F90 (modified) (5 diffs)
-
agrif_user.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
r4978 r4984 67 67 INTEGER :: scales_t_id 68 68 INTEGER :: avt_id, avm_id, avmu_id, avmv_id 69 INTEGER :: umsk_id, vmsk_id 70 INTEGER :: kindic_agr 69 71 70 72 !!---------------------------------------------------------------------- -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r4789 r4984 41 41 PUBLIC interptsn, interpsshn 42 42 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 43 PUBLIC interpe3t 43 PUBLIC interpe3t, interpumsk, interpvmsk 44 44 # if defined key_zdftke 45 45 PUBLIC Agrif_tke, interpavt, interpavm, interpavmu, interpavmv … … 1165 1165 SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1166 1166 !!---------------------------------------------------------------------- 1167 !! *** ROUTINE interp v***1167 !! *** ROUTINE interpe3t *** 1168 1168 !!---------------------------------------------------------------------- 1169 1169 ! … … 1174 1174 ! 1175 1175 INTEGER :: ji, jj, jk 1176 INTEGER :: icnt1177 LOGICAL :: western_side, eastern_side,northern_side,southern_side1176 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1177 REAL(wp) :: ztmpmsk 1178 1178 !!---------------------------------------------------------------------- 1179 1179 ! … … 1182 1182 DO jj=j1,j2 1183 1183 DO ji=i1,i2 1184 ptab(ji,jj,jk) = tmask(ji,jj,jk) * fse3t(ji,jj,jk)1184 ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 1185 1185 END DO 1186 1186 END DO … … 1192 1192 northern_side = (nb == 2).AND.(ndir == 2) 1193 1193 1194 icnt = 01195 1194 DO jk=k1,k2 1196 1195 DO jj=j1,j2 1197 1196 DO ji=i1,i2 1198 IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * fse3t(ji,jj,jk)) > 1.D-2) THEN 1197 ! Get velocity mask at boundary edge points: 1198 IF (western_side) ztmpmsk = umask(ji ,jj ,1) 1199 IF (eastern_side) ztmpmsk = umask(nlci-2,jj ,1) 1200 IF (northern_side) ztmpmsk = vmask(ji ,nlcj-2,1) 1201 IF (southern_side) ztmpmsk = vmask(ji ,2 ,1) 1202 1203 IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN 1199 1204 IF (western_side) THEN 1200 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji ,jj,jk1205 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1201 1206 ELSEIF (eastern_side) THEN 1202 WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji ,jj,jk1207 WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1203 1208 ELSEIF (southern_side) THEN 1204 WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji ,jj,jk1209 WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1205 1210 ELSEIF (northern_side) THEN 1206 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji ,jj,jk1211 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1207 1212 ENDIF 1208 WRITE(numout,*) ' ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), fse3t(ji,jj,jk)1209 icnt = icnt+ 11213 WRITE(numout,*) ' ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1214 kindic_agr = kindic_agr + 1 1210 1215 ENDIF 1211 1216 END DO 1212 1217 END DO 1213 1218 END DO 1214 IF(icnt /= 0) THEN 1215 CALL ctl_stop('ERROR in bathymetry merge between parent and child grids...') 1216 ELSE 1217 IF(lwp) WRITE(numout,*) 'interp e3t ok...' 1218 END IF 1219 1219 1220 ENDIF 1220 1221 ! 1221 1222 END SUBROUTINE interpe3t 1223 1224 SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1225 !!---------------------------------------------------------------------- 1226 !! *** ROUTINE interpumsk *** 1227 !!---------------------------------------------------------------------- 1228 ! 1229 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1230 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1231 LOGICAL :: before 1232 INTEGER, INTENT(in) :: nb , ndir 1233 ! 1234 INTEGER :: ji, jj, jk 1235 LOGICAL :: western_side, eastern_side 1236 !!---------------------------------------------------------------------- 1237 ! 1238 IF (before) THEN 1239 DO jk=k1,k2 1240 DO jj=j1,j2 1241 DO ji=i1,i2 1242 ptab(ji,jj,jk) = umask(ji,jj,jk) 1243 END DO 1244 END DO 1245 END DO 1246 ELSE 1247 1248 western_side = (nb == 1).AND.(ndir == 1) 1249 eastern_side = (nb == 1).AND.(ndir == 2) 1250 DO jk=k1,k2 1251 DO jj=j1,j2 1252 DO ji=i1,i2 1253 ! Velocity mask at boundary edge points: 1254 IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN 1255 IF (western_side) THEN 1256 WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1257 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 1258 kindic_agr = kindic_agr + 1 1259 ELSEIF (eastern_side) THEN 1260 WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1261 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 1262 kindic_agr = kindic_agr + 1 1263 ENDIF 1264 ENDIF 1265 END DO 1266 END DO 1267 END DO 1268 1269 ENDIF 1270 ! 1271 END SUBROUTINE interpumsk 1272 1273 SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1274 !!---------------------------------------------------------------------- 1275 !! *** ROUTINE interpvmsk *** 1276 !!---------------------------------------------------------------------- 1277 ! 1278 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1279 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1280 LOGICAL :: before 1281 INTEGER, INTENT(in) :: nb , ndir 1282 ! 1283 INTEGER :: ji, jj, jk 1284 LOGICAL :: northern_side, southern_side 1285 !!---------------------------------------------------------------------- 1286 ! 1287 IF (before) THEN 1288 DO jk=k1,k2 1289 DO jj=j1,j2 1290 DO ji=i1,i2 1291 ptab(ji,jj,jk) = vmask(ji,jj,jk) 1292 END DO 1293 END DO 1294 END DO 1295 ELSE 1296 1297 southern_side = (nb == 2).AND.(ndir == 1) 1298 northern_side = (nb == 2).AND.(ndir == 2) 1299 DO jk=k1,k2 1300 DO jj=j1,j2 1301 DO ji=i1,i2 1302 ! Velocity mask at boundary edge points: 1303 IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN 1304 IF (southern_side) THEN 1305 WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1306 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 1307 kindic_agr = kindic_agr + 1 1308 ELSEIF (northern_side) THEN 1309 WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1310 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 1311 kindic_agr = kindic_agr + 1 1312 ENDIF 1313 ENDIF 1314 END DO 1315 END DO 1316 END DO 1317 1318 ENDIF 1319 ! 1320 END SUBROUTINE interpvmsk 1222 1321 1223 1322 # if defined key_zdftke -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r4982 r4984 279 279 ENDIF 280 280 ENDIF 281 ! check if the bathy metry match 282 IF(ln_chk_bathy) CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 281 ! check if masks and bathymetries match 282 IF(ln_chk_bathy) THEN 283 ! 284 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 285 ! 286 kindic_agr = 0 287 ! check if umask agree with parent along western and eastern boundaries: 288 CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 289 ! check if vmask agree with parent along northern and southern boundaries: 290 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 291 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 292 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 293 ! 294 IF (lk_mpp) CALL mpp_sum( kindic_agr ) 295 IF( kindic_agr /= 0 ) THEN 296 CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 297 ELSE 298 IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 299 END IF 300 ENDIF 283 301 ! 284 302 ENDIF … … 336 354 337 355 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 356 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 357 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 338 358 339 359 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) … … 375 395 376 396 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 397 CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 398 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 377 399 378 400 # if defined key_zdftke … … 403 425 CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 404 426 405 CALL Agrif_Set_bc(e3t_id,(/-3*Agrif_irhox(),0/)) ! if west and rhox=3: column 2 to 11 427 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/)) ! if west and rhox=3: column 2 to 9 428 CALL Agrif_Set_bc(umsk_id,(/0,0/)) 429 CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 406 430 407 431 # if defined key_zdftke … … 417 441 418 442 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 443 419 444 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 420 445 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
Note: See TracChangeset
for help on using the changeset viewer.
