Changeset 8882 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD
- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- Location:
- branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD
- Files:
-
- 7 edited
-
trd_oce.F90 (modified) (1 diff)
-
trddyn.F90 (modified) (5 diffs)
-
trdglo.F90 (modified) (13 diffs)
-
trdken.F90 (modified) (10 diffs)
-
trdmxl.F90 (modified) (1 diff)
-
trdpen.F90 (modified) (1 diff)
-
trdtra.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r7646 r8882 72 72 INTEGER, PUBLIC, PARAMETER :: jpdyn_atf = 10 !: Asselin time filter 73 73 INTEGER, PUBLIC, PARAMETER :: jpdyn_tau = 11 !: surface stress 74 INTEGER, PUBLIC, PARAMETER :: jpdyn_bfri = 12 !: implicit bottom friction (ln_ bfrimp=.TRUE.)74 INTEGER, PUBLIC, PARAMETER :: jpdyn_bfri = 12 !: implicit bottom friction (ln_drgimp=.TRUE.) 75 75 INTEGER, PUBLIC, PARAMETER :: jpdyn_ken = 13 !: use for calculation of KE 76 76 ! -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r6140 r8882 15 15 USE oce ! ocean dynamics and tracers variables 16 16 USE dom_oce ! ocean space and time domain variables 17 USE zdf_oce ! ocean vertical physics variables 17 USE phycst ! physical constants 18 USE sbc_oce ! surface boundary condition: ocean 19 USE zdf_oce ! ocean vertical physics: variables 20 USE zdfdrg ! ocean vertical physics: bottom friction 18 21 USE trd_oce ! trends: ocean variables 19 USE zdfbfr ! bottom friction20 USE sbc_oce ! surface boundary condition: ocean21 USE phycst ! physical constants22 22 USE trdken ! trends: Kinetic ENergy 23 23 USE trdglo ! trends: global domain averaged 24 24 USE trdvor ! trends: vertical averaged vorticity 25 25 USE trdmxl ! trends: mixed layer averaged 26 ! 26 27 USE in_out_manager ! I/O manager 27 28 USE lbclnk ! lateral boundary condition 28 29 USE iom ! I/O manager library 29 30 USE lib_mpp ! MPP library 30 USE wrk_nemo ! Memory allocation31 31 32 32 IMPLICIT NONE 33 33 PRIVATE 34 34 35 PUBLIC trd_dyn ! called by all dynXX modules35 PUBLIC trd_dyn ! called by all dynXXX modules 36 36 37 37 !! * Substitutions 38 38 # include "vectopt_loop_substitute.h90" 39 39 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010)40 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 41 41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 103 103 INTEGER :: ji, jj, jk ! dummy loop indices 104 104 INTEGER :: ikbu, ikbv ! local integers 105 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace106 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace105 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace 107 107 !!---------------------------------------------------------------------- 108 108 ! … … 118 118 CASE( jpdyn_keg ) ; CALL iom_put( "utrd_keg", putrd ) ! Kinetic Energy gradient (or had) 119 119 CALL iom_put( "vtrd_keg", pvtrd ) 120 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy)120 ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) ) 121 121 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 122 122 z3dy(:,:,:) = 0._wp … … 133 133 CALL iom_put( "utrd_udx", z3dx ) 134 134 CALL iom_put( "vtrd_vdy", z3dy ) 135 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )136 CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical 135 DEALLOCATE( z3dx , z3dy ) 136 CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical advection 137 137 CALL iom_put( "vtrd_zad", pvtrd ) 138 CASE( jpdyn_ldf ) ; CALL iom_put( "utrd_ldf", putrd ) ! lateral diffusion138 CASE( jpdyn_ldf ) ; CALL iom_put( "utrd_ldf", putrd ) ! lateral diffusion 139 139 CALL iom_put( "vtrd_ldf", pvtrd ) 140 140 CASE( jpdyn_zdf ) ; CALL iom_put( "utrd_zdf", putrd ) ! vertical diffusion 141 141 CALL iom_put( "vtrd_zdf", pvtrd ) 142 ! 142 143 ! ! wind stress trends 143 CALL wrk_alloc( jpi, jpj, z2dx, z2dy)144 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 144 145 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 145 146 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 146 147 CALL iom_put( "utrd_tau", z2dx ) 147 148 CALL iom_put( "vtrd_tau", z2dy ) 148 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 149 CASE( jpdyn_bfr ) ! called if ln_bfrimp=T 150 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 151 CALL iom_put( "vtrd_bfr", pvtrd ) 152 CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends 153 CALL iom_put( "vtrd_atf", pvtrd ) 154 CASE( jpdyn_bfri ) ; IF( ln_bfrimp ) THEN ! bottom friction (implicit case) 155 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy ) 149 DEALLOCATE( z2dx , z2dy ) 150 ! ! bottom stress tends (implicit case) 151 IF( ln_drgimp ) THEN 152 ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) ) 156 153 z3dx(:,:,:) = 0._wp ; z3dy(:,:,:) = 0._wp ! after velocity known (now filed at this stage) 157 154 DO jk = 1, jpkm1 … … 160 157 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 161 158 ikbv = mbkv(ji,jj) 162 z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) /e3u_n(ji,jj,ikbu)163 z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) /e3v_n(ji,jj,ikbv)159 z3dx(ji,jj,jk) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )*un(ji,jj,ikbu)/e3u_n(ji,jj,ikbu) 160 z3dy(ji,jj,jk) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )*vn(ji,jj,ikbv)/e3v_n(ji,jj,ikbv) 164 161 END DO 165 162 END DO 166 163 END DO 167 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. ) 168 CALL iom_put( "utrd_bfri", z3dx ) 169 CALL iom_put( "vtrd_bfri", z3dy ) 170 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy ) 171 ENDIF 164 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. ) 165 CALL iom_put( "utrd_bfr", z3dx ) 166 CALL iom_put( "vtrd_bfr", z3dy ) 167 DEALLOCATE( z3dx , z3dy ) 168 ENDIF 169 CASE( jpdyn_bfr ) ! called if ln_drgimp=F 170 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 171 CALL iom_put( "vtrd_bfr", pvtrd ) 172 CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends 173 CALL iom_put( "vtrd_atf", pvtrd ) 172 174 END SELECT 173 175 ! -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r6140 r8882 9 9 10 10 !!---------------------------------------------------------------------- 11 !! trd_glo : domain averaged budget of trends (including kinetic energy and T^2 trends)12 !! glo_dyn_wri : print dynamic trends in ocean.output file13 !! glo_tra_wri : print global T & T^2 trends in ocean.output file14 !! trd_glo_init : initialization step11 !! trd_glo : domain averaged budget of trends (including kinetic energy and T^2 trends) 12 !! glo_dyn_wri : print dynamic trends in ocean.output file 13 !! glo_tra_wri : print global T & T^2 trends in ocean.output file 14 !! trd_glo_init : initialization step 15 15 !!---------------------------------------------------------------------- 16 USE oce 17 USE dom_oce 18 USE sbc_oce 19 USE trd_oce 20 USE phycst 21 USE ldftra 22 USE ldfdyn 23 USE zdf_oce 24 USE zdf bfr !bottom friction25 USE zdfddm 26 USE eosbn2 27 USE phycst 16 USE oce ! ocean dynamics and tracers variables 17 USE dom_oce ! ocean space and time domain variables 18 USE sbc_oce ! surface boundary condition: ocean 19 USE trd_oce ! trends: ocean variables 20 USE phycst ! physical constants 21 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 22 USE ldfdyn ! ocean dynamics: lateral physics 23 USE zdf_oce ! ocean vertical physics 24 USE zdfdrg ! ocean vertical physics: bottom friction 25 USE zdfddm ! ocean vertical physics: double diffusion 26 USE eosbn2 ! equation of state 27 USE phycst ! physical constants 28 28 ! 29 USE lib_mpp ! distibuted memory computing library 30 USE in_out_manager ! I/O manager 31 USE iom ! I/O manager library 32 USE wrk_nemo ! Memory allocation 29 USE lib_mpp ! distibuted memory computing library 30 USE in_out_manager ! I/O manager 31 USE iom ! I/O manager library 33 32 34 33 IMPLICIT NONE … … 53 52 !! * Substitutions 54 53 # include "vectopt_loop_substitute.h90" 55 # include "zdfddm_substitute.h90"56 54 !!---------------------------------------------------------------------- 57 55 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 78 76 INTEGER :: ikbu, ikbv ! local integers 79 77 REAL(wp):: zvm, zvt, zvs, z1_2rau0 ! local scalars 80 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 81 !!---------------------------------------------------------------------- 82 83 CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 84 78 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 79 !!---------------------------------------------------------------------- 80 ! 85 81 IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 86 82 ! … … 124 120 DO jj = 1, jpjm1 125 121 DO ji = 1, jpim1 126 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj 127 & * e1u (ji ,jj ) * e2u(ji,jj) * e3u_n(ji,jj,jk)128 zvs = ptrdy(ji,jj,jk) * tmask_i(ji 129 & * e1v (ji ,jj ) * e2v(ji,jj) * e3u_n(ji,jj,jk)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) 130 126 umo(ktrd) = umo(ktrd) + zvt 131 127 vmo(ktrd) = vmo(ktrd) + zvs … … 139 135 DO jj = 1, jpjm1 140 136 DO ji = 1, jpim1 141 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj 142 & * z1_2rau0 * e1u (ji ,jj ) * e2u(ji,jj)143 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji 144 & * z1_2rau0 * e1v (ji ,jj ) * e2v (ji,jj) * e3u_n(ji,jj,jk)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) 145 141 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 146 142 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs … … 152 148 IF( ktrd == jpdyn_atf ) THEN ! last trend (asselin time filter) 153 149 ! 154 IF( ln_ bfrimp ) THEN ! implicit bfrcase: compute separately the bottom friction150 IF( ln_drgimp ) THEN ! implicit drag case: compute separately the bottom friction 155 151 z1_2rau0 = 0.5_wp / rau0 156 152 DO jj = 1, jpjm1 … … 158 154 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 159 155 ikbv = mbkv(ji,jj) 160 zvt = bfrua(ji,jj) * un(ji,jj,ikbu) * e1u(ji,jj) * e2v(ji,jj)161 zvs = bfrva(ji,jj) * vn(ji,jj,ikbv) * e1v(ji,jj) *e2v(ji,jj)156 zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * un(ji,jj,ikbu) * e1e2u(ji,jj) 157 zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vn(ji,jj,ikbv) * e1e2v(ji,jj) 162 158 umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 163 159 vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs … … 166 162 END DO 167 163 ENDIF 164 !!gm top drag case is missing 168 165 ! 169 166 CALL glo_dyn_wri( kt ) ! print the results in ocean.output … … 179 176 ENDIF 180 177 ! 181 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )182 !183 178 END SUBROUTINE trd_glo 184 179 … … 194 189 INTEGER :: ji, jj, jk ! dummy loop indices 195 190 REAL(wp) :: zcof ! local scalar 196 REAL(wp), POINTER, DIMENSION(:,:,:) :: zkx, zky, zkz, zkepe 197 !!---------------------------------------------------------------------- 198 199 CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe ) 191 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkx, zky, zkz, zkepe 192 !!---------------------------------------------------------------------- 200 193 201 194 ! I. Momentum trends … … 284 277 & + vmo(jpdyn_bfr) + vmo(jpdyn_atf) ) / tvolv 285 278 WRITE (numout,9513) umo(jpdyn_tau) / tvolu, vmo(jpdyn_tau) / tvolv 286 IF( ln_ bfrimp ) WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv279 IF( ln_drgimp ) WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv 287 280 ENDIF 288 281 … … 323 316 & + hke(jpdyn_bfr) + hke(jpdyn_atf) ) / tvolt 324 317 WRITE (numout,9533) hke(jpdyn_tau) / tvolt 325 IF( ln_ bfrimp ) WRITE (numout,9534) hke(jpdyn_bfri) / tvolt318 IF( ln_drgimp ) WRITE (numout,9534) hke(jpdyn_bfri) / tvolt 326 319 ENDIF 327 320 … … 373 366 ENDIF 374 367 ! 375 CALL wrk_dealloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )376 !377 368 END SUBROUTINE glo_dyn_wri 378 369 -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r7646 r8882 13 13 USE oce ! ocean dynamics and tracers variables 14 14 USE dom_oce ! ocean space and time domain variables 15 USE phycst ! physical constants 15 16 USE sbc_oce ! surface boundary condition: ocean 16 17 USE zdf_oce ! ocean vertical physics variables 18 USE zdfdrg ! ocean vertical physics: bottom friction 19 USE ldftra ! ocean active tracers lateral physics 17 20 USE trd_oce ! trends: ocean variables 18 !!gm USE dynhpg ! hydrostatic pressure gradient19 USE zdfbfr ! bottom friction20 USE ldftra ! ocean active tracers lateral physics21 USE phycst ! physical constants22 21 USE trdvor ! ocean vorticity trends 23 22 USE trdglo ! trends:global domain averaged … … 27 26 USE iom ! I/O manager library 28 27 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory allocation30 28 USE ldfslp ! Isopycnal slopes 31 29 … … 74 72 !! diagnose separately the KE trend associated with wind stress 75 73 !! - bottom friction case (jpdyn_bfr): 76 !! explicit case (ln_ bfrimp=F): bottom trend put in the 1st level74 !! explicit case (ln_drgimp=F): bottom trend put in the 1st level 77 75 !! of putrd, pvtrd 78 76 ! … … 86 84 INTEGER :: ikbu , ikbv ! local integers 87 85 INTEGER :: ikbum1, ikbvm1 ! - - 88 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy, zke2d ! 2D workspace 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zke ! 3D workspace 90 !!---------------------------------------------------------------------- 91 ! 92 CALL wrk_alloc( jpi, jpj, jpk, zke ) 86 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z2dx, z2dy, zke2d ! 2D workspace 87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zke ! 3D workspace 88 !!---------------------------------------------------------------------- 93 89 ! 94 90 CALL lbc_lnk( putrd, 'U', -1. ) ; CALL lbc_lnk( pvtrd, 'V', -1. ) ! lateral boundary conditions … … 125 121 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion 126 122 ! ! ! wind stress trends 127 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d)123 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) ) 128 124 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 129 125 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) … … 136 132 END DO 137 133 CALL iom_put( "ketrd_tau" , zke2d ) ! 138 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d )134 DEALLOCATE( z2dx , z2dy , zke2d ) 139 135 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case) 140 136 !!gm TO BE DONE properly 141 !!gm only valid if ln_ bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....142 ! IF(.NOT. ln_ bfrimp) THEN137 !!gm only valid if ln_drgimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... 138 ! IF(.NOT. ln_drgimp) THEN 143 139 ! DO jj = 1, jpj ! 144 140 ! DO ji = 1, jpi … … 163 159 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 164 160 ! 165 ! IF( ln_ bfrimp ) THEN ! bottom friction (implicit case)161 ! IF( ln_drgimp ) THEN ! bottom friction (implicit case) 166 162 ! DO jj = 1, jpj ! after velocity known (now filed at this stage) 167 163 ! DO ji = 1, jpi … … 192 188 END SELECT 193 189 ! 194 CALL wrk_dealloc( jpi, jpj, jpk, zke )195 !196 190 END SUBROUTINE trd_ken 197 191 … … 207 201 !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps) 208 202 !!---------------------------------------------------------------------- 209 INTEGER, INTENT(in) :: kt ! ocean time-step index 210 !! 211 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pconv 212 ! 213 INTEGER :: ji, jj, jk ! dummy loop indices 214 INTEGER :: iku, ikv ! temporary integers 215 REAL(wp) :: zcoef ! temporary scalars 216 REAL(wp), POINTER, DIMENSION(:,:,:) :: zconv ! temporary conv on W-grid 217 !!---------------------------------------------------------------------- 218 ! 219 CALL wrk_alloc( jpi,jpj,jpk, zconv ) 203 INTEGER , INTENT(in ) :: kt ! ocean time-step index 204 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pconv ! 205 ! 206 INTEGER :: ji, jj, jk ! dummy loop indices 207 INTEGER :: iku, ikv ! local integers 208 REAL(wp) :: zcoef ! local scalars 209 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zconv ! 3D workspace 210 !!---------------------------------------------------------------------- 220 211 ! 221 212 ! Local constant initialization … … 240 231 END DO 241 232 ! 242 CALL wrk_dealloc( jpi,jpj,jpk, zconv )243 !244 233 END SUBROUTINE ken_p2k 245 234 -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r6140 r8882 69 69 INTEGER :: ionce, icount 70 70 71 !! * Substitutions72 # include "zdfddm_substitute.h90"73 71 !!---------------------------------------------------------------------- 74 72 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r6140 r8882 37 37 38 38 !! * Substitutions 39 # include "zdfddm_substitute.h90"40 39 # include "vectopt_loop_substitute.h90" 41 40 !!---------------------------------------------------------------------- -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r8698 r8882 31 31 USE iom ! I/O manager library 32 32 USE lib_mpp ! MPP library 33 USE wrk_nemo ! Memory allocation34 33 35 34 IMPLICIT NONE … … 42 41 43 42 !! * Substitutions 44 # include "zdfddm_substitute.h90"45 43 # include "vectopt_loop_substitute.h90" 46 44 !!---------------------------------------------------------------------- … … 83 81 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 84 82 ! 85 INTEGER :: jk ! loop indices 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwt, zws, ztrdt, ztrds ! 3D workspace 87 !!---------------------------------------------------------------------- 88 ! 89 CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 83 INTEGER :: jk ! loop indices 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace 85 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws, ztrdt ! 3D workspace 86 !!---------------------------------------------------------------------- 90 87 ! 91 88 IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays … … 104 101 ztrds(:,:,:) = 0._wp 105 102 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 103 !!gm Gurvan, verify the jptra_evd trend please ! 106 104 CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 107 105 CASE DEFAULT ! other trends: masked trends … … 124 122 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 125 123 ! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 126 CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt)124 ALLOCATE( zwt(jpi,jpj,jpk), zws(jpi,jpj,jpk), ztrdt(jpi,jpj,jpk) ) 127 125 ! 128 126 zwt(:,:, 1 ) = 0._wp ; zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes … … 130 128 DO jk = 2, jpk 131 129 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 132 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)130 zws(:,:,jk) = avs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 133 131 END DO 134 132 ! … … 154 152 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt ) 155 153 ! 156 CALL wrk_dealloc( jpi, jpj, jpk,zwt, zws, ztrdt )154 DEALLOCATE( zwt, zws, ztrdt ) 157 155 ! 158 156 CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng … … 176 174 ! 177 175 ENDIF 178 !179 CALL wrk_dealloc( jpi, jpj, jpk, ztrds )180 176 ! 181 177 END SUBROUTINE trd_tra … … 307 303 INTEGER :: ji, jj, jk ! dummy loop indices 308 304 INTEGER :: ikbu, ikbv ! local integers 309 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace305 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 310 306 !!---------------------------------------------------------------------- 311 307 ! … … 316 312 ! This total trend is done every time step 317 313 CASE( jptra_tot ) ; CALL iom_put( "ttrd_tot" , ptrdx ) ! model total trend 318 CALL iom_put( "strd_tot" , ptrdy )314 CALL iom_put( "strd_tot" , ptrdy ) 319 315 END SELECT 320 316 ! 321 317 ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file 322 318 IF( MOD( kt, 2 ) == 0 ) THEN 323 319 SELECT CASE( ktrd ) 324 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection325 CALL iom_put( "strd_xad", ptrdy )326 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection327 CALL iom_put( "strd_yad", ptrdy )328 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection329 CALL iom_put( "strd_zad", ptrdy )330 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface331 CALL wrk_alloc( jpi, jpj, z2dx, z2dy)332 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1)333 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1)334 CALL iom_put( "ttrd_sad", z2dx )335 CALL iom_put( "strd_sad", z2dy )336 CALL wrk_dealloc( jpi, jpj,z2dx, z2dy )337 ENDIF338 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad" , ptrdx )! total advection339 CALL iom_put( "strd_totad", ptrdy )340 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion341 CALL iom_put( "strd_ldf", ptrdy )342 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution)343 CALL iom_put( "strd_zdf", ptrdy )344 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp" , ptrdx ) ! PURE vertical diffusion (no isoneutral contribution)345 CALL iom_put( "strd_zdfp", ptrdy )346 CASE( jptra_evd ) ; CALL iom_put( "ttrd_evd" , ptrdx )! EVD trend (convection)347 CALL iom_put( "strd_evd", ptrdy )348 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping)349 CALL iom_put( "strd_dmp", ptrdy )350 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer351 CALL iom_put( "strd_bbl", ptrdy )352 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing353 CALL iom_put( "strd_npc", ptrdy )354 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature)355 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T)356 CALL iom_put( "strd_cdt", ptrdy(:,:,1) ) ! output as 2D surface fields357 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature)320 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 321 CALL iom_put( "strd_xad" , ptrdy ) 322 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 323 CALL iom_put( "strd_yad" , ptrdy ) 324 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 325 CALL iom_put( "strd_zad" , ptrdy ) 326 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 327 ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) ) 328 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 329 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 330 CALL iom_put( "ttrd_sad", z2dx ) 331 CALL iom_put( "strd_sad", z2dy ) 332 DEALLOCATE( z2dx, z2dy ) 333 ENDIF 334 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad", ptrdx ) ! total advection 335 CALL iom_put( "strd_totad", ptrdy ) 336 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 337 CALL iom_put( "strd_ldf" , ptrdy ) 338 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 339 CALL iom_put( "strd_zdf" , ptrdy ) 340 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp" , ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 341 CALL iom_put( "strd_zdfp" , ptrdy ) 342 CASE( jptra_evd ) ; CALL iom_put( "ttrd_evd" , ptrdx ) ! EVD trend (convection) 343 CALL iom_put( "strd_evd" , ptrdy ) 344 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 345 CALL iom_put( "strd_dmp" , ptrdy ) 346 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 347 CALL iom_put( "strd_bbl" , ptrdy ) 348 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 349 CALL iom_put( "strd_npc" , ptrdy ) 350 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 351 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 352 CALL iom_put( "strd_cdt" , ptrdy(:,:,1) ) ! output as 2D surface fields 353 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 358 354 END SELECT 359 355 ! the Asselin filter trend is also every other time step but needs to be lagged one time step … … 366 362 END IF 367 363 ! 364 ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file 365 IF( MOD( kt, 2 ) == 0 ) THEN 366 SELECT CASE( ktrd ) 367 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 368 CALL iom_put( "strd_xad" , ptrdy ) 369 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 370 CALL iom_put( "strd_yad" , ptrdy ) 371 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 372 CALL iom_put( "strd_zad" , ptrdy ) 373 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 374 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 375 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 376 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 377 CALL iom_put( "ttrd_sad", z2dx ) 378 CALL iom_put( "strd_sad", z2dy ) 379 DEALLOCATE( z2dx, z2dy ) 380 ENDIF 381 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad", ptrdx ) ! total advection 382 CALL iom_put( "strd_totad", ptrdy ) 383 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 384 CALL iom_put( "strd_ldf" , ptrdy ) 385 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 386 CALL iom_put( "strd_zdf" , ptrdy ) 387 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp" , ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 388 CALL iom_put( "strd_zdfp" , ptrdy ) 389 CASE( jptra_evd ) ; CALL iom_put( "ttrd_evd" , ptrdx ) ! EVD trend (convection) 390 CALL iom_put( "strd_evd" , ptrdy ) 391 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 392 CALL iom_put( "strd_dmp" , ptrdy ) 393 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 394 CALL iom_put( "strd_bbl" , ptrdy ) 395 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 396 CALL iom_put( "strd_npc" , ptrdy ) 397 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 398 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 399 CALL iom_put( "strd_cdt" , ptrdy(:,:,1) ) ! output as 2D surface fields 400 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 401 END SELECT 402 ! the Asselin filter trend is also every other time step but needs to be lagged one time step 403 ! Even when 1ts output is selected can go to the same (2ts) file as the trends plotted every even time step. 404 ELSEIF( MOD( kt, 2 ) == 1 ) THEN 405 SELECT CASE( ktrd ) 406 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 407 CALL iom_put( "strd_atf" , ptrdy ) 408 END SELECT 409 ENDIF 410 ! 368 411 END SUBROUTINE trd_tra_iom 369 412
Note: See TracChangeset
for help on using the changeset viewer.
