Changeset 10425 for NEMO/trunk/src/OCE/BDY/bdyini.F90
- Timestamp:
- 2018-12-19T22:54:16+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/BDY/bdyini.F90
r10068 r10425 1133 1133 END DO 1134 1134 END DO 1135 CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1. ) ! Lateral boundary cond.1135 CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1. ) ! Lateral boundary cond. 1136 1136 1137 1137 ! bdy masks are now set to zero on boundary points: … … 1169 1169 1170 1170 ! Lateral boundary conditions 1171 CALL lbc_lnk( zfmask, 'F', 1. )1172 CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. )1171 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 1172 CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. ) 1173 1173 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 1174 1174 … … 1203 1203 END DO 1204 1204 IF( icount /= 0 ) THEN 1205 IF(lwp) WRITE(numout,*) 1206 IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1205 WRITE(ctmp1,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1207 1206 ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 1208 IF(lwp) WRITE(numout,*) ' ========== ' 1209 IF(lwp) WRITE(numout,*) 1210 nstop = nstop + 1 1207 WRITE(ctmp2,*) ' ========== ' 1208 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1211 1209 ENDIF 1212 1210 END DO … … 1238 1236 END DO 1239 1237 IF( icount /= 0 ) THEN 1240 IF(lwp) WRITE(numout,*) 1241 IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1238 WRITE(ctmp1,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1242 1239 ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 1243 IF(lwp) WRITE(numout,*) ' ========== ' 1244 IF(lwp) WRITE(numout,*) 1245 nstop = nstop + 1 1240 WRITE(ctmp2,*) ' ========== ' 1241 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1246 1242 ENDIF 1247 1243 END DO … … 1280 1276 END DO 1281 1277 ! 1282 IF( lk_mpp ) CALL mpp_sum(bdysurftot ) ! sum over the global domain1278 CALL mpp_sum( 'bdyini', bdysurftot ) ! sum over the global domain 1283 1279 END IF 1284 1280 ! … … 1376 1372 icorns(ib2,1) = npckgw(ib1) 1377 1373 ELSEIF ((jpisft(ib2)==jpiwob(ib1)).AND.(jpjwft(ib1)==jpjsob(ib2))) THEN 1378 IF(lwp) WRITE(numout,*) 1379 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1380 & jpisft(ib2), jpjwft(ib1) 1381 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet' 1382 IF(lwp) WRITE(numout,*) ' Crossing problem with West segment: ',npckgw(ib1), & 1383 & ' and South segment: ',npckgs(ib2) 1384 IF(lwp) WRITE(numout,*) 1385 nstop = nstop + 1 1374 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1375 & jpisft(ib2), jpjwft(ib1) 1376 WRITE(ctmp2,*) ' ========== Not allowed yet' 1377 WRITE(ctmp3,*) ' Crossing problem with West segment: ',npckgw(ib1), & 1378 & ' and South segment: ',npckgs(ib2) 1379 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1386 1380 ELSE 1387 IF(lwp) WRITE(numout,*) 1388 IF(lwp) WRITE(numout,*) ' E R R O R : Check South and West Open boundary indices' 1389 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with West segment: ',npckgw(ib1) , & 1390 & ' and South segment: ',npckgs(ib2) 1391 IF(lwp) WRITE(numout,*) 1392 nstop = nstop+1 1381 WRITE(ctmp1,*) ' E R R O R : Check South and West Open boundary indices' 1382 WRITE(ctmp2,*) ' ========== Crossing problem with West segment: ',npckgw(ib1) , & 1383 & ' and South segment: ',npckgs(ib2) 1384 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1393 1385 END IF 1394 1386 END IF … … 1412 1404 icorns(ib2,2) = npckge(ib1) 1413 1405 ELSEIF ((jpjeft(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpieob(ib1)+1)) THEN 1414 IF(lwp) WRITE(numout,*) 1415 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1416 & jpisdt(ib2), jpjeft(ib1) 1417 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet' 1418 IF(lwp) WRITE(numout,*) ' Crossing problem with East segment: ',npckge(ib1), & 1419 & ' and South segment: ',npckgs(ib2) 1420 IF(lwp) WRITE(numout,*) 1421 nstop = nstop + 1 1406 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1407 & jpisdt(ib2), jpjeft(ib1) 1408 WRITE(ctmp2,*) ' ========== Not allowed yet' 1409 WRITE(ctmp3,*) ' Crossing problem with East segment: ',npckge(ib1), & 1410 & ' and South segment: ',npckgs(ib2) 1411 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1422 1412 ELSE 1423 IF(lwp) WRITE(numout,*) 1424 IF(lwp) WRITE(numout,*) ' E R R O R : Check South and East Open boundary indices' 1425 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1426 & ' and South segment: ',npckgs(ib2) 1427 IF(lwp) WRITE(numout,*) 1428 nstop = nstop + 1 1413 WRITE(ctmp1,*) ' E R R O R : Check South and East Open boundary indices' 1414 WRITE(ctmp2,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1415 & ' and South segment: ',npckgs(ib2) 1416 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1429 1417 END IF 1430 1418 END IF … … 1448 1436 icornn(ib2,1) = npckgw(ib1) 1449 1437 ELSEIF ((jpjwdt(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpiwob(ib1))) THEN 1450 IF(lwp) WRITE(numout,*) 1451 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1438 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1452 1439 & jpinft(ib2), jpjwdt(ib1) 1453 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet'1454 IF(lwp) WRITE(numout,*) ' Crossing problem with West segment: ',npckgw(ib1), &1440 WRITE(ctmp2,*) ' ========== Not allowed yet' 1441 WRITE(ctmp3,*) ' Crossing problem with West segment: ',npckgw(ib1), & 1455 1442 & ' and North segment: ',npckgn(ib2) 1456 IF(lwp) WRITE(numout,*) 1457 nstop = nstop + 1 1443 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1458 1444 ELSE 1459 IF(lwp) WRITE(numout,*) 1460 IF(lwp) WRITE(numout,*) ' E R R O R : Check North and West Open boundary indices' 1461 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with West segment: ',npckgw(ib1), & 1445 WRITE(ctmp1,*) ' E R R O R : Check North and West Open boundary indices' 1446 WRITE(ctmp2,*) ' ========== Crossing problem with West segment: ',npckgw(ib1), & 1462 1447 & ' and North segment: ',npckgn(ib2) 1463 IF(lwp) WRITE(numout,*) 1464 nstop = nstop + 1 1448 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1465 1449 END IF 1466 1450 END IF … … 1484 1468 icornn(ib2,2) = npckge(ib1) 1485 1469 ELSEIF ((jpjedt(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpieob(ib1)+1)) THEN 1486 IF(lwp) WRITE(numout,*) 1487 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1470 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1488 1471 & jpindt(ib2), jpjedt(ib1) 1489 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet' 1490 IF(lwp) WRITE(numout,*) ' Crossing problem with East segment: ',npckge(ib1), & 1491 & ' and North segment: ',npckgn(ib2) 1492 IF(lwp) WRITE(numout,*) 1493 nstop = nstop + 1 1472 WRITE(ctmp2,*) ' ========== Not allowed yet' 1473 WRITE(ctmp3,*) ' Crossing problem with East segment: ',npckge(ib1), & 1474 & ' and North segment: ',npckgn(ib2) 1475 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1494 1476 ELSE 1495 IF(lwp) WRITE(numout,*) 1496 IF(lwp) WRITE(numout,*) ' E R R O R : Check North and East Open boundary indices' 1497 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1498 & ' and North segment: ',npckgn(ib2) 1499 IF(lwp) WRITE(numout,*) 1500 nstop = nstop + 1 1477 WRITE(ctmp1,*) ' E R R O R : Check North and East Open boundary indices' 1478 WRITE(ctmp2,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1479 & ' and North segment: ',npckgn(ib2) 1480 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1501 1481 END IF 1502 1482 END IF … … 1520 1500 END DO 1521 1501 END DO 1522 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1502 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1523 1503 1524 1504 IF (ztestmask(1)==1) THEN 1525 1505 IF (icornw(ib,1)==0) THEN 1526 IF(lwp) WRITE(numout,*) 1527 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1528 IF(lwp) WRITE(numout,*) ' ========== does not start on land or on a corner' 1529 IF(lwp) WRITE(numout,*) 1530 nstop = nstop + 1 1506 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1507 WRITE(ctmp2,*) ' ========== does not start on land or on a corner' 1508 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1531 1509 ELSE 1532 1510 ! This is a corner … … 1538 1516 IF (ztestmask(2)==1) THEN 1539 1517 IF (icornw(ib,2)==0) THEN 1540 IF(lwp) WRITE(numout,*) 1541 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1542 IF(lwp) WRITE(numout,*) ' ========== does not end on land or on a corner' 1543 IF(lwp) WRITE(numout,*) 1544 nstop = nstop + 1 1518 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1519 WRITE(ctmp2,*) ' ========== does not end on land or on a corner' 1520 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1545 1521 ELSE 1546 1522 ! This is a corner … … 1564 1540 END DO 1565 1541 END DO 1566 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1542 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1567 1543 1568 1544 IF (ztestmask(1)==1) THEN 1569 1545 IF (icorne(ib,1)==0) THEN 1570 IF(lwp) WRITE(numout,*) 1571 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib) 1572 IF(lwp) WRITE(numout,*) ' ========== does not start on land or on a corner' 1573 IF(lwp) WRITE(numout,*) 1574 nstop = nstop + 1 1546 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckge(ib) 1547 WRITE(ctmp2,*) ' ========== does not start on land or on a corner' 1548 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1575 1549 ELSE 1576 1550 ! This is a corner … … 1582 1556 IF (ztestmask(2)==1) THEN 1583 1557 IF (icorne(ib,2)==0) THEN 1584 IF(lwp) WRITE(numout,*) 1585 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib) 1586 IF(lwp) WRITE(numout,*) ' ========== does not end on land or on a corner' 1587 IF(lwp) WRITE(numout,*) 1588 nstop = nstop + 1 1558 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckge(ib) 1559 WRITE(ctmp2,*) ' ========== does not end on land or on a corner' 1560 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1589 1561 ELSE 1590 1562 ! This is a corner … … 1608 1580 END DO 1609 1581 END DO 1610 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1582 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1611 1583 1612 1584 IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN 1613 IF(lwp) WRITE(numout,*) 1614 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1615 IF(lwp) WRITE(numout,*) ' ========== does not start on land or on a corner' 1616 IF(lwp) WRITE(numout,*) 1617 nstop = nstop + 1 1585 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1586 WRITE(ctmp2,*) ' ========== does not start on land or on a corner' 1587 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1618 1588 ENDIF 1619 1589 IF ((ztestmask(2)==1).AND.(icorns(ib,2)==0)) THEN 1620 IF(lwp) WRITE(numout,*) 1621 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1622 IF(lwp) WRITE(numout,*) ' ========== does not end on land or on a corner' 1623 IF(lwp) WRITE(numout,*) 1624 nstop = nstop + 1 1590 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1591 WRITE(ctmp2,*) ' ========== does not end on land or on a corner' 1592 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1625 1593 ENDIF 1626 1594 END DO … … 1638 1606 END DO 1639 1607 END DO 1640 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1608 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1641 1609 1642 1610 IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN 1643 IF(lwp) WRITE(numout,*) 1644 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1645 IF(lwp) WRITE(numout,*) ' ========== does not start on land' 1646 IF(lwp) WRITE(numout,*) 1647 nstop = nstop + 1 1611 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1612 WRITE(ctmp2,*) ' ========== does not start on land' 1613 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1648 1614 ENDIF 1649 1615 IF ((ztestmask(2)==1).AND.(icornn(ib,2)==0)) THEN 1650 IF(lwp) WRITE(numout,*) 1651 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1652 IF(lwp) WRITE(numout,*) ' ========== does not end on land' 1653 IF(lwp) WRITE(numout,*) 1654 nstop = nstop + 1 1616 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1617 WRITE(ctmp2,*) ' ========== does not end on land' 1618 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1655 1619 ENDIF 1656 1620 END DO … … 1691 1655 ! 1692 1656 IF( itest>0 ) THEN 1693 IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2 1694 IF(lwp) WRITE(numout,*) ' ========== have different open bdy schemes' 1695 IF(lwp) WRITE(numout,*) 1696 nstop = nstop + 1 1657 WRITE(ctmp1,*) ' E R R O R : Segments ', ib1, 'and ', ib2 1658 WRITE(ctmp2,*) ' ========== have different open bdy schemes' 1659 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1697 1660 ENDIF 1698 1661 !
Note: See TracChangeset
for help on using the changeset viewer.