- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r6140 r9019 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
Note: See TracChangeset
for help on using the changeset viewer.