Changeset 5945
- Timestamp:
- 2015-11-29T20:44:49+01:00 (8 years ago)
- Location:
- branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 12 edited
-
DIA/diaharm.F90 (modified) (2 diffs)
-
DIA/diahsb.F90 (modified) (2 diffs)
-
DOM/domain.F90 (modified) (1 diff)
-
DOM/domngb.F90 (modified) (2 diffs)
-
DOM/domvvl.F90 (modified) (2 diffs)
-
DOM/domzgr.F90 (modified) (41 diffs)
-
DOM/iscplhsb.F90 (modified) (9 diffs)
-
DOM/iscplrst.F90 (modified) (16 diffs)
-
DYN/divcur.F90 (modified) (2 diffs)
-
DYN/dynnxt.F90 (modified) (1 diff)
-
LBC/lbclnk.F90 (modified) (4 diffs)
-
TRA/trasbc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r5619 r5945 137 137 DO jk=1,nb_ana 138 138 DO ji=1,jpmax_harmo 139 IF (TRIM(tname(jk)) .eq.Wave(ji)%cname_tide) THEN139 IF (TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN 140 140 name(jk) = ji 141 141 EXIT … … 490 490 DO jj_sd = ji_sd, ninco 491 491 zval2 = ABS(ztmp3(ji_sd,jj_sd)) 492 IF( zval2 .GE.zval1 )THEN492 IF( zval2 >= zval1 )THEN 493 493 ipivot(ji_sd) = jj_sd 494 494 zval1 = zval2 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5823 r5945 202 202 ! ENDIF 203 203 !!gm end 204 204 205 IF( lk_vvl ) THEN 205 206 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) … … 276 277 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 277 278 IF(lwp) WRITE(numout,*) '~~~~~~~' 278 surf_ini(:,:) = e1 t(:,:) * e2t(:,:) * tmask_i(:,:)! initial ocean surface279 ssh_ini(:,:) = sshn(:,:) 279 surf_ini(:,:) = e12t(:,:) * tmask_i(:,:) ! initial ocean surface 280 ssh_ini(:,:) = sshn(:,:) ! initial ssh 280 281 DO jk = 1, jpk 281 282 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5932 r5945 324 324 WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla 325 325 ENDIF 326 IF ( nn_cla .EQ.1 ) THEN326 IF ( nn_cla == 1 ) THEN 327 327 IF ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 328 328 CONTINUE -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
r5779 r5945 43 43 CHARACTER(len=1), INTENT(in ) :: cdgrid ! grid name 'T', 'U', 'V', 'W' 44 44 ! 45 INTEGER :: ik ! working level 45 46 INTEGER , DIMENSION(2) :: iloc 46 INTEGER :: jk47 47 REAL(wp) :: zlon, zmini 48 48 REAL(wp), POINTER, DIMENSION(:,:) :: zglam, zgphi, zmask, zdist … … 54 54 ! 55 55 zmask(:,:) = 0._wp 56 jk = 157 IF ( PRESENT(kkk)) jk=kkk56 ik = 1 57 IF ( PRESENT(kkk) ) ik=kkk 58 58 SELECT CASE( cdgrid ) 59 CASE( 'U' ) ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej, jk)60 CASE( 'V' ) ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej, jk)61 CASE( 'F' ) ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej, jk)62 CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej, jk)59 CASE( 'U' ) ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik) 60 CASE( 'V' ) ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik) 61 CASE( 'F' ) ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik) 62 CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik) 63 63 END SELECT 64 64 65 IF (jphgr_msh .NE. 2 .AND. jphgr_msh .NE.3) THEN65 IF (jphgr_msh /= 2 .AND. jphgr_msh /= 3) THEN 66 66 zlon = MOD( plon + 720., 360. ) ! plon between 0 and 360 67 67 zglam(:,:) = MOD( zglam(:,:) + 720., 360. ) ! glam between 0 and 360 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5779 r5945 332 332 ! -------------------------------------------------- 333 333 IF( ln_vvl_ztilde ) THEN 334 IF( kt .GT.nit000 ) THEN334 IF( kt > nit000 ) THEN 335 335 DO jk = 1, jpkm1 336 336 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:) & … … 426 426 IF( lk_mpp ) CALL mpp_min( z_tmin ) ! min over the global domain 427 427 ! - ML - test: for the moment, stop simulation for too large e3_t variations 428 IF( ( z_tmax .GT. rn_zdef_max ) .OR. ( z_tmin .LT.- rn_zdef_max ) ) THEN428 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 429 429 IF( lk_mpp ) THEN 430 430 CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) ) -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5932 r5945 531 531 ! set grounded point to 0 532 532 ! (a treshold could be set here if needed, or set it offline based on the grounded fraction) 533 WHERE ( bathy(:,:) .LE.risfdep(:,:) + rn_isfhmin )533 WHERE ( bathy(:,:) <= risfdep(:,:) + rn_isfhmin ) 534 534 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 535 535 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp … … 824 824 END SUBROUTINE zgr_bot_level 825 825 826 827 !!---------------------------------------------------------------------- 828 !! *** ROUTINE zgr_ bot_level ***826 SUBROUTINE zgr_top_level 827 !!---------------------------------------------------------------------- 828 !! *** ROUTINE zgr_top_level *** 829 829 !! 830 830 !! ** Purpose : defines the vertical index of ocean top (mik. arrays) … … 1149 1149 gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 1150 1150 END DO 1151 IF (misfdep(ji,jj) .GE.2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))1151 IF (misfdep(ji,jj) >= 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 1152 1152 DO jk = misfdep(ji,jj) + 1, jpk 1153 1153 gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) … … 1204 1204 !! Bathymetry and isfdraft are modified (dig/close) to respect 1205 1205 !! this criterion. 1206 !!1207 1206 !! 1208 1207 !! ** Action : - test compatibility between isfdraft and bathy … … 1212 1211 INTEGER :: ji, jj, jl, jk ! dummy loop indices 1213 1212 INTEGER :: ik, it ! temporary integers 1214 INTEGER :: icompt, ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1 ! (ISF) 1213 INTEGER :: icompt, ibtest ! (ISF) 1214 INTEGER :: ibtestim1, ibtestip1 ! (ISF) 1215 INTEGER :: ibtestjm1, ibtestjp1 ! (ISF) 1215 1216 REAL(wp) :: zdepth ! Ajusted ocean depth to avoid too small e3t 1216 1217 REAL(wp) :: zmax ! Maximum and minimum depth 1217 REAL(wp) :: zbathydiff, zrisfdepdiff ! isf temporary scalar 1218 REAL(wp) :: zbathydiff ! isf temporary scalar 1219 REAL(wp) :: zrisfdepdiff ! isf temporary scalar 1218 1220 REAL(wp) :: ze3tp , ze3wp ! Last ocean level thickness at T- and W-points 1219 1221 REAL(wp) :: zdepwp ! Ajusted ocean depth to avoid too small e3t … … 1229 1231 1230 1232 ! (ISF) compute misfdep 1231 WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) .NE. 0) ; misfdep(:,:) = 1 ! open water : set misfdep to 11232 ELSEWHERE ; 1233 WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ; misfdep(:,:) = 1 ! open water : set misfdep to 1 1234 ELSEWHERE ; misfdep(:,:) = 2 ! iceshelf : initialize misfdep to second level 1233 1235 END WHERE 1234 1236 … … 1241 1243 WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth ) misfdep(:,:) = jk+1 1242 1244 END DO 1243 WHERE ( risfdep(:,:) <= e3t_1d(1) .AND. risfdep(:,:) .GT. 0._wp)1245 WHERE ( 0._wp < risfdep(:,:) .AND. risfdep(:,:) <= e3t_1d(1) ) 1244 1246 risfdep(:,:) = 0. ; misfdep(:,:) = 1 1245 1247 END WHERE … … 1250 1252 DO jl = 1, 10 1251 1253 ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments) 1252 WHERE (bathy(:,:) .LE.risfdep(:,:) + rn_isfhmin)1254 WHERE (bathy(:,:) <= risfdep(:,:) + rn_isfhmin) 1253 1255 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 1254 1256 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp … … 1259 1261 ENDWHERE 1260 1262 IF( lk_mpp ) THEN 1261 zbathy(:,:) = FLOAT( misfdep(:,:) )1263 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1262 1264 CALL lbc_lnk( zbathy, 'T', 1. ) 1263 1265 misfdep(:,:) = INT( zbathy(:,:) ) 1264 CALL lbc_lnk( risfdep, 'T', 1. ) 1265 CALL lbc_lnk( bathy, 'T', 1. ) 1266 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1266 1267 CALL lbc_lnk( risfdep,'T', 1. ) 1268 CALL lbc_lnk( bathy, 'T', 1. ) 1269 1270 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1267 1271 CALL lbc_lnk( zbathy, 'T', 1. ) 1268 mbathy(:,:) = INT( zbathy(:,:) )1272 mbathy(:,:) = INT( zbathy(:,:) ) 1269 1273 ENDIF 1274 ! JMM : lbc_lnk must do it ? no ??? 1270 1275 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 1271 misfdep( 1 ,:) = misfdep(jpim1,:) ! local domain is cyclic east-west1276 misfdep( 1 ,:) = misfdep(jpim1,:) ! local domain is cyclic east-west 1272 1277 misfdep(jpi,:) = misfdep( 2 ,:) 1273 ENDIF 1274 1275 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 1276 mbathy( 1 ,:) = mbathy(jpim1,:) ! local domain is cyclic east-west 1277 mbathy(jpi,:) = mbathy( 2 ,:) 1278 mbathy( 1 ,:) = mbathy(jpim1,:) ! local domain is cyclic east-west 1279 mbathy(jpi,:) = mbathy( 2 ,:) 1278 1280 ENDIF 1279 1281 … … 1305 1307 ! find the minimum change option: 1306 1308 ! test bathy 1307 IF (risfdep(ji,jj) .GT.1) THEN1309 IF (risfdep(ji,jj) > 1) THEN 1308 1310 IF ( .NOT. ln_iscpl ) THEN 1309 1311 zbathydiff =ABS(bathy(ji,jj) - (gdepw_1d(mbathy (ji,jj)+1) & … … 1312 1314 & - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 1313 1315 1314 IF (bathy(ji,jj) .GT. risfdep(ji,jj) .AND. mbathy(ji,jj) .LT.misfdep(ji,jj)) THEN1315 IF (zbathydiff .LE.zrisfdepdiff) THEN1316 IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) < misfdep(ji,jj)) THEN 1317 IF (zbathydiff <= zrisfdepdiff) THEN 1316 1318 bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat ) 1317 1319 mbathy(ji,jj)= mbathy(ji,jj) + 1 … … 1322 1324 ENDIF 1323 1325 ELSE 1324 IF (bathy(ji,jj) .GT. risfdep(ji,jj) .AND. mbathy(ji,jj) .LT.misfdep(ji,jj)) THEN1326 IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) < misfdep(ji,jj)) THEN 1325 1327 risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ) 1326 1328 misfdep(ji,jj) = misfdep(ji,jj) - 1 … … 1331 1333 END DO 1332 1334 1333 1335 ! At least 2 levels for water thickness at T, U, and V point. 1334 1336 DO jj = 1, jpj 1335 1337 DO ji = 1, jpi 1336 1338 ! find the minimum change option: 1337 1339 ! test bathy 1338 IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT.1) THEN1340 IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 1339 1341 IF ( .NOT. ln_iscpl ) THEN 1340 1342 zbathydiff =ABS(bathy(ji,jj) - ( gdepw_1d(mbathy (ji,jj)+1) & … … 1342 1344 zrisfdepdiff=ABS(risfdep(ji,jj) - ( gdepw_1d(misfdep(ji,jj) ) & 1343 1345 & - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 1344 IF (zbathydiff .LE.zrisfdepdiff) THEN1346 IF (zbathydiff <= zrisfdepdiff) THEN 1345 1347 mbathy(ji,jj) = mbathy(ji,jj) + 1 1346 1348 bathy(ji,jj) = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) … … 1360 1362 DO jj = 1, jpjm1 1361 1363 DO ji = 1, jpim1 1362 IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT.1) THEN1364 IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 1363 1365 IF ( .NOT. ln_iscpl ) THEN 1364 1366 zbathydiff =ABS(bathy(ji,jj ) - ( gdepw_1d(mbathy (ji,jj)+1) & … … 1366 1368 zrisfdepdiff=ABS(risfdep(ji,jj+1) - ( gdepw_1d(misfdep(ji,jj+1)) & 1367 1369 & - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat ))) 1368 IF (zbathydiff .LE.zrisfdepdiff) THEN1370 IF (zbathydiff <= zrisfdepdiff) THEN 1369 1371 mbathy(ji,jj) = mbathy(ji,jj) + 1 1370 1372 bathy(ji,jj) = gdepw_1d(mbathy (ji,jj )) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj )+1)*e3zps_rat ) … … 1382 1384 1383 1385 IF( lk_mpp ) THEN 1384 zbathy(:,:) = FLOAT( misfdep(:,:) )1386 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1385 1387 CALL lbc_lnk( zbathy, 'T', 1. ) 1386 1388 misfdep(:,:) = INT( zbathy(:,:) ) 1387 CALL lbc_lnk( risfdep, 'T', 1. ) 1388 CALL lbc_lnk( bathy, 'T', 1. ) 1389 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1389 1390 CALL lbc_lnk( risfdep,'T', 1. ) 1391 CALL lbc_lnk( bathy, 'T', 1. ) 1392 1393 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1390 1394 CALL lbc_lnk( zbathy, 'T', 1. ) 1391 mbathy(:,:) = INT( zbathy(:,:) )1395 mbathy(:,:) = INT( zbathy(:,:) ) 1392 1396 ENDIF 1393 1397 ! point V misdep(ji,jj) EQ mbathy(ji,jj+1) 1394 1398 DO jj = 1, jpjm1 1395 1399 DO ji = 1, jpim1 1396 IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GT.1) THEN1400 IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) > 1) THEN 1397 1401 IF ( .NOT. ln_iscpl ) THEN 1398 1402 zbathydiff =ABS( bathy(ji,jj+1) - ( gdepw_1d(mbathy (ji,jj+1)+1) & … … 1400 1404 zrisfdepdiff=ABS(risfdep(ji,jj ) - ( gdepw_1d(misfdep(ji,jj ) ) & 1401 1405 & - MIN( e3zps_min, e3t_1d(misfdep(ji,jj )-1)*e3zps_rat ))) 1402 IF (zbathydiff .LE.zrisfdepdiff) THEN1406 IF (zbathydiff <= zrisfdepdiff) THEN 1403 1407 mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1 1404 1408 bathy (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1) ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ) … … 1417 1421 1418 1422 IF( lk_mpp ) THEN 1419 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1420 CALL lbc_lnk( zbathy, 'T', 1. ) 1421 misfdep(:,:) = INT( zbathy(:,:) ) 1422 CALL lbc_lnk( risfdep, 'T', 1. ) 1423 CALL lbc_lnk( bathy, 'T', 1. ) 1424 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1423 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1425 1424 CALL lbc_lnk( zbathy, 'T', 1. ) 1426 mbathy(:,:) = INT( zbathy(:,:) ) 1425 misfdep(:,:) = INT( zbathy(:,:) ) 1426 1427 CALL lbc_lnk( risfdep,'T', 1. ) 1428 CALL lbc_lnk( bathy, 'T', 1. ) 1429 1430 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1431 CALL lbc_lnk( zbathy, 'T', 1. ) 1432 mbathy(:,:) = INT( zbathy(:,:) ) 1427 1433 ENDIF 1428 1434 … … 1430 1436 DO jj = 1, jpjm1 1431 1437 DO ji = 1, jpim1 1432 IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT.1) THEN1438 IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 1433 1439 IF ( .NOT. ln_iscpl ) THEN 1434 1440 zbathydiff =ABS( bathy(ji ,jj) - ( gdepw_1d(mbathy (ji,jj)+1) & … … 1436 1442 zrisfdepdiff=ABS(risfdep(ji+1,jj) - ( gdepw_1d(misfdep(ji+1,jj)) & 1437 1443 & - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat ))) 1438 IF (zbathydiff .LE.zrisfdepdiff) THEN1444 IF (zbathydiff <= zrisfdepdiff) THEN 1439 1445 mbathy(ji,jj) = mbathy(ji,jj) + 1 1440 1446 bathy(ji,jj) = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) … … 1452 1458 1453 1459 IF( lk_mpp ) THEN 1454 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1455 CALL lbc_lnk( zbathy, 'T', 1. ) 1456 misfdep(:,:) = INT( zbathy(:,:) ) 1457 CALL lbc_lnk( risfdep, 'T', 1. ) 1458 CALL lbc_lnk( bathy, 'T', 1. ) 1459 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1460 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1460 1461 CALL lbc_lnk( zbathy, 'T', 1. ) 1461 mbathy(:,:) = INT( zbathy(:,:) ) 1462 misfdep(:,:) = INT( zbathy(:,:) ) 1463 1464 CALL lbc_lnk( risfdep,'T', 1. ) 1465 CALL lbc_lnk( bathy, 'T', 1. ) 1466 1467 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1468 CALL lbc_lnk( zbathy, 'T', 1. ) 1469 mbathy(:,:) = INT( zbathy(:,:) ) 1462 1470 ENDIF 1463 1471 … … 1465 1473 DO jj = 1, jpjm1 1466 1474 DO ji = 1, jpim1 1467 IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GT.1) THEN1475 IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) > 1) THEN 1468 1476 IF ( .NOT. ln_iscpl ) THEN 1469 1477 zbathydiff =ABS( bathy(ji+1,jj) - ( gdepw_1d(mbathy (ji+1,jj)+1) & … … 1471 1479 zrisfdepdiff=ABS(risfdep(ji ,jj) - ( gdepw_1d(misfdep(ji ,jj) ) & 1472 1480 & - MIN( e3zps_min, e3t_1d(misfdep(ji ,jj)-1)*e3zps_rat ))) 1473 IF (zbathydiff .LE.zrisfdepdiff) THEN1481 IF (zbathydiff <= zrisfdepdiff) THEN 1474 1482 mbathy(ji+1,jj) = mbathy (ji+1,jj) + 1 1475 1483 bathy (ji+1,jj) = gdepw_1d(mbathy (ji+1,jj) ) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat ) … … 1487 1495 1488 1496 IF( lk_mpp ) THEN 1489 zbathy(:,:) = FLOAT( misfdep(:,:) )1497 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1490 1498 CALL lbc_lnk( zbathy, 'T', 1. ) 1491 1499 misfdep(:,:) = INT( zbathy(:,:) ) 1492 CALL lbc_lnk( risfdep, 'T', 1. ) 1493 CALL lbc_lnk( bathy, 'T', 1. ) 1494 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1500 1501 CALL lbc_lnk( risfdep,'T', 1. ) 1502 CALL lbc_lnk( bathy, 'T', 1. ) 1503 1504 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1495 1505 CALL lbc_lnk( zbathy, 'T', 1. ) 1496 mbathy(:,:) = INT( zbathy(:,:) )1506 mbathy(:,:) = INT( zbathy(:,:) ) 1497 1507 ENDIF 1498 1508 END DO … … 1504 1514 DO jk = 2, jpk 1505 1515 WHERE (misfdep==0) misfdep=jpk 1506 zmask=0 1507 WHERE (misfdep .LE.jk) zmask=11516 zmask=0._wp 1517 WHERE (misfdep <= jk) zmask=1 1508 1518 DO jj = 2, jpjm1 1509 1519 DO ji = 2, jpim1 1510 IF (misfdep(ji,jj) .EQ.jk) THEN1520 IF (misfdep(ji,jj) == jk) THEN 1511 1521 ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 1512 IF (ibtest .LE.1) THEN1522 IF (ibtest <= 1) THEN 1513 1523 risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1 1514 IF (misfdep(ji,jj) .GT.mbathy(ji,jj)) misfdep(ji,jj) = jpk1524 IF (misfdep(ji,jj) > mbathy(ji,jj)) misfdep(ji,jj) = jpk 1515 1525 END IF 1516 1526 END IF … … 1519 1529 END DO 1520 1530 WHERE (misfdep==jpk) 1521 misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0.1531 misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 1522 1532 END WHERE 1523 1533 IF( lk_mpp ) THEN 1524 zbathy(:,:) = FLOAT( misfdep(:,:) )1534 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1525 1535 CALL lbc_lnk( zbathy, 'T', 1. ) 1526 1536 misfdep(:,:) = INT( zbathy(:,:) ) 1527 CALL lbc_lnk( risfdep, 'T', 1. ) 1528 CALL lbc_lnk( bathy, 'T', 1. ) 1529 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1537 1538 CALL lbc_lnk( risfdep,'T', 1. ) 1539 CALL lbc_lnk( bathy, 'T', 1. ) 1540 1541 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1530 1542 CALL lbc_lnk( zbathy, 'T', 1. ) 1531 mbathy(:,:) = INT( zbathy(:,:) )1543 mbathy(:,:) = INT( zbathy(:,:) ) 1532 1544 ENDIF 1533 1545 1534 1546 ! remove single point "bay" on bathy coast line beneath an ice shelf' 1535 1547 DO jk = jpk,1,-1 1536 zmask=0 1537 WHERE (mbathy .GE.jk ) zmask=11548 zmask=0._wp 1549 WHERE (mbathy >= jk ) zmask=1 1538 1550 DO jj = 2, jpjm1 1539 1551 DO ji = 2, jpim1 1540 IF (mbathy(ji,jj) .EQ. jk .AND. misfdep(ji,jj) .GE.2) THEN1552 IF (mbathy(ji,jj) == jk .AND. misfdep(ji,jj) >= 2) THEN 1541 1553 ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 1542 IF (ibtest .LE.1) THEN1554 IF (ibtest <= 1) THEN 1543 1555 bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1 1544 IF (misfdep(ji,jj) .GT.mbathy(ji,jj)) mbathy(ji,jj) = 01556 IF (misfdep(ji,jj) > mbathy(ji,jj)) mbathy(ji,jj) = 0 1545 1557 END IF 1546 1558 END IF … … 1549 1561 END DO 1550 1562 WHERE (mbathy==0) 1551 misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0.1563 misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 1552 1564 END WHERE 1553 1565 IF( lk_mpp ) THEN 1554 zbathy(:,:) = FLOAT( misfdep(:,:) )1566 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1555 1567 CALL lbc_lnk( zbathy, 'T', 1. ) 1556 1568 misfdep(:,:) = INT( zbathy(:,:) ) 1557 CALL lbc_lnk( risfdep, 'T', 1. ) 1558 CALL lbc_lnk( bathy, 'T', 1. ) 1559 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1569 1570 CALL lbc_lnk( risfdep,'T', 1. ) 1571 CALL lbc_lnk( bathy, 'T', 1. ) 1572 1573 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1560 1574 CALL lbc_lnk( zbathy, 'T', 1. ) 1561 mbathy(:,:) = INT( zbathy(:,:) )1575 mbathy(:,:) = INT( zbathy(:,:) ) 1562 1576 ENDIF 1563 1577 … … 1565 1579 zmisfdep = misfdep 1566 1580 zrisfdep = risfdep 1567 WHERE (zmisfdep .LE. 1) zmisfdep=jpk1581 WHERE (zmisfdep <= 1._wp) zmisfdep=jpk 1568 1582 DO jj = 2, jpjm1 1569 1583 DO ji = 2, jpim1 1570 1584 ibtestim1 = zmisfdep(ji-1,jj ) ; ibtestip1 = zmisfdep(ji+1,jj ) 1571 1585 ibtestjm1 = zmisfdep(ji ,jj-1) ; ibtestjp1 = zmisfdep(ji ,jj+1) 1572 IF( zmisfdep(ji,jj) .GE.mbathy(ji-1,jj ) ) ibtestim1 = jpk1573 IF( zmisfdep(ji,jj) .GE.mbathy(ji+1,jj ) ) ibtestip1 = jpk1574 IF( zmisfdep(ji,jj) .GE.mbathy(ji ,jj-1) ) ibtestjm1 = jpk1575 IF( zmisfdep(ji,jj) .GE.mbathy(ji ,jj+1) ) ibtestjp1 = jpk1586 IF( zmisfdep(ji,jj) >= mbathy(ji-1,jj ) ) ibtestim1 = jpk 1587 IF( zmisfdep(ji,jj) >= mbathy(ji+1,jj ) ) ibtestip1 = jpk 1588 IF( zmisfdep(ji,jj) >= mbathy(ji ,jj-1) ) ibtestjm1 = jpk 1589 IF( zmisfdep(ji,jj) >= mbathy(ji ,jj+1) ) ibtestjp1 = jpk 1576 1590 ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 1577 IF( ibtest == jpk .AND. misfdep(ji,jj) .GE.2) THEN1591 IF( ibtest == jpk .AND. misfdep(ji,jj) >= 2) THEN 1578 1592 mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp 1579 1593 END IF 1580 IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) .GE.2) THEN1594 IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) >= 2) THEN 1581 1595 misfdep(ji,jj) = ibtest 1582 1596 risfdep(ji,jj) = gdepw_1d(ibtest) … … 1586 1600 1587 1601 IF( lk_mpp ) THEN 1588 zbathy(:,:) = FLOAT( misfdep(:,:) )1589 CALL lbc_lnk( zbathy, 'T', 1. )1602 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1603 CALL lbc_lnk( zbathy, 'T', 1. ) 1590 1604 misfdep(:,:) = INT( zbathy(:,:) ) 1605 1591 1606 CALL lbc_lnk( risfdep, 'T', 1. ) 1592 CALL lbc_lnk( bathy, 'T', 1. ) 1607 CALL lbc_lnk( bathy, 'T', 1. ) 1608 1593 1609 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1594 CALL lbc_lnk( zbathy, 'T', 1. )1610 CALL lbc_lnk( zbathy, 'T', 1. ) 1595 1611 mbathy(:,:) = INT( zbathy(:,:) ) 1596 1612 ENDIF … … 1602 1618 ibtestim1 = zmbathy(ji-1,jj ) ; ibtestip1 = zmbathy(ji+1,jj ) 1603 1619 ibtestjm1 = zmbathy(ji ,jj-1) ; ibtestjp1 = zmbathy(ji ,jj+1) 1604 IF( zmbathy(ji,jj) .LT.misfdep(ji-1,jj ) ) ibtestim1 = 01605 IF( zmbathy(ji,jj) .LT.misfdep(ji+1,jj ) ) ibtestip1 = 01606 IF( zmbathy(ji,jj) .LT.misfdep(ji ,jj-1) ) ibtestjm1 = 01607 IF( zmbathy(ji,jj) .LT.misfdep(ji ,jj+1) ) ibtestjp1 = 01620 IF( zmbathy(ji,jj) < misfdep(ji-1,jj ) ) ibtestim1 = 0 1621 IF( zmbathy(ji,jj) < misfdep(ji+1,jj ) ) ibtestip1 = 0 1622 IF( zmbathy(ji,jj) < misfdep(ji ,jj-1) ) ibtestjm1 = 0 1623 IF( zmbathy(ji,jj) < misfdep(ji ,jj+1) ) ibtestjp1 = 0 1608 1624 ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 1609 IF( ibtest == 0 .AND. misfdep(ji,jj) .GE.2) THEN1625 IF( ibtest == 0 .AND. misfdep(ji,jj) >= 2) THEN 1610 1626 mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ; 1611 1627 END IF 1612 IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) .GE.2) THEN1628 IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) >= 2) THEN 1613 1629 mbathy(ji,jj) = ibtest 1614 1630 bathy(ji,jj) = gdepw_1d(ibtest+1) … … 1617 1633 END DO 1618 1634 IF( lk_mpp ) THEN 1619 zbathy(:,:) = FLOAT( misfdep(:,:) )1620 CALL lbc_lnk( zbathy, 'T', 1. )1635 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1636 CALL lbc_lnk( zbathy, 'T', 1. ) 1621 1637 misfdep(:,:) = INT( zbathy(:,:) ) 1638 1622 1639 CALL lbc_lnk( risfdep, 'T', 1. ) 1623 CALL lbc_lnk( bathy, 'T', 1. ) 1640 CALL lbc_lnk( bathy, 'T', 1. ) 1641 1624 1642 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1625 CALL lbc_lnk( zbathy, 'T', 1. )1643 CALL lbc_lnk( zbathy, 'T', 1. ) 1626 1644 mbathy(:,:) = INT( zbathy(:,:) ) 1627 1645 ENDIF … … 1629 1647 DO jj = 1, jpjm1 1630 1648 DO ji = 1, jpim1 1631 IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE.1) THEN1649 IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 1632 1650 mbathy(ji,jj) = mbathy(ji,jj) - 1 ; bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)+1) ; 1633 1651 END IF … … 1635 1653 END DO 1636 1654 IF( lk_mpp ) THEN 1637 zbathy(:,:) = FLOAT( misfdep(:,:) )1638 CALL lbc_lnk( zbathy, 'T', 1. )1655 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1656 CALL lbc_lnk( zbathy, 'T', 1. ) 1639 1657 misfdep(:,:) = INT( zbathy(:,:) ) 1658 1640 1659 CALL lbc_lnk( risfdep, 'T', 1. ) 1641 CALL lbc_lnk( bathy, 'T', 1. ) 1660 CALL lbc_lnk( bathy, 'T', 1. ) 1661 1642 1662 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1643 CALL lbc_lnk( zbathy, 'T', 1. )1663 CALL lbc_lnk( zbathy, 'T', 1. ) 1644 1664 mbathy(:,:) = INT( zbathy(:,:) ) 1645 1665 ENDIF … … 1647 1667 DO jj = 1, jpjm1 1648 1668 DO ji = 1, jpim1 1649 IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE.1) THEN1669 IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 1650 1670 mbathy(ji+1,jj) = mbathy(ji+1,jj) - 1; bathy(ji+1,jj) = gdepw_1d(mbathy(ji+1,jj)+1) ; 1651 1671 END IF … … 1653 1673 END DO 1654 1674 IF( lk_mpp ) THEN 1655 zbathy(:,:) = FLOAT( misfdep(:,:) )1675 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1656 1676 CALL lbc_lnk( zbathy, 'T', 1. ) 1657 1677 misfdep(:,:) = INT( zbathy(:,:) ) 1658 CALL lbc_lnk( risfdep, 'T', 1. ) 1659 CALL lbc_lnk( bathy, 'T', 1. ) 1678 1679 CALL lbc_lnk( risfdep,'T', 1. ) 1680 CALL lbc_lnk( bathy, 'T', 1. ) 1681 1660 1682 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1661 1683 CALL lbc_lnk( zbathy, 'T', 1. ) … … 1665 1687 DO jj = 1, jpjm1 1666 1688 DO ji = 1, jpi 1667 IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE.1) THEN1689 IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 1668 1690 mbathy(ji,jj) = mbathy(ji,jj) - 1 ; bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)+1) ; 1669 1691 END IF … … 1671 1693 END DO 1672 1694 IF( lk_mpp ) THEN 1673 zbathy(:,:) = FLOAT( misfdep(:,:) )1695 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1674 1696 CALL lbc_lnk( zbathy, 'T', 1. ) 1675 1697 misfdep(:,:) = INT( zbathy(:,:) ) 1676 CALL lbc_lnk( risfdep, 'T', 1. ) 1677 CALL lbc_lnk( bathy, 'T', 1. ) 1698 1699 CALL lbc_lnk( risfdep,'T', 1. ) 1700 CALL lbc_lnk( bathy, 'T', 1. ) 1701 1678 1702 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1679 1703 CALL lbc_lnk( zbathy, 'T', 1. ) … … 1683 1707 DO jj = 1, jpjm1 1684 1708 DO ji = 1, jpi 1685 IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE.1) THEN1686 mbathy(ji,jj+1) = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1) 1709 IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 1710 mbathy(ji,jj+1) = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1) = gdepw_1d(mbathy(ji,jj+1)+1) ; 1687 1711 END IF 1688 1712 END DO 1689 1713 END DO 1690 1714 IF( lk_mpp ) THEN 1691 zbathy(:,:) = FLOAT( misfdep(:,:) )1715 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1692 1716 CALL lbc_lnk( zbathy, 'T', 1. ) 1693 1717 misfdep(:,:) = INT( zbathy(:,:) ) 1694 CALL lbc_lnk( risfdep, 'T', 1. ) 1695 CALL lbc_lnk( bathy, 'T', 1. ) 1718 1719 CALL lbc_lnk( risfdep,'T', 1. ) 1720 CALL lbc_lnk( bathy, 'T', 1. ) 1721 1696 1722 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1697 1723 CALL lbc_lnk( zbathy, 'T', 1. ) … … 1829 1855 IF( nn_timing == 1 ) CALL timing_stop('zgr_isf') 1830 1856 1831 END SUBROUTINE 1857 END SUBROUTINE zgr_isf 1832 1858 1833 1859 SUBROUTINE zgr_sco … … 2158 2184 fsde3w(:,:,:) = gdep3w_0(:,:,:) 2159 2185 ! 2160 where (e3t_0 (:,:,:) .eq.0.0) e3t_0(:,:,:) = 1.02161 where (e3u_0 (:,:,:) .eq.0.0) e3u_0(:,:,:) = 1.02162 where (e3v_0 (:,:,:) .eq.0.0) e3v_0(:,:,:) = 1.02163 where (e3f_0 (:,:,:) .eq.0.0) e3f_0(:,:,:) = 1.02164 where (e3w_0 (:,:,:) .eq.0.0) e3w_0(:,:,:) = 1.02165 where (e3uw_0 (:,:,:) .eq.0.0) e3uw_0(:,:,:) = 1.02166 where (e3vw_0 (:,:,:) .eq.0.0) e3vw_0(:,:,:) = 1.02186 where (e3t_0 (:,:,:) == 0.0) e3t_0(:,:,:) = 1.0_wp 2187 where (e3u_0 (:,:,:) == 0.0) e3u_0(:,:,:) = 1.0_wp 2188 where (e3v_0 (:,:,:) == 0.0) e3v_0(:,:,:) = 1.0_wp 2189 where (e3f_0 (:,:,:) == 0.0) e3f_0(:,:,:) = 1.0_wp 2190 where (e3w_0 (:,:,:) == 0.0) e3w_0(:,:,:) = 1.0_wp 2191 where (e3uw_0 (:,:,:) == 0.0) e3uw_0(:,:,:) = 1.0_wp 2192 where (e3vw_0 (:,:,:) == 0.0) e3vw_0(:,:,:) = 1.0_wp 2167 2193 2168 2194 #if defined key_agrif -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
r5920 r5945 70 70 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat 71 71 REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 72 INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, vnpts72 INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts 73 73 INTEGER :: jpts, npts 74 74 … … 131 131 & + e12t(jim1,jj ) * tmask(jim1,jj ,jk) + e12t(jip1,jj ) * tmask(jip1,jj ,jk) 132 132 133 IF ( zsum .NE.0._wp ) THEN133 IF ( zsum /= 0._wp ) THEN 134 134 zjip1_ratio = e12t(jip1,jj ) * tmask(jip1,jj ,jk) / zsum 135 135 zjim1_ratio = e12t(jim1,jj ) * tmask(jim1,jj ,jk) / zsum … … 155 155 pts_flx (ji,jj,jk,jp_tem) = 0._wp 156 156 157 ELSE IF (zsum .EQ.0._wp ) THEN157 ELSE IF (zsum == 0._wp ) THEN 158 158 ! case where we close a cell and no adjacent cell open 159 159 ! check if the cell beneath is wet 160 IF ( tmask(ji,jj,jk+1) .EQ.1._wp ) THEN160 IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN 161 161 pvol_flx(ji,jj,jk+1) = pvol_flx(ji,jj,jk+1) + pvol_flx(ji,jj,jk) 162 162 pts_flx (ji,jj,jk+1,jp_sal)= pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal) … … 169 169 ELSE 170 170 ! case no adjacent cell on the horizontal and on the vertical 171 IF ( lwp ) THEN ! JMM : cAution this warning may occur on any mpp subdomain but numout is only 172 ! open for narea== 1 (lwp=T) 171 173 WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal' 172 174 WRITE(numout,*) ' ',mig(ji),' ',mjg(jj),' ',jk 173 175 WRITE(numout,*) ' ',ji,' ',jj,' ',jk,' ',narea 174 176 WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal ' 177 ENDIF 175 178 ! We deal with these points later. 176 179 END IF … … 188 191 ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 189 192 ! allocation and initialisation of the list of problematic point 190 ALLOCATE( vnpts(jpnij))191 vnpts(:)=0193 ALLOCATE(inpts(jpnij)) 194 inpts(:)=0 192 195 193 196 ! fill narea location with the number of problematic point … … 197 200 IF ( ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1) == 0._wp .AND. tmask_h(ji,jj) == 1._wp & 198 201 .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN 199 vnpts(narea) = vnpts(narea) + 1202 inpts(narea) = inpts(narea) + 1 200 203 END IF 201 204 END DO … … 204 207 205 208 ! build array of total problematic point on each cpu (share to each cpu) 206 CALL mpp_max( vnpts,jpnij)209 CALL mpp_max(inpts,jpnij) 207 210 208 211 ! size of the new variable 209 npts = SUM( vnpts)212 npts = SUM(inpts) 210 213 211 214 ! allocation of the coordinates, correction, index vector for the problematic points 212 215 ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts)) 213 ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20 ; zlat(:) = -1.0e20214 zcorr_vol(:) = -1.0e20 215 zcorr_sal(:) = -1.0e20 216 zcorr_tem(:) = -1.0e20 216 ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp 217 zcorr_vol(:) = -1.0e20_wp 218 zcorr_sal(:) = -1.0e20_wp 219 zcorr_tem(:) = -1.0e20_wp 217 220 218 221 ! fill new variable 219 jpts = SUM( vnpts(1:narea-1))222 jpts = SUM(inpts(1:narea-1)) 220 223 DO jk = 1,jpk-1 221 224 DO jj = 2,jpj-1 … … 223 226 IF ( ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1) == 0._wp .AND. tmask_h(ji,jj) == 1._wp & 224 227 .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN 225 jpts = jpts + 1 ! positioning in the vnpts vector for the area narea228 jpts = jpts + 1 ! positioning in the inpts vector for the area narea 226 229 ixpts(jpts) = ji ; iypts(jpts) = jj ; izpts(jpts) = jk 227 230 zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj) … … 273 276 274 277 ! deallocate variables 275 DEALLOCATE( vnpts)278 DEALLOCATE(inpts) 276 279 DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat) 277 280 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r5920 r5945 30 30 31 31 PUBLIC iscpl_stp ! step management 32 PUBLIC iscpl_rst_interpol ! routine to wet and dry 32 PUBLIC iscpl_rst_interpol ! routine to wet and dry ! JMM: why PUBLIC, it is only called 33 ! from this module from iscpl_stp, called from istate ?? 33 34 !! 34 35 !! * Substitutions … … 51 52 !! 52 53 !!---------------------------------------------------------------------- 54 INTEGER :: inum0 53 55 REAL(wp), DIMENSION(:,: ), POINTER :: zsmask_b 54 56 REAL(wp), DIMENSION(:,:,:), POINTER :: ztmask_b, zumask_b, zvmask_b 55 57 REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b , ze3u_b , ze3v_b 56 58 REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b 59 CHARACTER(20) :: cfile 57 60 !!---------------------------------------------------------------------- 58 INTEGER :: inum059 CHARACTER(20) :: cfile60 61 61 62 CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before … … 118 119 fse3u_b (:,:,:) = fse3u_n (:,:,:) 119 120 fse3v_b (:,:,:) = fse3v_n (:,:,:) 121 120 122 IF ( lk_vvl ) THEN 121 123 fse3uw_b(:,:,:) = fse3uw_n(:,:,:) … … 154 156 REAL(wp), DIMENSION(:,: ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t 155 157 REAL(wp), DIMENSION(:,: ), POINTER :: zbub , zbvb , zbun , zbvn 156 REAL(wp), DIMENSION(:,: ), POINTER :: zssh0 , zssh1, hu1,hv1158 REAL(wp), DIMENSION(:,: ), POINTER :: zssh0 , zssh1, zhu1, zhv1 157 159 REAL(wp), DIMENSION(:,: ), POINTER :: zsmask0, zsmask1 158 160 REAL(wp), DIMENSION(:,:,: ), POINTER :: ztmask0, ztmask1, ztrp 159 161 REAL(wp), DIMENSION(:,:,: ), POINTER :: zwmaskn, zwmaskb, ztmp3d 160 162 REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 163 !!---------------------------------------------------------------------- 161 164 162 165 !! allocate variables … … 167 170 CALL wrk_alloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t) 168 171 CALL wrk_alloc(jpi,jpj, zbub , zbvb , zbun , zbvn ) 169 CALL wrk_alloc(jpi,jpj, zssh0 , zssh1, hu1, hv1)172 CALL wrk_alloc(jpi,jpj, zssh0 , zssh1, zhu1, zhv1 ) 170 173 171 174 !! mask value to be sure … … 193 196 jjp1=jj+1; jjm1=jj-1; 194 197 summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1)) 195 IF (zdsmask(ji,jj) ==1._wp .AND. summsk .NE.0._wp) THEN198 IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 196 199 sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj) & 197 200 & + zssh0(jim1,jj)*zsmask0(jim1,jj) & … … 247 250 fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 248 251 END DO 249 IF (mikt(ji,jj) .GT.1) THEN252 IF (mikt(ji,jj) > 1) THEN 250 253 jk = mikt(ji,jj) 251 254 fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk) … … 301 304 302 305 ! new water column 303 hu1=0.0_wp ;304 hv1=0.0_wp ;306 zhu1=0.0_wp ; 307 zhv1=0.0_wp ; 305 308 DO jk = 1,jpk 306 hu1(:,:) =hu1(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)307 hv1(:,:) =hv1(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)309 zhu1(:,:) = zhu1(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 310 zhv1(:,:) = zhv1(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 308 311 END DO 309 312 … … 313 316 DO jj = 1,jpj 314 317 DO ji = 1,jpi 315 IF (zbun(ji,jj) .NE. zbub(ji,jj) .AND. hu1(ji,jj) .NE.0._wp ) THEN316 zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/ hu1(ji,jj)318 IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN 319 zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj) 317 320 END IF 318 IF (zbvn(ji,jj) .NE. zbvb(ji,jj) .AND. hv1(ji,jj) .NE.0._wp ) THEN319 zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/ hv1(ji,jj)321 IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN 322 zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj) 320 323 END IF 321 324 END DO … … 343 346 jjp1=jj+1; jjm1=jj-1; 344 347 summsk= (ztmask0(jip1,jj ,jk)+ztmask0(jim1,jj ,jk)+ztmask0(ji ,jjp1,jk)+ztmask0(ji ,jjm1,jk)) 345 IF (zdmask(ji,jj) ==1._wp .AND. summsk .NE.0._wp) THEN348 IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 346 349 !! horizontal basic extrapolation 347 350 tsn(ji,jj,jk,1)=( zts0(jip1,jj ,jk,1)*ztmask0(jip1,jj ,jk) & … … 354 357 & +zts0(ji ,jjm1,jk,2)*ztmask0(ji ,jjm1,jk) ) / summsk 355 358 ztmask1(ji,jj,jk)=1 356 ELSEIF (zdmask(ji,jj) ==1._wp .AND. summsk==0._wp) THEN359 ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN 357 360 !! vertical extrapolation if horizontal extrapolation failed 358 361 jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1) 359 362 summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1)) 360 IF (zdmask(ji,jj) ==1._wp .AND. summsk .NE.0._wp ) THEN363 IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN 361 364 tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1) & 362 365 & +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk … … 372 375 CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp) 373 376 CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp) 374 CALL lbc_lnk(ztmask1, 'T',1._wp)377 CALL lbc_lnk(ztmask1, 'T',1._wp) 375 378 376 379 ! update … … 393 396 zdzp1 = MAX(0._wp,fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1)) 394 397 zdz = fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk ) 395 zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk ) - fsdepw_n(ji,jj,jk ))398 zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk ) - fsdepw_n(ji,jj,jk )) 396 399 IF (zdz .LT. 0._wp) THEN 400 !!!!JMM : numout must not be used without IF (lwp) 401 IF ( lwp ) THEN 397 402 WRITE(numout,*) 'ERROR dz n ', ji,jj,jk,zdz,fsdepw_n(ji,jj,jk+1),fsdepw_n(ji,jj,jk),fsdepw_n(ji,jj,jk-1) 398 403 WRITE(numout,*) 'ERROR dz n = ',fse3t_n (ji,jj,jk+1),fse3t_n (ji,jj,jk),fse3t_n (ji,jj,jk-1), sshn(ji,jj) … … 405 410 WRITE(numout,*) 'ERROR dz b = ', zwmaskb(ji,jj,jk+1), zwmaskb(ji,jj,jk), zwmaskb(ji,jj,jk-1) 406 411 WRITE(numout,*) 'ERROR dz b = ', gdepw_0(ji,jj,jk+1), gdepw_0(ji,jj,jk), gdepw_0(ji,jj,jk-1) 412 ENDIF 407 413 CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' ) 408 414 END IF … … 423 429 ! case we open a cell but no neigbour cells available to get an estimate of T and S 424 430 WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 425 tsn(:,:,:,2) =-99._wp ! Special value for closed pool (checking purpose in output.init)431 tsn(:,:,:,2) = -99._wp ! Special value for closed pool (checking purpose in output.init) 426 432 tmask(:,:,:) = 0._wp ! set mask to 0 to run 427 433 umask(:,:,:) = 0._wp … … 445 451 CALL wrk_dealloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t) 446 452 CALL wrk_dealloc(jpi,jpj, zbub , zbvb , zbun , zbvn ) 447 CALL wrk_dealloc(jpi,jpj, zssh0 , zssh1 , hu1 , hv1)453 CALL wrk_dealloc(jpi,jpj, zssh0 , zssh1 , zhu1 , zhv1 ) 448 454 449 455 END SUBROUTINE iscpl_rst_interpol -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r5779 r5945 29 29 USE sbcrnf ! river runoff 30 30 USE sbcisf ! ice shelf 31 USE iscplhsb ! ice sheet / ocean coupling31 USE iscplhsb ! ice sheet / ocean coupling 32 32 USE iscplini ! 33 33 USE cla ! cross land advection (cla_div routine) … … 329 329 ! ! =============== 330 330 331 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field)332 IF( ln_divisf .AND. (nn_isf .GT. 0) ) CALL sbc_isf_div ( hdivn ) ! ice shelf(update hdivn field)333 IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn ) ! ice shelf(update hdivn field)331 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 332 IF( ln_divisf .AND. (nn_isf > 0) ) CALL sbc_isf_div( hdivn ) ! ice shelf (update hdivn field) 333 IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn ) ! ice shelf coupling (update hdivn field) 334 334 IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field) 335 335 ! -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r5619 r5945 100 100 ! 101 101 INTEGER :: ji, jj, jk ! dummy loop indices 102 INTEGER :: iku, ikv ! local integers103 102 #if ! defined key_dynspg_flt 104 103 REAL(wp) :: z2dt ! temporary scalar -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r5779 r5945 17 17 !!---------------------------------------------------------------------- 18 18 !! lbc_lnk : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 19 !! lbc_sum : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp 19 20 !! lbc_lnk_e : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 20 21 !! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp … … 31 32 END INTERFACE 32 33 34 !JMM interface not defined if not key_mpp_mpi : likely do not compile without this CPP key !!!! 33 35 INTERFACE lbc_sum 34 36 MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d … … 64 66 !! Default option shared memory computing 65 67 !!---------------------------------------------------------------------- 66 !! lbc_lnk : generic interface for lbc_lnk_3d and lbc_lnk_2d 67 !! lbc_lnk_3d : set the lateral boundary condition on a 3D variable on ocean mesh 68 !! lbc_lnk_2d : set the lateral boundary condition on a 2D variable on ocean mesh 69 !! lbc_bdy_lnk : set the lateral BDY boundary condition 68 !! lbc_sum : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d 69 !! lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh 70 !! lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh 71 !! lbc_lnk : generic interface for lbc_lnk_3d and lbc_lnk_2d 72 !! lbc_lnk_3d : set the lateral boundary condition on a 3D variable on ocean mesh 73 !! lbc_lnk_2d : set the lateral boundary condition on a 2D variable on ocean mesh 74 !! lbc_bdy_lnk : set the lateral BDY boundary condition 70 75 !!---------------------------------------------------------------------- 71 76 USE oce ! ocean dynamics and tracers … … 79 84 INTERFACE lbc_lnk 80 85 MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d 86 END INTERFACE 87 88 INTERFACE lbc_sum 89 MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 81 90 END INTERFACE 82 91 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r5779 r5945 22 22 USE sbcrnf ! River runoff 23 23 USE sbcisf ! Ice shelf 24 USE iscplini ! Ice sheet coupling24 USE iscplini ! Ice sheet coupling 25 25 USE traqsr ! solar radiation penetration 26 26 USE trd_oce ! trends: ocean variables
Note: See TracChangeset
for help on using the changeset viewer.
