- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 11 edited
-
. (modified) (1 prop)
-
src/OCE/TRD/trddyn.F90 (modified) (9 diffs)
-
src/OCE/TRD/trdglo.F90 (modified) (15 diffs)
-
src/OCE/TRD/trdini.F90 (modified) (5 diffs)
-
src/OCE/TRD/trdken.F90 (modified) (14 diffs)
-
src/OCE/TRD/trdmxl.F90 (modified) (13 diffs)
-
src/OCE/TRD/trdmxl_rst.F90 (modified) (2 diffs)
-
src/OCE/TRD/trdpen.F90 (modified) (7 diffs)
-
src/OCE/TRD/trdtra.F90 (modified) (16 diffs)
-
src/OCE/TRD/trdtrc.F90 (modified) (2 diffs)
-
src/OCE/TRD/trdvor.F90 (modified) (31 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/trddyn.F90
r10425 r13463 36 36 37 37 !! * Substitutions 38 # include "vectopt_loop_substitute.h90" 38 # include "do_loop_substitute.h90" 39 # include "domzgr_substitute.h90" 39 40 !!---------------------------------------------------------------------- 40 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 44 45 CONTAINS 45 46 46 SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt )47 SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt, Kmm ) 47 48 !!--------------------------------------------------------------------- 48 49 !! *** ROUTINE trd_mod *** … … 55 56 INTEGER , INTENT(in ) :: ktrd ! trend index 56 57 INTEGER , INTENT(in ) :: kt ! time step 58 INTEGER , INTENT(in ) :: Kmm ! time level index 57 59 !!---------------------------------------------------------------------- 58 60 ! … … 66 68 ! 3D output of momentum and/or tracers trends using IOM interface 67 69 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 68 IF( ln_dyn_trd ) CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt )70 IF( ln_dyn_trd ) CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm ) 69 71 70 72 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 71 73 ! Integral Constraints Properties for momentum and/or tracers trends 72 74 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 73 IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt )75 IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt, Kmm ) 74 76 75 77 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 76 78 ! Kinetic Energy trends 77 79 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 78 IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt )80 IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt, Kmm ) 79 81 80 82 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 81 83 ! Vorticity trends 82 84 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 83 IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt )85 IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt, Kmm ) 84 86 85 87 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 91 93 92 94 93 SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt )95 SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm ) 94 96 !!--------------------------------------------------------------------- 95 97 !! *** ROUTINE trd_dyn_iom *** … … 100 102 INTEGER , INTENT(in ) :: ktrd ! trend index 101 103 INTEGER , INTENT(in ) :: kt ! time step 104 INTEGER , INTENT(in ) :: Kmm ! time level index 102 105 ! 103 106 INTEGER :: ji, jj, jk ! dummy loop indices … … 121 124 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 122 125 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 131 CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 126 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 127 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) ) 128 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) ) 129 END_3D 130 CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 132 131 CALL iom_put( "utrd_udx", z3dx ) 133 132 CALL iom_put( "vtrd_vdy", z3dy ) … … 142 141 ! ! wind stress trends 143 142 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 )143 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u(:,:,1,Kmm) * rho0 ) 144 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v(:,:,1,Kmm) * rho0 ) 146 145 CALL iom_put( "utrd_tau", z2dx ) 147 146 CALL iom_put( "vtrd_tau", z2dy ) … … 159 158 ! ikbv = mbkv(ji,jj) 160 159 ! 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)160 ! & * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 162 161 ! 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)162 ! & * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 164 163 ! END DO 165 164 ! END DO 166 165 ! END DO 167 ! CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1. , z3dy, 'V', -1.)166 ! CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 168 167 ! CALL iom_put( "utrd_bfr", z3dx ) 169 168 ! CALL iom_put( "vtrd_bfr", z3dy ) -
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 ) -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdini.F90
r10068 r13463 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 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in reference namelist' , lwp)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 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist' , lwp)51 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist' ) 55 52 IF(lwm) WRITE( numond, namtrd ) 56 53 ! … … 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/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdken.F90
r10425 r13463 40 40 41 41 !! * Substitutions 42 # include "vectopt_loop_substitute.h90" 42 # include "do_loop_substitute.h90" 43 # include "domzgr_substitute.h90" 43 44 !!---------------------------------------------------------------------- 44 45 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 59 60 60 61 61 SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt )62 SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt, Kmm ) 62 63 !!--------------------------------------------------------------------- 63 64 !! *** ROUTINE trd_ken *** … … 67 68 !! ** Method : - apply lbc to the input masked velocity trends 68 69 !! - compute the associated KE trend: 69 !! zke = 0.5 * ( mi-1[ u n * putrd * bu ] + mj-1[ vn* pvtrd * bv] ) / bt70 !! zke = 0.5 * ( mi-1[ uu(Kmm) * putrd * bu ] + mj-1[ vv(Kmm) * pvtrd * bv] ) / bt 70 71 !! where bu, bv, bt are the volume of u-, v- and t-boxes. 71 72 !! - vertical diffusion case (jpdyn_zdf): … … 80 81 INTEGER , INTENT(in ) :: ktrd ! trend index 81 82 INTEGER , INTENT(in ) :: kt ! time step 83 INTEGER , INTENT(in ) :: Kmm ! time level index 82 84 ! 83 85 INTEGER :: ji, jj, jk ! dummy loop indices … … 88 90 !!---------------------------------------------------------------------- 89 91 ! 90 CALL lbc_lnk_multi( 'trdken', putrd, 'U', -1. , pvtrd, 'V', -1.) ! lateral boundary conditions92 CALL lbc_lnk_multi( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp ) ! lateral boundary conditions 91 93 ! 92 94 nkstp = kt 93 95 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)96 bu (:,:,jk) = e1e2u(:,:) * e3u(:,:,jk,Kmm) 97 bv (:,:,jk) = e1e2v(:,:) * e3v(:,:,jk,Kmm) 98 r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) * tmask(:,:,jk) 97 99 END DO 98 100 ! … … 100 102 zke(1,:, : ) = 0._wp 101 103 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 104 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 105 zke(ji,jj,jk) = 0.5_wp * rho0 *( uu(ji ,jj,jk,Kmm) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) & 106 & + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) & 107 & + vv(ji,jj ,jk,Kmm) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) & 108 & + vv(ji,jj-1,jk,Kmm) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk) ) * r1_bt(ji,jj,jk) 109 END_3D 112 110 ! 113 111 SELECT CASE( ktrd ) … … 122 120 ! ! ! wind stress trends 123 121 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)122 z2dx(:,:) = uu(:,:,1,Kmm) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 123 z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 126 124 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 125 DO_2D( 0, 1, 0, 1 ) 126 zke2d(ji,jj) = r1_rho0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 127 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 128 END_2D 133 129 CALL iom_put( "ketrd_tau" , zke2d ) ! 134 130 DEALLOCATE( z2dx , z2dy , zke2d ) … … 141 137 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 142 138 ! 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)139 ! z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) 140 ! z2dy(ji,jj) = vv(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) 145 141 ! END DO 146 142 ! END DO … … 157 153 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf" , zke ) ! asselin filter trends 158 154 !! 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....155 !! reflechir a une possible sauvegarde du "vrai" uu(Kmm),vv(Kmm) pour le calcul de atf.... 160 156 ! 161 157 ! IF( ln_drgimp ) THEN ! bottom friction (implicit case) … … 164 160 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 165 161 ! 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)162 ! z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 163 ! z2dy(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 168 164 ! END DO 169 165 ! END DO … … 179 175 CASE( jpdyn_ken ) ; ! kinetic energy 180 176 ! called in dynnxt.F90 before asselin time filter 181 ! with putrd=u a and pvtrd=va177 ! with putrd=uu(Krhs) and pvtrd=vv(Krhs) 182 178 zke(:,:,:) = 0.5_wp * zke(:,:,:) 183 179 CALL iom_put( "KE", zke ) 184 180 ! 185 CALL ken_p2k( kt , zke )181 CALL ken_p2k( kt , zke, Kmm ) 186 182 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 187 183 ! … … 191 187 192 188 193 SUBROUTINE ken_p2k( kt , pconv )189 SUBROUTINE ken_p2k( kt , pconv, Kmm ) 194 190 !!--------------------------------------------------------------------- 195 191 !! *** ROUTINE ken_p2k *** … … 202 198 !!---------------------------------------------------------------------- 203 199 INTEGER , INTENT(in ) :: kt ! ocean time-step index 200 INTEGER , INTENT(in ) :: Kmm ! time level index 204 201 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pconv ! 205 202 ! … … 211 208 ! 212 209 ! Local constant initialization 213 zcoef = - r au0 * grav * 0.5_wp210 zcoef = - rho0 * grav * 0.5_wp 214 211 215 212 ! Surface value (also valid in partial step case) 216 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * w n(:,:,1) * e3w_n(:,:,1)213 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * ww(:,:,1) * e3w(:,:,1,Kmm) 217 214 218 215 ! interior value (2=<jk=<jpkm1) 219 216 DO jk = 2, jpk 220 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * w n(:,:,jk) * e3w_n(:,:,jk)217 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * ww(:,:,jk) * e3w(:,:,jk,Kmm) 221 218 END DO 222 219 223 220 ! 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 221 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 222 zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm) 223 pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 224 END_3D 232 225 ! 233 226 END SUBROUTINE ken_p2k -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdmxl.F90
r10425 r13463 68 68 INTEGER :: ionce, icount 69 69 70 !! * Substitutions 71 # include "do_loop_substitute.h90" 72 # include "domzgr_substitute.h90" 70 73 !!---------------------------------------------------------------------- 71 74 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 86 89 87 90 88 SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln )91 SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln, Kmm ) 89 92 !!---------------------------------------------------------------------- 90 93 !! *** ROUTINE trd_tra_mng *** … … 98 101 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 99 102 INTEGER , INTENT(in ) :: kt ! time step index 103 INTEGER , INTENT(in ) :: Kmm ! time level index 100 104 REAL(wp) , INTENT(in ) :: p2dt ! time step [s] 101 105 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: kmxln ! number of t-box for the vertical average … … 116 120 ! 117 121 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 122 DO_3D( 1, 1, 1, 1, 1, jpktrd ) 123 IF( jk - kmxln(ji,jj) < 0 ) THEN 124 wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 125 ENDIF 126 END_3D 125 127 hmxl(:,:) = 0._wp ! NOW mixed-layer depth 126 128 DO jk = 1, jpktrd … … 136 138 tml(:,:) = 0._wp ; sml(:,:) = 0._wp 137 139 DO jk = 1, jpktrd 138 tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts n(:,:,jk,jp_tem)139 sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts n(:,:,jk,jp_sal)140 tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_tem,Kmm) 141 sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_sal,Kmm) 140 142 END DO 141 143 ! … … 152 154 !!gm to be put juste before the output ! 153 155 ! ! Lateral boundary conditions 154 ! CALL lbc_lnk_multi( 'trdmxl', tmltrd(:,:,jl), 'T', 1. , smltrd(:,:,jl), 'T', 1.)156 ! CALL lbc_lnk_multi( 'trdmxl', tmltrd(:,:,jl), 'T', 1.0_wp , smltrd(:,:,jl), 'T', 1.0_wp ) 155 157 !!gm end 156 158 … … 371 373 hmxlbn(:,:) = hmxl(:,:) 372 374 373 IF( ln_ctl ) THEN375 IF( sn_cfctl%l_prtctl ) THEN 374 376 WRITE(numout,*) ' we reach kt == nit000 + 1 = ', nit000+1 375 377 CALL prt_ctl(tab2d_1=tmlbb , clinfo1=' tmlbb - : ', mask1=tmask) … … 380 382 END IF 381 383 382 IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. ( ln_ctl )) THEN384 IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. sn_cfctl%l_prtctl ) THEN 383 385 IF( ln_trdmxl_instant ) THEN 384 386 WRITE(numout,*) ' restart from kt == nit000 = ', nit000 … … 470 472 !-- Lateral boundary conditions 471 473 ! ... temperature ... ... salinity ... 472 CALL lbc_lnk_multi( 'trdmxl', ztmltot , 'T', 1. , zsmltot , 'T', 1., &473 & ztmlres , 'T', 1. , zsmlres , 'T', 1., &474 & ztmlatf , 'T', 1. , zsmlatf , 'T', 1.)474 CALL lbc_lnk_multi( 'trdmxl', ztmltot , 'T', 1.0_wp, zsmltot , 'T', 1.0_wp, & 475 & ztmlres , 'T', 1.0_wp, zsmlres , 'T', 1.0_wp, & 476 & ztmlatf , 'T', 1.0_wp, zsmlatf , 'T', 1.0_wp ) 475 477 476 478 … … 521 523 !-- Lateral boundary conditions 522 524 ! ... temperature ... ... salinity ... 523 CALL lbc_lnk_multi( 'trdmxl', ztmltot2, 'T', 1. , zsmltot2, 'T', 1., &524 & ztmlres2, 'T', 1. , zsmlres2, 'T', 1.)525 ! 526 CALL lbc_lnk_multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1. , zsmltrd2(:,:,:), 'T', 1.) ! / in the NetCDF trends file525 CALL lbc_lnk_multi( 'trdmxl', ztmltot2, 'T', 1.0_wp, zsmltot2, 'T', 1.0_wp, & 526 & ztmlres2, 'T', 1.0_wp, zsmlres2, 'T', 1.0_wp ) 527 ! 528 CALL lbc_lnk_multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! / in the NetCDF trends file 527 529 528 530 ! III.3 Time evolution array swap … … 548 550 hmxlbn (:,:) = hmxl (:,:) 549 551 550 IF( ln_ctl ) THEN552 IF( sn_cfctl%l_prtctl ) THEN 551 553 IF( ln_trdmxl_instant ) THEN 552 554 CALL prt_ctl(tab2d_1=tmlbb , clinfo1=' tmlbb - : ', mask1=tmask) … … 732 734 !!---------------------------------------------------------------------- 733 735 ! 734 REWIND( numnam_ref ) ! Namelist namtrd_mxl in reference namelist : mixed layer trends diagnostic735 736 READ ( numnam_ref, namtrd_mxl, IOSTAT = ios, ERR = 901 ) 736 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist', lwp ) 737 738 REWIND( numnam_cfg ) ! Namelist namtrd_mxl in configuration namelist : mixed layer trends diagnostic 737 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist' ) 738 739 739 READ ( numnam_cfg, namtrd_mxl, IOSTAT = ios, ERR = 902 ) 740 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist' , lwp)740 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist' ) 741 741 IF(lwm) WRITE( numond, namtrd_mxl ) 742 742 ! … … 764 764 765 765 IF( MOD( nitend, nn_trd ) /= 0 ) THEN 766 WRITE(numout,cform_err) 767 WRITE(numout,*) ' Your nitend parameter, nitend = ', nitend 768 WRITE(numout,*) ' is no multiple of the trends diagnostics frequency ' 769 WRITE(numout,*) ' you defined, nn_trd = ', nn_trd 770 WRITE(numout,*) ' This will not allow you to restart from this simulation. ' 771 WRITE(numout,*) ' You should reconsider this choice. ' 772 WRITE(numout,*) 773 WRITE(numout,*) ' N.B. the nitend parameter is also constrained to be a ' 774 WRITE(numout,*) ' multiple of the nn_fsbc parameter ' 775 CALL ctl_stop( 'trd_mxl_init: see comment just above' ) 766 WRITE(ctmp1,*) ' Your nitend parameter, nitend = ', nitend 767 WRITE(ctmp2,*) ' is no multiple of the trends diagnostics frequency ' 768 WRITE(ctmp3,*) ' you defined, nn_trd = ', nn_trd 769 WRITE(ctmp4,*) ' This will not allow you to restart from this simulation. ' 770 WRITE(ctmp5,*) ' You should reconsider this choice. ' 771 WRITE(ctmp6,*) 772 WRITE(ctmp7,*) ' N.B. the nitend parameter is also constrained to be a ' 773 WRITE(ctmp8,*) ' multiple of the nn_fsbc parameter ' 774 CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4, ctmp5, ctmp6, ctmp7, ctmp8 ) 776 775 END IF 777 776 -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdmxl_rst.F90
r10425 r13463 47 47 !!-------------------------------------------------------------------------------- 48 48 49 IF( .NOT. ln_rst_list .AND. nn_stock == -1 ) RETURN ! we will never do any restart 50 49 51 ! to get better performances with NetCDF format: 50 52 ! we open and define the ocean restart_mxl file one time step before writing the data (-> at nitrst - 1) 51 53 ! except if we write ocean restart_mxl files every time step or if an ocean restart_mxl file was writen at nitend - 1 52 IF( kt == nitrst - 1 .OR. n stock == 1 .OR. ( kt == nitend .AND. MOD( nitend - 1, nstock ) == 0 ) ) THEN54 IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. MOD( nitend - 1, nn_stock ) == 0 ) ) THEN 53 55 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 54 56 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst … … 147 149 IF( ln_trdmxl_instant ) THEN 148 150 !-- Temperature 149 CALL iom_get( inum, jpdom_auto glo, 'tmlbb' , tmlbb )150 CALL iom_get( inum, jpdom_auto glo, 'tmlbn' , tmlbn )151 CALL iom_get( inum, jpdom_auto glo, 'tmlatfb' , tmlatfb )151 CALL iom_get( inum, jpdom_auto, 'tmlbb' , tmlbb ) 152 CALL iom_get( inum, jpdom_auto, 'tmlbn' , tmlbn ) 153 CALL iom_get( inum, jpdom_auto, 'tmlatfb' , tmlatfb ) 152 154 ! 153 155 !-- Salinity 154 CALL iom_get( inum, jpdom_auto glo, 'smlbb' , smlbb )155 CALL iom_get( inum, jpdom_auto glo, 'smlbn' , smlbn )156 CALL iom_get( inum, jpdom_auto glo, 'smlatfb' , smlatfb )156 CALL iom_get( inum, jpdom_auto, 'smlbb' , smlbb ) 157 CALL iom_get( inum, jpdom_auto, 'smlbn' , smlbn ) 158 CALL iom_get( inum, jpdom_auto, 'smlatfb' , smlatfb ) 157 159 ELSE 158 CALL iom_get( inum, jpdom_auto glo, 'hmxlbn' , hmxlbn ) ! needed for hmxl_sum160 CALL iom_get( inum, jpdom_auto, 'hmxlbn' , hmxlbn ) ! needed for hmxl_sum 159 161 ! 160 162 !-- Temperature 161 CALL iom_get( inum, jpdom_auto glo, 'tmlbn' , tmlbn ) ! needed for tml_sum162 CALL iom_get( inum, jpdom_auto glo, 'tml_sumb' , tml_sumb )163 CALL iom_get( inum, jpdom_auto, 'tmlbn' , tmlbn ) ! needed for tml_sum 164 CALL iom_get( inum, jpdom_auto, 'tml_sumb' , tml_sumb ) 163 165 DO jk = 1, jpltrd 164 166 IF( jk < 10 ) THEN ; WRITE(charout,FMT="('tmltrd_csum_ub_', I1)") jk 165 167 ELSE ; WRITE(charout,FMT="('tmltrd_csum_ub_', I2)") jk 166 168 ENDIF 167 CALL iom_get( inum, jpdom_auto glo, charout, tmltrd_csum_ub(:,:,jk) )169 CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub(:,:,jk) ) 168 170 END DO 169 CALL iom_get( inum, jpdom_auto glo, 'tmltrd_atf_sumb' , tmltrd_atf_sumb)171 CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb' , tmltrd_atf_sumb) 170 172 ! 171 173 !-- Salinity 172 CALL iom_get( inum, jpdom_auto glo, 'smlbn' , smlbn ) ! needed for sml_sum173 CALL iom_get( inum, jpdom_auto glo, 'sml_sumb' , sml_sumb )174 CALL iom_get( inum, jpdom_auto, 'smlbn' , smlbn ) ! needed for sml_sum 175 CALL iom_get( inum, jpdom_auto, 'sml_sumb' , sml_sumb ) 174 176 DO jk = 1, jpltrd 175 177 IF( jk < 10 ) THEN ; WRITE(charout,FMT="('smltrd_csum_ub_', I1)") jk 176 178 ELSE ; WRITE(charout,FMT="('smltrd_csum_ub_', I2)") jk 177 179 ENDIF 178 CALL iom_get( inum, jpdom_auto glo, charout, smltrd_csum_ub(:,:,jk) )180 CALL iom_get( inum, jpdom_auto, charout, smltrd_csum_ub(:,:,jk) ) 179 181 END DO 180 CALL iom_get( inum, jpdom_auto glo, 'smltrd_atf_sumb' , smltrd_atf_sumb)182 CALL iom_get( inum, jpdom_auto, 'smltrd_atf_sumb' , smltrd_atf_sumb) 181 183 ! 182 184 CALL iom_close( inum ) -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdpen.F90
r10425 r13463 36 36 37 37 !! * Substitutions 38 # include " vectopt_loop_substitute.h90"38 # include "domzgr_substitute.h90" 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 42 42 !! Software governed by the CeCILL license (see ./LICENSE) 43 43 !!---------------------------------------------------------------------- 44 44 45 CONTAINS 45 46 … … 55 56 56 57 57 SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt )58 SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt, Kmm ) 58 59 !!--------------------------------------------------------------------- 59 60 !! *** ROUTINE trd_tra_mng *** … … 66 67 INTEGER , INTENT(in) :: ktrd ! tracer trend index 67 68 INTEGER , INTENT(in) :: kt ! time step index 69 INTEGER , INTENT(in) :: Kmm ! time level index 68 70 REAL(wp) , INTENT(in) :: pdt ! time step [s] 69 71 ! … … 77 79 IF( kt /= nkstp ) THEN ! full eos: set partial derivatives at the 1st call of kt time step 78 80 nkstp = kt 79 CALL eos_pen( ts n, rab_PE, zpe)81 CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm ) 80 82 CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) ) 81 83 CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) ) … … 95 97 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 96 98 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)99 z2d(:,:) = ww(:,:,1) * ( & 100 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm) & 101 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm) & 102 & ) / e3t(:,:,1,Kmm) 101 103 CALL iom_put( "petrd_sad" , z2d ) 102 104 DEALLOCATE( z2d ) … … 112 114 CASE ( jptra_bbc ) ; CALL iom_put( "petrd_bbc" , zpe ) ! bottom bound cond (geoth flux) 113 115 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 116 ! 123 117 END SELECT -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdtra.F90
r10425 r13463 41 41 42 42 !! * Substitutions 43 # include "vectopt_loop_substitute.h90" 43 # include "do_loop_substitute.h90" 44 # include "domzgr_substitute.h90" 44 45 !!---------------------------------------------------------------------- 45 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 60 61 61 62 62 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )63 SUBROUTINE trd_tra( kt, Kmm, Krhs, ctype, ktra, ktrd, ptrd, pu, ptra ) 63 64 !!--------------------------------------------------------------------- 64 65 !! *** ROUTINE trd_tra *** … … 77 78 INTEGER , INTENT(in) :: ktra ! tracer index 78 79 INTEGER , INTENT(in) :: ktrd ! tracer trend index 80 INTEGER , INTENT(in) :: Kmm, Krhs ! time level indices 79 81 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 velocity82 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! now velocity 81 83 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 82 84 ! 83 INTEGER :: jk ! loop indices 85 INTEGER :: jk ! loop indices 86 INTEGER :: i01 ! 0 or 1 84 87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace 85 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws, ztrdt ! 3D workspace … … 89 92 IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 90 93 ENDIF 91 94 ! 95 i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) ) 96 ! 92 97 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN !== Temperature trend ==! 93 98 ! 94 SELECT CASE( ktrd )99 SELECT CASE( ktrd*i01 ) 95 100 ! ! 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 )101 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm ) 102 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Y', trdty, Kmm ) 103 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Z', trdt, Kmm ) 99 104 CASE( jptra_bbc, & ! qsr, bbc: on temperature only, send to trd_tra_mng 100 105 & jptra_qsr ) ; trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 101 106 ztrds(:,:,:) = 0._wp 102 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )107 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 103 108 !!gm Gurvan, verify the jptra_evd trend please ! 104 109 CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) … … 111 116 IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN !== Salinity trends ==! 112 117 ! 113 SELECT CASE( ktrd )118 SELECT CASE( ktrd*i01 ) 114 119 ! ! advection: transform the advective flux into a trend 115 120 ! ! 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 )121 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X' , ztrds, Kmm ) 122 CALL trd_tra_mng( trdtx, ztrds, ktrd, kt, Kmm ) 123 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Y' , ztrds, Kmm ) 124 CALL trd_tra_mng( trdty, ztrds, ktrd, kt, Kmm ) 125 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Z' , ztrds, Kmm ) 126 CALL trd_tra_mng( trdt , ztrds, ktrd, kt, Kmm ) 122 127 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 123 128 ! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" … … 127 132 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 128 133 DO jk = 2, jpk 129 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 130 zws(:,:,jk) = avs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 134 zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) & 135 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 136 zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) & 137 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 131 138 END DO 132 139 ! 133 140 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 134 141 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)142 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 143 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 137 144 END DO 138 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )145 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt, Kmm ) 139 146 ! 140 147 ! ! Also calculate EVD trend at this point. 141 148 zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes 142 149 DO jk = 2, jpk 143 zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 144 zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 150 zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) & 151 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 152 zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) & 153 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 145 154 END DO 146 155 ! 147 156 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 148 157 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)158 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 159 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 151 160 END DO 152 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )161 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt, Kmm ) 153 162 ! 154 163 DEALLOCATE( zwt, zws, ztrdt ) … … 156 165 CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng 157 166 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 158 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )167 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 159 168 END SELECT 160 169 ENDIF … … 162 171 IF( ctype == 'TRC' ) THEN !== passive tracer trend ==! 163 172 ! 164 SELECT CASE( ktrd )173 SELECT CASE( ktrd*i01 ) 165 174 ! ! 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)175 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm ) 176 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Y', ztrds, Kmm ) 177 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Z', ztrds, Kmm ) 169 178 CASE DEFAULT ! other trends: just masked 170 179 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 171 180 END SELECT 172 181 ! ! send trend to trd_trc 173 CALL trd_trc( ztrds, ktra, ktrd, kt )182 CALL trd_trc( ztrds, ktra, ktrd, kt, Kmm ) 174 183 ! 175 184 ENDIF … … 178 187 179 188 180 SUBROUTINE trd_tra_adv( pf, pu n, ptn, cdir, ptrd)189 SUBROUTINE trd_tra_adv( pf, pu, pt, cdir, ptrd, Kmm ) 181 190 !!--------------------------------------------------------------------- 182 191 !! *** ROUTINE trd_tra_adv *** … … 191 200 !!---------------------------------------------------------------------- 192 201 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 tracer202 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu ! now velocity in one direction 203 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt ! now or before tracer 195 204 CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction 196 205 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction 206 INTEGER, INTENT(in) :: Kmm ! time level index 197 207 ! 198 208 INTEGER :: ji, jj, jk ! dummy loop indices … … 211 221 ptrd(:,:,jpk) = 0._wp 212 222 ! 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 223 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 224 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 225 & - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk) ) & 226 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 227 END_3D 222 228 ! 223 229 END SUBROUTINE trd_tra_adv 224 230 225 231 226 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt )232 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm ) 227 233 !!--------------------------------------------------------------------- 228 234 !! *** ROUTINE trd_tra_mng *** … … 236 242 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 237 243 INTEGER , INTENT(in ) :: kt ! time step 238 !!---------------------------------------------------------------------- 239 240 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdt (restart with Euler time stepping) 241 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdt (leapfrog) 242 ENDIF 244 INTEGER , INTENT(in ) :: Kmm ! time level index 245 !!---------------------------------------------------------------------- 243 246 244 247 ! ! 3D output of tracers trends using IOM interface 245 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )248 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm ) 246 249 247 250 ! ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 248 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )251 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm ) 249 252 250 253 ! ! Potential ENergy trends 251 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r 2dt)254 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, rDt, Kmm ) 252 255 253 256 ! ! Mixed layer trends for active tracers … … 282 285 CASE ( jptra_atf ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' ) ! asselin time filter (last trend) 283 286 ! 284 CALL trd_mxl( kt, r 2dt ) ! trends: Mixed-layer (output)287 CALL trd_mxl( kt, rDt ) ! trends: Mixed-layer (output) 285 288 END SELECT 286 289 ! … … 290 293 291 294 292 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt )295 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm ) 293 296 !!--------------------------------------------------------------------- 294 297 !! *** ROUTINE trd_tra_iom *** … … 300 303 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 301 304 INTEGER , INTENT(in ) :: kt ! time step 305 INTEGER , INTENT(in ) :: Kmm ! time level index 302 306 !! 303 307 INTEGER :: ji, jj, jk ! dummy loop indices … … 326 330 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 327 331 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)332 z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm) 333 z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm) 330 334 CALL iom_put( "ttrd_sad", z2dx ) 331 335 CALL iom_put( "strd_sad", z2dy ) -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdtrc.F90
r10068 r13463 1 1 MODULE trdtrc 2 USE par_kind 2 3 !!====================================================================== 3 4 !! *** MODULE trdtrc *** … … 9 10 CONTAINS 10 11 11 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )12 SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 12 13 INTEGER :: kt, kjn, ktrd 13 REAL :: ptrtrd(:,:,:) 14 INTEGER :: Kmm ! time level index 15 REAL(wp):: ptrtrd(:,:,:) 14 16 WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 15 17 WRITE(*,*) ' " " : You should not have seen this print! error?', kjn, ktrd, kt -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdvor.F90
r10425 r13463 46 46 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avr ! average 47 47 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrb ! before vorticity (kt-1) 48 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbb ! vorticity at begining of the n write-1 timestep averaging period48 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbb ! vorticity at begining of the nn_write-1 timestep averaging period 49 49 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbn ! after vorticity at time step after the 50 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the N WRITE-1 timesteps50 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the NN_WRITE-1 timesteps 51 51 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrtot ! 52 52 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrres ! … … 56 56 57 57 !! * Substitutions 58 # include "vectopt_loop_substitute.h90" 58 # include "do_loop_substitute.h90" 59 # include "domzgr_substitute.h90" 59 60 !!---------------------------------------------------------------------- 60 61 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 78 79 79 80 80 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt )81 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt, Kmm ) 81 82 !!---------------------------------------------------------------------- 82 83 !! *** ROUTINE trd_vor *** … … 88 89 INTEGER , INTENT(in ) :: ktrd ! trend index 89 90 INTEGER , INTENT(in ) :: kt ! time step 91 INTEGER , INTENT(in ) :: Kmm ! time level index 90 92 ! 91 93 INTEGER :: ji, jj ! dummy loop indices … … 94 96 95 97 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.98 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm ) ! Hydrostatique Pressure Gradient 99 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg, Kmm ) ! KE Gradient 100 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo, Kmm ) ! Relative Vorticity 101 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo, Kmm ) ! Planetary Vorticity Term 102 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf, Kmm ) ! Horizontal Diffusion 103 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm ) ! Vertical Advection 104 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm ) ! Surface Pressure Grad. 103 105 CASE( jpdyn_zdf ) ! Vertical Diffusion 104 106 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 107 DO_2D( 0, 0, 0, 0 ) 108 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 ) 109 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 ) 110 END_2D 111 ! 112 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm ) ! zdf trend including surf./bot. stresses 113 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm ) ! surface wind stress 114 114 CASE( jpdyn_bfr ) 115 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr ) ! Bottom stress115 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr, Kmm ) ! Bottom stress 116 116 ! 117 117 CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends 118 CALL trd_vor_iom( kt )118 CALL trd_vor_iom( kt, Kmm ) 119 119 END SELECT 120 120 ! … … 122 122 123 123 124 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )124 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd, Kmm ) 125 125 !!---------------------------------------------------------------------------- 126 126 !! *** ROUTINE trd_vor_zint *** … … 129 129 !! from ocean surface down to control surface (NetCDF output) 130 130 !! 131 !! ** Method/usage : integration done over n write-1 time steps131 !! ** Method/usage : integration done over nn_write-1 time steps 132 132 !! 133 133 !! ** Action : trends : … … 143 143 !! vortrd (,,10) = forcing term 144 144 !! vortrd (,,11) = bottom friction term 145 !! rotot(,) : total cumulative trends over n write-1 time steps145 !! rotot(,) : total cumulative trends over nn_write-1 time steps 146 146 !! vor_avrtot(,) : first membre of vrticity equation 147 147 !! vor_avrres(,) : residual = dh/dt entrainment … … 150 150 !!---------------------------------------------------------------------- 151 151 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 152 INTEGER , INTENT(in ) :: Kmm ! time level index 152 153 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend 153 154 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvtrdvor ! v vorticity trend … … 161 162 162 163 zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp ! Initialisation 163 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1.) ! lateral boundary condition164 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) ! lateral boundary condition 164 165 165 166 … … 171 172 ! 172 173 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 174 DO_2D( 0, 0, 0, 0 ) 175 ikbu = mbkv(ji,jj) 176 ikbv = mbkv(ji,jj) 177 zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu) 178 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,ikbv,Kmm) * e2v(ji,jj) * vmask(ji,jj,ikbv) 179 END_2D 181 180 ! 182 181 CASE( jpvor_swf ) ! wind stress 183 zudpvor(:,:) = putrdvor(:,:) * e3u _n(:,:,1) * e1u(:,:) * umask(:,:,1)184 zvdpvor(:,:) = pvtrdvor(:,:) * e3v _n(:,:,1) * e2v(:,:) * vmask(:,:,1)182 zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1) 183 zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1) 185 184 ! 186 185 END SELECT 187 186 188 187 ! Average except for Beta.V 189 zudpvor(:,:) = zudpvor(:,:) * r1_hu _n(:,:)190 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv _n(:,:)188 zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 189 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 191 190 192 191 ! Curl … … 194 193 DO jj = 1, jpjm1 195 194 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 196 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 195 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 196 & / ( e1f(ji,jj) * e2f(ji,jj) ) 197 197 END DO 198 198 END DO … … 207 207 208 208 209 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )209 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd , Kmm ) 210 210 !!---------------------------------------------------------------------------- 211 211 !! *** ROUTINE trd_vor_zint *** … … 214 214 !! from ocean surface down to control surface (NetCDF output) 215 215 !! 216 !! ** Method/usage : integration done over n write-1 time steps216 !! ** Method/usage : integration done over nn_write-1 time steps 217 217 !! 218 218 !! ** Action : trends : … … 228 228 !! vortrd (,,10) = forcing term 229 229 !! vortrd (,,11) = bottom friction term 230 !! rotot(,) : total cumulative trends over n write-1 time steps230 !! rotot(,) : total cumulative trends over nn_write-1 time steps 231 231 !! vor_avrtot(,) : first membre of vrticity equation 232 232 !! vor_avrres(,) : residual = dh/dt entrainment … … 236 236 ! 237 237 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 238 INTEGER , INTENT(in ) :: Kmm ! time level index 238 239 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: putrdvor ! u vorticity trend 239 240 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvtrdvor ! v vorticity trend … … 250 251 zvdpvor(:,:) = 0._wp 251 252 ! ! lateral boundary condition on input momentum trends 252 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1.)253 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) 253 254 254 255 ! ===================================== … … 257 258 ! putrdvor and pvtrdvor terms 258 259 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)260 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk) 261 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk) 261 262 END DO 262 263 … … 269 270 DO jj = 1, jpjm1 270 271 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 271 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 272 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) & 273 & / ( e1f(ji,jj) * e2f(ji,jj) ) 272 274 END DO 273 275 END DO 274 276 ! Average of the Curl and Surface mask 275 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu _n(:,:) * fmask(:,:,1)277 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 276 278 ENDIF 277 279 ! 278 280 ! Average 279 zudpvor(:,:) = zudpvor(:,:) * r1_hu _n(:,:)280 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv _n(:,:)281 zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 282 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 281 283 ! 282 284 ! Curl … … 284 286 DO jj=1,jpjm1 285 287 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 286 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 288 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 289 & / ( e1f(ji,jj) * e2f(ji,jj) ) 287 290 END DO 288 291 END DO … … 298 301 299 302 300 SUBROUTINE trd_vor_iom( kt )303 SUBROUTINE trd_vor_iom( kt , Kmm ) 301 304 !!---------------------------------------------------------------------- 302 305 !! *** ROUTINE trd_vor *** … … 306 309 !!---------------------------------------------------------------------- 307 310 INTEGER , INTENT(in ) :: kt ! time step 311 INTEGER , INTENT(in ) :: Kmm ! time level index 308 312 ! 309 313 INTEGER :: ji, jj, jk, jl ! dummy loop indices 310 314 INTEGER :: it, itmod ! local integers 311 315 REAL(wp) :: zmean ! local scalars 312 REAL(wp), DIMENSION(jpi,jpj) :: zu n, zvn316 REAL(wp), DIMENSION(jpi,jpj) :: zuu, zvv 313 317 !!---------------------------------------------------------------------- 314 318 … … 327 331 328 332 vor_avr (:,:) = 0._wp 329 zu n(:,:) = 0._wp330 zv n(:,:) = 0._wp333 zuu (:,:) = 0._wp 334 zvv (:,:) = 0._wp 331 335 vor_avrtot(:,:) = 0._wp 332 336 vor_avrres(:,:) = 0._wp … … 334 338 ! Vertically averaged velocity 335 339 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)340 zuu(:,:) = zuu(:,:) + e1u(:,:) * uu(:,:,jk,Kmm) * e3u(:,:,jk,Kmm) 341 zvv(:,:) = zvv(:,:) + e2v(:,:) * vv(:,:,jk,Kmm) * e3v(:,:,jk,Kmm) 338 342 END DO 339 343 340 zu n(:,:) = zun(:,:) * r1_hu_n(:,:)341 zv n(:,:) = zvn(:,:) * r1_hv_n(:,:)344 zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm) 345 zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm) 342 346 343 347 ! Curl 344 348 DO ji = 1, jpim1 345 349 DO jj = 1, jpjm1 346 vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 347 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 350 vor_avr(ji,jj) = ( ( zvv(ji+1,jj) - zvv(ji,jj) ) & 351 & - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) & 352 & / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 348 353 END DO 349 354 END DO … … 360 365 ENDIF 361 366 362 ! II.2 cumulated trends over analysis period (kt=2 to n write)367 ! II.2 cumulated trends over analysis period (kt=2 to nn_write) 363 368 ! ---------------------- 364 ! trends cumulated over n write-2 time steps369 ! trends cumulated over nn_write-2 time steps 365 370 366 371 IF( kt >= nit000+2 ) THEN … … 376 381 ! III. Output in netCDF + residual computation 377 382 ! ============================================= 378 383 379 384 ! define time axis 380 385 it = kt … … 385 390 ! III.1 compute total trend 386 391 ! ------------------------ 387 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * r dt )392 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rn_Dt ) 388 393 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 389 394 … … 395 400 396 401 ! Boundary conditions 397 CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1. , vor_avrres, 'F', 1.)402 CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 398 403 399 404 … … 504 509 ENDIF 505 510 #if defined key_diainstant 506 zsto = n write*rdt511 zsto = nn_write*rn_Dt 507 512 clop = "inst("//TRIM(clop)//")" 508 513 #else 509 zsto = r dt514 zsto = rn_Dt 510 515 clop = "ave("//TRIM(clop)//")" 511 516 #endif 512 zout = nn_trd*r dt517 zout = nn_trd*rn_Dt 513 518 514 519 IF(lwp) WRITE(numout,*) ' netCDF initialization' … … 516 521 ! II.2 Compute julian date from starting date of the run 517 522 ! ------------------------ 518 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )523 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 519 524 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 520 525 IF(lwp) WRITE(numout,*)' ' … … 528 533 IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 529 534 CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit 530 & 1, jpj, nit000-1, zjulian, r dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )535 & 1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set ) 531 536 CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface 532 537
Note: See TracChangeset
for help on using the changeset viewer.
