- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/ZDF/zdfdrg.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/ZDF/zdfdrg.F90
r12178 r12928 73 73 74 74 !! * Substitutions 75 # include " vectopt_loop_substitute.h90"75 # include "do_loop_substitute.h90" 76 76 !!---------------------------------------------------------------------- 77 77 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 81 81 CONTAINS 82 82 83 SUBROUTINE zdf_drg( kt, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0, & ! <<== in83 SUBROUTINE zdf_drg( kt, Kmm, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0, & ! <<== in 84 84 & pCdU ) ! ==>> out : bottom drag [m/s] 85 85 !!---------------------------------------------------------------------- … … 99 99 !!---------------------------------------------------------------------- 100 100 INTEGER , INTENT(in ) :: kt ! ocean time-step index 101 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 101 102 ! ! !! !== top or bottom variables ==! 102 103 INTEGER , DIMENSION(:,:), INTENT(in ) :: k_mk ! wet level (1st or last) … … 114 115 ! 115 116 IF( l_log_not_linssh ) THEN !== "log layer" ==! compute Cd and -Cd*|U| 116 DO jj = 2, jpjm1 117 DO ji = 2, jpim1 118 imk = k_mk(ji,jj) ! ocean bottom level at t-points 119 zut = un(ji,jj,imk) + un(ji-1,jj,imk) ! 2 x velocity at t-point 120 zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 121 zzz = 0.5_wp * e3t_n(ji,jj,imk) ! altitude below/above (top/bottom) the boundary 122 ! 117 DO_2D_00_00 118 imk = k_mk(ji,jj) ! ocean bottom level at t-points 119 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point 120 zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm) 121 zzz = 0.5_wp * e3t(ji,jj,imk,Kmm) ! altitude below/above (top/bottom) the boundary 122 ! 123 123 !!JC: possible WAD implementation should modify line below if layers vanish 124 zcd = ( vkarmn / LOG( zzz / pz0 ) )**2 125 zcd = pCd0(ji,jj) * MIN( MAX( pCdmin , zcd ) , pCdmax ) ! here pCd0 = mask*boost 126 pCdU(ji,jj) = - zcd * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 127 END DO 128 END DO 124 zcd = ( vkarmn / LOG( zzz / pz0 ) )**2 125 zcd = pCd0(ji,jj) * MIN( MAX( pCdmin , zcd ) , pCdmax ) ! here pCd0 = mask*boost 126 pCdU(ji,jj) = - zcd * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 127 END_2D 129 128 ELSE !== standard Cd ==! 130 DO jj = 2, jpjm1 131 DO ji = 2, jpim1 132 imk = k_mk(ji,jj) ! ocean bottom level at t-points 133 zut = un(ji,jj,imk) + un(ji-1,jj,imk) ! 2 x velocity at t-point 134 zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 135 ! ! here pCd0 = mask*boost * drag 136 pCdU(ji,jj) = - pCd0(ji,jj) * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 137 END DO 138 END DO 139 ENDIF 140 ! 141 IF(ln_ctl) CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 129 DO_2D_00_00 130 imk = k_mk(ji,jj) ! ocean bottom level at t-points 131 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point 132 zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm) 133 ! ! here pCd0 = mask*boost * drag 134 pCdU(ji,jj) = - pCd0(ji,jj) * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 135 END_2D 136 ENDIF 137 ! 138 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 142 139 ! 143 140 END SUBROUTINE zdf_drg 144 141 145 142 146 SUBROUTINE zdf_drg_exp( kt, pub, pvb, pua, pva )143 SUBROUTINE zdf_drg_exp( kt, Kmm, pub, pvb, pua, pva ) 147 144 !!---------------------------------------------------------------------- 148 145 !! *** ROUTINE zdf_drg_exp *** … … 157 154 !!--------------------------------------------------------------------- 158 155 INTEGER , INTENT(in ) :: kt ! ocean time-step index 156 INTEGER , INTENT(in ) :: Kmm ! time level indices 159 157 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pub, pvb ! the two components of the before velocity 160 158 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! the two components of the velocity tendency … … 167 165 !!--------------------------------------------------------------------- 168 166 ! 169 !!gm bug : time step is only r dt (not 2 rdt if euler start !)170 zm1_2dt = - 1._wp / ( 2._wp * r dt )167 !!gm bug : time step is only rn_Dt (not 2 rn_Dt if euler start !) 168 zm1_2dt = - 1._wp / ( 2._wp * rn_Dt ) 171 169 172 170 IF( l_trddyn ) THEN ! trends: store the input trends … … 176 174 ENDIF 177 175 178 DO jj = 2, jpjm1 179 DO ji = 2, jpim1 180 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 181 ikbv = mbkv(ji,jj) 176 DO_2D_00_00 177 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 178 ikbv = mbkv(ji,jj) 179 ! 180 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 181 zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u(ji,jj,ikbu,Kmm) 182 zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v(ji,jj,ikbv,Kmm) 183 ! 184 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu) 185 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv) 186 END_2D 187 ! 188 IF( ln_isfcav ) THEN ! ocean cavities 189 DO_2D_00_00 190 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 191 ikbv = mikv(ji,jj) 182 192 ! 183 193 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 184 zCdu = 0.5*( rCdU_ bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu)185 zCdv = 0.5*( rCdU_ bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv)194 zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u(ji,jj,ikbu,Kmm) ! NB: Cdtop masked 195 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v(ji,jj,ikbv,Kmm) 186 196 ! 187 197 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu) 188 198 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv) 189 END DO 190 END DO 191 ! 192 IF( ln_isfcav ) THEN ! ocean cavities 193 DO jj = 2, jpjm1 194 DO ji = 2, jpim1 195 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 196 ikbv = mikv(ji,jj) 197 ! 198 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 199 zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu) ! NB: Cdtop masked 200 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 201 ! 202 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu) 203 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv) 204 END DO 205 END DO 199 END_2D 206 200 ENDIF 207 201 ! … … 209 203 ztrdu(:,:,:) = pua(:,:,:) - ztrdu(:,:,:) 210 204 ztrdv(:,:,:) = pva(:,:,:) - ztrdv(:,:,:) 211 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )205 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt, Kmm ) 212 206 DEALLOCATE( ztrdu, ztrdv ) 213 207 ENDIF 214 208 ! ! print mean trends (used for debugging) 215 IF( ln_ctl) CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr - Ua: ', mask1=umask, &216 & tab3d_2=pva, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )209 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr - Ua: ', mask1=umask, & 210 & tab3d_2=pva, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 217 211 ! 218 212 END SUBROUTINE zdf_drg_exp … … 236 230 ! !== drag nature ==! 237 231 ! 238 REWIND( numnam_ref ) ! Namelist namdrg in reference namelist239 232 READ ( numnam_ref, namdrg, IOSTAT = ios, ERR = 901) 240 233 901 IF( ios /= 0 ) CALL ctl_nam( ios , 'namdrg in reference namelist' ) 241 REWIND( numnam_cfg ) ! Namelist namdrg in configuration namelist242 234 READ ( numnam_cfg, namdrg, IOSTAT = ios, ERR = 902 ) 243 235 902 IF( ios > 0 ) CALL ctl_nam( ios , 'namdrg in configuration namelist' ) … … 335 327 ! !== read namlist ==! 336 328 ! 337 REWIND( numnam_ref ) ! Namelist cl_namdrg in reference namelist338 329 IF(ll_top) READ ( numnam_ref, namdrg_top, IOSTAT = ios, ERR = 901) 339 330 IF(ll_bot) READ ( numnam_ref, namdrg_bot, IOSTAT = ios, ERR = 901) 340 331 901 IF( ios /= 0 ) CALL ctl_nam( ios , TRIM(cl_namref) ) 341 REWIND( numnam_cfg ) ! Namelist cd_namdrg in configuration namelist342 332 IF(ll_top) READ ( numnam_cfg, namdrg_top, IOSTAT = ios, ERR = 902 ) 343 333 IF(ll_bot) READ ( numnam_cfg, namdrg_bot, IOSTAT = ios, ERR = 902 ) … … 431 421 l_log_not_linssh = .FALSE. !- don't update Cd at each time step 432 422 ! 433 DO jj = 1, jpj ! pCd0 = mask (and boosted) logarithmic drag coef. 434 DO ji = 1, jpi 435 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 436 zcd = ( vkarmn / LOG( zzz / rn_z0 ) )**2 437 pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN( MAX( rn_Cd0 , zcd ) , rn_Cdmax ) ! rn_Cd0 < Cd0 < rn_Cdmax 438 END DO 439 END DO 423 DO_2D_11_11 424 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 425 zcd = ( vkarmn / LOG( zzz / rn_z0 ) )**2 426 pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN( MAX( rn_Cd0 , zcd ) , rn_Cdmax ) ! rn_Cd0 < Cd0 < rn_Cdmax 427 END_2D 440 428 ELSE !* Cd updated at each time-step ==> pCd0 = mask * boost 441 429 IF(lwp) WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.
