Changeset 9987 for branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r7960 r9987 27 27 USE lib_mpp ! MPP library 28 28 USE wrk_nemo ! Memory allocation 29 USE ldfslp ! Isopycnal slopes 29 30 30 31 IMPLICIT NONE … … 42 43 # include "domzgr_substitute.h90" 43 44 # include "vectopt_loop_substitute.h90" 45 # include "ldfeiv_substitute.h90" 46 44 47 !!---------------------------------------------------------------------- 45 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 117 120 ! 118 121 SELECT CASE( ktrd ) 119 120 121 122 123 124 125 126 127 128 122 CASE( jpdyn_hpg ) ; CALL iom_put( "ketrd_hpg", zke ) ! hydrostatic pressure gradient 123 CASE( jpdyn_spg ) ; CALL iom_put( "ketrd_spg", zke ) ! surface pressure gradient 124 CASE( jpdyn_spgexp ); CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 125 CASE( jpdyn_spgflt ); CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 126 CASE( jpdyn_pvo ) ; CALL iom_put( "ketrd_pvo", zke ) ! planetary vorticity 127 CASE( jpdyn_rvo ) ; CALL iom_put( "ketrd_rvo", zke ) ! relative vorticity (or metric term) 128 CASE( jpdyn_keg ) ; CALL iom_put( "ketrd_keg", zke ) ! Kinetic Energy gradient (or had) 129 CASE( jpdyn_zad ) ; CALL iom_put( "ketrd_zad", zke ) ! vertical advection 130 CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf", zke ) ! lateral diffusion 131 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf", zke ) ! vertical diffusion 129 132 ! ! wind stress trends 130 131 132 133 134 135 136 137 138 139 140 141 142 133 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 134 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 135 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 136 zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp 137 DO jj = 2, jpj 138 DO ji = 2, jpi 139 zke2d(ji,jj) = 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 140 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 141 END DO 142 END DO 143 CALL iom_put( "ketrd_tau", zke2d ) 144 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d ) 145 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr", zke ) ! bottom friction (explicit case) 143 146 !!gm TO BE DONE properly 144 147 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... … … 162 165 ! ENDIF 163 166 !!gm end 164 167 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf", zke ) ! asselin filter trends 165 168 !! a faire !!!! idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 166 169 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... … … 184 187 ! CALL iom_put( "ketrd_bfri", zke2d ) 185 188 ! ENDIF 186 CASE( jpdyn_ken ) ; ! kinetic energy 187 ! called in dynnxt.F90 before asselin time filter 188 ! with putrd=ua and pvtrd=va 189 zke(:,:,:) = 0.5_wp * zke(:,:,:) 190 CALL iom_put( "KE", zke ) 191 ! 192 CALL ken_p2k( kt , zke ) 193 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 189 CASE( jpdyn_ken ) ; ! kinetic energy 190 ! called in dynnxt.F90 before asselin time filter 191 ! with putrd=ua and pvtrd=va 192 zke(:,:,:) = 0.5_wp * zke(:,:,:) 193 CALL iom_put( "KE", zke ) 194 ! 195 CALL ken_p2k( kt , zke ) 196 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 197 CASE( jpdyn_eivke ) 198 ! CMIP6 diagnostic tknebto = tendency of KE from 199 ! parameterized mesoscale eddy advection 200 ! = vertical_integral( k (N S)^2 ) rho dz 201 ! rho = reference density 202 ! S = isoneutral slope. 203 ! Most terms are on W grid so work on this grid 204 CALL wrk_alloc( jpi, jpj, zke2d ) 205 zke2d(:,:) = 0._wp 206 DO jk = 1,jpk 207 DO ji = 1,jpi 208 DO jj = 1,jpj 209 zke2d(ji,jj) = zke2d(ji,jj) + rau0 * fsaeiw(ji, jj, jk) & 210 & * ( wslpi(ji, jj, jk) * wslpi(ji,jj,jk) & 211 & + wslpj(ji, jj, jk) * wslpj(ji,jj,jk) ) & 212 & * rn2(ji,jj,jk) * fse3w(ji, jj, jk) 213 ENDDO 214 ENDDO 215 ENDDO 216 CALL iom_put("ketrd_eiv", zke2d) 217 CALL wrk_dealloc( jpi, jpj, zke2d ) 194 218 ! 195 219 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.