- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5930 r6060 41 41 42 42 !! * Substitutions 43 # include "domzgr_substitute.h90"44 43 # include "vectopt_loop_substitute.h90" 45 44 !!---------------------------------------------------------------------- … … 94 93 CALL lbc_lnk( putrd, 'U', -1. ) ; CALL lbc_lnk( pvtrd, 'V', -1. ) ! lateral boundary conditions 95 94 ! 96 IF ( lk_vvl .AND. kt /= nkstp ) THEN ! Variable volume: set box volume at the 1st call of kt time step 97 nkstp = kt 98 DO jk = 1, jpkm1 99 bu (:,:,jk) = e1e2u(:,:) * fse3u_n(:,:,jk) 100 bv (:,:,jk) = e1e2v(:,:) * fse3v_n(:,:,jk) 101 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk) 102 END DO 103 ENDIF 95 nkstp = kt 96 DO jk = 1, jpkm1 97 bu (:,:,jk) = e1e2u(:,:) * e3u_n(:,:,jk) 98 bv (:,:,jk) = e1e2v(:,:) * e3v_n(:,:,jk) 99 r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t_n(:,:,jk) * tmask(:,:,jk) 100 END DO 104 101 ! 105 102 zke(:,:,jpk) = 0._wp … … 118 115 ! 119 116 SELECT CASE( ktrd ) 120 CASE( jpdyn_hpg ) ; CALL iom_put( "ketrd_hpg" , zke ) ! hydrostatic pressure gradient121 CASE( jpdyn_spg ) ; CALL iom_put( "ketrd_spg" , zke ) ! surface pressure gradient122 CASE( jpdyn_pvo ) ; CALL iom_put( "ketrd_pvo" , zke ) ! planetary vorticity123 CASE( jpdyn_rvo ) ; CALL iom_put( "ketrd_rvo" , zke ) ! relative vorticity (or metric term)124 CASE( jpdyn_keg ) ; CALL iom_put( "ketrd_keg" , zke ) ! Kinetic Energy gradient (or had)125 CASE( jpdyn_zad ) ; CALL iom_put( "ketrd_zad" , zke ) ! vertical advection126 CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf" , zke ) ! lateral diffusion127 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion128 !! wind stress trends117 CASE( jpdyn_hpg ) ; CALL iom_put( "ketrd_hpg" , zke ) ! hydrostatic pressure gradient 118 CASE( jpdyn_spg ) ; CALL iom_put( "ketrd_spg" , zke ) ! surface pressure gradient 119 CASE( jpdyn_pvo ) ; CALL iom_put( "ketrd_pvo" , zke ) ! planetary vorticity 120 CASE( jpdyn_rvo ) ; CALL iom_put( "ketrd_rvo" , zke ) ! relative vorticity (or metric term) 121 CASE( jpdyn_keg ) ; CALL iom_put( "ketrd_keg" , zke ) ! Kinetic Energy gradient (or had) 122 CASE( jpdyn_zad ) ; CALL iom_put( "ketrd_zad" , zke ) ! vertical advection 123 CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf" , zke ) ! lateral diffusion 124 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion 125 ! ! ! wind stress trends 129 126 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 130 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1 u(:,:) *e2u(:,:) * umask(:,:,1)131 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1 v(:,:) *e2v(:,:) * vmask(:,:,1)127 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 128 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 132 129 zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp 133 130 DO jj = 2, jpj 134 131 DO ji = 2, jpi 135 zke2d(ji,jj) = 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) &136 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1)132 zke2d(ji,jj) = r1_rau0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 133 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 137 134 END DO 138 135 END DO 139 CALL iom_put( "ketrd_tau" , zke2d )136 CALL iom_put( "ketrd_tau" , zke2d ) ! 140 137 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d ) 141 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case)138 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case) 142 139 !!gm TO BE DONE properly 143 140 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... … … 158 155 ! END DO 159 156 ! END DO 160 ! CALL iom_put( "ketrd_bfr", zke2d )! bottom friction (explicit case)157 ! CALL iom_put( "ketrd_bfr" , zke2d ) ! bottom friction (explicit case) 161 158 ! ENDIF 162 159 !!gm end 163 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf" , zke ) ! asselin filter trends160 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf" , zke ) ! asselin filter trends 164 161 !! a faire !!!! idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 165 162 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... … … 170 167 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 171 168 ! ikbv = mbkv(ji,jj) 172 ! z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu)173 ! z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv)169 ! z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 170 ! z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 174 171 ! END DO 175 172 ! END DO … … 183 180 ! CALL iom_put( "ketrd_bfri", zke2d ) 184 181 ! ENDIF 185 CASE( jpdyn_ken ) ; ! kinetic energy 186 ! called in dynnxt.F90 before asselin time filter 187 ! with putrd=ua and pvtrd=va 188 zke(:,:,:) = 0.5_wp * zke(:,:,:) 189 CALL iom_put( "KE", zke ) 190 ! 191 CALL ken_p2k( kt , zke ) 192 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 182 CASE( jpdyn_ken ) ; ! kinetic energy 183 ! called in dynnxt.F90 before asselin time filter with putrd=ua and pvtrd=va 184 zke(:,:,:) = 0.5_wp * zke(:,:,:) 185 CALL iom_put( "KE", zke ) 186 ! 187 CALL ken_p2k( kt , zke ) 188 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 193 189 ! 194 190 END SELECT … … 225 221 226 222 ! Surface value (also valid in partial step case) 227 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * fse3w(:,:,1)223 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1) 228 224 229 225 ! interior value (2=<jk=<jpkm1) 230 226 DO jk = 2, jpk 231 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * fse3w(:,:,jk)227 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk) 232 228 END DO 233 229 … … 236 232 DO jj = 1, jpj 237 233 DO ji = 1, jpi 238 zcoef = 0.5_wp / fse3t(ji,jj,jk)234 zcoef = 0.5_wp / e3t_n(ji,jj,jk) 239 235 pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 240 236 END DO … … 264 260 IF( trd_ken_alloc() /= 0 ) CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 265 261 ! 266 !!gm IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) ) &267 !!gm & CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate')268 !269 IF( .NOT.lk_vvl ) THEN ! constant volume: bu, bv, 1/bt computed one for all270 DO jk = 1, jpkm1271 bu (:,:,jk) = e1e2u(:,:) * fse3u_n(:,:,jk)272 bv (:,:,jk) = e1e2v(:,:) * fse3v_n(:,:,jk)273 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) )274 END DO275 ENDIF276 !277 262 END SUBROUTINE trd_ken_init 278 263
Note: See TracChangeset
for help on using the changeset viewer.
