- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRD/trdglo.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdglo.F90
r10425 r13463 51 51 52 52 !! * Substitutions 53 # include "vectopt_loop_substitute.h90" 53 # include "do_loop_substitute.h90" 54 # include "domzgr_substitute.h90" 54 55 !!---------------------------------------------------------------------- 55 56 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 59 60 CONTAINS 60 61 61 SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt )62 SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt, Kmm ) 62 63 !!--------------------------------------------------------------------- 63 64 !! *** ROUTINE trd_glo *** … … 72 73 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type (='DYN'/'TRA') 73 74 INTEGER , INTENT(in ) :: kt ! time step 75 INTEGER , INTENT(in ) :: Kmm ! time level index 74 76 !! 75 77 INTEGER :: ji, jj, jk ! dummy loop indices 76 78 INTEGER :: ikbu, ikbv ! local integers 77 REAL(wp):: zvm, zvt, zvs, z1_2r au0 ! local scalars79 REAL(wp):: zvm, zvt, zvs, z1_2rho0 ! local scalars 78 80 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 79 81 !!---------------------------------------------------------------------- … … 84 86 ! 85 87 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 88 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 89 zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * 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 * ts(ji,jj,jk,jp_tem,Kmm) 95 s2 (ktrd) = s2(ktrd) + zvs * ts(ji,jj,jk,jp_sal,Kmm) 96 END_3D 99 97 ! ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 100 98 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(:,:) )99 tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 100 smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 101 t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 102 s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 105 103 ENDIF 106 104 ! … … 117 115 ! 118 116 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 117 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 118 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 119 & * e1e2u (ji,jj) * e3u(ji,jj,jk,Kmm) 120 zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 121 & * e1e2v (ji,jj) * e3u(ji,jj,jk,Kmm) 122 umo(ktrd) = umo(ktrd) + zvt 123 vmo(ktrd) = vmo(ktrd) + zvs 124 hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 125 END_3D 132 126 ! 133 127 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 128 z1_2rho0 = 0.5_wp / rho0 129 DO_2D( 1, 0, 1, 0 ) 130 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 131 & * z1_2rho0 * e1e2u(ji,jj) 132 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 133 & * z1_2rho0 * e1e2v(ji,jj) 134 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 135 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 136 hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 137 END_2D 146 138 ENDIF 147 139 ! … … 150 142 ! ! 151 143 ! IF( ln_drgimp ) THEN ! implicit drag case: compute separately the bottom friction 152 ! z1_2r au0 = 0.5_wp / rau0144 ! z1_2rho0 = 0.5_wp / rho0 153 145 ! DO jj = 1, jpjm1 154 146 ! DO ji = 1, jpim1 155 147 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 156 148 ! 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)149 ! zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu(ji,jj,ikbu,Kmm) * e1e2u(ji,jj) 150 ! zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv(ji,jj,ikbv,Kmm) * e1e2v(ji,jj) 159 151 ! umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 160 152 ! vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs 161 ! hke(jpdyn_bfri) = hke(jpdyn_bfri) + u n(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs153 ! hke(jpdyn_bfri) = hke(jpdyn_bfri) + uu(ji,jj,ikbu,Kmm) * zvt + vv(ji,jj,ikbv,Kmm) * zvs 162 154 ! END DO 163 155 ! END DO … … 183 175 184 176 185 SUBROUTINE glo_dyn_wri( kt )177 SUBROUTINE glo_dyn_wri( kt, Kmm ) 186 178 !!--------------------------------------------------------------------- 187 179 !! *** ROUTINE glo_dyn_wri *** … … 190 182 !!---------------------------------------------------------------------- 191 183 INTEGER, INTENT(in) :: kt ! ocean time-step index 184 INTEGER, INTENT(in) :: Kmm ! time level index 192 185 ! 193 186 INTEGER :: ji, jj, jk ! dummy loop indices … … 209 202 zkepe(:,:,:) = 0._wp 210 203 211 CALL eos( ts n, rhd, rhop ) ! now potential density212 213 zcof = 0.5_wp / r au0 ! Density flux at w-point204 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop ) ! now potential density 205 206 zcof = 0.5_wp / rho0 ! Density flux at w-point 214 207 zkz(:,:,1) = 0._wp 215 208 DO jk = 2, jpk 216 zkz(:,:,jk) = zcof * e1e2t(:,:) * w n(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)209 zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 217 210 END DO 218 211 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 212 zcof = 0.5_wp / rho0 ! Density flux at u and v-points 213 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 214 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) & 215 & * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 216 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) & 217 & * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 218 END_3D 228 219 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 220 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 221 zkepe(ji,jj,jk) = - ( zkz(ji,jj,jk) - zkz(ji ,jj ,jk+1) & 222 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & 223 & + zky(ji,jj,jk) - zky(ji ,jj-1,jk ) ) & 224 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 225 END_3D 239 226 240 227 ! I.2 Basin averaged kinetic energy trend … … 242 229 peke = 0._wp 243 230 DO jk = 1, jpkm1 244 peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) ) 231 peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) & 232 & * e3t(:,:,jk,Kmm) ) 245 233 END DO 246 234 peke = grav * peke … … 363 351 9546 FORMAT(' 0 < horizontal diffusion : ', e20.13) 364 352 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)353 9548 FORMAT(' pressure gradient u2 = - 1/rho0 u.dz(rhop) : ', e20.13, ' u.dz(rhop) =', e20.13) 366 354 ! 367 355 ! Save potential to kinetic energy conversion for next time step … … 506 494 507 495 508 SUBROUTINE trd_glo_init 496 SUBROUTINE trd_glo_init( Kmm ) 509 497 !!--------------------------------------------------------------------- 510 498 !! *** ROUTINE trd_glo_init *** … … 512 500 !! ** Purpose : Read the namtrd namelist 513 501 !!---------------------------------------------------------------------- 502 INTEGER, INTENT(in) :: Kmm ! time level index 514 503 INTEGER :: ji, jj, jk ! dummy loop indices 515 504 !!---------------------------------------------------------------------- … … 524 513 tvolt = 0._wp 525 514 DO jk = 1, jpkm1 526 tvolt = tvolt + SUM( e1e2t(:,:) * e3t _n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )515 tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) ) 527 516 END DO 528 517 CALL mpp_sum( 'trdglo', tvolt ) ! sum over the global domain … … 538 527 tvolv = 0._wp 539 528 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 529 DO_3D( 0, 0, 0, 0, 1, jpk ) 530 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) & 531 & * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 532 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) & 533 & * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 534 END_3D 548 535 CALL mpp_sum( 'trdglo', tvolu ) ! sums over the global domain 549 536 CALL mpp_sum( 'trdglo', tvolv )
Note: See TracChangeset
for help on using the changeset viewer.
