- Timestamp:
- 2015-11-29T20:44:49+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.