- Timestamp:
- 2017-06-06T15:55:44+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD
- Files:
-
- 4 edited
-
trd_oce.F90 (modified) (1 diff)
-
trddyn.F90 (modified) (5 diffs)
-
trdglo.F90 (modified) (12 diffs)
-
trdken.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r7646 r8143 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_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r6140 r8143 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_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r7931 r8143 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 … … 77 76 INTEGER :: ikbu, ikbv ! local integers 78 77 REAL(wp):: zvm, zvt, zvs, z1_2rau0 ! local scalars 79 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 80 !!---------------------------------------------------------------------- 81 82 CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 83 78 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 79 !!---------------------------------------------------------------------- 80 ! 84 81 IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 85 82 ! … … 123 120 DO jj = 1, jpjm1 124 121 DO ji = 1, jpim1 125 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj 126 & * e1u (ji ,jj ) * e2u(ji,jj) * e3u_n(ji,jj,jk)127 zvs = ptrdy(ji,jj,jk) * tmask_i(ji 128 & * 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) 129 126 umo(ktrd) = umo(ktrd) + zvt 130 127 vmo(ktrd) = vmo(ktrd) + zvs … … 138 135 DO jj = 1, jpjm1 139 136 DO ji = 1, jpim1 140 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj 141 & * z1_2rau0 * e1u (ji ,jj ) * e2u(ji,jj)142 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji 143 & * 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) 144 141 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 145 142 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs … … 151 148 IF( ktrd == jpdyn_atf ) THEN ! last trend (asselin time filter) 152 149 ! 153 IF( ln_ bfrimp ) THEN ! implicit bfrcase: compute separately the bottom friction150 IF( ln_drgimp ) THEN ! implicit drag case: compute separately the bottom friction 154 151 z1_2rau0 = 0.5_wp / rau0 155 152 DO jj = 1, jpjm1 … … 157 154 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 158 155 ikbv = mbkv(ji,jj) 159 zvt = bfrua(ji,jj) * un(ji,jj,ikbu) * e1u(ji,jj) * e2v(ji,jj)160 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) 161 158 umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 162 159 vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs … … 165 162 END DO 166 163 ENDIF 164 !!gm top drag case is missing 167 165 ! 168 166 CALL glo_dyn_wri( kt ) ! print the results in ocean.output … … 178 176 ENDIF 179 177 ! 180 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )181 !182 178 END SUBROUTINE trd_glo 183 179 … … 193 189 INTEGER :: ji, jj, jk ! dummy loop indices 194 190 REAL(wp) :: zcof ! local scalar 195 REAL(wp), POINTER, DIMENSION(:,:,:) :: zkx, zky, zkz, zkepe 196 !!---------------------------------------------------------------------- 197 198 CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe ) 191 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkx, zky, zkz, zkepe 192 !!---------------------------------------------------------------------- 199 193 200 194 ! I. Momentum trends … … 283 277 & + vmo(jpdyn_bfr) + vmo(jpdyn_atf) ) / tvolv 284 278 WRITE (numout,9513) umo(jpdyn_tau) / tvolu, vmo(jpdyn_tau) / tvolv 285 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 286 280 ENDIF 287 281 … … 322 316 & + hke(jpdyn_bfr) + hke(jpdyn_atf) ) / tvolt 323 317 WRITE (numout,9533) hke(jpdyn_tau) / tvolt 324 IF( ln_ bfrimp ) WRITE (numout,9534) hke(jpdyn_bfri) / tvolt318 IF( ln_drgimp ) WRITE (numout,9534) hke(jpdyn_bfri) / tvolt 325 319 ENDIF 326 320 … … 372 366 ENDIF 373 367 ! 374 CALL wrk_dealloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )375 !376 368 END SUBROUTINE glo_dyn_wri 377 369 -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r7646 r8143 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 !!gm USE dynhpg ! hydrostatic pressure gradient 20 USE ldftra ! ocean active tracers lateral physics 17 21 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 22 USE trdvor ! ocean vorticity trends 23 23 USE trdglo ! trends:global domain averaged … … 27 27 USE iom ! I/O manager library 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory allocation30 29 USE ldfslp ! Isopycnal slopes 31 30 … … 74 73 !! diagnose separately the KE trend associated with wind stress 75 74 !! - bottom friction case (jpdyn_bfr): 76 !! explicit case (ln_ bfrimp=F): bottom trend put in the 1st level75 !! explicit case (ln_drgimp=F): bottom trend put in the 1st level 77 76 !! of putrd, pvtrd 78 77 ! … … 86 85 INTEGER :: ikbu , ikbv ! local integers 87 86 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 ) 87 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z2dx, z2dy, zke2d ! 2D workspace 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zke ! 3D workspace 89 !!---------------------------------------------------------------------- 93 90 ! 94 91 CALL lbc_lnk( putrd, 'U', -1. ) ; CALL lbc_lnk( pvtrd, 'V', -1. ) ! lateral boundary conditions … … 125 122 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion 126 123 ! ! ! wind stress trends 127 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d)124 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) ) 128 125 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 129 126 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) … … 136 133 END DO 137 134 CALL iom_put( "ketrd_tau" , zke2d ) ! 138 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d )135 DEALLOCATE( z2dx , z2dy , zke2d ) 139 136 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case) 140 137 !!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) THEN138 !!gm only valid if ln_drgimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... 139 ! IF(.NOT. ln_drgimp) THEN 143 140 ! DO jj = 1, jpj ! 144 141 ! DO ji = 1, jpi … … 163 160 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 164 161 ! 165 ! IF( ln_ bfrimp ) THEN ! bottom friction (implicit case)162 ! IF( ln_drgimp ) THEN ! bottom friction (implicit case) 166 163 ! DO jj = 1, jpj ! after velocity known (now filed at this stage) 167 164 ! DO ji = 1, jpi … … 192 189 END SELECT 193 190 ! 194 CALL wrk_dealloc( jpi, jpj, jpk, zke )195 !196 191 END SUBROUTINE trd_ken 197 192 … … 207 202 !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps) 208 203 !!---------------------------------------------------------------------- 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 ) 204 INTEGER , INTENT(in ) :: kt ! ocean time-step index 205 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pconv ! 206 ! 207 INTEGER :: ji, jj, jk ! dummy loop indices 208 INTEGER :: iku, ikv ! local integers 209 REAL(wp) :: zcoef ! local scalars 210 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zconv ! 3D workspace 211 !!---------------------------------------------------------------------- 220 212 ! 221 213 ! Local constant initialization … … 240 232 END DO 241 233 ! 242 CALL wrk_dealloc( jpi,jpj,jpk, zconv )243 !244 234 END SUBROUTINE ken_p2k 245 235
Note: See TracChangeset
for help on using the changeset viewer.
