- 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/TRD/trdglo.F90 (modified) (15 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/TRD/trdglo.F90
r10425 r12928 51 51 52 52 !! * Substitutions 53 # include " vectopt_loop_substitute.h90"53 # include "do_loop_substitute.h90" 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 59 59 CONTAINS 60 60 61 SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt )61 SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt, Kmm ) 62 62 !!--------------------------------------------------------------------- 63 63 !! *** ROUTINE trd_glo *** … … 72 72 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type (='DYN'/'TRA') 73 73 INTEGER , INTENT(in ) :: kt ! time step 74 INTEGER , INTENT(in ) :: Kmm ! time level index 74 75 !! 75 76 INTEGER :: ji, jj, jk ! dummy loop indices 76 77 INTEGER :: ikbu, ikbv ! local integers 77 REAL(wp):: zvm, zvt, zvs, z1_2r au0 ! local scalars78 REAL(wp):: zvm, zvt, zvs, z1_2rho0 ! local scalars 78 79 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 79 80 !!---------------------------------------------------------------------- … … 84 85 ! 85 86 CASE( 'TRA' ) !== Tracers (T & S) ==! 86 DO jk = 1, jpkm1 ! global sum of mask volume trend and trend*T (including interior mask) 87 DO jj = 1, jpj 88 DO ji = 1, jpi 89 zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 90 zvt = ptrdx(ji,jj,jk) * zvm 91 zvs = ptrdy(ji,jj,jk) * zvm 92 tmo(ktrd) = tmo(ktrd) + zvt 93 smo(ktrd) = smo(ktrd) + zvs 94 t2 (ktrd) = t2(ktrd) + zvt * tsn(ji,jj,jk,jp_tem) 95 s2 (ktrd) = s2(ktrd) + zvs * tsn(ji,jj,jk,jp_sal) 96 END DO 97 END DO 98 END DO 87 DO_3D_11_11( 1, jpkm1 ) 88 zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 89 zvt = ptrdx(ji,jj,jk) * zvm 90 zvs = ptrdy(ji,jj,jk) * zvm 91 tmo(ktrd) = tmo(ktrd) + zvt 92 smo(ktrd) = smo(ktrd) + zvs 93 t2 (ktrd) = t2(ktrd) + zvt * ts(ji,jj,jk,jp_tem,Kmm) 94 s2 (ktrd) = s2(ktrd) + zvs * ts(ji,jj,jk,jp_sal,Kmm) 95 END_3D 99 96 ! ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 100 97 IF( ln_linssh .AND. ktrd == jptra_zad ) THEN 101 tmo(jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) )102 smo(jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:) )103 t2 (jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) )104 s2 (jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:) )98 tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 99 smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 100 t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 101 s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 105 102 ENDIF 106 103 ! … … 117 114 ! 118 115 CASE( 'DYN' ) !== Momentum and KE ==! 119 DO jk = 1, jpkm1 120 DO jj = 1, jpjm1 121 DO ji = 1, jpim1 122 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 123 & * e1e2u (ji,jj) * e3u_n(ji,jj,jk) 124 zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 125 & * e1e2v (ji,jj) * e3u_n(ji,jj,jk) 126 umo(ktrd) = umo(ktrd) + zvt 127 vmo(ktrd) = vmo(ktrd) + zvs 128 hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs 129 END DO 130 END DO 131 END DO 116 DO_3D_10_10( 1, jpkm1 ) 117 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 118 & * e1e2u (ji,jj) * e3u(ji,jj,jk,Kmm) 119 zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 120 & * e1e2v (ji,jj) * e3u(ji,jj,jk,Kmm) 121 umo(ktrd) = umo(ktrd) + zvt 122 vmo(ktrd) = vmo(ktrd) + zvs 123 hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 124 END_3D 132 125 ! 133 126 IF( ktrd == jpdyn_zdf ) THEN ! zdf trend: compute separately the surface forcing trend 134 z1_2rau0 = 0.5_wp / rau0 135 DO jj = 1, jpjm1 136 DO ji = 1, jpim1 137 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 138 & * z1_2rau0 * e1e2u(ji,jj) 139 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 140 & * z1_2rau0 * e1e2v(ji,jj) 141 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 142 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 143 hke(jpdyn_tau) = hke(jpdyn_tau) + un(ji,jj,1) * zvt + vn(ji,jj,1) * zvs 144 END DO 145 END DO 127 z1_2rho0 = 0.5_wp / rho0 128 DO_2D_10_10 129 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 130 & * z1_2rho0 * e1e2u(ji,jj) 131 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 132 & * z1_2rho0 * e1e2v(ji,jj) 133 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 134 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 135 hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 136 END_2D 146 137 ENDIF 147 138 ! … … 150 141 ! ! 151 142 ! IF( ln_drgimp ) THEN ! implicit drag case: compute separately the bottom friction 152 ! z1_2r au0 = 0.5_wp / rau0143 ! z1_2rho0 = 0.5_wp / rho0 153 144 ! DO jj = 1, jpjm1 154 145 ! DO ji = 1, jpim1 155 146 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 156 147 ! ikbv = mbkv(ji,jj) 157 ! zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * u n(ji,jj,ikbu) * e1e2u(ji,jj)158 ! zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * v n(ji,jj,ikbv) * e1e2v(ji,jj)148 ! zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu(ji,jj,ikbu,Kmm) * e1e2u(ji,jj) 149 ! zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv(ji,jj,ikbv,Kmm) * e1e2v(ji,jj) 159 150 ! umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 160 151 ! vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs 161 ! hke(jpdyn_bfri) = hke(jpdyn_bfri) + u n(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs152 ! hke(jpdyn_bfri) = hke(jpdyn_bfri) + uu(ji,jj,ikbu,Kmm) * zvt + vv(ji,jj,ikbv,Kmm) * zvs 162 153 ! END DO 163 154 ! END DO … … 183 174 184 175 185 SUBROUTINE glo_dyn_wri( kt )176 SUBROUTINE glo_dyn_wri( kt, Kmm ) 186 177 !!--------------------------------------------------------------------- 187 178 !! *** ROUTINE glo_dyn_wri *** … … 190 181 !!---------------------------------------------------------------------- 191 182 INTEGER, INTENT(in) :: kt ! ocean time-step index 183 INTEGER, INTENT(in) :: Kmm ! time level index 192 184 ! 193 185 INTEGER :: ji, jj, jk ! dummy loop indices … … 209 201 zkepe(:,:,:) = 0._wp 210 202 211 CALL eos( ts n, rhd, rhop ) ! now potential density212 213 zcof = 0.5_wp / r au0 ! Density flux at w-point203 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop ) ! now potential density 204 205 zcof = 0.5_wp / rho0 ! Density flux at w-point 214 206 zkz(:,:,1) = 0._wp 215 207 DO jk = 2, jpk 216 zkz(:,:,jk) = zcof * e1e2t(:,:) * w n(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)208 zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 217 209 END DO 218 210 219 zcof = 0.5_wp / rau0 ! Density flux at u and v-points 220 DO jk = 1, jpkm1 221 DO jj = 1, jpjm1 222 DO ji = 1, jpim1 223 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 224 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 225 END DO 226 END DO 227 END DO 211 zcof = 0.5_wp / rho0 ! Density flux at u and v-points 212 DO_3D_10_10( 1, jpkm1 ) 213 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 214 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 215 END_3D 228 216 229 DO jk = 1, jpkm1 ! Density flux divergence at t-point 230 DO jj = 2, jpjm1 231 DO ji = 2, jpim1 232 zkepe(ji,jj,jk) = - ( zkz(ji,jj,jk) - zkz(ji ,jj ,jk+1) & 233 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & 234 & + zky(ji,jj,jk) - zky(ji ,jj-1,jk ) ) & 235 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 236 END DO 237 END DO 238 END DO 217 DO_3D_00_00( 1, jpkm1 ) 218 zkepe(ji,jj,jk) = - ( zkz(ji,jj,jk) - zkz(ji ,jj ,jk+1) & 219 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & 220 & + zky(ji,jj,jk) - zky(ji ,jj-1,jk ) ) & 221 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 222 END_3D 239 223 240 224 ! I.2 Basin averaged kinetic energy trend … … 242 226 peke = 0._wp 243 227 DO jk = 1, jpkm1 244 peke = peke + SUM( zkepe(:,:,jk) * gdept _n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) )228 peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) ) 245 229 END DO 246 230 peke = grav * peke … … 363 347 9546 FORMAT(' 0 < horizontal diffusion : ', e20.13) 364 348 9547 FORMAT(' 0 < vertical diffusion : ', e20.13) 365 9548 FORMAT(' pressure gradient u2 = - 1/r au0 u.dz(rhop) : ', e20.13, ' u.dz(rhop) =', e20.13)349 9548 FORMAT(' pressure gradient u2 = - 1/rho0 u.dz(rhop) : ', e20.13, ' u.dz(rhop) =', e20.13) 366 350 ! 367 351 ! Save potential to kinetic energy conversion for next time step … … 506 490 507 491 508 SUBROUTINE trd_glo_init 492 SUBROUTINE trd_glo_init( Kmm ) 509 493 !!--------------------------------------------------------------------- 510 494 !! *** ROUTINE trd_glo_init *** … … 512 496 !! ** Purpose : Read the namtrd namelist 513 497 !!---------------------------------------------------------------------- 498 INTEGER, INTENT(in) :: Kmm ! time level index 514 499 INTEGER :: ji, jj, jk ! dummy loop indices 515 500 !!---------------------------------------------------------------------- … … 524 509 tvolt = 0._wp 525 510 DO jk = 1, jpkm1 526 tvolt = tvolt + SUM( e1e2t(:,:) * e3t _n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )511 tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) ) 527 512 END DO 528 513 CALL mpp_sum( 'trdglo', tvolt ) ! sum over the global domain … … 538 523 tvolv = 0._wp 539 524 540 DO jk = 1, jpk 541 DO jj = 2, jpjm1 542 DO ji = fs_2, fs_jpim1 ! vector opt. 543 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 544 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 545 END DO 546 END DO 547 END DO 525 DO_3D_00_00( 1, jpk ) 526 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 527 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 528 END_3D 548 529 CALL mpp_sum( 'trdglo', tvolu ) ! sums over the global domain 549 530 CALL mpp_sum( 'trdglo', tvolv )
Note: See TracChangeset
for help on using the changeset viewer.
