- Timestamp:
- 2013-11-20T10:35:28+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r3764 r4276 169 169 !!---------------------------------------------------------------------- 170 170 !! *** ROUTINE zgr_z *** 171 !! 171 !! 172 172 !! ** Purpose : set the depth of model levels and the resulting 173 173 !! vertical scale factors. … … 639 639 END DO 640 640 END DO 641 IF( lk_mpp ) CALL mpp_sum( icompt ) 641 642 IF( icompt == 0 ) THEN 642 643 IF(lwp) WRITE(numout,*)' no isolated ocean grid points' … … 1252 1253 DO jj = 1, jpj 1253 1254 DO ji = 1, jpi 1254 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 )1255 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp ) 1255 1256 hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper ) 1256 1257 END DO … … 1367 1368 fsde3w(:,:,:) = gdep3w(:,:,:) 1368 1369 ! 1369 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1.0 1370 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1.0 1371 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1.0 1372 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1.0 1373 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1.0 1374 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1.0 1375 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1.0 1376 1370 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1._wp 1371 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1._wp 1372 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1._wp 1373 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1._wp 1374 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1._wp 1375 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1._wp 1376 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1._wp 1377 1378 #if defined key_agrif 1379 ! Ensure meaningful vertical scale factors in ghost lines/columns 1380 IF( .NOT. Agrif_Root() ) THEN 1381 ! 1382 IF((nbondi == -1).OR.(nbondi == 2)) THEN 1383 e3u(1,:,:) = e3u(2,:,:) 1384 ENDIF 1385 ! 1386 IF((nbondi == 1).OR.(nbondi == 2)) THEN 1387 e3u(nlci-1,:,:) = e3u(nlci-2,:,:) 1388 ENDIF 1389 ! 1390 IF((nbondj == -1).OR.(nbondj == 2)) THEN 1391 e3v(:,1,:) = e3v(:,2,:) 1392 ENDIF 1393 ! 1394 IF((nbondj == 1).OR.(nbondj == 2)) THEN 1395 e3v(:,nlcj-1,:) = e3v(:,nlcj-2,:) 1396 ENDIF 1397 ! 1398 ENDIF 1399 #endif 1377 1400 1378 1401 fsdept(:,:,:) = gdept (:,:,:) … … 1423 1446 WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(1,1,jk), fsdepw(1,1,jk), & 1424 1447 & fse3t (1,1,jk), fse3w (1,1,jk), jk=1,jpk ) 1425 DO jj = mj0(20), mj1(20) 1426 DO ji = mi0(20), mi1(20) 1448 iip1 = MIN(20, jpiglo-1) ! for config with i smaller than 20 points 1449 ijp1 = MIN(20, jpjglo-1) ! for config with j smaller than 20 points 1450 DO jj = mj0(ijp1), mj1(ijp1) 1451 DO ji = mi0(iip1), mi1(iip1) 1427 1452 WRITE(numout,*) 1428 WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k) bathy = ', bathy(ji,jj), hbatt(ji,jj) 1453 WRITE(numout,*) ' domzgr: vertical coordinates : point (',iip1,',',ijp1,',k) bathy = ', & 1454 & bathy(ji,jj), hbatt(ji,jj) 1429 1455 WRITE(numout,*) ' ~~~~~~ --------------------' 1430 1456 WRITE(numout,"(9x,' level gdept gdepw gde3w e3t e3w ')") … … 1433 1459 END DO 1434 1460 END DO 1435 DO jj = mj0(74), mj1(74) 1436 DO ji = mi0(100), mi1(100) 1461 iip1 = MIN( 74, jpiglo-1) 1462 ijp1 = MIN( 100, jpjglo-1) 1463 DO jj = mj0(ijp1), mj1(ijp1) 1464 DO ji = mi0(iip1), mi1(iip1) 1437 1465 WRITE(numout,*) 1438 WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k) bathy = ', bathy(ji,jj), hbatt(ji,jj) 1466 WRITE(numout,*) ' domzgr: vertical coordinates : point (',iip1,',',ijp1,',k) bathy = ', & 1467 & bathy(ji,jj), hbatt(ji,jj) 1439 1468 WRITE(numout,*) ' ~~~~~~ --------------------' 1440 1469 WRITE(numout,"(9x,' level gdept gdepw gde3w e3t e3w ')") … … 1723 1752 ENDDO 1724 1753 ! 1725 CALL lbc_lnk(e3t ,'T',1.) ; CALL lbc_lnk(e3u ,'T',1.)1726 CALL lbc_lnk(e3v ,'T',1.) ; CALL lbc_lnk(e3f ,'T',1.)1727 CALL lbc_lnk(e3w ,'T',1.)1728 CALL lbc_lnk(e3uw,'T',1.) ; CALL lbc_lnk(e3vw,'T',1.)1729 !1730 1754 ! ! ============= 1731 1755 … … 1824 1848 !!---------------------------------------------------------------------- 1825 1849 ! 1826 pf = ( TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1 ) + rn_thetb ) ) &1850 pf = ( TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1,wp) + rn_thetb ) ) & 1827 1851 & - TANH( rn_thetb * rn_theta ) ) & 1828 1852 & * ( COSH( rn_theta ) & … … 1850 1874 ! 1851 1875 IF ( rn_theta == 0 ) then ! uniform sigma 1852 pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )1876 pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1,wp ) 1853 1877 ELSE ! stretched sigma 1854 pf1 = ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1 )) ) ) / SINH( rn_theta ) &1855 & + pbb * ( (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1 )) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta ) ) &1878 pf1 = ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1,wp)) ) ) / SINH( rn_theta ) & 1879 & + pbb * ( (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1,wp)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta ) ) & 1856 1880 & / ( 2._wp * TANH( 0.5_wp * rn_theta ) ) ) 1857 1881 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.