- Timestamp:
- 2012-02-23T12:21:08+01:00 (12 years ago)
- Location:
- branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 1 deleted
- 11 edited
-
DYN/dynbfr.F90 (modified) (1 diff)
-
DYN/dynnxt.F90 (modified) (2 diffs)
-
DYN/dynzdf_imp.F90 (modified) (2 diffs)
-
TRA/tradmp.F90 (modified) (2 diffs)
-
TRA/tranxt.F90 (modified) (3 diffs)
-
TRA/trasbc.F90 (modified) (5 diffs)
-
TRD/trdicp.F90 (modified) (14 diffs)
-
TRD/trdicp_oce.F90 (deleted)
-
TRD/trdmod.F90 (modified) (6 diffs)
-
TRD/trdmod_oce.F90 (modified) (3 diffs)
-
TRD/trdtra.F90 (modified) (5 diffs)
-
oce.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r3294 r3317 57 57 IF( nn_timing == 1 ) CALL timing_start('dyn_bfr') 58 58 ! 59 !!gm issue: better to put the logical in step to control the call of zdf_bfr 60 !! ==> change the logical from ln_bfrimp to ln_bfr_exp !! 59 61 IF( .NOT.ln_bfrimp) THEN ! only for explicit bottom friction form 60 62 ! implicit bfr is implemented in dynzdf_imp 61 63 64 !!gm bug : time step is only rdt (not 2 rdt if euler start !) 62 65 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 63 66 -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r3316 r3317 31 31 USE dynadv ! dynamics: vector invariant versus flux form 32 32 USE domvvl ! variable volume 33 USE trdmod ! ocean dynamics trends 34 USE trdmod_oce ! ocean variables trends 33 35 USE obc_oce ! ocean open boundary conditions 34 36 USE obcdyn ! open boundary condition for momentum (obc_dyn routine) … … 292 294 293 295 IF( ln_3D_trd_d ) THEN ! 3D output: asselin filter trends on momentum 294 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 295 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 296 CALL iom_put( "utrd_atf", zua ) ! asselin filter trends on momentum 297 CALL iom_put( "vtrd_atf", zva ) 296 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 297 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 298 CALL trd_mod( zua, zva, jpdyn_trd_atf, 'DYN', kt ) 298 299 ENDIF 299 300 -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r3294 r3317 94 94 IF( ln_bfrimp ) THEN 95 95 # if defined key_vectopt_loop 96 DO jj = 1, 197 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)96 DO jj = 1, 1 97 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 98 98 # else 99 DO jj = 2, jpjm1100 DO ji = 2, jpim199 DO jj = 2, jpjm1 100 DO ji = 2, jpim1 101 101 # endif 102 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points103 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)104 zavmu(ji,jj) = avmu(ji,jj,ikbu+1)105 zavmv(ji,jj) = avmv(ji,jj,ikbv+1)106 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1)107 avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)108 END DO109 END DO102 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 103 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 104 zavmu(ji,jj) = avmu(ji,jj,ikbu+1) 105 zavmv(ji,jj) = avmv(ji,jj,ikbv+1) 106 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 107 avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1) 108 END DO 109 END DO 110 110 ENDIF 111 111 … … 284 284 IF( ln_bfrimp ) THEN 285 285 # if defined key_vectopt_loop 286 DO jj = 1, 1287 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)286 DO jj = 1, 1 287 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 288 288 # else 289 DO jj = 2, jpjm1290 DO ji = 2, jpim1289 DO jj = 2, jpjm1 290 DO ji = 2, jpim1 291 291 # endif 292 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points293 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)294 avmu(ji,jj,ikbu+1) = zavmu(ji,jj)295 avmv(ji,jj,ikbv+1) = zavmv(ji,jj)296 END DO297 END DO292 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 293 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 294 avmu(ji,jj,ikbu+1) = zavmu(ji,jj) 295 avmv(ji,jj,ikbv+1) = zavmv(ji,jj) 296 END DO 297 END DO 298 298 ENDIF 299 299 ! -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r3294 r3317 47 47 PUBLIC dtacof_zoom ! routine called by in both tradmp.F90 and trcdmp.F90 48 48 49 ! !!* Namelist namtra_dmp : T & S newtonian damping *49 ! !!* Namelist namtra_dmp : T & S newtonian damping * 50 50 LOGICAL, PUBLIC :: ln_tradmp = .TRUE. !: internal damping flag 51 51 INTEGER :: nn_hdmp = -1 ! = 0/-1/'latitude' for damping over T and S … … 111 111 ! 112 112 CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta ) 113 ! 113 114 ! !== input T-S data at kt ==! 114 115 CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r3294 r3317 29 29 USE zdf_oce ! ??? 30 30 USE domvvl ! variable volume 31 USE ldftra_oce ! ocean active tracers lateral physics 31 32 USE dynspg_oce ! surface pressure gradient variables 32 33 USE dynhpg ! hydrostatic pressure gradient … … 132 133 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 133 134 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 135 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 136 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdfp, ztrdt ) 137 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdfp, ztrds ) 138 ENDIF 134 139 ENDIF 135 140 … … 168 173 & tab3d_2=tsn(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask ) 169 174 ! 170 ! 171 IF( nn_timing == 1 ) CALL timing_stop('tra_nxt') 175 IF( nn_timing == 1 ) CALL timing_stop('tra_nxt') 172 176 ! 173 177 END SUBROUTINE tra_nxt -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r3294 r3317 104 104 !! ** Action : - Update the 1st level of (ta,sa) with the trend associated 105 105 !! with the tracer surface boundary condition 106 !! - s ave the trend it in ttrd ('key_trdtra')106 !! - send trends to trdtra module (l_trdtra=T) 107 107 !!---------------------------------------------------------------------- 108 108 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 123 123 zsrau = 1. / rau0 ! initialization 124 124 125 IF( l_trdtra ) 125 IF( l_trdtra ) THEN !* Save ta and sa trends 126 126 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 127 127 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 145 145 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 146 146 IF(lwp) WRITE(numout,*) ' nit000-1 surface tracer content forcing fields red in the restart file' 147 zfact = 0.5 e0147 zfact = 0.5_wp 148 148 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 149 149 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 150 150 ELSE ! No restart or restart not found: Euler forward time stepping 151 zfact = 1. e0151 zfact = 1._wp 152 152 sbc_tsc_b(:,:,:) = 0.e0 153 153 ENDIF 154 154 ELSE ! Swap of forcing fields 155 155 ! ! ---------------------- 156 zfact = 0.5 e0156 zfact = 0.5_wp 157 157 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 158 158 ENDIF … … 206 206 !---------------------------------------- 207 207 ! 208 zfact = 0.5e0209 208 210 209 ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection) 211 210 IF( ln_rnf ) THEN 211 zfact = 0.5_wp 212 212 DO jj = 2, jpj 213 213 DO ji = fs_2, fs_jpim1 214 zdep = 1. / h_rnf(ji,jj) 215 zdep = zfact * zdep 214 zdep = zfact / h_rnf(ji,jj) 216 215 IF ( rnf(ji,jj) /= 0._wp ) THEN 217 216 DO jk = 1, nk_rnf(ji,jj) … … 225 224 END DO 226 225 ENDIF 227 !!gm It should be useless 226 !!gm It should be useless ==>> to be suppressed ! 228 227 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 228 !!gm : end of useless 229 229 230 230 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90
r3316 r3317 7 7 !! 3.5 ! 2012-02 (G. Madec) add 3D tracer zdf trend output using iom 8 8 !!---------------------------------------------------------------------- 9 #if defined key_trdtra || defined key_trddyn || defined key_esopa 9 10 10 !!---------------------------------------------------------------------- 11 !! 'key_trdtra' or active tracers trends diagnostics 12 !! 'key_trddyn' momentum trends diagnostics 13 !!---------------------------------------------------------------------- 14 !! trd_icp : compute the basin averaged properties for tra/dyn 15 !! trd_dwr : print dynmaic trends in ocean.output file 16 !! trd_twr : print tracers trends in ocean.output file 17 !! trd_icp_init : initialization step 11 !! trd_budget : domain averaged budget of trends (including kinetic energy and T^2 trends) 12 !! trd_icp : compute the basin averaged properties for tra/dyn 13 !! trd_dwr : print dynmaic trends in ocean.output file 14 !! trd_twr : print tracers trends in ocean.output file 15 !! trd_icp_init : initialization step 18 16 !!---------------------------------------------------------------------- 19 17 USE oce ! ocean dynamics and tracers variables 20 18 USE dom_oce ! ocean space and time domain variables 19 USE sbc_oce ! surface boundary condition: ocean 20 USE phycst ! physical constants 21 21 USE trdmod_oce ! ocean variables trends 22 22 USE ldftra_oce ! ocean active tracers: lateral physics 23 23 USE ldfdyn_oce ! ocean dynamics: lateral physics 24 24 USE zdf_oce ! ocean vertical physics 25 USE zdfbfr ! bottom friction 25 26 USE zdfddm ! ocean vertical physics: double diffusion 26 27 USE eosbn2 ! equation of state … … 34 35 PRIVATE 35 36 36 INTERFACE trd_icp 37 MODULE PROCEDURE trd_2d, trd_3d 38 END INTERFACE 39 40 PUBLIC trd_icp ! called by trdmod.F90 37 PUBLIC trd_budget ! called by trdmod.F90 41 38 PUBLIC trd_dwr ! called by step.F90 42 39 PUBLIC trd_twr ! called by step.F90 43 40 PUBLIC trd_icp_init ! called by opa.F90 41 42 ! !!! Variables used for diagnostics 43 REAL(wp) :: tvolt ! volume of the whole ocean computed at t-points 44 REAL(wp) :: tvolu ! volume of the whole ocean computed at u-points 45 REAL(wp) :: tvolv ! volume of the whole ocean computed at v-points 46 REAL(wp) :: rpktrd ! potential to kinetic energy conversion 47 REAL(wp) :: peke ! conversion potential energy - kinetic energy trend 48 49 ! !!! domain averaged trends 50 REAL(wp), DIMENSION(jptot_tra) :: tmo, smo ! temperature and salinity trends 51 REAL(wp), DIMENSION(jptot_tra) :: t2 , s2 ! T^2 and S^2 trends 52 REAL(wp), DIMENSION(jptot_dyn) :: umo, vmo ! momentum trends 53 REAL(wp), DIMENSION(jptot_dyn) :: hke ! kinetic energy trends (u^2+v^2) 44 54 45 55 !! * Substitutions … … 54 64 CONTAINS 55 65 56 SUBROUTINE trd_ 2d( ptrd2dx, ptrd2dy, ktrd , ctype)66 SUBROUTINE trd_budget( ptrdx, ptrdy, ktrd, ctype, kt ) 57 67 !!--------------------------------------------------------------------- 58 !! *** ROUTINE trd_ 2d***68 !! *** ROUTINE trd_budget *** 59 69 !! 60 !! ** Purpose : compute and print the domain averaged properties of tracers 61 !! and/or momentum equations at each nn_trd time step. 62 !!---------------------------------------------------------------------- 63 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ptrd2dx ! Temperature or U trend 64 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ptrd2dy ! Salinity or V trend 65 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 66 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends 70 !! ** Purpose : integral constraint diagnostics for momentum and/or tracer trends 71 !! 72 !!---------------------------------------------------------------------- 73 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 74 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 75 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 76 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 77 INTEGER , INTENT(in ) :: kt ! time step 67 78 !! 68 INTEGER :: ji, jj ! loop indices 69 !!---------------------------------------------------------------------- 70 71 SELECT CASE( ctype ) !== Mask trends ==! 72 ! 73 CASE( 'DYN' ) ! Momentum 74 DO jj = 1, jpjm1 75 DO ji = 1, jpim1 76 ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,1) 77 ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 79 INTEGER :: ji, jj, jk ! dummy loop indices 80 INTEGER :: ikbu, ikbv ! local integers 81 REAL(wp):: zvm, zvt, zvs, z1_2rau0 ! local scalars 82 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 83 !!---------------------------------------------------------------------- 84 85 CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 86 87 IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 88 ! 89 SELECT CASE( ctype ) 90 ! 91 CASE( 'TRA' ) !== Tracers (T & S) ==! 92 DO jk = 1, jpkm1 ! global sum of mask volume trend and trend*T (including interior mask) 93 DO jj = 1, jpj 94 DO ji = 1, jpi 95 zvm = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 96 zvt = ptrdx(ji,jj,jk) * zvm 97 zvs = ptrdy(ji,jj,jk) * zvm 98 tmo(ktrd) = tmo(ktrd) + zvt 99 smo(ktrd) = smo(ktrd) + zvs 100 t2 (ktrd) = t2(ktrd) + zvt * tsn(ji,jj,jk,jp_tem) 101 s2 (ktrd) = s2(ktrd) + zvs * tsn(ji,jj,jk,jp_sal) 102 END DO 103 END DO 78 104 END DO 79 END DO 80 ptrd2dx(jpi, : ) = 0._wp ; ptrd2dy(jpi, : ) = 0._wp 81 ptrd2dx( : ,jpj) = 0._wp ; ptrd2dy( : ,jpj) = 0._wp 82 ! 83 CASE( 'TRA' ) ! Tracers 84 ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:) 85 ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:) 86 ! 87 END SELECT 88 89 SELECT CASE( ctype ) !== Basin averaged tracer/momentum trends ==! 90 ! 91 CASE( 'DYN' ) ! Momentum 92 umo(ktrd) = 0._wp 93 vmo(ktrd) = 0._wp 94 ! 95 SELECT CASE( ktrd ) 96 CASE( jpdyn_trd_swf ) ! surface forcing 97 umo(ktrd) = SUM( ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) ) 98 vmo(ktrd) = SUM( ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) ) 105 ! ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 106 IF( .NOT.lk_vvl .AND. ktrd == jptra_trd_zad ) THEN 107 tmo(jptra_trd_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) ) 108 smo(jptra_trd_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) ) 109 t2 (jptra_trd_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) ) 110 s2 (jptra_trd_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) ) 111 ENDIF 112 ! 113 IF( ktrd == jptra_trd_atf ) THEN ! last trend (asselin time filter) 114 ! 115 CALL trd_twr( kt ) ! print the results in ocean.output 116 ! 117 tmo(:) = 0._wp ! prepare the next time step (domain averaged array reset to zero) 118 smo(:) = 0._wp 119 t2 (:) = 0._wp 120 s2 (:) = 0._wp 121 ! 122 ENDIF 123 ! 124 CASE( 'DYN' ) !== Momentum and KE ==! 125 DO jk = 1, jpkm1 126 DO jj = 1, jpjm1 127 DO ji = 1, jpim1 128 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) & 129 & * e1u (ji ,jj ) * e2u (ji,jj) * fse3u(ji,jj,jk) 130 zvs = ptrdy(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 131 & * e1v (ji ,jj ) * e2v (ji,jj) * fse3u(ji,jj,jk) 132 umo(ktrd) = umo(ktrd) + zvt 133 vmo(ktrd) = vmo(ktrd) + zvs 134 hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs 135 END DO 136 END DO 137 END DO 138 ! 139 IF( ktrd == jpdyn_trd_zdf ) THEN ! zdf trend: compute separately the surface forcing trend 140 z1_2rau0 = 0.5_wp / rau0 141 DO jj = 1, jpjm1 142 DO ji = 1, jpim1 143 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) & 144 & * z1_2rau0 * e1u (ji ,jj ) * e2u (ji,jj) 145 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 146 & * z1_2rau0 * e1v (ji ,jj ) * e2v (ji,jj) * fse3u(ji,jj,jk) 147 umo(jpdyn_trd_tau) = umo(jpdyn_trd_tau) + zvt 148 vmo(jpdyn_trd_tau) = vmo(jpdyn_trd_tau) + zvs 149 hke(jpdyn_trd_tau) = hke(jpdyn_trd_tau) + un(ji,jj,1) * zvt + vn(ji,jj,1) * zvs 150 END DO 151 END DO 152 ENDIF 153 ! 154 IF( ktrd == jpdyn_trd_atf ) THEN ! last trend (asselin time filter) 155 ! 156 IF( ln_bfrimp ) THEN ! implicit bfr case: compute separately the bottom friction 157 z1_2rau0 = 0.5_wp / rau0 158 DO jj = 1, jpjm1 159 DO ji = 1, jpim1 160 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 161 ikbv = mbkv(ji,jj) 162 zvt = bfrua(ji,jj) * un(ji,jj,ikbu) * e1u(ji,jj) * e2v(ji,jj) 163 zvs = bfrva(ji,jj) * vn(ji,jj,ikbv) * e1v(ji,jj) * e2v(ji,jj) 164 umo(jpdyn_trd_bfr) = umo(jpdyn_trd_bfr) + zvt 165 vmo(jpdyn_trd_bfr) = vmo(jpdyn_trd_bfr) + zvs 166 hke(jpdyn_trd_bfr) = hke(jpdyn_trd_bfr) + un(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs 167 END DO 168 END DO 169 ENDIF 170 ! 171 CALL trd_dwr( kt ) ! print the results in ocean.output 172 ! 173 umo(:) = 0._wp ! reset for the next time step 174 vmo(:) = 0._wp 175 hke(:) = 0._wp 176 ! 177 ENDIF 178 ! 99 179 END SELECT 100 180 ! 101 CASE( 'TRA' ) ! Tracers 102 tmo(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 103 smo(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 104 END SELECT 105 106 SELECT CASE( ctype ) !== Basin averaged tracer/momentum square trends ==! (now field) 107 ! 108 CASE( 'DYN' ) ! Momentum 109 hke(ktrd) = SUM( un(:,:,1) * ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) & 110 & + vn(:,:,1) * ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) ) 111 ! 112 CASE( 'TRA' ) ! Tracers 113 t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_tem) ) 114 s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_sal) ) 115 ! 116 END SELECT 117 ! 118 END SUBROUTINE trd_2d 119 120 121 SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype ) 122 !!--------------------------------------------------------------------- 123 !! *** ROUTINE trd_3d *** 124 !! 125 !! ** Purpose : verify the basin averaged properties of tracers and/or 126 !! momentum equations at every time step frequency nn_trd. 127 !!---------------------------------------------------------------------- 128 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrd3dx ! Temperature or U trend 129 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrd3dy ! Salinity or V trend 130 INTEGER, INTENT(in ) :: ktrd ! momentum or tracer trend index 131 CHARACTER(len=3), INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends 132 !! 133 INTEGER :: ji, jj, jk ! dummy loop indices 134 !!---------------------------------------------------------------------- 135 136 SELECT CASE( ctype ) !== Mask the trends ==! 137 ! 138 CASE( 'DYN' ) ! Momentum 139 DO jk = 1, jpkm1 140 DO jj = 1, jpjm1 141 DO ji = 1, jpim1 142 ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 143 ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 144 END DO 145 END DO 146 END DO 147 ptrd3dx(jpi, : ,:) = 0._wp ; ptrd3dy(jpi, : ,:) = 0._wp 148 ptrd3dx( : ,jpj,:) = 0._wp ; ptrd3dy( : ,jpj,:) = 0._wp 149 ! 150 CASE( 'TRA' ) ! Tracers 151 DO jk = 1, jpkm1 152 ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 153 ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 154 END DO 155 ! 156 END SELECT 157 158 SELECT CASE( ctype ) !== Basin averaged tracer/momentum trends ==! 159 ! 160 CASE( 'DYN' ) ! Momentum 161 umo(ktrd) = 0._wp 162 vmo(ktrd) = 0._wp 163 DO jk = 1, jpkm1 164 umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) ) 165 vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 166 END DO 167 ! 168 CASE( 'TRA' ) ! Tracers 169 tmo(ktrd) = 0._wp 170 smo(ktrd) = 0._wp 171 DO jk = 1, jpkm1 172 tmo(ktrd) = tmo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 173 smo(ktrd) = smo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 174 END DO 175 ! 176 END SELECT 177 178 SELECT CASE( ctype ) !== Basin averaged tracer/momentum square trends ==! (now field) 179 ! 180 CASE( 'DYN' ) ! Momentum 181 hke(ktrd) = 0._wp 182 DO jk = 1, jpkm1 183 hke(ktrd) = hke(ktrd) + SUM( un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) & 184 & + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 185 END DO 186 ! 187 CASE( 'TRA' ) ! Tracers 188 t2(ktrd) = 0._wp 189 s2(ktrd) = 0._wp 190 DO jk = 1, jpkm1 191 t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tsn(:,:,jk,jp_tem) * e1e2t(:,:) * fse3t(:,:,jk) ) 192 s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * tsn(:,:,jk,jp_sal) * e1e2t(:,:) * fse3t(:,:,jk) ) 193 END DO 194 ! 195 END SELECT 196 ! 197 END SUBROUTINE trd_3d 181 ENDIF 182 ! 183 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 184 ! 185 END SUBROUTINE trd_budget 198 186 199 187 … … 262 250 REAL(wp), POINTER, DIMENSION(:,:,:) :: zkx, zky, zkz, zkepe 263 251 !!---------------------------------------------------------------------- 264 265 IF( ln_3D_trd_t .AND. ln_3D_trd_d ) RETURN ! do nothing if 3D output with IOM266 252 267 253 CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe ) … … 333 319 WRITE (numout,*) 334 320 WRITE (numout,9500) kt 335 WRITE (numout,9501) umo(jpicpd_hpg) / tvolu, vmo(jpicpd_hpg) / tvolv 336 WRITE (numout,9502) umo(jpicpd_keg) / tvolu, vmo(jpicpd_keg) / tvolv 337 WRITE (numout,9503) umo(jpicpd_rvo) / tvolu, vmo(jpicpd_rvo) / tvolv 338 WRITE (numout,9504) umo(jpicpd_pvo) / tvolu, vmo(jpicpd_pvo) / tvolv 339 WRITE (numout,9505) umo(jpicpd_ldf) / tvolu, vmo(jpicpd_ldf) / tvolv 340 WRITE (numout,9506) umo(jpicpd_had) / tvolu, vmo(jpicpd_had) / tvolv 341 WRITE (numout,9507) umo(jpicpd_zad) / tvolu, vmo(jpicpd_zad) / tvolv 342 WRITE (numout,9508) umo(jpicpd_zdf) / tvolu, vmo(jpicpd_zdf) / tvolv 343 WRITE (numout,9509) umo(jpicpd_spg) / tvolu, vmo(jpicpd_spg) / tvolv 344 WRITE (numout,9510) umo(jpicpd_swf) / tvolu, vmo(jpicpd_swf) / tvolv 345 WRITE (numout,9511) umo(jpicpd_dat) / tvolu, vmo(jpicpd_dat) / tvolv 346 WRITE (numout,9512) umo(jpicpd_bfr) / tvolu, vmo(jpicpd_bfr) / tvolv 321 WRITE (numout,9501) umo(jpdyn_trd_hpg) / tvolu, vmo(jpdyn_trd_hpg) / tvolv 322 WRITE (numout,9509) umo(jpdyn_trd_spg) / tvolu, vmo(jpdyn_trd_spg) / tvolv 323 WRITE (numout,9502) umo(jpdyn_trd_keg) / tvolu, vmo(jpdyn_trd_keg) / tvolv 324 WRITE (numout,9503) umo(jpdyn_trd_rvo) / tvolu, vmo(jpdyn_trd_rvo) / tvolv 325 WRITE (numout,9504) umo(jpdyn_trd_pvo) / tvolu, vmo(jpdyn_trd_pvo) / tvolv 326 WRITE (numout,9507) umo(jpdyn_trd_zad) / tvolu, vmo(jpdyn_trd_zad) / tvolv 327 WRITE (numout,9505) umo(jpdyn_trd_ldf) / tvolu, vmo(jpdyn_trd_ldf) / tvolv 328 WRITE (numout,9508) umo(jpdyn_trd_zdf) / tvolu, vmo(jpdyn_trd_zdf) / tvolv 329 WRITE (numout,9510) umo(jpdyn_trd_tau) / tvolu, vmo(jpdyn_trd_tau) / tvolv 330 WRITE (numout,9511) umo(jpdyn_trd_bfr) / tvolu, vmo(jpdyn_trd_bfr) / tvolv 331 WRITE (numout,9512) umo(jpdyn_trd_atf) / tvolu, vmo(jpdyn_trd_atf) / tvolv 347 332 WRITE (numout,9513) 348 333 WRITE (numout,9514) & 349 & ( umo(jp icpd_hpg) + umo(jpicpd_keg) + umo(jpicpd_rvo) + umo(jpicpd_pvo) + umo(jpicpd_ldf) &350 & + umo(jp icpd_had) + umo(jpicpd_zad) + umo(jpicpd_zdf) + umo(jpicpd_spg) + umo(jpicpd_dat) &351 & + umo(jp icpd_swf) + umo(jpicpd_bfr) ) / tvolu, &352 & ( vmo(jp icpd_hpg) + vmo(jpicpd_keg) + vmo(jpicpd_rvo) + vmo(jpicpd_pvo) + vmo(jpicpd_ldf) &353 & + vmo(jp icpd_had) + vmo(jpicpd_zad) + vmo(jpicpd_zdf) + vmo(jpicpd_spg) + vmo(jpicpd_dat) &354 & + vmo(jp icpd_swf) + vmo(jpicpd_bfr) ) / tvolv334 & ( umo(jpdyn_trd_hpg) + umo(jpdyn_trd_spg) + umo(jpdyn_trd_keg) + umo(jpdyn_trd_rvo) & 335 & + umo(jpdyn_trd_pvo) + umo(jpdyn_trd_zad) + umo(jpdyn_trd_ldf) + umo(jpdyn_trd_zdf) & 336 & + umo(jpdyn_trd_tau) + umo(jpdyn_trd_bfr) + umo(jpdyn_trd_atf) ) / tvolu, & 337 & ( vmo(jpdyn_trd_hpg) + vmo(jpdyn_trd_spg) + vmo(jpdyn_trd_keg) + vmo(jpdyn_trd_rvo) & 338 & + vmo(jpdyn_trd_pvo) + vmo(jpdyn_trd_zad) + vmo(jpdyn_trd_ldf) + vmo(jpdyn_trd_zdf) & 339 & + vmo(jpdyn_trd_tau) + vmo(jpdyn_trd_bfr) + vmo(jpdyn_trd_atf) ) / tvolv 355 340 ENDIF 356 341 … … 361 346 9504 FORMAT(' coriolis term u= ', e20.13, ' v= ', e20.13) 362 347 9505 FORMAT(' horizontal diffusion u= ', e20.13, ' v= ', e20.13) 363 9506 FORMAT(' horizontal advection u= ', e20.13, ' v= ', e20.13)364 348 9507 FORMAT(' vertical advection u= ', e20.13, ' v= ', e20.13) 365 349 9508 FORMAT(' vertical diffusion u= ', e20.13, ' v= ', e20.13) 366 350 9509 FORMAT(' surface pressure gradient u= ', e20.13, ' v= ', e20.13) 367 9510 FORMAT(' surface wind forcingu= ', e20.13, ' v= ', e20.13)368 9511 FORMAT(' dampimg termu= ', e20.13, ' v= ', e20.13)369 9512 FORMAT(' bottom fluxu= ', e20.13, ' v= ', e20.13)351 9510 FORMAT(' surface wind stress u= ', e20.13, ' v= ', e20.13) 352 9511 FORMAT(' bottom friction u= ', e20.13, ' v= ', e20.13) 353 9512 FORMAT(' Asselin time filter u= ', e20.13, ' v= ', e20.13) 370 354 9513 FORMAT(' -----------------------------------------------------------------------------') 371 355 9514 FORMAT(' total trend u= ', e20.13, ' v= ', e20.13) … … 375 359 WRITE (numout,*) 376 360 WRITE (numout,9520) kt 377 WRITE (numout,9521) hke(jpicpd_hpg) / tvolt 378 WRITE (numout,9522) hke(jpicpd_keg) / tvolt 379 WRITE (numout,9523) hke(jpicpd_rvo) / tvolt 380 WRITE (numout,9524) hke(jpicpd_pvo) / tvolt 381 WRITE (numout,9525) hke(jpicpd_ldf) / tvolt 382 WRITE (numout,9526) hke(jpicpd_had) / tvolt 383 WRITE (numout,9527) hke(jpicpd_zad) / tvolt 384 WRITE (numout,9528) hke(jpicpd_zdf) / tvolt 385 WRITE (numout,9529) hke(jpicpd_spg) / tvolt 386 WRITE (numout,9530) hke(jpicpd_swf) / tvolt 387 WRITE (numout,9531) hke(jpicpd_dat) / tvolt 388 WRITE (numout,9532) hke(jpicpd_bfr) / tvolt 361 WRITE (numout,9521) hke(jpdyn_trd_hpg) / tvolt 362 WRITE (numout,9529) hke(jpdyn_trd_spg) / tvolt 363 WRITE (numout,9522) hke(jpdyn_trd_keg) / tvolt 364 WRITE (numout,9523) hke(jpdyn_trd_rvo) / tvolt 365 WRITE (numout,9524) hke(jpdyn_trd_pvo) / tvolt 366 WRITE (numout,9527) hke(jpdyn_trd_zad) / tvolt 367 WRITE (numout,9525) hke(jpdyn_trd_ldf) / tvolt 368 WRITE (numout,9528) hke(jpdyn_trd_zdf) / tvolt 369 WRITE (numout,9530) hke(jpdyn_trd_tau) / tvolt 370 WRITE (numout,9531) hke(jpdyn_trd_bfr) / tvolt 371 WRITE (numout,9532) hke(jpdyn_trd_atf) / tvolt 389 372 WRITE (numout,9533) 390 373 WRITE (numout,9534) & 391 & ( hke(jp icpd_hpg) + hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_pvo) + hke(jpicpd_ldf) &392 & + hke(jp icpd_had) + hke(jpicpd_zad) + hke(jpicpd_zdf) + hke(jpicpd_spg) + hke(jpicpd_dat) &393 & + hke(jp icpd_swf) + hke(jpicpd_bfr)) / tvolt374 & ( hke(jpdyn_trd_hpg) + hke(jpdyn_trd_spg) + hke(jpdyn_trd_keg) + hke(jpdyn_trd_rvo) & 375 & + hke(jpdyn_trd_pvo) + hke(jpdyn_trd_zad) + hke(jpdyn_trd_ldf) + hke(jpdyn_trd_zdf) & 376 & + hke(jpdyn_trd_tau) + hke(jpdyn_trd_bfr) + hke(jpdyn_trd_atf) ) / tvolt 394 377 ENDIF 395 378 396 379 9520 FORMAT(' kinetic energy trend at it= ', i6, ' :', /' ====================================') 397 380 9521 FORMAT(' pressure gradient u2= ', e20.13) 381 9529 FORMAT(' surface pressure gradient u2= ', e20.13) 398 382 9522 FORMAT(' ke gradient u2= ', e20.13) 399 383 9523 FORMAT(' relative vorticity term u2= ', e20.13) 400 384 9524 FORMAT(' coriolis term u2= ', e20.13) 385 9527 FORMAT(' vertical advection u2= ', e20.13) 401 386 9525 FORMAT(' horizontal diffusion u2= ', e20.13) 402 9526 FORMAT(' horizontal advection u2= ', e20.13)403 9527 FORMAT(' vertical advection u2= ', e20.13)404 387 9528 FORMAT(' vertical diffusion u2= ', e20.13) 405 9529 FORMAT(' surface pressure gradient u2= ', e20.13) 406 9530 FORMAT(' surface wind forcing u2= ', e20.13) 407 9531 FORMAT(' dampimg term u2= ', e20.13) 408 9532 FORMAT(' bottom flux u2= ', e20.13) 388 9530 FORMAT(' surface wind stress u2= ', e20.13) 389 9531 FORMAT(' bottom friction u2= ', e20.13) 390 9532 FORMAT(' Asselin time filter u2= ', e20.13) 409 391 9533 FORMAT(' --------------------------------------------------') 410 392 9534 FORMAT(' total trend u2= ', e20.13) … … 414 396 WRITE (numout,*) 415 397 WRITE (numout,9540) kt 416 WRITE (numout,9541) ( hke(jp icpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt417 WRITE (numout,9542) ( hke(jp icpd_keg) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt418 WRITE (numout,9543) ( hke(jp icpd_pvo) ) / tvolt419 WRITE (numout,9544) ( hke(jp icpd_rvo) ) / tvolt420 WRITE (numout,9545) ( hke(jp icpd_spg) ) / tvolt421 WRITE (numout,9546) ( hke(jp icpd_ldf) ) / tvolt422 WRITE (numout,9547) ( hke(jp icpd_zdf) ) / tvolt423 WRITE (numout,9548) ( hke(jp icpd_hpg) ) / tvolt, rpktrd / tvolt398 WRITE (numout,9541) ( hke(jpdyn_trd_keg) + hke(jpdyn_trd_rvo) + hke(jpdyn_trd_zad) ) / tvolt 399 WRITE (numout,9542) ( hke(jpdyn_trd_keg) + hke(jpdyn_trd_zad) ) / tvolt 400 WRITE (numout,9543) ( hke(jpdyn_trd_pvo) ) / tvolt 401 WRITE (numout,9544) ( hke(jpdyn_trd_rvo) ) / tvolt 402 WRITE (numout,9545) ( hke(jpdyn_trd_spg) ) / tvolt 403 WRITE (numout,9546) ( hke(jpdyn_trd_ldf) ) / tvolt 404 WRITE (numout,9547) ( hke(jpdyn_trd_zdf) ) / tvolt 405 WRITE (numout,9548) ( hke(jpdyn_trd_hpg) ) / tvolt, rpktrd / tvolt 424 406 WRITE (numout,*) 425 407 WRITE (numout,*) … … 427 409 428 410 9540 FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================') 429 9541 FORMAT(' 0 = non linear term (true if key_vorenergy or key_combined): ', e20.13)430 9542 FORMAT(' 0 = ke gradient + horizontal + vertical advection: ', e20.13)431 9543 FORMAT(' 0 = coriolis term (true if key_vorenergy or key_combined): ', e20.13)432 9544 FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.): ', e20.13)433 9545 FORMAT(' 0 = surface pressure gradient 434 9546 FORMAT(' 0 >horizontal diffusion : ', e20.13)435 9547 FORMAT(' 0 >vertical diffusion : ', e20.13)411 9541 FORMAT(' 0 = non linear term (true if KE conserved) : ', e20.13) 412 9542 FORMAT(' 0 = ke gradient + vertical advection : ', e20.13) 413 9543 FORMAT(' 0 = coriolis term (true if KE conserving scheme) : ', e20.13) 414 9544 FORMAT(' 0 = vorticity term (true if KE conserving scheme) : ', e20.13) 415 9545 FORMAT(' 0 = surface pressure gradient ??? : ', e20.13) 416 9546 FORMAT(' 0 < horizontal diffusion : ', e20.13) 417 9547 FORMAT(' 0 < vertical diffusion : ', e20.13) 436 418 9548 FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop) : ', e20.13, ' u.dz(rhop) =', e20.13) 437 419 ! … … 455 437 ! 456 438 INTEGER :: jk ! loop indices 457 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwt, zws, ztrdt, ztrds ! 3D workspace 458 !!---------------------------------------------------------------------- 459 460 461 IF( ln_3D_trd_t ) THEN ! 3D output: treat the vertical diffusion trends (if iso) 462 ! 463 CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt, ztrds ) 464 ! 465 IF( ln_traldf_iso ) THEN ! iso-neutral diffusion : re-compute the PURE vertical diffusive trend 466 ! ! zdf trends using now field (called after the swap) 467 zwt(:,:, 1 ) = 0._wp ; zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes 468 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 469 DO jk = 2, jpk 470 zwt(:,:,jk) = avt(:,:,jk) * ( tsn(:,:,jk-1,jp_tem) - tsn(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 471 zws(:,:,jk) = fsavs(:,:,jk) * ( tsn(:,:,jk-1,jp_sal) - tsn(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 472 END DO 473 ! 474 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 475 DO jk = 1, jpkm1 476 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 477 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 478 END DO 479 CALL iom_put( "ttrd_zdfp", ztrdt ) ! PURE vertical diffusion (no isoneutral contribution) 480 CALL iom_put( "strd_zdfp", ztrds ) 481 ENDIF 482 ! 483 CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt, ztrds ) 484 ! 485 RETURN ! do nothing else if 3D output with IOM 486 ! 487 ENDIF 488 439 !!---------------------------------------------------------------------- 489 440 490 441 ! I. Tracers trends … … 509 460 WRITE (numout,*) 510 461 WRITE (numout,9400) kt 511 WRITE (numout,9401) tmo(jp icpt_xad) / tvolt, smo(jpicpt_xad) / tvolt512 WRITE (numout,9411) tmo(jp icpt_yad) / tvolt, smo(jpicpt_yad) / tvolt513 WRITE (numout,9402) tmo(jp icpt_zad) / tvolt, smo(jpicpt_zad) / tvolt514 WRITE (numout,9403) tmo(jp icpt_ldf) / tvolt, smo(jpicpt_ldf) / tvolt515 WRITE (numout,9404) tmo(jp icpt_zdf) / tvolt, smo(jpicpt_zdf) / tvolt516 WRITE (numout,9405) tmo(jp icpt_npc) / tvolt, smo(jpicpt_npc) / tvolt517 WRITE (numout,9406) tmo(jp icpt_dmp) / tvolt, smo(jpicpt_dmp) / tvolt518 WRITE (numout,9407) tmo(jp icpt_qsr) / tvolt519 WRITE (numout,9408) tmo(jp icpt_nsr) / tvolt, smo(jpicpt_nsr) / tvolt462 WRITE (numout,9401) tmo(jptra_trd_xad) / tvolt, smo(jptra_trd_xad) / tvolt 463 WRITE (numout,9411) tmo(jptra_trd_yad) / tvolt, smo(jptra_trd_yad) / tvolt 464 WRITE (numout,9402) tmo(jptra_trd_zad) / tvolt, smo(jptra_trd_zad) / tvolt 465 WRITE (numout,9403) tmo(jptra_trd_ldf) / tvolt, smo(jptra_trd_ldf) / tvolt 466 WRITE (numout,9404) tmo(jptra_trd_zdf) / tvolt, smo(jptra_trd_zdf) / tvolt 467 WRITE (numout,9405) tmo(jptra_trd_npc) / tvolt, smo(jptra_trd_npc) / tvolt 468 WRITE (numout,9406) tmo(jptra_trd_dmp) / tvolt, smo(jptra_trd_dmp) / tvolt 469 WRITE (numout,9407) tmo(jptra_trd_qsr) / tvolt 470 WRITE (numout,9408) tmo(jptra_trd_nsr) / tvolt, smo(jptra_trd_nsr) / tvolt 520 471 WRITE (numout,9409) 521 WRITE (numout,9410) ( tmo(jp icpt_xad) + tmo(jpicpt_yad) + tmo(jpicpt_zad) + tmo(jpicpt_ldf) + tmo(jpicpt_zdf) &522 & + tmo(jp icpt_npc) + tmo(jpicpt_dmp) + tmo(jpicpt_qsr) + tmo(jpicpt_nsr) ) / tvolt, &523 & ( smo(jp icpt_xad) + smo(jpicpt_yad) + smo(jpicpt_zad) + smo(jpicpt_ldf) + smo(jpicpt_zdf) &524 & + smo(jp icpt_npc) + smo(jpicpt_dmp) + smo(jpicpt_nsr) ) / tvolt472 WRITE (numout,9410) ( tmo(jptra_trd_xad) + tmo(jptra_trd_yad) + tmo(jptra_trd_zad) + tmo(jptra_trd_ldf) + tmo(jptra_trd_zdf) & 473 & + tmo(jptra_trd_npc) + tmo(jptra_trd_dmp) + tmo(jptra_trd_qsr) + tmo(jptra_trd_nsr) ) / tvolt, & 474 & ( smo(jptra_trd_xad) + smo(jptra_trd_yad) + smo(jptra_trd_zad) + smo(jptra_trd_ldf) + smo(jptra_trd_zdf) & 475 & + smo(jptra_trd_npc) + smo(jptra_trd_dmp) + smo(jptra_trd_nsr) ) / tvolt 525 476 ENDIF 526 477 … … 544 495 WRITE (numout,*) 545 496 WRITE (numout,9420) kt 546 WRITE (numout,9421) t2(jp icpt_xad) / tvolt, s2(jpicpt_xad) / tvolt547 WRITE (numout,9431) t2(jp icpt_yad) / tvolt, s2(jpicpt_yad) / tvolt548 WRITE (numout,9422) t2(jp icpt_zad) / tvolt, s2(jpicpt_zad) / tvolt549 WRITE (numout,9423) t2(jp icpt_ldf) / tvolt, s2(jpicpt_ldf) / tvolt550 WRITE (numout,9424) t2(jp icpt_zdf) / tvolt, s2(jpicpt_zdf) / tvolt551 WRITE (numout,9425) t2(jp icpt_npc) / tvolt, s2(jpicpt_npc) / tvolt552 WRITE (numout,9426) t2(jp icpt_dmp) / tvolt, s2(jpicpt_dmp) / tvolt553 WRITE (numout,9427) t2(jp icpt_qsr) / tvolt554 WRITE (numout,9428) t2(jp icpt_nsr) / tvolt, s2(jpicpt_nsr) / tvolt497 WRITE (numout,9421) t2(jptra_trd_xad) / tvolt, s2(jptra_trd_xad) / tvolt 498 WRITE (numout,9431) t2(jptra_trd_yad) / tvolt, s2(jptra_trd_yad) / tvolt 499 WRITE (numout,9422) t2(jptra_trd_zad) / tvolt, s2(jptra_trd_zad) / tvolt 500 WRITE (numout,9423) t2(jptra_trd_ldf) / tvolt, s2(jptra_trd_ldf) / tvolt 501 WRITE (numout,9424) t2(jptra_trd_zdf) / tvolt, s2(jptra_trd_zdf) / tvolt 502 WRITE (numout,9425) t2(jptra_trd_npc) / tvolt, s2(jptra_trd_npc) / tvolt 503 WRITE (numout,9426) t2(jptra_trd_dmp) / tvolt, s2(jptra_trd_dmp) / tvolt 504 WRITE (numout,9427) t2(jptra_trd_qsr) / tvolt 505 WRITE (numout,9428) t2(jptra_trd_nsr) / tvolt, s2(jptra_trd_nsr) / tvolt 555 506 WRITE (numout,9429) 556 WRITE (numout,9430) ( t2(jp icpt_xad) + t2(jpicpt_yad) + t2(jpicpt_zad) + t2(jpicpt_ldf) + t2(jpicpt_zdf) &557 & + t2(jp icpt_npc) + t2(jpicpt_dmp) + t2(jpicpt_qsr) + t2(jpicpt_nsr) ) / tvolt, &558 & ( s2(jp icpt_xad) + s2(jpicpt_yad) + s2(jpicpt_zad) + s2(jpicpt_ldf) + s2(jpicpt_zdf) &559 & + s2(jp icpt_npc) + s2(jpicpt_dmp) + s2(jpicpt_nsr) ) / tvolt507 WRITE (numout,9430) ( t2(jptra_trd_xad) + t2(jptra_trd_yad) + t2(jptra_trd_zad) + t2(jptra_trd_ldf) + t2(jptra_trd_zdf) & 508 & + t2(jptra_trd_npc) + t2(jptra_trd_dmp) + t2(jptra_trd_qsr) + t2(jptra_trd_nsr) ) / tvolt, & 509 & ( s2(jptra_trd_xad) + s2(jptra_trd_yad) + s2(jptra_trd_zad) + s2(jptra_trd_ldf) + s2(jptra_trd_zdf) & 510 & + s2(jptra_trd_npc) + s2(jptra_trd_dmp) + s2(jptra_trd_nsr) ) / tvolt 560 511 ENDIF 561 512 … … 579 530 WRITE (numout,*) 580 531 WRITE (numout,9440) kt 581 WRITE (numout,9441) ( tmo(jp icpt_xad)+tmo(jpicpt_yad)+tmo(jpicpt_zad) )/tvolt, &582 & ( smo(jp icpt_xad)+smo(jpicpt_yad)+smo(jpicpt_zad) )/tvolt583 WRITE (numout,9442) tmo(jp icpt_zl1)/tvolt, smo(jpicpt_zl1)/tvolt584 WRITE (numout,9443) tmo(jp icpt_ldf)/tvolt, smo(jpicpt_ldf)/tvolt585 WRITE (numout,9444) tmo(jp icpt_zdf)/tvolt, smo(jpicpt_zdf)/tvolt586 WRITE (numout,9445) tmo(jp icpt_npc)/tvolt, smo(jpicpt_npc)/tvolt587 WRITE (numout,9446) ( t2(jp icpt_xad)+t2(jpicpt_yad)+t2(jpicpt_zad) )/tvolt, &588 & ( s2(jp icpt_xad)+s2(jpicpt_yad)+s2(jpicpt_zad) )/tvolt589 WRITE (numout,9447) t2(jp icpt_ldf)/tvolt, s2(jpicpt_ldf)/tvolt590 WRITE (numout,9448) t2(jp icpt_zdf)/tvolt, s2(jpicpt_zdf)/tvolt591 WRITE (numout,9449) t2(jp icpt_npc)/tvolt, s2(jpicpt_npc)/tvolt532 WRITE (numout,9441) ( tmo(jptra_trd_xad)+tmo(jptra_trd_yad)+tmo(jptra_trd_zad) )/tvolt, & 533 & ( smo(jptra_trd_xad)+smo(jptra_trd_yad)+smo(jptra_trd_zad) )/tvolt 534 WRITE (numout,9442) tmo(jptra_trd_sad)/tvolt, smo(jptra_trd_sad)/tvolt 535 WRITE (numout,9443) tmo(jptra_trd_ldf)/tvolt, smo(jptra_trd_ldf)/tvolt 536 WRITE (numout,9444) tmo(jptra_trd_zdf)/tvolt, smo(jptra_trd_zdf)/tvolt 537 WRITE (numout,9445) tmo(jptra_trd_npc)/tvolt, smo(jptra_trd_npc)/tvolt 538 WRITE (numout,9446) ( t2(jptra_trd_xad)+t2(jptra_trd_yad)+t2(jptra_trd_zad) )/tvolt, & 539 & ( s2(jptra_trd_xad)+s2(jptra_trd_yad)+s2(jptra_trd_zad) )/tvolt 540 WRITE (numout,9447) t2(jptra_trd_ldf)/tvolt, s2(jptra_trd_ldf)/tvolt 541 WRITE (numout,9448) t2(jptra_trd_zdf)/tvolt, s2(jptra_trd_zdf)/tvolt 542 WRITE (numout,9449) t2(jptra_trd_npc)/tvolt, s2(jptra_trd_npc)/tvolt 592 543 ENDIF 593 544 … … 609 560 END SUBROUTINE trd_twr 610 561 611 # else612 !!----------------------------------------------------------------------613 !! Default case : Empty module614 !!----------------------------------------------------------------------615 INTERFACE trd_icp616 MODULE PROCEDURE trd_2d, trd_3d617 END INTERFACE618 619 CONTAINS620 SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype ) ! Empty routine621 REAL, DIMENSION(:,:) :: ptrd2dx, ptrd2dy622 INTEGER , INTENT(in ) :: ktrd ! tracer trend index623 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends624 WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', &625 & ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype626 END SUBROUTINE trd_2d627 SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype ) ! Empty routine628 REAL, DIMENSION(:,:,:) :: ptrd3dx, ptrd3dy629 INTEGER , INTENT(in ) :: ktrd ! tracer trend index630 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends631 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', &632 & ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype633 END SUBROUTINE trd_3d634 SUBROUTINE trd_icp_init ! Empty routine635 END SUBROUTINE trd_icp_init636 SUBROUTINE trd_dwr( kt ) ! Empty routine637 WRITE(*,*) 'trd_dwr: You should not have seen this print! error ?', kt638 END SUBROUTINE trd_dwr639 SUBROUTINE trd_twr( kt ) ! Empty routine640 WRITE(*,*) 'trd_twr: You should not have seen this print! error ?', kt641 END SUBROUTINE trd_twr642 #endif643 644 562 !!====================================================================== 645 563 END MODULE trdicp -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
r3316 r3317 11 11 #if defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 12 12 !!---------------------------------------------------------------------- 13 !! trd_mod 14 !! trd_3Diom 15 !! trd_ budget : domain averaged budget of trends (including kinetic energy and tracer variance trends)16 !! trd_mod_init : Initialization step17 !!----------------------------------------------------------------------18 USE oce ! ocean dynamics and tracersvariables19 USE dom_oce ! ocean space and time domainvariables20 USE zdf_oce ! ocean vertical physics variables21 USE trdmod_oce ! ocean variables trends22 USE ldftra_oce 23 USE sbc_oce 24 USE phycst 25 USE trdvor 26 USE trdicp 27 USE trdmld 28 USE in_out_manager 29 USE iom 30 USE lib_mpp 31 USE wrk_nemo 13 !! trd_mod : manage the type of trend diagnostics 14 !! trd_3Diom : output 3D momentum and/or tracer trends using IOM 15 !! trd_mod_init : Initialization step 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers variables 18 USE dom_oce ! ocean space and time domain variables 19 USE zdf_oce ! ocean vertical physics variables 20 USE trdmod_oce ! ocean variables trends 21 USE zdfbfr ! bottom friction 22 USE ldftra_oce ! ocean active tracers lateral physics 23 USE sbc_oce ! surface boundary condition: ocean 24 USE phycst ! physical constants 25 USE trdvor ! ocean vorticity trends 26 USE trdicp ! ocean bassin integral constraints properties 27 USE trdmld ! ocean active mixed layer tracers trends 28 USE in_out_manager ! I/O manager 29 USE iom ! I/O manager library 30 USE lib_mpp ! MPP library 31 USE wrk_nemo ! Memory allocation 32 32 33 33 IMPLICIT NONE … … 89 89 IF( lk_trdvor .AND. ctype == 'DYN' ) THEN ! II. Vorticity trends 90 90 ! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 91 SELECT CASE 92 CASE 93 CASE 94 CASE 95 CASE 96 CASE 97 CASE 98 CASE 99 CASE 91 SELECT CASE( ktrd ) 92 CASE( jpdyn_trd_hpg ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_prg ) ! Hydrostatique Pressure Gradient 93 CASE( jpdyn_trd_keg ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_keg ) ! KE Gradient 94 CASE( jpdyn_trd_rvo ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_rvo ) ! Relative Vorticity 95 CASE( jpdyn_trd_pvo ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_pvo ) ! Planetary Vorticity Term 96 CASE( jpdyn_trd_ldf ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_ldf ) ! Horizontal Diffusion 97 CASE( jpdyn_trd_zad ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zad ) ! Vertical Advection 98 CASE( jpdyn_trd_spg ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_spg ) ! Surface Pressure Grad. 99 CASE( jpdyn_trd_zdf ) ! Vertical Diffusion 100 100 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 101 101 DO jj = 2, jpjm1 ! wind stress trends 102 102 DO ji = fs_2, fs_jpim1 ! vector opt. 103 ztswu(ji,jj) = ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 )104 ztswv(ji,jj) = ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 )103 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 104 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 105 105 END DO 106 106 END DO … … 157 157 158 158 159 SUBROUTINE trd_budget( ptrdx, ptrdy, ktrd, ctype, kt )160 !!---------------------------------------------------------------------161 !! *** ROUTINE trd_budget ***162 !!163 !! ** Purpose : integral constraint diagnostics for momentum and/or tracer trends164 !!165 !!----------------------------------------------------------------------166 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend167 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend168 INTEGER , INTENT(in ) :: ktrd ! tracer trend index169 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA'170 INTEGER , INTENT(in ) :: kt ! time step171 !!172 INTEGER :: ji, jj ! dummy loop indices173 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace174 !!----------------------------------------------------------------------175 176 CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )177 178 IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN179 !180 IF( lk_trdtra .AND. ctype == 'TRA' ) THEN ! active tracer trends181 SELECT CASE ( ktrd )182 CASE ( jptra_trd_ldf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype ) ! lateral diff183 CASE ( jptra_trd_zdf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype ) ! vertical diff (Kz)184 CASE ( jptra_trd_bbc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype ) ! bottom boundary cond185 CASE ( jptra_trd_bbl ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype ) ! bottom boundary layer186 CASE ( jptra_trd_npc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype ) ! static instability mixing187 CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping188 CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat.189 CASE ( jptra_trd_nsr ) ; z2dx(:,:) = ptrdx(:,:,1) ! non solar radiation190 z2dy(:,:) = ptrdy(:,:,1)191 CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype )192 CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv193 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv194 CASE ( jptra_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) ! z- vertical adv195 ! ! surface flux196 IF( lk_vvl ) THEN ! variable volume = zero197 z2dx(:,:) = 0._wp198 z2dy(:,:) = 0._wp199 ELSE ! constant volume = wn*tsn/e3t200 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1)201 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1)202 ENDIF203 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )204 END SELECT205 ENDIF206 207 IF( lk_trddyn .AND. ctype == 'DYN' ) THEN ! momentum trends208 !209 SELECT CASE ( ktrd )210 CASE( jpdyn_trd_hpg ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_hpg, ctype ) ! hydrost. pressure gradient211 CASE( jpdyn_trd_spg ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_spg, ctype ) ! surface pressure grad.212 CASE( jpdyn_trd_pvo ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_pvo, ctype ) ! planetary vorticity213 CASE( jpdyn_trd_rvo ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_rvo, ctype ) ! relative vorticity or metric term214 CASE( jpdyn_trd_keg ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_keg, ctype ) ! KE gradient or hor. advection215 CASE( jpdyn_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_zad, ctype ) ! vertical advection216 CASE( jpdyn_trd_ldf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_ldf, ctype ) ! lateral diffusion217 CASE( jpdyn_trd_zdf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_zdf, ctype ) ! vertical diffusion (icluding bfr & tau)218 ztswu(:,:) = ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(:,:,1) * rau0 )219 ztswv(:,:) = ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(:,:,1) * rau0 )220 CALL trd_icp( ztswu, ztswv, jpicpd_swf, ctype ) ! wind stress trends221 CASE( jpdyn_trd_bfr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_bfr, ctype ) ! bottom friction trends222 END SELECT223 !224 ENDIF225 !226 ENDIF227 !228 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )229 !230 END SUBROUTINE trd_budget231 232 233 159 SUBROUTINE trd_3Diom( ptrdx, ptrdy, ktrd, ctype, kt ) 234 160 !!--------------------------------------------------------------------- … … 244 170 !! 245 171 INTEGER :: ji, jj, jk ! dummy loop indices 246 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy, ztswu, ztswv ! 2D workspace 247 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace 172 INTEGER :: ikbu, ikbv ! local integers 173 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy, ztswu, ztswv ! 2D workspace 174 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace 248 175 !!---------------------------------------------------------------------- 249 176 … … 253 180 ! 254 181 SELECT CASE( ktrd ) 255 CASE( jptra_trd_xad ) ; CALL iom_put( "ttrd_xad", ptrdx ) ! x- horizontal advection 256 CALL iom_put( "strd_xad", ptrdy ) 257 CASE( jptra_trd_yad ) ; CALL iom_put( "ttrd_yad", ptrdx ) ! y- horizontal advection 258 CALL iom_put( "strd_yad", ptrdy ) 259 CASE( jptra_trd_zad ) ; CALL iom_put( "ttrd_zad", ptrdx ) ! z- vertical advection 260 CALL iom_put( "strd_zad", ptrdy ) 261 IF( .NOT.lk_vvl ) THEN ! cst volume : adv flux through z=0 surface 262 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 263 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 264 CALL iom_put( "ttrd_sad", z2dx ) 265 CALL iom_put( "strd_sad", z2dy ) 266 ENDIF 267 CASE( jptra_trd_ldf ) ; CALL iom_put( "ttrd_ldf", ptrdx ) ! lateral diffusion 268 CALL iom_put( "strd_ldf", ptrdy ) 269 CASE( jptra_trd_zdf ) ; CALL iom_put( "ttrd_zdf", ptrdx ) ! vertical diffusion (including Kz contribution) 270 CALL iom_put( "strd_zdf", ptrdy ) 271 CASE( jptra_trd_dmp ) ; CALL iom_put( "ttrd_dmp", ptrdx ) ! internal restoring (damping) 272 CALL iom_put( "strd_dmp", ptrdy ) 273 CASE( jptra_trd_bbl ) ; CALL iom_put( "ttrd_bbl", ptrdx ) ! bottom boundary layer 274 CALL iom_put( "strd_bbl", ptrdy ) 275 CASE( jptra_trd_npc ) ; CALL iom_put( "ttrd_npc", ptrdx ) ! static instability mixing 276 CALL iom_put( "strd_npc", ptrdy ) 277 CASE( jptra_trd_qsr ) ; CALL iom_put( "ttrd_qsr", ptrdx ) ! penetrative solar radiat. (only on temperature) 278 CASE( jptra_trd_nsr ) ; CALL iom_put( "ttrd_qns", ptrdx(:,:,1) ) ! non-solar radiation (only on temperature) 279 CASE( jptra_trd_bbc ) ; CALL iom_put( "ttrd_bbc", ptrdx ) ! geothermal heating (only on temperature) 182 CASE( jptra_trd_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 183 CALL iom_put( "strd_xad" , ptrdy ) 184 CASE( jptra_trd_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 185 CALL iom_put( "strd_yad" , ptrdy ) 186 CASE( jptra_trd_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 187 CALL iom_put( "strd_zad" , ptrdy ) 188 IF( .NOT.lk_vvl ) THEN ! cst volume : adv flux through z=0 surface 189 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 190 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 191 CALL iom_put( "ttrd_sad", z2dx ) 192 CALL iom_put( "strd_sad", z2dy ) 193 ENDIF 194 CASE( jptra_trd_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 195 CALL iom_put( "strd_ldf" , ptrdy ) 196 CASE( jptra_trd_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 197 CALL iom_put( "strd_zdf" , ptrdy ) 198 CASE( jptra_trd_zdfp ) ; CALL iom_put( "ttrd_zdfp", ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 199 CALL iom_put( "strd_zdfp", ptrdy ) 200 CASE( jptra_trd_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 201 CALL iom_put( "strd_dmp" , ptrdy ) 202 CASE( jptra_trd_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 203 CALL iom_put( "strd_bbl" , ptrdy ) 204 CASE( jptra_trd_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 205 CALL iom_put( "strd_npc" , ptrdy ) 206 CASE( jptra_trd_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx ) ! surface forcing + runoff (ln_rnf=T) 207 CALL iom_put( "strd_cdt" , ptrdy ) 208 CASE( jptra_trd_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 209 CASE( jptra_trd_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 210 CASE( jptra_trd_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 211 CALL iom_put( "strd_atf" , ptrdy ) 212 280 213 END SELECT 281 214 ENDIF … … 322 255 CALL iom_put( "utrd_tau", z2dx ) 323 256 CALL iom_put( "vtrd_tau", z2dy ) 324 CASE( jpdyn_trd_bfr ) ; CALL iom_put( "utrd_bfr", ptrdx ) ! bottom friction term 325 CALL iom_put( "vtrd_bfr", ptrdy ) 257 CASE( jpdyn_trd_bfr ) 258 IF( .NOT.ln_bfrimp ) CALL iom_put( "utrd_bfr", ptrdx ) ! bottom friction (explicit case) 259 IF( .NOT.ln_bfrimp ) CALL iom_put( "vtrd_bfr", ptrdy ) 260 !!gm only valid if ln_bfrimp=T otherwise the bottom stress as to be recomputed.... 261 262 CASE( jpdyn_trd_atf ) ; CALL iom_put( "utrd_atf", ptrdx ) ! asselin filter trends 263 CALL iom_put( "vtrd_atf", ptrdy ) 264 IF( ln_bfrimp ) THEN ! bottom friction (implicit case) 265 z3dx(:,:,:) = 0._wp ; z3dy(:,:,:) = 0._wp ! after velocity known (now filed at this stage) 266 DO jk = 1, jpkm1 267 DO jj = 2, jpjm1 268 DO ji = 2, jpim1 269 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 270 ikbv = mbkv(ji,jj) 271 z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu) 272 z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv) 273 END DO 274 END DO 275 END DO 276 CALL iom_put( "utrd_bfr", z3dx ) ! bottom friction (implicit) 277 CALL iom_put( "vtrd_bfr", z3dy ) 278 ENDIF 279 ! 326 280 END SELECT 327 281 ! -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90
r3316 r3317 6 6 !! History : 1.0 ! 2004-08 (C. Talandier) Original code 7 7 !!---------------------------------------------------------------------- 8 USE trdicp_oce ! ocean momentum/tracers bassin properties trends variables8 USE par_oce ! ocean parameters 9 9 USE trdmld_oce ! ocean active mixed layer tracers trends variables 10 10 USE trdvor_oce ! ocean vorticity trends variables … … 12 12 IMPLICIT NONE 13 13 PUBLIC 14 15 #if defined key_trdtra && defined key_trddyn || defined key_esopa 16 LOGICAL, PARAMETER :: lk_trdtra = .TRUE. !: tracers trend flag 17 LOGICAL, PARAMETER :: lk_trddyn = .TRUE. !: momentum trend flag 18 #elif defined key_trdtra 19 LOGICAL, PARAMETER :: lk_trdtra = .TRUE. !: tracers trend flag 20 LOGICAL, PARAMETER :: lk_trddyn = .FALSE. !: momentum trend flag 21 #elif defined key_trddyn 22 LOGICAL, PARAMETER :: lk_trdtra = .FALSE. !: tracers trend flag 23 LOGICAL, PARAMETER :: lk_trddyn = .TRUE. !: momentum trend flag 24 #else 25 LOGICAL, PARAMETER :: lk_trdtra = .FALSE. !: tracers trend flag 26 LOGICAL, PARAMETER :: lk_trddyn = .FALSE. !: momentum trend flag 27 #endif 14 28 15 29 ! !!* Namelist namtrd: diagnostics on dynamics/tracer trends * … … 46 60 LOGICAL , PUBLIC :: l_trdtrc = .FALSE. !: tracers trend flag 47 61 # endif 48 ! !!!* Active tracers trends indexes 49 INTEGER, PUBLIC, PARAMETER :: jptra_trd_xad = 1 !: x- horizontal advection 50 INTEGER, PUBLIC, PARAMETER :: jptra_trd_yad = 2 !: y- horizontal advection 51 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zad = 3 !: z- vertical advection 52 INTEGER, PUBLIC, PARAMETER :: jptra_trd_ldf = 4 !: lateral diffusion 53 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zdf = 5 !: vertical diffusion 54 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbc = 6 !: Bottom Boundary Condition (geoth. heating) 55 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbl = 7 !: Bottom Boundary Layer (diffusive and/or advective) 56 INTEGER, PUBLIC, PARAMETER :: jptra_trd_npc = 8 !: non-penetrative convection treatment 57 INTEGER, PUBLIC, PARAMETER :: jptra_trd_dmp = 9 !: internal restoring (damping) 58 INTEGER, PUBLIC, PARAMETER :: jptra_trd_qsr = 10 !: penetrative solar radiation 59 INTEGER, PUBLIC, PARAMETER :: jptra_trd_nsr = 11 !: non solar radiation 60 INTEGER, PUBLIC, PARAMETER :: jptra_trd_atf = 12 !: Asselin time filter 62 ! !!!* Active tracers trends indexes 63 INTEGER, PUBLIC, PARAMETER :: jptot_tra = 14 !: Total trend nb: change it when adding/removing one indice below 64 ! =================== ! 65 INTEGER, PUBLIC, PARAMETER :: jptra_trd_xad = 1 !: x- horizontal advection 66 INTEGER, PUBLIC, PARAMETER :: jptra_trd_yad = 2 !: y- horizontal advection 67 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zad = 3 !: z- vertical advection 68 INTEGER, PUBLIC, PARAMETER :: jptra_trd_sad = 4 !: z- vertical advection 69 INTEGER, PUBLIC, PARAMETER :: jptra_trd_ldf = 5 !: lateral diffusion 70 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zdf = 6 !: vertical diffusion 71 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zdfp = 7 !: "PURE" vert. diffusion (ln_traldf_iso=T) 72 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbc = 8 !: Bottom Boundary Condition (geoth. heating) 73 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbl = 9 !: Bottom Boundary Layer (diffusive and/or advective) 74 INTEGER, PUBLIC, PARAMETER :: jptra_trd_npc = 10 !: non-penetrative convection treatment 75 INTEGER, PUBLIC, PARAMETER :: jptra_trd_dmp = 11 !: internal restoring (damping) 76 INTEGER, PUBLIC, PARAMETER :: jptra_trd_qsr = 12 !: penetrative solar radiation 77 INTEGER, PUBLIC, PARAMETER :: jptra_trd_nsr = 13 !: non solar radiation / C/D on salinity (+runoff if ln_rnf=T) 78 INTEGER, PUBLIC, PARAMETER :: jptra_trd_atf = 14 !: Asselin time filter 61 79 ! 62 ! !!!* Passive tracers trends indexes (use if "key_top" defined)63 INTEGER, PUBLIC, PARAMETER :: jptra_trd_sms = 13 !: sources m. sinks64 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radn = 14 !: corr. trn<0 in trcrad65 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radb = 15 !: corr. trb<0 in trcrad (like atf)80 ! !!!* Passive tracers trends indices (use if "key_top" defined) 81 INTEGER, PUBLIC, PARAMETER :: jptra_trd_sms = 13 !: sources m. sinks 82 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radn = 14 !: corr. trn<0 in trcrad 83 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radb = 15 !: corr. trb<0 in trcrad (like atf) 66 84 ! 67 ! !!!* Momentum trends indexes 68 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_hpg = 1 !: hydrostatic pressure gradient 69 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_spg = 2 !: surface pressure gradient 70 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_keg = 3 !: kinetic energy gradient or horizontal advection 71 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_rvo = 4 !: relative vorticity or metric term 72 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_pvo = 5 !: planetary vorticity 73 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zad = 6 !: vertical advection 74 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_ldf = 7 !: horizontal diffusion 75 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zdf = 8 !: vertical diffusion 76 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_swf = 9 !: surface stress 77 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_bfr = 10 !: bottom stress 78 85 ! !!!* Momentum trends indices 86 INTEGER, PUBLIC, PARAMETER :: jptot_dyn = 11 !: Total trend nb: change it when adding/removing one indice below 87 ! =================== ! 88 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_hpg = 1 !: hydrostatic pressure gradient 89 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_spg = 2 !: surface pressure gradient 90 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_keg = 3 !: kinetic energy gradient or horizontal advection 91 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_rvo = 4 !: relative vorticity or metric term 92 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_pvo = 5 !: planetary vorticity 93 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zad = 6 !: vertical advection 94 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_ldf = 7 !: horizontal diffusion 95 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zdf = 8 !: vertical diffusion 96 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_tau = 9 !: surface stress 97 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_bfr = 10 !: bottom stress 98 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_atf = 11 !: Asselin time filter 99 ! 79 100 !!---------------------------------------------------------------------- 80 101 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r3316 r3317 12 12 !! trd_tra_adv : transform a div(U.T) trend into a U.grad(T) trend 13 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers variables 14 15 USE dom_oce ! ocean domain 16 USE zdf_oce ! ocean vertical physics 17 USE zdfddm ! vertical physics: double diffusion 15 18 USE trdmod_oce ! ocean active mixed layer tracers trends 16 19 USE trdmod ! ocean active mixed layer tracers trends 17 20 USE trdmod_trc ! ocean passive mixed layer tracers trends 21 USE ldftra_oce ! ocean active tracers lateral physics 18 22 USE in_out_manager ! I/O manager 19 23 USE lib_mpp ! MPP library … … 29 33 !! * Substitutions 30 34 # include "domzgr_substitute.h90" 35 # include "zdfddm_substitute.h90" 31 36 # include "vectopt_loop_substitute.h90" 32 37 !!---------------------------------------------------------------------- … … 38 43 39 44 INTEGER FUNCTION trd_tra_alloc() 40 !!--------------------------------------------------------------------- -------45 !!--------------------------------------------------------------------- 41 46 !! *** FUNCTION trd_tra_alloc *** 42 !!--------------------------------------------------------------------- -------47 !!--------------------------------------------------------------------- 43 48 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 44 49 ! … … 69 74 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 70 75 ! 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrds 76 INTEGER :: jk ! loop indices 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwt, zws, ztrdt, ztrds ! 3D workspace 72 78 !!---------------------------------------------------------------------- 73 79 ! 74 80 CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 75 ! 81 ! 76 82 IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays 77 83 IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 78 84 ENDIF 79 85 80 86 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN !== Temperature trend ==! 81 87 ! … … 112 118 ENDIF 113 119 ! 120 IF( ktrd == jptra_trd_zdfp ) THEN ! diagnose the "PURE" Kz trend (here: just before the swap) 121 ! 122 IF( ln_traldf_iso ) THEN ! iso-neutral diffusion only otherwise jptra_trd_zdf is "PURE" 123 ! 124 CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 125 ! 126 zwt(:,:, 1 ) = 0._wp ; zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes 127 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 128 DO jk = 2, jpk 129 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 130 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 131 END DO 132 ! 133 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 134 DO jk = 1, jpkm1 135 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 136 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 137 END DO 138 CALL trd_mod( ztrdt, ztrds, jptra_trd_zdfp, ctype, kt ) 139 ! 140 CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 141 ! 142 ENDIF 143 ! 144 ENDIF 114 145 ENDIF 115 146 -
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/oce.F90
r3294 r3317 25 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rotb , rotn !: relative vorticity [s-1] 26 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb, hdivn !: horizontal divergence [s-1] 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsb , tsn 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsb , tsn , tsa !: 4D T-S fields [Celcius,psu] 28 28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 29 29 ! 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsa !: 4D T-S trends fields & work array 31 ! 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 [no units] 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop !: potential volumic mass [kg/m3] 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 [no units] 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop !: potential volumic mass [kg/m3] 34 32 35 33 !! free surface ! before ! now ! after !
Note: See TracChangeset
for help on using the changeset viewer.
