- Timestamp:
- 2013-11-20T17:28:04+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4245 r4292 88 88 !! vertical scale factors. 89 89 !! 90 !! ** Method : - reference 1D vertical coordinate (gdep._ 0, e3._0)90 !! ** Method : - reference 1D vertical coordinate (gdep._1d, e3._1d) 91 91 !! - read/set ocean depth and ocean levels (bathy, mbathy) 92 92 !! - vertical coordinate (gdep., e3.) depending on the … … 153 153 IF( nprint == 1 .AND. lwp ) THEN 154 154 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 155 WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ), &156 & ' w ', MINVAL( fsdepw(:,:,:) ), '3w ', MINVAL( fsde3w(:,:,:) )157 WRITE(numout,*) ' MIN val e3 t ', MINVAL( fse3t(:,:,:) ), ' f ', MINVAL( fse3f(:,:,:) ), &158 & ' u ', MINVAL( fse3u(:,:,:) ), ' u ', MINVAL( fse3v(:,:,:) ), &159 & ' uw', MINVAL( fse3uw(:,:,:)), ' vw', MINVAL( fse3vw(:,:,:)), &160 & ' w ', MINVAL( fse3w(:,:,:) )161 162 WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ), &163 & ' w ', MAXVAL( fsdepw(:,:,:) ), '3w ', MAXVAL( fsde3w(:,:,:) )164 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( fse3t(:,:,:) ), ' f ', MAXVAL( fse3f(:,:,:) ), &165 & ' u ', MAXVAL( fse3u(:,:,:) ), ' u ', MAXVAL( fse3v(:,:,:) ), &166 & ' uw', MAXVAL( fse3uw(:,:,:)), ' vw', MAXVAL( fse3vw(:,:,:)), &167 & ' w ', MAXVAL( fse3w(:,:,:) )155 WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ), & 156 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gdep3w_0(:,:,:) ) 157 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ), & 158 & ' u ', MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ), & 159 & ' uw', MINVAL( e3uw_0(:,:,:)), ' vw', MINVAL( e3vw_0(:,:,:)), & 160 & ' w ', MINVAL( e3w_0(:,:,:) ) 161 162 WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ), & 163 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gdep3w_0(:,:,:) ) 164 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ), & 165 & ' u ', MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ), & 166 & ' uw', MAXVAL( e3uw_0(:,:,:)), ' vw', MAXVAL( e3vw_0(:,:,:)), & 167 & ' w ', MAXVAL( e3w_0(:,:,:) ) 168 168 ENDIF 169 169 ! … … 176 176 !!---------------------------------------------------------------------- 177 177 !! *** ROUTINE zgr_z *** 178 !! 178 !! 179 179 !! ** Purpose : set the depth of model levels and the resulting 180 180 !! vertical scale factors. … … 184 184 !! function the derivative of which gives the scale factors. 185 185 !! both depth and scale factors only depend on k (1d arrays). 186 !! w-level: gdepw_ 0 = fsdep(k)187 !! e3w_ 0(k) = dk(fsdep)(k) = fse3(k)188 !! t-level: gdept_ 0 = fsdep(k+0.5)189 !! e3t_ 0(k) = dk(fsdep)(k+0.5) = fse3(k+0.5)190 !! 191 !! ** Action : - gdept_ 0, gdepw_0: depth of T- and W-point (m)192 !! - e3t_ 0 , e3w_0: scale factors at T- and W-levels (m)186 !! w-level: gdepw_1d = gdep(k) 187 !! e3w_1d(k) = dk(gdep)(k) = e3(k) 188 !! t-level: gdept_1d = gdep(k+0.5) 189 !! e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5) 190 !! 191 !! ** Action : - gdept_1d, gdepw_1d : depth of T- and W-point (m) 192 !! - e3t_1d , e3w_1d : scale factors at T- and W-levels (m) 193 193 !! 194 194 !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. … … 262 262 zw = FLOAT( jk ) 263 263 zt = FLOAT( jk ) + 0.5_wp 264 gdepw_ 0(jk) = ( zw - 1 ) * za1265 gdept_ 0(jk) = ( zt - 1 ) * za1266 e3w_ 0(jk) = za1267 e3t_ 0(jk) = za1264 gdepw_1d(jk) = ( zw - 1 ) * za1 265 gdept_1d(jk) = ( zt - 1 ) * za1 266 e3w_1d (jk) = za1 267 e3t_1d (jk) = za1 268 268 END DO 269 269 ELSE ! Madec & Imbard 1996 function … … 272 272 zw = REAL( jk , wp ) 273 273 zt = REAL( jk , wp ) + 0.5_wp 274 gdepw_ 0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) ) )275 gdept_ 0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) ) )276 e3w_ 0(jk) = za0 + za1 * TANH( (zw-zkth) / zacr )277 e3t_ 0(jk) = za0 + za1 * TANH( (zt-zkth) / zacr )274 gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) ) ) 275 gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) ) ) 276 e3w_1d (jk) = za0 + za1 * TANH( (zw-zkth) / zacr ) 277 e3t_1d (jk) = za0 + za1 * TANH( (zt-zkth) / zacr ) 278 278 END DO 279 279 ELSE … … 282 282 zt = FLOAT( jk ) + 0.5_wp 283 283 ! Double tanh function 284 gdepw_ 0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr ) ) &285 & + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) ) )286 gdept_ 0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr ) ) &287 & + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) ) )288 e3w_ 0 (jk) = za0 + za1 * TANH( (zw-zkth ) / zacr )&289 & + za2 * TANH( (zw-zkth2) / zacr2 )290 e3t_ 0 (jk) = za0 + za1 * TANH( (zt-zkth ) / zacr )&291 & + za2 * TANH( (zt-zkth2) / zacr2 )284 gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr ) ) & 285 & + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) ) ) 286 gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr ) ) & 287 & + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) ) ) 288 e3w_1d (jk) = za0 + za1 * TANH( (zw-zkth ) / zacr ) & 289 & + za2 * TANH( (zw-zkth2) / zacr2 ) 290 e3t_1d (jk) = za0 + za1 * TANH( (zt-zkth ) / zacr ) & 291 & + za2 * TANH( (zt-zkth2) / zacr2 ) 292 292 END DO 293 293 ENDIF 294 gdepw_ 0(1) = 0._wp ! force first w-level to be exactly at zero294 gdepw_1d(1) = 0._wp ! force first w-level to be exactly at zero 295 295 ENDIF 296 296 297 297 !!gm BUG in s-coordinate this does not work! 298 298 ! deepest/shallowest W level Above/Below ~10m 299 zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_ 0 )! ref. depth with tolerance (10% of minimum layer thickness)300 nlb10 = MINLOC( gdepw_ 0, mask = gdepw_0 > zrefdep, dim = 1 )! shallowest W level Below ~10m299 zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d ) ! ref. depth with tolerance (10% of minimum layer thickness) 300 nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m 301 301 nla10 = nlb10 - 1 ! deepest W level Above ~10m 302 302 !!gm end bug … … 305 305 WRITE(numout,*) 306 306 WRITE(numout,*) ' Reference z-coordinate depth and scale factors:' 307 WRITE(numout, "(9x,' level gdept gdepw e3t e3w')" )308 WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_ 0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )307 WRITE(numout, "(9x,' level gdept_1d gdepw_1d e3t_1d e3w_1d ')" ) 308 WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk ) 309 309 ENDIF 310 310 DO jk = 1, jpk ! control positivity 311 IF( e3w_ 0 (jk) <= 0._wp .OR. e3t_0 (jk) <= 0._wp ) CALL ctl_stop( 'dom:zgr_z: e3w or e3t=< 0 ' )312 IF( gdepw_ 0(jk) < 0._wp .OR. gdept_0(jk) < 0._wp ) CALL ctl_stop( 'dom:zgr_z: gdepw or gdept< 0 ' )311 IF( e3w_1d (jk) <= 0._wp .OR. e3t_1d (jk) <= 0._wp ) CALL ctl_stop( 'dom:zgr_z: e3w_1d or e3t_1d =< 0 ' ) 312 IF( gdepw_1d(jk) < 0._wp .OR. gdept_1d(jk) < 0._wp ) CALL ctl_stop( 'dom:zgr_z: gdepw_1d or gdept_1d < 0 ' ) 313 313 END DO 314 314 ! … … 382 382 idta(:,:) = jpkm1 383 383 DO jk = 1, jpkm1 384 WHERE( gdept_ 0(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_0(jk+1) ) idta(:,:) = jk384 WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) ) idta(:,:) = jk 385 385 END DO 386 386 ENDIF … … 388 388 IF(lwp) WRITE(numout,*) ' Depth = depthw(jpkm1)' 389 389 idta(:,:) = jpkm1 ! before last level 390 zdta(:,:) = gdepw_ 0(jpk) ! last w-point depth391 h_oce = gdepw_ 0(jpk)390 zdta(:,:) = gdepw_1d(jpk) ! last w-point depth 391 h_oce = gdepw_1d(jpk) 392 392 ENDIF 393 393 ELSE ! bump centered in the basin … … 398 398 r_bump = 50000._wp ! bump radius (meters) 399 399 h_bump = 2700._wp ! bump height (meters) 400 h_oce = gdepw_ 0(jpk)! background ocean depth (meters)400 h_oce = gdepw_1d(jpk) ! background ocean depth (meters) 401 401 IF(lwp) WRITE(numout,*) ' bump characteristics: ' 402 402 IF(lwp) WRITE(numout,*) ' bump center (i,j) = ', ii_bump, ii_bump … … 418 418 idta(:,:) = jpkm1 419 419 DO jk = 1, jpkm1 420 WHERE( gdept_ 0(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_0(jk+1) ) idta(:,:) = jk420 WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) ) idta(:,:) = jk 421 421 END DO 422 422 ENDIF … … 460 460 CALL iom_close( inum ) 461 461 mbathy(:,:) = INT( bathy(:,:) ) 462 ! 462 ! ! ===================== 463 463 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 464 ! 464 ! ! ===================== 465 465 IF( nn_cla == 0 ) THEN 466 466 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open … … 531 531 IF ( .not. ln_sco ) THEN !== set a minimum depth ==! 532 532 IF( rn_hmin < 0._wp ) THEN ; ik = - INT( rn_hmin ) ! from a nb of level 533 ELSE ; ik = MINLOC( gdepw_ 0, mask = gdepw_0> rn_hmin, dim = 1 ) ! from a depth533 ELSE ; ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 ) ! from a depth 534 534 ENDIF 535 zhmin = gdepw_ 0(ik+1) ! minimum depth = ik+1 w-levels535 zhmin = gdepw_1d(ik+1) ! minimum depth = ik+1 w-levels 536 536 WHERE( bathy(:,:) <= 0._wp ) ; bathy(:,:) = 0._wp ! min=0 over the lands 537 537 ELSE WHERE ; bathy(:,:) = MAX( zhmin , bathy(:,:) ) ! min=zhmin over the oceans … … 798 798 ! 799 799 DO jk = 1, jpk 800 gdept(:,:,jk) = gdept_0(jk)801 gdepw(:,:,jk) = gdepw_0(jk)802 gdep3w(:,:,jk) = gdepw_0(jk)803 e3t (:,:,jk) = e3t_0(jk)804 e3u (:,:,jk) = e3t_0(jk)805 e3v (:,:,jk) = e3t_0(jk)806 e3f (:,:,jk) = e3t_0(jk)807 e3w (:,:,jk) = e3w_0(jk)808 e3uw(:,:,jk) = e3w_0(jk)809 e3vw(:,:,jk) = e3w_0(jk)800 gdept_0 (:,:,jk) = gdept_1d(jk) 801 gdepw_0 (:,:,jk) = gdepw_1d(jk) 802 gdep3w_0(:,:,jk) = gdepw_1d(jk) 803 e3t_0 (:,:,jk) = e3t_1d (jk) 804 e3u_0 (:,:,jk) = e3t_1d (jk) 805 e3v_0 (:,:,jk) = e3t_1d (jk) 806 e3f_0 (:,:,jk) = e3t_1d (jk) 807 e3w_0 (:,:,jk) = e3w_1d (jk) 808 e3uw_0 (:,:,jk) = e3w_1d (jk) 809 e3vw_0 (:,:,jk) = e3w_1d (jk) 810 810 END DO 811 811 ! … … 832 832 !! with partial steps on 3d arrays ( i, j, k ). 833 833 !! 834 !! w-level: gdepw (i,j,k) = fsdep(k)835 !! e3w (i,j,k) = dk(fsdep)(k) = fse3(i,j,k)836 !! t-level: gdept (i,j,k) = fsdep(k+0.5)837 !! e3t (i,j,k) = dk(fsdep)(k+0.5) = fse3(i,j,k+0.5)834 !! w-level: gdepw_0(i,j,k) = gdep(k) 835 !! e3w_0(i,j,k) = dk(gdep)(k) = e3(i,j,k) 836 !! t-level: gdept_0(i,j,k) = gdep(k+0.5) 837 !! e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5) 838 838 !! 839 839 !! With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc), … … 843 843 !! - bathy = 0 => mbathy = 0 844 844 !! - 1 < mbathy < jpkm1 845 !! - bathy > gdepw (jpk) => mbathy = jpkm1845 !! - bathy > gdepw_0(jpk) => mbathy = jpkm1 846 846 !! 847 847 !! Then, for each case, we find the new depth at t- and w- levels … … 855 855 !! schemes. 856 856 !! 857 !! c a u t i o n : gdept_ 0, gdepw_0 and e3._0are positives858 !! - - - - - - - gdept , gdepwand e3. are positives857 !! c a u t i o n : gdept_1d, gdepw_1d and e3._1d are positives 858 !! - - - - - - - gdept_0, gdepw_0 and e3. are positives 859 859 !! 860 860 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. … … 892 892 ! bathymetry in level (from bathy_meter) 893 893 ! =================== 894 zmax = gdepw_ 0(jpk) + e3t_0(jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_0(jpkm1) )894 zmax = gdepw_1d(jpk) + e3t_1d(jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) ) 895 895 bathy(:,:) = MIN( zmax , bathy(:,:) ) ! bounded value of bathy (min already set at the end of zgr_bat) 896 896 WHERE( bathy(:,:) == 0._wp ) ; mbathy(:,:) = 0 ! land : set mbathy to 0 … … 900 900 ! Compute mbathy for ocean points (i.e. the number of ocean levels) 901 901 ! find the number of ocean levels such that the last level thickness 902 ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_ 0(where903 ! e3t_ 0is the reference level thickness902 ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where 903 ! e3t_1d is the reference level thickness 904 904 DO jk = jpkm1, 1, -1 905 zdepth = gdepw_ 0(jk) + MIN( e3zps_min, e3t_0(jk)*e3zps_rat )905 zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 906 906 WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth ) mbathy(:,:) = jk-1 907 907 END DO … … 909 909 ! Scale factors and depth at T- and W-points 910 910 DO jk = 1, jpk ! intitialization to the reference z-coordinate 911 gdept (:,:,jk) = gdept_0(jk)912 gdepw (:,:,jk) = gdepw_0(jk)913 e3t (:,:,jk) = e3t_0(jk)914 e3w (:,:,jk) = e3w_0(jk)911 gdept_0(:,:,jk) = gdept_1d(jk) 912 gdepw_0(:,:,jk) = gdepw_1d(jk) 913 e3t_0 (:,:,jk) = e3t_1d (jk) 914 e3w_0 (:,:,jk) = e3w_1d (jk) 915 915 END DO 916 916 ! … … 922 922 IF( ik == jpkm1 ) THEN 923 923 zdepwp = bathy(ji,jj) 924 ze3tp = bathy(ji,jj) - gdepw_ 0(ik)925 ze3wp = 0.5_wp * e3w_ 0(ik) * ( 1._wp + ( ze3tp/e3t_0(ik) ) )926 e3t (ji,jj,ik ) = ze3tp927 e3t (ji,jj,ik+1) = ze3tp928 e3w (ji,jj,ik ) = ze3wp929 e3w (ji,jj,ik+1) = ze3tp930 gdepw (ji,jj,ik+1) = zdepwp931 gdept (ji,jj,ik ) = gdept_0(ik-1) + ze3wp932 gdept (ji,jj,ik+1) = gdept(ji,jj,ik) + ze3tp924 ze3tp = bathy(ji,jj) - gdepw_1d(ik) 925 ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 926 e3t_0(ji,jj,ik ) = ze3tp 927 e3t_0(ji,jj,ik+1) = ze3tp 928 e3w_0(ji,jj,ik ) = ze3wp 929 e3w_0(ji,jj,ik+1) = ze3tp 930 gdepw_0(ji,jj,ik+1) = zdepwp 931 gdept_0(ji,jj,ik ) = gdept_1d(ik-1) + ze3wp 932 gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 933 933 ! 934 934 ELSE ! standard case 935 IF( bathy(ji,jj) <= gdepw_ 0(ik+1) ) THEN ; gdepw(ji,jj,ik+1) = bathy(ji,jj)936 ELSE ; gdepw (ji,jj,ik+1) = gdepw_0(ik+1)935 IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN ; gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 936 ELSE ; gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 937 937 ENDIF 938 !gm Bug? check the gdepw_ 0938 !gm Bug? check the gdepw_1d 939 939 ! ... on ik 940 gdept (ji,jj,ik) = gdepw_0(ik) + ( gdepw (ji,jj,ik+1) - gdepw_0(ik) ) &941 & * ((gdept_0( ik ) - gdepw_0(ik) ) &942 & / ( gdepw_0( ik+1) - gdepw_0(ik) ))943 e3t (ji,jj,ik) = e3t_0 (ik) * ( gdepw (ji,jj,ik+1) - gdepw_0(ik) ) &944 & / ( gdepw_ 0( ik+1) - gdepw_0(ik) )945 e3w (ji,jj,ik) = 0.5_wp * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2._wp * gdepw_0(ik) ) &946 & * ( e3w_ 0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) )940 gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) ) & 941 & * ((gdept_1d( ik ) - gdepw_1d(ik) ) & 942 & / ( gdepw_1d( ik+1) - gdepw_1d(ik) )) 943 e3t_0(ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) ) & 944 & / ( gdepw_1d( ik+1) - gdepw_1d(ik) ) 945 e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) & 946 & * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 947 947 ! ... on ik+1 948 e3w (ji,jj,ik+1) = e3t(ji,jj,ik)949 e3t (ji,jj,ik+1) = e3t(ji,jj,ik)950 gdept (ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)948 e3w_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik) 949 e3t_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik) 950 gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 951 951 ENDIF 952 952 ENDIF … … 959 959 ik = mbathy(ji,jj) 960 960 IF( ik > 0 ) THEN ! ocean point only 961 e3tp (ji,jj) = e3t (ji,jj,ik)962 e3wp (ji,jj) = e3w (ji,jj,ik)961 e3tp (ji,jj) = e3t_0(ji,jj,ik) 962 e3wp (ji,jj) = e3w_0(ji,jj,ik) 963 963 ! test 964 zdiff= gdepw (ji,jj,ik+1) - gdept(ji,jj,ik )964 zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik ) 965 965 IF( zdiff <= 0._wp .AND. lwp ) THEN 966 966 it = it + 1 967 967 WRITE(numout,*) ' it = ', it, ' ik = ', ik, ' (i,j) = ', ji, jj 968 968 WRITE(numout,*) ' bathy = ', bathy(ji,jj) 969 WRITE(numout,*) ' gdept = ', gdept(ji,jj,ik), ' gdepw = ', gdepw(ji,jj,ik+1), ' zdiff = ', zdiff970 WRITE(numout,*) ' e3tp = ', e3t (ji,jj,ik), ' e3wp = ', e3w(ji,jj,ik )969 WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 970 WRITE(numout,*) ' e3tp = ', e3t_0 (ji,jj,ik), ' e3wp = ', e3w_0 (ji,jj,ik ) 971 971 ENDIF 972 972 ENDIF … … 976 976 ! Scale factors and depth at U-, V-, UW and VW-points 977 977 DO jk = 1, jpk ! initialisation to z-scale factors 978 e3u (:,:,jk) = e3t_0(jk)979 e3v (:,:,jk) = e3t_0(jk)980 e3uw (:,:,jk) = e3w_0(jk)981 e3vw (:,:,jk) = e3w_0(jk)978 e3u_0 (:,:,jk) = e3t_1d(jk) 979 e3v_0 (:,:,jk) = e3t_1d(jk) 980 e3uw_0(:,:,jk) = e3w_1d(jk) 981 e3vw_0(:,:,jk) = e3w_1d(jk) 982 982 END DO 983 983 DO jk = 1,jpk ! Computed as the minimum of neighbooring scale factors 984 984 DO jj = 1, jpjm1 985 985 DO ji = 1, fs_jpim1 ! vector opt. 986 e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )987 e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )988 e3uw (ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji+1,jj,jk) )989 e3vw (ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji,jj+1,jk) )990 END DO 991 END DO 992 END DO 993 CALL lbc_lnk( e3u , 'U', 1._wp ) ; CALL lbc_lnk( e3uw, 'U', 1._wp ) ! lateral boundary conditions994 CALL lbc_lnk( e3v , 'V', 1._wp ) ; CALL lbc_lnk( e3vw, 'V', 1._wp )986 e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) ) 987 e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) ) 988 e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) ) 989 e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) ) 990 END DO 991 END DO 992 END DO 993 CALL lbc_lnk( e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk( e3uw_0, 'U', 1._wp ) ! lateral boundary conditions 994 CALL lbc_lnk( e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 995 995 ! 996 996 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) 997 WHERE( e3u (:,:,jk) == 0._wp ) e3u (:,:,jk) = e3t_0(jk)998 WHERE( e3v (:,:,jk) == 0._wp ) e3v (:,:,jk) = e3t_0(jk)999 WHERE( e3uw (:,:,jk) == 0._wp ) e3uw(:,:,jk) = e3w_0(jk)1000 WHERE( e3vw (:,:,jk) == 0._wp ) e3vw(:,:,jk) = e3w_0(jk)997 WHERE( e3u_0 (:,:,jk) == 0._wp ) e3u_0 (:,:,jk) = e3t_1d(jk) 998 WHERE( e3v_0 (:,:,jk) == 0._wp ) e3v_0 (:,:,jk) = e3t_1d(jk) 999 WHERE( e3uw_0(:,:,jk) == 0._wp ) e3uw_0(:,:,jk) = e3w_1d(jk) 1000 WHERE( e3vw_0(:,:,jk) == 0._wp ) e3vw_0(:,:,jk) = e3w_1d(jk) 1001 1001 END DO 1002 1002 1003 1003 ! Scale factor at F-point 1004 1004 DO jk = 1, jpk ! initialisation to z-scale factors 1005 e3f (:,:,jk) = e3t_0(jk)1005 e3f_0(:,:,jk) = e3t_1d(jk) 1006 1006 END DO 1007 1007 DO jk = 1, jpk ! Computed as the minimum of neighbooring V-scale factors 1008 1008 DO jj = 1, jpjm1 1009 1009 DO ji = 1, fs_jpim1 ! vector opt. 1010 e3f (ji,jj,jk) = MIN( e3v(ji,jj,jk), e3v(ji+1,jj,jk) )1011 END DO 1012 END DO 1013 END DO 1014 CALL lbc_lnk( e3f , 'F', 1._wp ) ! Lateral boundary conditions1010 e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) ) 1011 END DO 1012 END DO 1013 END DO 1014 CALL lbc_lnk( e3f_0, 'F', 1._wp ) ! Lateral boundary conditions 1015 1015 ! 1016 1016 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) 1017 WHERE( e3f (:,:,jk) == 0._wp ) e3f(:,:,jk) = e3t_0(jk)1017 WHERE( e3f_0(:,:,jk) == 0._wp ) e3f_0(:,:,jk) = e3t_1d(jk) 1018 1018 END DO 1019 1019 !!gm bug ? : must be a do loop with mj0,mj1 1020 1020 ! 1021 e3t (:,mj0(1),:) = e3t(:,mj0(2),:) ! we duplicate factor scales for jj = 1 and jj = 21022 e3w (:,mj0(1),:) = e3w(:,mj0(2),:)1023 e3u (:,mj0(1),:) = e3u(:,mj0(2),:)1024 e3v (:,mj0(1),:) = e3v(:,mj0(2),:)1025 e3f (:,mj0(1),:) = e3f(:,mj0(2),:)1021 e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:) ! we duplicate factor scales for jj = 1 and jj = 2 1022 e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 1023 e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 1024 e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 1025 e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 1026 1026 1027 1027 ! Control of the sign 1028 IF( MINVAL( e3t (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3t<= 0' )1029 IF( MINVAL( e3w (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3w<= 0' )1030 IF( MINVAL( gdept (:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdepw< 0' )1031 IF( MINVAL( gdepw (:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdepw< 0' )1028 IF( MINVAL( e3t_0 (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3t_0 <= 0' ) 1029 IF( MINVAL( e3w_0 (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3w_0 <= 0' ) 1030 IF( MINVAL( gdept_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdept_0 < 0' ) 1031 IF( MINVAL( gdepw_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdepw_0 < 0' ) 1032 1032 1033 ! Compute gdep3w (vertical sum of e3w)1034 gdep3w (:,:,1) = 0.5_wp * e3w(:,:,1)1033 ! Compute gdep3w_0 (vertical sum of e3w) 1034 gdep3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 1035 1035 DO jk = 2, jpk 1036 gdep3w (:,:,jk) = gdep3w(:,:,jk-1) + e3w(:,:,jk)1036 gdep3w_0(:,:,jk) = gdep3w_0(:,:,jk-1) + e3w_0(:,:,jk) 1037 1037 END DO 1038 1038 … … 1043 1043 DO ji = 1, jpi 1044 1044 ik = MAX( mbathy(ji,jj), 1 ) 1045 zprt(ji,jj,1) = e3t (ji,jj,ik)1046 zprt(ji,jj,2) = e3w (ji,jj,ik)1047 zprt(ji,jj,3) = e3u (ji,jj,ik)1048 zprt(ji,jj,4) = e3v (ji,jj,ik)1049 zprt(ji,jj,5) = e3f (ji,jj,ik)1050 zprt(ji,jj,6) = gdep3w (ji,jj,ik)1045 zprt(ji,jj,1) = e3t_0 (ji,jj,ik) 1046 zprt(ji,jj,2) = e3w_0 (ji,jj,ik) 1047 zprt(ji,jj,3) = e3u_0 (ji,jj,ik) 1048 zprt(ji,jj,4) = e3v_0 (ji,jj,ik) 1049 zprt(ji,jj,5) = e3f_0 (ji,jj,ik) 1050 zprt(ji,jj,6) = gdep3w_0(ji,jj,ik) 1051 1051 END DO 1052 1052 END DO … … 1387 1387 ENDIF 1388 1388 1389 CALL lbc_lnk( e3t , 'T', 1._wp )1390 CALL lbc_lnk( e3u , 'U', 1._wp )1391 CALL lbc_lnk( e3v , 'V', 1._wp )1392 CALL lbc_lnk( e3f , 'F', 1._wp )1393 CALL lbc_lnk( e3w , 'W', 1._wp )1394 CALL lbc_lnk( e3uw , 'U', 1._wp )1395 CALL lbc_lnk( e3vw , 'V', 1._wp )1396 1397 fsdepw(:,:,:) = gdepw (:,:,:)1398 fsde3w(:,:,:) = gdep3w (:,:,:)1399 ! 1400 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1._wp1401 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1._wp1402 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1._wp1403 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1._wp1404 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1._wp1405 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1._wp1406 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1._wp1389 CALL lbc_lnk( e3t_0 , 'T', 1._wp ) 1390 CALL lbc_lnk( e3u_0 , 'U', 1._wp ) 1391 CALL lbc_lnk( e3v_0 , 'V', 1._wp ) 1392 CALL lbc_lnk( e3f_0 , 'F', 1._wp ) 1393 CALL lbc_lnk( e3w_0 , 'W', 1._wp ) 1394 CALL lbc_lnk( e3uw_0, 'U', 1._wp ) 1395 CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 1396 1397 fsdepw(:,:,:) = gdepw_0 (:,:,:) 1398 fsde3w(:,:,:) = gdep3w_0(:,:,:) 1399 ! 1400 where (e3t_0 (:,:,:).eq.0.0) e3t_0(:,:,:) = 1.0 1401 where (e3u_0 (:,:,:).eq.0.0) e3u_0(:,:,:) = 1.0 1402 where (e3v_0 (:,:,:).eq.0.0) e3v_0(:,:,:) = 1.0 1403 where (e3f_0 (:,:,:).eq.0.0) e3f_0(:,:,:) = 1.0 1404 where (e3w_0 (:,:,:).eq.0.0) e3w_0(:,:,:) = 1.0 1405 where (e3uw_0 (:,:,:).eq.0.0) e3uw_0(:,:,:) = 1.0 1406 where (e3vw_0 (:,:,:).eq.0.0) e3vw_0(:,:,:) = 1.0 1407 1407 1408 1408 #if defined key_agrif … … 1411 1411 ! 1412 1412 IF((nbondi == -1).OR.(nbondi == 2)) THEN 1413 e3u (1,:,:) = e3u(2,:,:)1413 e3u_0(1,:,:) = e3u_0(2,:,:) 1414 1414 ENDIF 1415 1415 ! 1416 1416 IF((nbondi == 1).OR.(nbondi == 2)) THEN 1417 e3u (nlci-1,:,:) = e3u(nlci-2,:,:)1417 e3u_0(nlci-1,:,:) = e3u_0(nlci-2,:,:) 1418 1418 ENDIF 1419 1419 ! 1420 1420 IF((nbondj == -1).OR.(nbondj == 2)) THEN 1421 e3v (:,1,:) = e3v(:,2,:)1421 e3v_0(:,1,:) = e3v_0(:,2,:) 1422 1422 ENDIF 1423 1423 ! 1424 1424 IF((nbondj == 1).OR.(nbondj == 2)) THEN 1425 e3v (:,nlcj-1,:) = e3v(:,nlcj-2,:)1425 e3v_0(:,nlcj-1,:) = e3v_0(:,nlcj-2,:) 1426 1426 ENDIF 1427 1427 ! … … 1429 1429 #endif 1430 1430 1431 fsdept(:,:,:) = gdept (:,:,:)1432 fsdepw(:,:,:) = gdepw (:,:,:)1433 fsde3w(:,:,:) = gdep3w (:,:,:)1434 fse3t (:,:,:) = e3t (:,:,:)1435 fse3u (:,:,:) = e3u (:,:,:)1436 fse3v (:,:,:) = e3v (:,:,:)1437 fse3f (:,:,:) = e3f (:,:,:)1438 fse3w (:,:,:) = e3w (:,:,:)1439 fse3uw(:,:,:) = e3uw (:,:,:)1440 fse3vw(:,:,:) = e3vw (:,:,:)1431 fsdept(:,:,:) = gdept_0 (:,:,:) 1432 fsdepw(:,:,:) = gdepw_0 (:,:,:) 1433 fsde3w(:,:,:) = gdep3w_0(:,:,:) 1434 fse3t (:,:,:) = e3t_0 (:,:,:) 1435 fse3u (:,:,:) = e3u_0 (:,:,:) 1436 fse3v (:,:,:) = e3v_0 (:,:,:) 1437 fse3f (:,:,:) = e3f_0 (:,:,:) 1438 fse3w (:,:,:) = e3w_0 (:,:,:) 1439 fse3uw(:,:,:) = e3uw_0 (:,:,:) 1440 fse3vw(:,:,:) = e3vw_0 (:,:,:) 1441 1441 !! 1442 1442 ! HYBRID : … … 1453 1453 1454 1454 IF( nprint == 1 .AND. lwp ) THEN ! min max values over the local domain 1455 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )1456 WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ), &1457 & ' w ', MINVAL( fsdepw(:,:,:) ), '3w ' , MINVAL( fsde3w(:,:,:) )1458 WRITE(numout,*) ' MIN val e3 t ', MINVAL( fse3t (:,:,:) ), ' f ' , MINVAL( fse3f(:,:,:) ), &1459 & ' u ', MINVAL( fse3u (:,:,:) ), ' u ' , MINVAL( fse3v(:,:,:) ), &1460 & ' uw', MINVAL( fse3uw(:,:,:) ), ' vw' , MINVAL( fse3vw(:,:,:) ), &1461 & ' w ', MINVAL( fse3w(:,:,:) )1462 1463 WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ), &1464 & ' w ', MAXVAL( fsdepw(:,:,:) ), '3w ' , MAXVAL( fsde3w(:,:,:) )1465 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( fse3t (:,:,:) ), ' f ' , MAXVAL( fse3f(:,:,:) ), &1466 & ' u ', MAXVAL( fse3u (:,:,:) ), ' u ' , MAXVAL( fse3v(:,:,:) ), &1467 & ' uw', MAXVAL( fse3uw(:,:,:) ), ' vw' , MAXVAL( fse3vw(:,:,:) ), &1468 & ' w ', MAXVAL( fse3w(:,:,:) )1455 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 1456 WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ), & 1457 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ' , MINVAL( gdep3w_0(:,:,:) ) 1458 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0 (:,:,:) ), ' f ' , MINVAL( e3f_0 (:,:,:) ), & 1459 & ' u ', MINVAL( e3u_0 (:,:,:) ), ' u ' , MINVAL( e3v_0 (:,:,:) ), & 1460 & ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw' , MINVAL( e3vw_0 (:,:,:) ), & 1461 & ' w ', MINVAL( e3w_0 (:,:,:) ) 1462 1463 WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ), & 1464 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ' , MAXVAL( gdep3w_0(:,:,:) ) 1465 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0 (:,:,:) ), ' f ' , MAXVAL( e3f_0 (:,:,:) ), & 1466 & ' u ', MAXVAL( e3u_0 (:,:,:) ), ' u ' , MAXVAL( e3v_0 (:,:,:) ), & 1467 & ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw' , MAXVAL( e3vw_0 (:,:,:) ), & 1468 & ' w ', MAXVAL( e3w_0 (:,:,:) ) 1469 1469 ENDIF 1470 1470 ! END DO … … 1473 1473 WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1) 1474 1474 WRITE(numout,*) ' ~~~~~~ --------------------' 1475 WRITE(numout,"(9x,' level gdept gdepw gde3w e3t e3w ')") 1476 WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(1,1,jk), fsdepw(1,1,jk), & 1477 & fse3t (1,1,jk), fse3w (1,1,jk), jk=1,jpk ) 1478 iip1 = MIN(20, jpiglo-1) ! for config with i smaller than 20 points 1479 ijp1 = MIN(20, jpjglo-1) ! for config with j smaller than 20 points 1480 DO jj = mj0(ijp1), mj1(ijp1) 1481 DO ji = mi0(iip1), mi1(iip1) 1475 WRITE(numout,"(9x,' level gdept_0 gdepw_0 e3t_0 e3w_0')") 1476 WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(1,1,jk), gdepw_0(1,1,jk), & 1477 & e3t_0 (1,1,jk) , e3w_0 (1,1,jk) , jk=1,jpk ) 1478 DO jj = mj0(20), mj1(20) 1479 DO ji = mi0(20), mi1(20) 1482 1480 WRITE(numout,*) 1483 WRITE(numout,*) ' domzgr: vertical coordinates : point (',iip1,',',ijp1,',k) bathy = ', & 1484 & bathy(ji,jj), hbatt(ji,jj) 1481 WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k) bathy = ', bathy(ji,jj), hbatt(ji,jj) 1485 1482 WRITE(numout,*) ' ~~~~~~ --------------------' 1486 WRITE(numout,"(9x,' level gdept gdepw gde3w e3t e3w ')") 1487 WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk), & 1488 & fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk ) 1489 END DO 1490 END DO 1491 iip1 = MIN( 74, jpiglo-1) 1492 ijp1 = MIN( 100, jpjglo-1) 1493 DO jj = mj0(ijp1), mj1(ijp1) 1494 DO ji = mi0(iip1), mi1(iip1) 1483 WRITE(numout,"(9x,' level gdept_0 gdepw_0 e3t_0 e3w_0')") 1484 WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk), & 1485 & e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk ) 1486 END DO 1487 END DO 1488 DO jj = mj0(74), mj1(74) 1489 DO ji = mi0(100), mi1(100) 1495 1490 WRITE(numout,*) 1496 WRITE(numout,*) ' domzgr: vertical coordinates : point (',iip1,',',ijp1,',k) bathy = ', & 1497 & bathy(ji,jj), hbatt(ji,jj) 1491 WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k) bathy = ', bathy(ji,jj), hbatt(ji,jj) 1498 1492 WRITE(numout,*) ' ~~~~~~ --------------------' 1499 WRITE(numout,"(9x,' level gdept gdepw gde3w e3t e3w')")1500 WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk), &1501 & fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )1493 WRITE(numout,"(9x,' level gdept_0 gdepw_0 e3t_0 e3w_0')") 1494 WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk), & 1495 & e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk ) 1502 1496 END DO 1503 1497 END DO … … 1617 1611 zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 1618 1612 zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 1619 gdept (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft )1620 gdepw (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw )1621 gdep3w (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft )1613 gdept_0 (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft ) 1614 gdepw_0 (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw ) 1615 gdep3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft ) 1622 1616 END DO 1623 1617 ! … … 1640 1634 & / ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 1641 1635 ! 1642 e3t (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )1643 e3u (ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )1644 e3v (ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )1645 e3f (ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )1636 e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 1637 e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 1638 e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 1639 e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 1646 1640 ! 1647 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )1648 e3uw (ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )1649 e3vw (ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )1641 e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 1642 e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 1643 e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 1650 1644 END DO 1651 1645 END DO … … 1745 1739 1746 1740 DO jk = 1, jpk 1747 gdept (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk)1748 gdepw (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk)1749 gdep3w (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk)1741 gdept_0 (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk) 1742 gdepw_0 (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk) 1743 gdep3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk) 1750 1744 END DO 1751 1745 … … 1769 1763 ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 1770 1764 1771 e3t (ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk)1772 e3u (ji,jj,jk)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj,jk)1773 e3v (ji,jj,jk)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj,jk)1774 e3f (ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk)1765 e3t_0(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk) 1766 e3u_0(ji,jj,jk)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj,jk) 1767 e3v_0(ji,jj,jk)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj,jk) 1768 e3f_0(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk) 1775 1769 ! 1776 e3w (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)1777 e3uw (ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk)1778 e3vw (ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk)1770 e3w_0(ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk) 1771 e3uw_0(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk) 1772 e3vw_0(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk) 1779 1773 END DO 1780 1774 1781 1775 ENDDO 1782 1776 ENDDO 1777 ! 1778 CALL lbc_lnk(e3t_0 ,'T',1.) ; CALL lbc_lnk(e3u_0 ,'T',1.) 1779 CALL lbc_lnk(e3v_0 ,'T',1.) ; CALL lbc_lnk(e3f_0 ,'T',1.) 1780 CALL lbc_lnk(e3w_0 ,'T',1.) 1781 CALL lbc_lnk(e3uw_0,'T',1.) ; CALL lbc_lnk(e3vw_0,'T',1.) 1783 1782 ! 1784 1783 ! ! ============= … … 1838 1837 zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 1839 1838 zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 1840 gdept (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft )1841 gdepw (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw )1842 gdep3w (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft )1839 gdept_0 (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft ) 1840 gdepw_0 (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw ) 1841 gdep3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft ) 1843 1842 END DO 1844 1843 !!gm: e3uw, e3vw can be suppressed (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays) … … 1846 1845 DO ji = 1, jpi 1847 1846 DO jk = 1, jpk 1848 e3t (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )1849 e3u (ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )1850 e3v (ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )1851 e3f (ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )1847 e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) ) 1848 e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) ) 1849 e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) ) 1850 e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) ) 1852 1851 ! 1853 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )1854 e3uw (ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )1855 e3vw (ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )1852 e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) ) 1853 e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) ) 1854 e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) ) 1856 1855 END DO 1857 1856 END DO … … 1878 1877 !!---------------------------------------------------------------------- 1879 1878 ! 1880 pf = ( TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1 ,wp) + rn_thetb ) ) &1879 pf = ( TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb ) ) & 1881 1880 & - TANH( rn_thetb * rn_theta ) ) & 1882 1881 & * ( COSH( rn_theta ) & … … 1904 1903 ! 1905 1904 IF ( rn_theta == 0 ) then ! uniform sigma 1906 pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 ,wp)1905 pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 ) 1907 1906 ELSE ! stretched sigma 1908 pf1 = ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1 ,wp)) ) ) / SINH( rn_theta ) &1909 & + pbb * ( (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1 ,wp)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta ) ) &1907 pf1 = ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta ) & 1908 & + pbb * ( (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta ) ) & 1910 1909 & / ( 2._wp * TANH( 0.5_wp * rn_theta ) ) ) 1911 1910 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
