Changeset 12377 for NEMO/trunk/src/OCE/TRD
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 10 edited
-
. (modified) (1 prop)
-
src/OCE/TRD/trddyn.F90 (modified) (9 diffs)
-
src/OCE/TRD/trdglo.F90 (modified) (14 diffs)
-
src/OCE/TRD/trdini.F90 (modified) (5 diffs)
-
src/OCE/TRD/trdken.F90 (modified) (14 diffs)
-
src/OCE/TRD/trdmxl.F90 (modified) (9 diffs)
-
src/OCE/TRD/trdpen.F90 (modified) (6 diffs)
-
src/OCE/TRD/trdtra.F90 (modified) (16 diffs)
-
src/OCE/TRD/trdtrc.F90 (modified) (1 diff)
-
src/OCE/TRD/trdvor.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/TRD/trddyn.F90
r10425 r12377 36 36 37 37 !! * Substitutions 38 # include " vectopt_loop_substitute.h90"38 # include "do_loop_substitute.h90" 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 44 44 CONTAINS 45 45 46 SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt )46 SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt, Kmm ) 47 47 !!--------------------------------------------------------------------- 48 48 !! *** ROUTINE trd_mod *** … … 55 55 INTEGER , INTENT(in ) :: ktrd ! trend index 56 56 INTEGER , INTENT(in ) :: kt ! time step 57 INTEGER , INTENT(in ) :: Kmm ! time level index 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 66 67 ! 3D output of momentum and/or tracers trends using IOM interface 67 68 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 68 IF( ln_dyn_trd ) CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt )69 IF( ln_dyn_trd ) CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm ) 69 70 70 71 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 71 72 ! Integral Constraints Properties for momentum and/or tracers trends 72 73 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 73 IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt )74 IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt, Kmm ) 74 75 75 76 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 76 77 ! Kinetic Energy trends 77 78 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 78 IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt )79 IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt, Kmm ) 79 80 80 81 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 81 82 ! Vorticity trends 82 83 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 83 IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt )84 IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt, Kmm ) 84 85 85 86 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 91 92 92 93 93 SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt )94 SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm ) 94 95 !!--------------------------------------------------------------------- 95 96 !! *** ROUTINE trd_dyn_iom *** … … 100 101 INTEGER , INTENT(in ) :: ktrd ! trend index 101 102 INTEGER , INTENT(in ) :: kt ! time step 103 INTEGER , INTENT(in ) :: Kmm ! time level index 102 104 ! 103 105 INTEGER :: ji, jj, jk ! dummy loop indices … … 121 123 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 122 124 z3dy(:,:,:) = 0._wp 123 DO jk = 1, jpkm1 ! no mask as un,vn are masked 124 DO jj = 2, jpjm1 125 DO ji = 2, jpim1 126 z3dx(ji,jj,jk) = un(ji,jj,jk) * ( un(ji+1,jj,jk) - un(ji-1,jj,jk) ) / ( 2._wp * e1u(ji,jj) ) 127 z3dy(ji,jj,jk) = vn(ji,jj,jk) * ( vn(ji,jj+1,jk) - vn(ji,jj-1,jk) ) / ( 2._wp * e2v(ji,jj) ) 128 END DO 129 END DO 130 END DO 125 DO_3D_00_00( 1, jpkm1 ) 126 z3dx(ji,jj,jk) = uu(ji,jj,jk,Kmm) * ( uu(ji+1,jj,jk,Kmm) - uu(ji-1,jj,jk,Kmm) ) / ( 2._wp * e1u(ji,jj) ) 127 z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) ) 128 END_3D 131 129 CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 132 130 CALL iom_put( "utrd_udx", z3dx ) … … 142 140 ! ! wind stress trends 143 141 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 144 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u _n(:,:,1) * rau0 )145 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v _n(:,:,1) * rau0 )142 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u(:,:,1,Kmm) * rau0 ) 143 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v(:,:,1,Kmm) * rau0 ) 146 144 CALL iom_put( "utrd_tau", z2dx ) 147 145 CALL iom_put( "vtrd_tau", z2dy ) … … 159 157 ! ikbv = mbkv(ji,jj) 160 158 ! z3dx(ji,jj,jk) = 0.5 * ( rCdU_bot(ji+1,jj) + rCdU_bot(ji,jj) ) & 161 ! & * u n(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)159 ! & * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 162 160 ! z3dy(ji,jj,jk) = 0.5 * ( rCdU_bot(ji,jj+1) + rCdU_bot(ji,jj) ) & 163 ! & * v n(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)161 ! & * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 164 162 ! END DO 165 163 ! END DO -
NEMO/trunk/src/OCE/TRD/trdglo.F90
r10425 r12377 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 … … 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 127 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 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_2rau0 * 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_2rau0 * 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 ! … … 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 density203 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop ) ! now potential density 212 204 213 205 zcof = 0.5_wp / rau0 ! 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 211 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 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 … … 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 ) -
NEMO/trunk/src/OCE/TRD/trdini.F90
r11536 r12377 25 25 PUBLIC trd_init ! called by nemogcm.F90 module 26 26 27 !! * Substitutions28 # include "vectopt_loop_substitute.h90"29 27 !!---------------------------------------------------------------------- 30 28 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 34 32 CONTAINS 35 33 36 SUBROUTINE trd_init 34 SUBROUTINE trd_init( Kmm ) 37 35 !!---------------------------------------------------------------------- 38 36 !! *** ROUTINE trd_init *** … … 40 38 !! ** Purpose : Initialization of trend diagnostics 41 39 !!---------------------------------------------------------------------- 40 INTEGER, INTENT(in) :: Kmm ! time level index 42 41 INTEGER :: ios ! local integer 43 42 !! … … 46 45 !!---------------------------------------------------------------------- 47 46 ! 48 REWIND( numnam_ref ) ! Namelist namtrd in reference namelist : trends diagnostic49 47 READ ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901 ) 50 48 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in reference namelist' ) 51 49 ! 52 REWIND( numnam_cfg ) ! Namelist namtrd in configuration namelist : trends diagnostic53 50 READ ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 ) 54 51 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist' ) … … 96 93 97 94 ! ! diagnostic initialization 98 IF( ln_glo_trd ) CALL trd_glo_init ! global domain averaged trends95 IF( ln_glo_trd ) CALL trd_glo_init( Kmm ) ! global domain averaged trends 99 96 IF( ln_tra_mxl ) CALL trd_mxl_init ! mixed-layer trends 100 97 IF( ln_vor_trd ) CALL trd_vor_init ! barotropic vorticity trends -
NEMO/trunk/src/OCE/TRD/trdken.F90
r10425 r12377 40 40 41 41 !! * Substitutions 42 # include " vectopt_loop_substitute.h90"42 # include "do_loop_substitute.h90" 43 43 !!---------------------------------------------------------------------- 44 44 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 59 59 60 60 61 SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt )61 SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt, Kmm ) 62 62 !!--------------------------------------------------------------------- 63 63 !! *** ROUTINE trd_ken *** … … 67 67 !! ** Method : - apply lbc to the input masked velocity trends 68 68 !! - compute the associated KE trend: 69 !! zke = 0.5 * ( mi-1[ u n * putrd * bu ] + mj-1[ vn* pvtrd * bv] ) / bt69 !! zke = 0.5 * ( mi-1[ uu(Kmm) * putrd * bu ] + mj-1[ vv(Kmm) * pvtrd * bv] ) / bt 70 70 !! where bu, bv, bt are the volume of u-, v- and t-boxes. 71 71 !! - vertical diffusion case (jpdyn_zdf): … … 80 80 INTEGER , INTENT(in ) :: ktrd ! trend index 81 81 INTEGER , INTENT(in ) :: kt ! time step 82 INTEGER , INTENT(in ) :: Kmm ! time level index 82 83 ! 83 84 INTEGER :: ji, jj, jk ! dummy loop indices … … 92 93 nkstp = kt 93 94 DO jk = 1, jpkm1 94 bu (:,:,jk) = e1e2u(:,:) * e3u _n(:,:,jk)95 bv (:,:,jk) = e1e2v(:,:) * e3v _n(:,:,jk)96 r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t _n(:,:,jk) * tmask(:,:,jk)95 bu (:,:,jk) = e1e2u(:,:) * e3u(:,:,jk,Kmm) 96 bv (:,:,jk) = e1e2v(:,:) * e3v(:,:,jk,Kmm) 97 r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) * tmask(:,:,jk) 97 98 END DO 98 99 ! … … 100 101 zke(1,:, : ) = 0._wp 101 102 zke(:,1, : ) = 0._wp 102 DO jk = 1, jpkm1 103 DO jj = 2, jpj 104 DO ji = 2, jpi 105 zke(ji,jj,jk) = 0.5_wp * rau0 *( un(ji ,jj,jk) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) & 106 & + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) & 107 & + vn(ji,jj ,jk) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) & 108 & + vn(ji,jj-1,jk) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk) ) * r1_bt(ji,jj,jk) 109 END DO 110 END DO 111 END DO 103 DO_3D_01_01( 1, jpkm1 ) 104 zke(ji,jj,jk) = 0.5_wp * rau0 *( uu(ji ,jj,jk,Kmm) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) & 105 & + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) & 106 & + vv(ji,jj ,jk,Kmm) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) & 107 & + vv(ji,jj-1,jk,Kmm) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk) ) * r1_bt(ji,jj,jk) 108 END_3D 112 109 ! 113 110 SELECT CASE( ktrd ) … … 122 119 ! ! ! wind stress trends 123 120 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) ) 124 z2dx(:,:) = u n(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1)125 z2dy(:,:) = v n(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1)121 z2dx(:,:) = uu(:,:,1,Kmm) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 122 z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 126 123 zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp 127 DO jj = 2, jpj 128 DO ji = 2, jpi 129 zke2d(ji,jj) = r1_rau0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 130 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 131 END DO 132 END DO 124 DO_2D_01_01 125 zke2d(ji,jj) = r1_rau0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 126 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 127 END_2D 133 128 CALL iom_put( "ketrd_tau" , zke2d ) ! 134 129 DEALLOCATE( z2dx , z2dy , zke2d ) … … 141 136 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 142 137 ! ikbv = mbkv(ji,jj) 143 ! z2dx(ji,jj) = u n(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu)144 ! z2dy(ji,jj) = v n(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv)138 ! z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) 139 ! z2dy(ji,jj) = vv(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) 145 140 ! END DO 146 141 ! END DO … … 157 152 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf" , zke ) ! asselin filter trends 158 153 !! a faire !!!! idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 159 !! reflechir a une possible sauvegarde du "vrai" u n,vnpour le calcul de atf....154 !! reflechir a une possible sauvegarde du "vrai" uu(Kmm),vv(Kmm) pour le calcul de atf.... 160 155 ! 161 156 ! IF( ln_drgimp ) THEN ! bottom friction (implicit case) … … 164 159 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 165 160 ! ikbv = mbkv(ji,jj) 166 ! z2dx(ji,jj) = u n(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)167 ! z2dy(ji,jj) = u n(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)161 ! z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 162 ! z2dy(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 168 163 ! END DO 169 164 ! END DO … … 179 174 CASE( jpdyn_ken ) ; ! kinetic energy 180 175 ! called in dynnxt.F90 before asselin time filter 181 ! with putrd=u a and pvtrd=va176 ! with putrd=uu(Krhs) and pvtrd=vv(Krhs) 182 177 zke(:,:,:) = 0.5_wp * zke(:,:,:) 183 178 CALL iom_put( "KE", zke ) 184 179 ! 185 CALL ken_p2k( kt , zke )180 CALL ken_p2k( kt , zke, Kmm ) 186 181 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 187 182 ! … … 191 186 192 187 193 SUBROUTINE ken_p2k( kt , pconv )188 SUBROUTINE ken_p2k( kt , pconv, Kmm ) 194 189 !!--------------------------------------------------------------------- 195 190 !! *** ROUTINE ken_p2k *** … … 202 197 !!---------------------------------------------------------------------- 203 198 INTEGER , INTENT(in ) :: kt ! ocean time-step index 199 INTEGER , INTENT(in ) :: Kmm ! time level index 204 200 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pconv ! 205 201 ! … … 214 210 215 211 ! Surface value (also valid in partial step case) 216 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * w n(:,:,1) * e3w_n(:,:,1)212 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * ww(:,:,1) * e3w(:,:,1,Kmm) 217 213 218 214 ! interior value (2=<jk=<jpkm1) 219 215 DO jk = 2, jpk 220 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * w n(:,:,jk) * e3w_n(:,:,jk)216 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * ww(:,:,jk) * e3w(:,:,jk,Kmm) 221 217 END DO 222 218 223 219 ! conv value on T-point 224 DO jk = 1, jpkm1 225 DO jj = 1, jpj 226 DO ji = 1, jpi 227 zcoef = 0.5_wp / e3t_n(ji,jj,jk) 228 pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 229 END DO 230 END DO 231 END DO 220 DO_3D_11_11( 1, jpkm1 ) 221 zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm) 222 pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 223 END_3D 232 224 ! 233 225 END SUBROUTINE ken_p2k -
NEMO/trunk/src/OCE/TRD/trdmxl.F90
r11536 r12377 68 68 INTEGER :: ionce, icount 69 69 70 !! * Substitutions 71 # include "do_loop_substitute.h90" 70 72 !!---------------------------------------------------------------------- 71 73 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 86 88 87 89 88 SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln )90 SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln, Kmm ) 89 91 !!---------------------------------------------------------------------- 90 92 !! *** ROUTINE trd_tra_mng *** … … 98 100 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 99 101 INTEGER , INTENT(in ) :: kt ! time step index 102 INTEGER , INTENT(in ) :: Kmm ! time level index 100 103 REAL(wp) , INTENT(in ) :: p2dt ! time step [s] 101 104 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: kmxln ! number of t-box for the vertical average … … 116 119 ! 117 120 wkx(:,:,:) = 0._wp !== now ML weights for vertical averaging ==! 118 DO jk = 1, jpktrd ! initialize wkx with vertical scale factor in mixed-layer 119 DO jj = 1,jpj 120 DO ji = 1,jpi 121 IF( jk - kmxln(ji,jj) < 0 ) wkx(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 122 END DO 123 END DO 124 END DO 121 DO_3D_11_11( 1, jpktrd ) 122 IF( jk - kmxln(ji,jj) < 0 ) wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 123 END_3D 125 124 hmxl(:,:) = 0._wp ! NOW mixed-layer depth 126 125 DO jk = 1, jpktrd … … 136 135 tml(:,:) = 0._wp ; sml(:,:) = 0._wp 137 136 DO jk = 1, jpktrd 138 tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts n(:,:,jk,jp_tem)139 sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts n(:,:,jk,jp_sal)137 tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_tem,Kmm) 138 sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_sal,Kmm) 140 139 END DO 141 140 ! … … 371 370 hmxlbn(:,:) = hmxl(:,:) 372 371 373 IF( ln_ctl ) THEN372 IF( sn_cfctl%l_prtctl ) THEN 374 373 WRITE(numout,*) ' we reach kt == nit000 + 1 = ', nit000+1 375 374 CALL prt_ctl(tab2d_1=tmlbb , clinfo1=' tmlbb - : ', mask1=tmask) … … 380 379 END IF 381 380 382 IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. ( ln_ctl )) THEN381 IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. sn_cfctl%l_prtctl ) THEN 383 382 IF( ln_trdmxl_instant ) THEN 384 383 WRITE(numout,*) ' restart from kt == nit000 = ', nit000 … … 548 547 hmxlbn (:,:) = hmxl (:,:) 549 548 550 IF( ln_ctl ) THEN549 IF( sn_cfctl%l_prtctl ) THEN 551 550 IF( ln_trdmxl_instant ) THEN 552 551 CALL prt_ctl(tab2d_1=tmlbb , clinfo1=' tmlbb - : ', mask1=tmask) … … 732 731 !!---------------------------------------------------------------------- 733 732 ! 734 REWIND( numnam_ref ) ! Namelist namtrd_mxl in reference namelist : mixed layer trends diagnostic735 733 READ ( numnam_ref, namtrd_mxl, IOSTAT = ios, ERR = 901 ) 736 734 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist' ) 737 735 738 REWIND( numnam_cfg ) ! Namelist namtrd_mxl in configuration namelist : mixed layer trends diagnostic739 736 READ ( numnam_cfg, namtrd_mxl, IOSTAT = ios, ERR = 902 ) 740 737 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist' ) -
NEMO/trunk/src/OCE/TRD/trdpen.F90
r10425 r12377 35 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: rab_pe ! partial derivatives of PE anomaly with respect to T and S 36 36 37 !! * Substitutions38 # include "vectopt_loop_substitute.h90"39 37 !!---------------------------------------------------------------------- 40 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 55 53 56 54 57 SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt )55 SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt, Kmm ) 58 56 !!--------------------------------------------------------------------- 59 57 !! *** ROUTINE trd_tra_mng *** … … 66 64 INTEGER , INTENT(in) :: ktrd ! tracer trend index 67 65 INTEGER , INTENT(in) :: kt ! time step index 66 INTEGER , INTENT(in) :: Kmm ! time level index 68 67 REAL(wp) , INTENT(in) :: pdt ! time step [s] 69 68 ! … … 77 76 IF( kt /= nkstp ) THEN ! full eos: set partial derivatives at the 1st call of kt time step 78 77 nkstp = kt 79 CALL eos_pen( ts n, rab_PE, zpe)78 CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm ) 80 79 CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) ) 81 80 CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) ) … … 95 94 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 96 95 ALLOCATE( z2d(jpi,jpj) ) 97 z2d(:,:) = w n(:,:,1) * ( &98 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts n(:,:,1,jp_tem) &99 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts n(:,:,1,jp_sal) &100 & ) / e3t _n(:,:,1)96 z2d(:,:) = ww(:,:,1) * ( & 97 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm) & 98 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm) & 99 & ) / e3t(:,:,1,Kmm) 101 100 CALL iom_put( "petrd_sad" , z2d ) 102 101 DEALLOCATE( z2d ) … … 112 111 CASE ( jptra_bbc ) ; CALL iom_put( "petrd_bbc" , zpe ) ! bottom bound cond (geoth flux) 113 112 CASE ( jptra_atf ) ; CALL iom_put( "petrd_atf" , zpe ) ! asselin time filter (last trend) 114 !IF( ln_linssh ) THEN ! cst volume : ssh term (otherwise include in e3t variation)115 ! ALLOCATE( z2d(jpi,jpj) )116 ! z2d(:,:) = ( ssha(:,:) - sshb(:,:) ) &117 ! & * ( dPE_dt(:,:,1) * tsn(:,:,1,jp_tem) &118 ! & + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal) ) / ( e3t_n(:,:,1) * pdt )119 ! CALL iom_put( "petrd_sad" , z2d )120 ! DEALLOCATE( z2d )121 !ENDIF122 113 ! 123 114 END SELECT -
NEMO/trunk/src/OCE/TRD/trdtra.F90
r10425 r12377 41 41 42 42 !! * Substitutions 43 # include " vectopt_loop_substitute.h90"43 # include "do_loop_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 60 60 61 61 62 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )62 SUBROUTINE trd_tra( kt, Kmm, Krhs, ctype, ktra, ktrd, ptrd, pu, ptra ) 63 63 !!--------------------------------------------------------------------- 64 64 !! *** ROUTINE trd_tra *** … … 77 77 INTEGER , INTENT(in) :: ktra ! tracer index 78 78 INTEGER , INTENT(in) :: ktrd ! tracer trend index 79 INTEGER , INTENT(in) :: Kmm, Krhs ! time level indices 79 80 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux 80 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu n! now velocity81 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! now velocity 81 82 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 82 83 ! … … 94 95 SELECT CASE( ktrd ) 95 96 ! ! advection: transform the advective flux into a trend 96 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pu n, ptra, 'X', trdtx)97 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd, pu n, ptra, 'Y', trdty)98 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd, pu n, ptra, 'Z', trdt )97 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm ) 98 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Y', trdty, Kmm ) 99 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Z', trdt, Kmm ) 99 100 CASE( jptra_bbc, & ! qsr, bbc: on temperature only, send to trd_tra_mng 100 101 & jptra_qsr ) ; trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 101 102 ztrds(:,:,:) = 0._wp 102 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )103 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 103 104 !!gm Gurvan, verify the jptra_evd trend please ! 104 105 CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) … … 114 115 ! ! advection: transform the advective flux into a trend 115 116 ! ! and send T & S trends to trd_tra_mng 116 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'X' , ztrds)117 CALL trd_tra_mng( trdtx, ztrds, ktrd, kt )118 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Y' , ztrds)119 CALL trd_tra_mng( trdty, ztrds, ktrd, kt )120 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Z' , ztrds)121 CALL trd_tra_mng( trdt , ztrds, ktrd, kt )117 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X' , ztrds, Kmm ) 118 CALL trd_tra_mng( trdtx, ztrds, ktrd, kt, Kmm ) 119 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Y' , ztrds, Kmm ) 120 CALL trd_tra_mng( trdty, ztrds, ktrd, kt, Kmm ) 121 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Z' , ztrds, Kmm ) 122 CALL trd_tra_mng( trdt , ztrds, ktrd, kt, Kmm ) 122 123 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 123 124 ! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" … … 127 128 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 128 129 DO jk = 2, jpk 129 zwt(:,:,jk) = avt(:,:,jk) * ( ts a(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)130 zws(:,:,jk) = avs(:,:,jk) * ( ts a(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)130 zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 131 zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 131 132 END DO 132 133 ! 133 134 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 134 135 DO jk = 1, jpkm1 135 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t _n(:,:,jk)136 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t _n(:,:,jk)136 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 137 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 137 138 END DO 138 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )139 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt, Kmm ) 139 140 ! 140 141 ! ! Also calculate EVD trend at this point. 141 142 zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes 142 143 DO jk = 2, jpk 143 zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts a(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)144 zws(:,:,jk) = avt_evd(:,:,jk) * ( ts a(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)144 zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 145 zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 145 146 END DO 146 147 ! 147 148 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 148 149 DO jk = 1, jpkm1 149 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t _n(:,:,jk)150 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t _n(:,:,jk)150 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 151 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 151 152 END DO 152 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )153 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt, Kmm ) 153 154 ! 154 155 DEALLOCATE( zwt, zws, ztrdt ) … … 156 157 CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng 157 158 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 158 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )159 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 159 160 END SELECT 160 161 ENDIF … … 164 165 SELECT CASE( ktrd ) 165 166 ! ! advection: transform the advective flux into a masked trend 166 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'X', ztrds)167 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Y', ztrds)168 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Z', ztrds)167 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm ) 168 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Y', ztrds, Kmm ) 169 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Z', ztrds, Kmm ) 169 170 CASE DEFAULT ! other trends: just masked 170 171 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 171 172 END SELECT 172 173 ! ! send trend to trd_trc 173 CALL trd_trc( ztrds, ktra, ktrd, kt )174 CALL trd_trc( ztrds, ktra, ktrd, kt, Kmm ) 174 175 ! 175 176 ENDIF … … 178 179 179 180 180 SUBROUTINE trd_tra_adv( pf, pu n, ptn, cdir, ptrd)181 SUBROUTINE trd_tra_adv( pf, pu, pt, cdir, ptrd, Kmm ) 181 182 !!--------------------------------------------------------------------- 182 183 !! *** ROUTINE trd_tra_adv *** … … 191 192 !!---------------------------------------------------------------------- 192 193 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pf ! advective flux in one direction 193 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu n! now velocity in one direction194 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt n! now or before tracer194 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu ! now velocity in one direction 195 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt ! now or before tracer 195 196 CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction 196 197 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction 198 INTEGER, INTENT(in) :: Kmm ! time level index 197 199 ! 198 200 INTEGER :: ji, jj, jk ! dummy loop indices … … 211 213 ptrd(:,:,jpk) = 0._wp 212 214 ! 213 DO jk = 1, jpkm1 ! advective trend 214 DO jj = 2, jpjm1 215 DO ji = fs_2, fs_jpim1 ! vector opt. 216 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 217 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) & 218 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 219 END DO 220 END DO 221 END DO 215 DO_3D_00_00( 1, jpkm1 ) 216 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 217 & - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk) ) & 218 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 219 END_3D 222 220 ! 223 221 END SUBROUTINE trd_tra_adv 224 222 225 223 226 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt )224 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm ) 227 225 !!--------------------------------------------------------------------- 228 226 !! *** ROUTINE trd_tra_mng *** … … 236 234 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 237 235 INTEGER , INTENT(in ) :: kt ! time step 236 INTEGER , INTENT(in ) :: Kmm ! time level index 238 237 !!---------------------------------------------------------------------- 239 238 … … 243 242 244 243 ! ! 3D output of tracers trends using IOM interface 245 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )244 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm ) 246 245 247 246 ! ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 248 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )247 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm ) 249 248 250 249 ! ! Potential ENergy trends 251 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt )250 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt, Kmm ) 252 251 253 252 ! ! Mixed layer trends for active tracers … … 290 289 291 290 292 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt )291 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm ) 293 292 !!--------------------------------------------------------------------- 294 293 !! *** ROUTINE trd_tra_iom *** … … 300 299 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 301 300 INTEGER , INTENT(in ) :: kt ! time step 301 INTEGER , INTENT(in ) :: Kmm ! time level index 302 302 !! 303 303 INTEGER :: ji, jj, jk ! dummy loop indices … … 326 326 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 327 327 ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) ) 328 z2dx(:,:) = w n(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1)329 z2dy(:,:) = w n(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1)328 z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm) 329 z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm) 330 330 CALL iom_put( "ttrd_sad", z2dx ) 331 331 CALL iom_put( "strd_sad", z2dy ) -
NEMO/trunk/src/OCE/TRD/trdtrc.F90
r10068 r12377 9 9 CONTAINS 10 10 11 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )11 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 12 12 INTEGER :: kt, kjn, ktrd 13 INTEGER :: Kmm ! time level index 13 14 REAL :: ptrtrd(:,:,:) 14 15 WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) -
NEMO/trunk/src/OCE/TRD/trdvor.F90
r11536 r12377 56 56 57 57 !! * Substitutions 58 # include " vectopt_loop_substitute.h90"58 # include "do_loop_substitute.h90" 59 59 !!---------------------------------------------------------------------- 60 60 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 78 78 79 79 80 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt )80 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt, Kmm ) 81 81 !!---------------------------------------------------------------------- 82 82 !! *** ROUTINE trd_vor *** … … 88 88 INTEGER , INTENT(in ) :: ktrd ! trend index 89 89 INTEGER , INTENT(in ) :: kt ! time step 90 INTEGER , INTENT(in ) :: Kmm ! time level index 90 91 ! 91 92 INTEGER :: ji, jj ! dummy loop indices … … 94 95 95 96 SELECT CASE( ktrd ) 96 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg ) ! Hydrostatique Pressure Gradient97 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg ) ! KE Gradient98 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo ) ! Relative Vorticity99 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo ) ! Planetary Vorticity Term100 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf ) ! Horizontal Diffusion101 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad ) ! Vertical Advection102 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg ) ! Surface Pressure Grad.97 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm ) ! Hydrostatique Pressure Gradient 98 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg, Kmm ) ! KE Gradient 99 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo, Kmm ) ! Relative Vorticity 100 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo, Kmm ) ! Planetary Vorticity Term 101 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf, Kmm ) ! Horizontal Diffusion 102 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm ) ! Vertical Advection 103 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm ) ! Surface Pressure Grad. 103 104 CASE( jpdyn_zdf ) ! Vertical Diffusion 104 105 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 105 DO jj = 2, jpjm1 ! wind stress trends 106 DO ji = fs_2, fs_jpim1 ! vector opt. 107 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 ) 108 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 ) 109 END DO 110 END DO 111 ! 112 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf ) ! zdf trend including surf./bot. stresses 113 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf ) ! surface wind stress 106 DO_2D_00_00 107 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rau0 ) 108 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rau0 ) 109 END_2D 110 ! 111 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm ) ! zdf trend including surf./bot. stresses 112 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm ) ! surface wind stress 114 113 CASE( jpdyn_bfr ) 115 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr ) ! Bottom stress114 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr, Kmm ) ! Bottom stress 116 115 ! 117 116 CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends 118 CALL trd_vor_iom( kt )117 CALL trd_vor_iom( kt, Kmm ) 119 118 END SELECT 120 119 ! … … 122 121 123 122 124 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )123 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd, Kmm ) 125 124 !!---------------------------------------------------------------------------- 126 125 !! *** ROUTINE trd_vor_zint *** … … 150 149 !!---------------------------------------------------------------------- 151 150 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 151 INTEGER , INTENT(in ) :: Kmm ! time level index 152 152 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend 153 153 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvtrdvor ! v vorticity trend … … 171 171 ! 172 172 CASE( jpvor_bfr ) ! bottom friction 173 DO jj = 2, jpjm1 174 DO ji = fs_2, fs_jpim1 175 ikbu = mbkv(ji,jj) 176 ikbv = mbkv(ji,jj) 177 zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 178 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 179 END DO 180 END DO 173 DO_2D_00_00 174 ikbu = mbkv(ji,jj) 175 ikbv = mbkv(ji,jj) 176 zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu) 177 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,ikbv,Kmm) * e2v(ji,jj) * vmask(ji,jj,ikbv) 178 END_2D 181 179 ! 182 180 CASE( jpvor_swf ) ! wind stress 183 zudpvor(:,:) = putrdvor(:,:) * e3u _n(:,:,1) * e1u(:,:) * umask(:,:,1)184 zvdpvor(:,:) = pvtrdvor(:,:) * e3v _n(:,:,1) * e2v(:,:) * vmask(:,:,1)181 zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1) 182 zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1) 185 183 ! 186 184 END SELECT 187 185 188 186 ! Average except for Beta.V 189 zudpvor(:,:) = zudpvor(:,:) * r1_hu _n(:,:)190 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv _n(:,:)187 zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 188 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 191 189 192 190 ! Curl … … 207 205 208 206 209 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )207 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd , Kmm ) 210 208 !!---------------------------------------------------------------------------- 211 209 !! *** ROUTINE trd_vor_zint *** … … 236 234 ! 237 235 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 236 INTEGER , INTENT(in ) :: Kmm ! time level index 238 237 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: putrdvor ! u vorticity trend 239 238 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvtrdvor ! v vorticity trend … … 257 256 ! putrdvor and pvtrdvor terms 258 257 DO jk = 1,jpk 259 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u _n(:,:,jk) * e1u(:,:) * umask(:,:,jk)260 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v _n(:,:,jk) * e2v(:,:) * vmask(:,:,jk)258 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk) 259 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk) 261 260 END DO 262 261 … … 273 272 END DO 274 273 ! Average of the Curl and Surface mask 275 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu _n(:,:) * fmask(:,:,1)274 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 276 275 ENDIF 277 276 ! 278 277 ! Average 279 zudpvor(:,:) = zudpvor(:,:) * r1_hu _n(:,:)280 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv _n(:,:)278 zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 279 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 281 280 ! 282 281 ! Curl … … 298 297 299 298 300 SUBROUTINE trd_vor_iom( kt )299 SUBROUTINE trd_vor_iom( kt , Kmm ) 301 300 !!---------------------------------------------------------------------- 302 301 !! *** ROUTINE trd_vor *** … … 306 305 !!---------------------------------------------------------------------- 307 306 INTEGER , INTENT(in ) :: kt ! time step 307 INTEGER , INTENT(in ) :: Kmm ! time level index 308 308 ! 309 309 INTEGER :: ji, jj, jk, jl ! dummy loop indices 310 310 INTEGER :: it, itmod ! local integers 311 311 REAL(wp) :: zmean ! local scalars 312 REAL(wp), DIMENSION(jpi,jpj) :: zu n, zvn312 REAL(wp), DIMENSION(jpi,jpj) :: zuu, zvv 313 313 !!---------------------------------------------------------------------- 314 314 … … 327 327 328 328 vor_avr (:,:) = 0._wp 329 zu n(:,:) = 0._wp330 zv n(:,:) = 0._wp329 zuu (:,:) = 0._wp 330 zvv (:,:) = 0._wp 331 331 vor_avrtot(:,:) = 0._wp 332 332 vor_avrres(:,:) = 0._wp … … 334 334 ! Vertically averaged velocity 335 335 DO jk = 1, jpk - 1 336 zu n(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk)337 zv n(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk)336 zuu(:,:) = zuu(:,:) + e1u(:,:) * uu(:,:,jk,Kmm) * e3u(:,:,jk,Kmm) 337 zvv(:,:) = zvv(:,:) + e2v(:,:) * vv(:,:,jk,Kmm) * e3v(:,:,jk,Kmm) 338 338 END DO 339 339 340 zu n(:,:) = zun(:,:) * r1_hu_n(:,:)341 zv n(:,:) = zvn(:,:) * r1_hv_n(:,:)340 zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm) 341 zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm) 342 342 343 343 ! Curl 344 344 DO ji = 1, jpim1 345 345 DO jj = 1, jpjm1 346 vor_avr(ji,jj) = ( ( zv n(ji+1,jj) - zvn(ji,jj) ) &347 & - ( zu n(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)346 vor_avr(ji,jj) = ( ( zvv(ji+1,jj) - zvv(ji,jj) ) & 347 & - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 348 348 END DO 349 349 END DO
Note: See TracChangeset
for help on using the changeset viewer.
