- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/BDY/bdyini.F90
r13226 r13899 416 416 CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 417 417 DO ii = 1,nblendta(igrd,ib_bdy) 418 nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 418 nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 419 419 END DO 420 420 CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 421 421 DO ii = 1,nblendta(igrd,ib_bdy) 422 nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 422 nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 423 423 END DO 424 424 CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) … … 786 786 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 787 787 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 788 IF( mig (ii) > 2 .AND. mig(ii) < jpiglo-2 .AND. mjg(ij) > 2 .AND. mjg(ij) < jpjglo-2 ) THEN788 IF( mig0(ii) > 2 .AND. mig0(ii) < Ni0glo-2 .AND. mjg0(ij) > 2 .AND. mjg0(ij) < Nj0glo-2 ) THEN 789 789 WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain' 790 790 CALL ctl_stop( ctmp1 ) … … 1071 1071 SUBROUTINE bdy_read_seg( kb_bdy, knblendta ) 1072 1072 !!---------------------------------------------------------------------- 1073 !! *** ROUTINE bdy_ coords_seg ***1073 !! *** ROUTINE bdy_read_seg *** 1074 1074 !! 1075 1075 !! ** Purpose : build bdy coordinates with segments defined in namelist … … 1111 1111 CASE( 'N' ) 1112 1112 IF( nbdyind == -1 ) THEN ! Automatic boundary definition: if nbdysegX = -1 1113 nbdyind = jpjglo - 2 ! set boundary to whole side of model domain.1113 nbdyind = Nj0glo - 2 ! set boundary to whole side of model domain. 1114 1114 nbdybeg = 2 1115 nbdyend = jpiglo - 11115 nbdyend = Ni0glo - 1 1116 1116 ENDIF 1117 1117 nbdysegn = nbdysegn + 1 1118 1118 npckgn(nbdysegn) = kb_bdy ! Save bdy package number 1119 jpjnob(nbdysegn) = nbdyind 1119 jpjnob(nbdysegn) = nbdyind 1120 1120 jpindt(nbdysegn) = nbdybeg 1121 1121 jpinft(nbdysegn) = nbdyend … … 1125 1125 nbdyind = 2 ! set boundary to whole side of model domain. 1126 1126 nbdybeg = 2 1127 nbdyend = jpiglo - 11127 nbdyend = Ni0glo - 1 1128 1128 ENDIF 1129 1129 nbdysegs = nbdysegs + 1 … … 1135 1135 CASE( 'E' ) 1136 1136 IF( nbdyind == -1 ) THEN ! Automatic boundary definition: if nbdysegX = -1 1137 nbdyind = jpiglo - 2 ! set boundary to whole side of model domain.1137 nbdyind = Ni0glo - 2 ! set boundary to whole side of model domain. 1138 1138 nbdybeg = 2 1139 nbdyend = jpjglo - 11139 nbdyend = Nj0glo - 1 1140 1140 ENDIF 1141 1141 nbdysege = nbdysege + 1 … … 1149 1149 nbdyind = 2 ! set boundary to whole side of model domain. 1150 1150 nbdybeg = 2 1151 nbdyend = jpjglo - 11151 nbdyend = Nj0glo - 1 1152 1152 ENDIF 1153 1153 nbdysegw = nbdysegw + 1 … … 1192 1192 IF(lwp) WRITE(numout,*) 'Number of north segments : ', nbdysegn 1193 1193 IF(lwp) WRITE(numout,*) 'Number of south segments : ', nbdysegs 1194 ! 1194 1195 ! 1. Check bounds 1195 1196 !---------------- 1196 1197 DO ib = 1, nbdysegn 1197 1198 IF (lwp) WRITE(numout,*) '**check north seg bounds pckg: ', npckgn(ib) 1198 IF ((jpjnob(ib).ge. jpjglo-1).or.&1199 IF ((jpjnob(ib).ge.Nj0glo-1).or.& 1199 1200 &(jpjnob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1200 1201 IF (jpindt(ib).ge.jpinft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1201 1202 IF (jpindt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1202 IF (jpinft(ib).gt. jpiglo) CALL ctl_stop( 'End index out of domain' )1203 IF (jpinft(ib).gt.Ni0glo) CALL ctl_stop( 'End index out of domain' ) 1203 1204 END DO 1204 1205 ! 1205 1206 DO ib = 1, nbdysegs 1206 1207 IF (lwp) WRITE(numout,*) '**check south seg bounds pckg: ', npckgs(ib) 1207 IF ((jpjsob(ib).ge. jpjglo-1).or.&1208 IF ((jpjsob(ib).ge.Nj0glo-1).or.& 1208 1209 &(jpjsob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1209 1210 IF (jpisdt(ib).ge.jpisft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1210 1211 IF (jpisdt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1211 IF (jpisft(ib).gt. jpiglo) CALL ctl_stop( 'End index out of domain' )1212 IF (jpisft(ib).gt.Ni0glo) CALL ctl_stop( 'End index out of domain' ) 1212 1213 END DO 1213 1214 ! 1214 1215 DO ib = 1, nbdysege 1215 1216 IF (lwp) WRITE(numout,*) '**check east seg bounds pckg: ', npckge(ib) 1216 IF ((jpieob(ib).ge. jpiglo-1).or.&1217 IF ((jpieob(ib).ge.Ni0glo-1).or.& 1217 1218 &(jpieob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1218 1219 IF (jpjedt(ib).ge.jpjeft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1219 1220 IF (jpjedt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1220 IF (jpjeft(ib).gt. jpjglo) CALL ctl_stop( 'End index out of domain' )1221 IF (jpjeft(ib).gt.Nj0glo) CALL ctl_stop( 'End index out of domain' ) 1221 1222 END DO 1222 1223 ! 1223 1224 DO ib = 1, nbdysegw 1224 1225 IF (lwp) WRITE(numout,*) '**check west seg bounds pckg: ', npckgw(ib) 1225 IF ((jpiwob(ib).ge. jpiglo-1).or.&1226 IF ((jpiwob(ib).ge.Ni0glo-1).or.& 1226 1227 &(jpiwob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1227 1228 IF (jpjwdt(ib).ge.jpjwft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1228 1229 IF (jpjwdt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1229 IF (jpjwft(ib).gt. jpjglo) CALL ctl_stop( 'End index out of domain' )1230 IF (jpjwft(ib).gt.Nj0glo) CALL ctl_stop( 'End index out of domain' ) 1230 1231 ENDDO 1231 !1232 1232 ! 1233 1233 ! 2. Look for segment crossings … … 1378 1378 DO ji = 1, jpi 1379 1379 DO jj = 1, jpj 1380 IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 1381 & ((jj + njmpp - 1) == jpjwdt(ib))) ztestmask(1)=tmask(ji,jj,1) 1382 IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 1383 & ((jj + njmpp - 1) == jpjwft(ib))) ztestmask(2)=tmask(ji,jj,1) 1380 IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1381 IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1384 1382 END DO 1385 1383 END DO … … 1416 1414 DO ji = 1, jpi 1417 1415 DO jj = 1, jpj 1418 IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 1419 & ((jj + njmpp - 1) == jpjedt(ib))) ztestmask(1)=tmask(ji,jj,1) 1420 IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 1421 & ((jj + njmpp - 1) == jpjeft(ib))) ztestmask(2)=tmask(ji,jj,1) 1416 IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1417 IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1422 1418 END DO 1423 1419 END DO … … 1454 1450 DO ji = 1, jpi 1455 1451 DO jj = 1, jpj 1456 IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 1457 & ((ji + nimpp - 1) == jpisdt(ib))) ztestmask(1)=tmask(ji,jj,1) 1458 IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 1459 & ((ji + nimpp - 1) == jpisft(ib))) ztestmask(2)=tmask(ji,jj,1) 1452 IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1453 IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1460 1454 END DO 1461 1455 END DO … … 1478 1472 DO ji = 1, jpi 1479 1473 DO jj = 1, jpj 1480 IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 1481 & ((ji + nimpp - 1) == jpindt(ib))) ztestmask(1)=tmask(ji,jj,1) 1482 IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 1483 & ((ji + nimpp - 1) == jpinft(ib))) ztestmask(2)=tmask(ji,jj,1) 1474 IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1475 IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1484 1476 END DO 1485 1477 END DO … … 1534 1526 DO ij = jpjedt(iseg), jpjeft(iseg) 1535 1527 icount = icount + 1 1536 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 1537 nbjdta(icount, igrd, ib_bdy) = ij 1528 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir + nn_hls 1529 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1538 1530 nbrdta(icount, igrd, ib_bdy) = ir 1539 1531 ENDDO … … 1546 1538 DO ij = jpjedt(iseg), jpjeft(iseg) 1547 1539 icount = icount + 1 1548 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir 1549 nbjdta(icount, igrd, ib_bdy) = ij 1540 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir + nn_hls 1541 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1550 1542 nbrdta(icount, igrd, ib_bdy) = ir 1551 1543 ENDDO … … 1559 1551 DO ij = jpjedt(iseg), jpjeft(iseg) 1560 1552 icount = icount + 1 1561 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 1562 nbjdta(icount, igrd, ib_bdy) = ij 1553 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir + nn_hls 1554 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1563 1555 nbrdta(icount, igrd, ib_bdy) = ir 1564 1556 ENDDO … … 1579 1571 DO ij = jpjwdt(iseg), jpjwft(iseg) 1580 1572 icount = icount + 1 1581 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1582 nbjdta(icount, igrd, ib_bdy) = ij 1573 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1574 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1583 1575 nbrdta(icount, igrd, ib_bdy) = ir 1584 1576 ENDDO … … 1591 1583 DO ij = jpjwdt(iseg), jpjwft(iseg) 1592 1584 icount = icount + 1 1593 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1594 nbjdta(icount, igrd, ib_bdy) = ij 1585 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1586 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1595 1587 nbrdta(icount, igrd, ib_bdy) = ir 1596 1588 ENDDO … … 1604 1596 DO ij = jpjwdt(iseg), jpjwft(iseg) 1605 1597 icount = icount + 1 1606 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1607 nbjdta(icount, igrd, ib_bdy) = ij 1598 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1599 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1608 1600 nbrdta(icount, igrd, ib_bdy) = ir 1609 1601 ENDDO … … 1624 1616 DO ii = jpindt(iseg), jpinft(iseg) 1625 1617 icount = icount + 1 1626 nbidta(icount, igrd, ib_bdy) = ii 1627 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 1618 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1619 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir + nn_hls 1628 1620 nbrdta(icount, igrd, ib_bdy) = ir 1629 1621 ENDDO … … 1637 1629 DO ii = jpindt(iseg), jpinft(iseg) 1638 1630 icount = icount + 1 1639 nbidta(icount, igrd, ib_bdy) = ii 1640 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 1631 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1632 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir + nn_hls 1641 1633 nbrdta(icount, igrd, ib_bdy) = ir 1642 1634 ENDDO … … 1651 1643 DO ii = jpindt(iseg), jpinft(iseg) 1652 1644 icount = icount + 1 1653 nbidta(icount, igrd, ib_bdy) = ii 1654 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir 1645 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1646 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir + nn_hls 1655 1647 nbrdta(icount, igrd, ib_bdy) = ir 1656 1648 ENDDO … … 1669 1661 DO ii = jpisdt(iseg), jpisft(iseg) 1670 1662 icount = icount + 1 1671 nbidta(icount, igrd, ib_bdy) = ii 1672 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1663 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1664 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1673 1665 nbrdta(icount, igrd, ib_bdy) = ir 1674 1666 ENDDO … … 1682 1674 DO ii = jpisdt(iseg), jpisft(iseg) 1683 1675 icount = icount + 1 1684 nbidta(icount, igrd, ib_bdy) = ii 1685 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1676 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1677 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1686 1678 nbrdta(icount, igrd, ib_bdy) = ir 1687 1679 ENDDO … … 1696 1688 DO ii = jpisdt(iseg), jpisft(iseg) 1697 1689 icount = icount + 1 1698 nbidta(icount, igrd, ib_bdy) = ii 1699 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1690 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1691 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1700 1692 nbrdta(icount, igrd, ib_bdy) = ir 1701 1693 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.