Changeset 15625
- Timestamp:
- 2022-01-04T16:39:00+01:00 (2 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+
- Files:
-
- 8 edited
-
EXPREF/namelist_cfg (modified) (2 diffs)
-
MY_SRC/eosbn2.F90 (modified) (2 diffs)
-
MY_SRC/isf_oce.F90 (modified) (1 diff)
-
MY_SRC/isfcavgam.F90 (modified) (1 diff)
-
MY_SRC/isfstp.F90 (modified) (4 diffs)
-
MY_SRC/istate.F90 (modified) (6 diffs)
-
MY_SRC/sbcfwb.F90 (modified) (4 diffs)
-
MY_SRC/tradmp.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/EXPREF/namelist_cfg
r15574 r15625 194 194 rn_gammat0 = 0.0215 ! gammat coefficient used in blk formula 195 195 rn_gammas0 = 0.614e-3 ! gammas coefficient used in blk formula 196 rn_vtide = 0.01 ! tidal velocity [m/s]197 196 ! 198 197 rn_htbl = 20. ! thickness of the top boundary layer (Losh et al. 2008) … … 280 279 !----------------------------------------------------------------------- 281 280 rn_Cd0 = 2.5e-3 ! drag coefficient [-] 282 rn_ke0 = 0.0e-3! background kinetic energy [m2/s2] (non-linear cases)281 rn_ke0 = 1.0e-4 ! background kinetic energy [m2/s2] (non-linear cases) 283 282 / 284 283 !----------------------------------------------------------------------- -
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/eosbn2.F90
r15574 r15625 17 17 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 18 18 !! - ! 2010-10 (G. Nurser, G. Madec) add alpha/beta used in ldfslp 19 !! 3.7 ! 2012-0 3(F. Roquet, G. Madec) add primitive of alpha and beta used in PE computation19 !! 3.7 ! 2012-03 (F. Roquet, G. Madec) add primitive of alpha and beta used in PE computation 20 20 !! - ! 2012-05 (F. Roquet) add Vallis and original JM95 equation of state 21 21 !! - ! 2013-04 (F. Roquet, G. Madec) add eos_rab, change bn2 computation and reorganize the module … … 295 295 CASE( np_leos ) !== linear ISOMIP EOS ==! 296 296 ! 297 DO_3D( 1, 1, 1, 1, 1, jpkm1 )297 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 298 298 zt = pts (ji,jj,jk,jp_tem,Knn) - (-1._wp) 299 299 zs = pts (ji,jj,jk,jp_sal,Knn) - 34.2_wp -
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/isf_oce.F90
r15574 r15625 38 38 REAL(wp) , PUBLIC :: rn_gammat0 !: temperature exchange coeficient [] 39 39 REAL(wp) , PUBLIC :: rn_gammas0 !: salinity exchange coeficient [] 40 REAL(wp) , PUBLIC :: rn_vtide !: tidal background velocity (can be different to what is used in the41 40 REAL(wp) , PUBLIC :: rn_htbl !: Losch top boundary layer thickness [m] 42 41 REAL(wp) , PUBLIC :: rn_isfload_T !: -
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/isfcavgam.F90
r15574 r15625 95 95 pgs(:,:) = rn_gammas0 96 96 CASE ( 'vel' ) ! gamma is proportional to u* 97 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r n_vtide**2, pgt, pgs )97 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r_ke0_top, pgt, pgs ) 98 98 CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 99 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r n_vtide**2, pqoce, pqfwf, pRc, pgt, pgs )99 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pRc, pgt, pgs ) 100 100 CASE DEFAULT 101 101 CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') -
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/isfstp.F90
r15574 r15625 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 41 !! $Id: isfstp.F90 1 1876 2019-11-08 11:26:42Z mathiot$41 !! $Id: isfstp.F90 15574 2021-12-03 19:32:50Z techene $ 42 42 !! Software governed by the CeCILL license (see ./LICENSE) 43 43 !!---------------------------------------------------------------------- … … 195 195 ! 196 196 IF ( ln_isf ) THEN 197 #if key_qco 198 # if ! defined key_isf 199 CALL ctl_stop( 'STOP', 'isf_ctl: ice shelf requires both ln_isf=T AND key_isf activated' ) 200 # endif 201 #endif 197 202 WRITE(numout,*) ' Add debug print in isf module ln_isfdebug = ', ln_isfdebug 198 203 WRITE(numout,*) … … 205 210 WRITE(numout,*) ' gammat coefficient rn_gammat0 = ', rn_gammat0 206 211 WRITE(numout,*) ' gammas coefficient rn_gammas0 = ', rn_gammas0 207 WRITE(numout,*) ' top background ke used (from namdrg_top) rn_ vtide**2 = ', rn_vtide**2212 WRITE(numout,*) ' top background ke used (from namdrg_top) rn_ke0 = ', r_ke0_top 208 213 WRITE(numout,*) ' top drag coef. used (from namdrg_top) rn_Cd0 = ', r_Cdmin_top 209 214 END IF … … 300 305 & ln_isfpar_mlt , cn_isfpar_mlt , sn_isfpar_fwf , & 301 306 & sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff, & 302 & ln_isfcpl , nn_drown , ln_isfcpl_cons, ln_isfdebug, rn_vtide,&307 & ln_isfcpl , nn_drown , ln_isfcpl_cons, ln_isfdebug, & 303 308 & cn_isfload , rn_isfload_T , rn_isfload_S , cn_isfdir , & 304 309 & rn_isfpar_bg03_gt0 -
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/istate.F90
r15574 r15625 33 33 USE iom ! I/O library 34 34 USE lib_mpp ! MPP library 35 USE lbclnk ! lateal boundary condition / mpp exchanges 35 36 USE restart ! restart 36 37 … … 50 51 !!---------------------------------------------------------------------- 51 52 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 52 !! $Id: istate.F90 1 1423 2019-08-08 14:02:49Z mathiot$53 !! $Id: istate.F90 15581 2021-12-07 13:08:22Z techene $ 53 54 !! Software governed by the CeCILL license (see ./LICENSE) 54 55 !!---------------------------------------------------------------------- … … 60 61 !! 61 62 !! ** Purpose : Initialization of the dynamics and tracer fields. 63 !! 64 !! ** Method : 62 65 !!---------------------------------------------------------------------- 63 66 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices … … 87 90 88 91 #if defined key_agrif 89 IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN92 IF ( .NOT.Agrif_root() .AND. ln_init_chfrpar ) THEN 90 93 numror = 0 ! define numror = 0 -> no restart file to read 91 94 ln_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) … … 126 129 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 127 130 END DO 128 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 131 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 132 ! make sure that periodicities are properly applied 133 CALL lbc_lnk( 'istate', ts(:,:,:,jp_tem,Kbb), 'T', 1._wp, ts(:,:,:,jp_sal,Kbb), 'T', 1._wp, & 134 & uu(:,:,:, Kbb), 'U', -1._wp, vv(:,:,:, Kbb), 'V', -1._wp ) 129 135 ENDIF 130 136 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 131 137 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 132 138 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 133 134 139 ENDIF 135 140 #if defined key_agrif … … 137 142 #endif 138 143 ! 139 ! Initialize "now" and "before"barotropic velocities:140 ! Do it whatever the free surface method, these arrays being eventually used144 ! Initialize "now" barotropic velocities: 145 ! Do it whatever the free surface method, these arrays being used eventually 141 146 ! 147 !!gm the use of umask & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 148 #if ! defined key_RK3 142 149 uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp 143 uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp144 !145 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked146 150 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 147 151 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 148 152 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 149 !150 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk)151 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk)152 153 END_3D 153 !154 154 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 155 155 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 156 #endif 156 157 ! 157 uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 158 vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 158 #if defined key_RK3 159 IF( .NOT. ln_rstart ) THEN 160 #endif 161 ! Initialize "before" barotropic velocities. "now" values are always set but 162 ! "before" values may have been read from a restart to ensure restartability. 163 ! In the non-restart or non-RK3 cases they need to be initialised here: 164 uu_b(:,:,Kbb) = 0._wp ; vv_b(:,:,Kbb) = 0._wp 165 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 166 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 167 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 168 END_3D 169 uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 170 vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 171 ! 172 #if defined key_RK3 173 ENDIF 174 #endif 159 175 ! 160 176 END SUBROUTINE istate_init -
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/sbcfwb.F90
r15574 r15625 36 36 37 37 REAL(wp) :: rn_fwb0 ! initial freshwater adjustment flux [kg/m2/s] (nn_fwb = 2 only) 38 REAL(wp) :: a_fwb ! annual domain averaged freshwater budget from the 39 ! previous year 38 REAL(wp) :: a_fwb ! annual domain averaged freshwater budget from the previous year 39 REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget from the year before or at initial state 40 REAL(wp) :: a_fwb_ini ! initial domain averaged freshwater budget 40 41 REAL(wp) :: area ! global mean ocean surface (interior domain) 41 42 … … 129 130 ENDIF 130 131 ! 131 CASE ( 4 ) !== global mean fwf set to zero (ISOMIP case) ==! 132 ! 133 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 134 z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) ) 135 ! 136 ! correction for ice sheet coupling testing (ie remove the excess through the surface) 137 ! test impact on the melt as conservation correction made in depth 138 ! test conservation level as sbcfwb is conserving 139 ! avoid the model to blow up for large ssh drop (isomip OCEAN3 with melt switch off and uniform T/S) 140 IF (ln_isfcpl .AND. ln_isfcpl_cons) THEN 141 z_fwf = z_fwf + glob_sum( 'sbcfwb', e1e2t(:,:) * risfcpl_cons_ssh(:,:) * rho0 ) 132 CASE ( 2 ) !== fw adjustment based on fw budget at the end of the previous year ==! 133 ! simulation is supposed to start 1st of January 134 IF( kt == nit000 ) THEN ! initialisation 135 ! ! set the fw adjustment (a_fwb) 136 IF ( ln_rstart .AND. iom_varid( numror, 'a_fwb_b', ldstop = .FALSE. ) > 0 & ! as read from restart file 137 & .AND. iom_varid( numror, 'a_fwb', ldstop = .FALSE. ) > 0 ) THEN 138 IF(lwp) WRITE(numout,*) 'sbc_fwb : reading freshwater-budget from restart file' 139 CALL iom_get( numror, 'a_fwb_b', a_fwb_b ) 140 CALL iom_get( numror, 'a_fwb' , a_fwb ) 141 ! 142 a_fwb_ini = a_fwb_b 143 ELSE ! as specified in namelist 144 IF(lwp) WRITE(numout,*) 'sbc_fwb : setting freshwater-budget from namelist rn_fwb0' 145 a_fwb = rn_fwb0 146 a_fwb_b = 0._wp ! used only the first year then it is replaced by a_fwb_ini 147 ! 148 a_fwb_ini = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rho0 ) ) & 149 & * rho0 / ( area * rday * REAL(nyear_len(1), wp) ) 142 150 END IF 143 151 ! 144 z_fwf = z_fwf / area 145 zcoef = z_fwf * rcp 146 emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) ! (Eq. 34 AD2015) 147 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! (Eq. 35 AD2015) ! use sst_m to avoid generation of any bouyancy fluxes 148 sfx(:,:) = sfx(:,:) + z_fwf * sss_m(:,:) * tmask(:,:,1) ! (Eq. 36 AD2015) ! use sss_m to avoid generation of any bouyancy fluxes 149 ENDIF 150 ! 151 CASE ( 2 ) !== fw adjustment based on fw budget at the end of the previous year ==! 152 ! 153 IF( kt == nit000 ) THEN ! initialisation 154 ! ! set the fw adjustment (a_fwb) 155 IF ( ln_rstart .AND. iom_varid( numror, 'a_fwb', ldstop = .FALSE. ) > 0 ) THEN ! as read from restart file 156 IF(lwp) WRITE(numout,*) 'sbc_fwb : reading FW-budget adjustment from restart file' 157 CALL iom_get( numror, 'a_fwb', a_fwb ) 158 ELSE ! as specified in namelist 159 a_fwb = rn_fwb0 160 END IF 161 ! 162 IF(lwp)WRITE(numout,*) 163 IF(lwp)WRITE(numout,*)'sbc_fwb : initial freshwater-budget adjustment = ', a_fwb, 'kg/m2/s' 164 ! 165 ENDIF 166 ! ! Update a_fwb if new year start 167 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!! 168 IF( MOD( kt, ikty ) == 0 ) THEN 169 ! mean sea level taking into account the ice+snow 170 ! sum over the global domain 171 a_fwb = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rho0 ) ) 172 a_fwb = a_fwb * 1.e+3 / ( area * rday * 365. ) ! convert in Kg/m3/s = mm/s 173 !!gm ! !!bug 365d year 174 ENDIF 175 ! 176 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes 177 zcoef = a_fwb * rcp 178 emp(:,:) = emp(:,:) + a_fwb * tmask(:,:,1) 179 qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 152 IF(lwp) WRITE(numout,*) 153 IF(lwp) WRITE(numout,*)'sbc_fwb : freshwater-budget at the end of previous year = ', a_fwb , 'kg/m2/s' 154 IF(lwp) WRITE(numout,*)' freshwater-budget at initial state = ', a_fwb_ini, 'kg/m2/s' 155 ! 156 ELSE 157 ! at the end of year n: 158 ikty = nyear_len(1) * 86400 / NINT(rn_Dt) 159 IF( MOD( kt, ikty ) == 0 ) THEN ! Update a_fwb at the last time step of a year 160 ! It should be the first time step of a year MOD(kt-1,ikty) but then the restart would be wrong 161 ! Hence, we make a small error here but the code is restartable 162 a_fwb_b = a_fwb_ini 163 ! mean sea level taking into account ice+snow 164 a_fwb = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rho0 ) ) 165 a_fwb = a_fwb * rho0 / ( area * rday * REAL(nyear_len(1), wp) ) ! convert in kg/m2/s 166 ENDIF 167 ! 168 ENDIF 169 ! 170 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes using previous year budget minus initial state 171 zcoef = ( a_fwb - a_fwb_b ) 172 emp(:,:) = emp(:,:) + zcoef * tmask(:,:,1) 173 qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 180 174 ! outputs 181 IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zcoef * sst_m(:,:) * tmask(:,:,1) )182 IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', - a_fwb* tmask(:,:,1) )175 IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zcoef * rcp * sst_m(:,:) * tmask(:,:,1) ) 176 IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zcoef * tmask(:,:,1) ) 183 177 ENDIF 184 178 ! Output restart information … … 187 181 IF(lwp) WRITE(numout,*) 'sbc_fwb : writing FW-budget adjustment to ocean restart file at it = ', kt 188 182 IF(lwp) WRITE(numout,*) '~~~~' 189 CALL iom_rstput( kt, nitrst, numrow, 'a_fwb', a_fwb ) 183 CALL iom_rstput( kt, nitrst, numrow, 'a_fwb_b', a_fwb_b ) 184 CALL iom_rstput( kt, nitrst, numrow, 'a_fwb', a_fwb ) 190 185 END IF 191 186 ! 192 IF( kt == nitend .AND. lwp ) WRITE(numout,*) 'sbc_fwb : final freshwater-budget adjustment = ', a_fwb, 'kg/m2/s' 187 IF( kt == nitend .AND. lwp ) THEN 188 WRITE(numout,*) 'sbc_fwb : freshwater-budget at the end of simulation (year now) = ', a_fwb , 'kg/m2/s' 189 WRITE(numout,*) ' freshwater-budget at initial state = ', a_fwb_b, 'kg/m2/s' 190 ENDIF 193 191 ! 194 192 CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==! … … 249 247 DEALLOCATE( ztmsk_neg , ztmsk_pos , ztmsk_tospread , z_wgt , zerp_cor ) 250 248 ! 249 CASE ( 4 ) !== global mean fwf set to zero (ISOMIP case) ==! 250 ! 251 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 252 z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) ) 253 ! 254 ! correction for ice sheet coupling testing (ie remove the excess through the surface) 255 ! test impact on the melt as conservation correction made in depth 256 ! test conservation level as sbcfwb is conserving 257 ! avoid the model to blow up for large ssh drop (isomip OCEAN3 with melt switch off and uniform T/S) 258 IF (ln_isfcpl .AND. ln_isfcpl_cons) THEN 259 z_fwf = z_fwf + glob_sum( 'sbcfwb', e1e2t(:,:) * risfcpl_cons_ssh(:,:) * rho0 ) 260 END IF 261 ! 262 z_fwf = z_fwf / area 263 zcoef = z_fwf * rcp 264 emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) ! (Eq. 34 AD2015) 265 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! (Eq. 35 AD2015) ! use sst_m to avoid generation of any bouyancy fluxes 266 sfx(:,:) = sfx(:,:) + z_fwf * sss_m(:,:) * tmask(:,:,1) ! (Eq. 36 AD2015) ! use sss_m to avoid generation of any bouyancy fluxes 267 ENDIF 268 ! 251 269 CASE DEFAULT !== you should never be there ==! 252 270 CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) -
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/tradmp.F90
r15574 r15625 24 24 USE oce ! ocean: variables 25 25 USE dom_oce ! ocean: domain variables 26 USE c1d ! 1D vertical configuration27 26 USE trd_oce ! trends: ocean variables 28 27 USE trdtra ! trends manager: tracers … … 56 55 !!---------------------------------------------------------------------- 57 56 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 58 !! $Id: tradmp.F90 1 0425 2018-12-19 21:54:16Z smasson $57 !! $Id: tradmp.F90 15574 2021-12-03 19:32:50Z techene $ 59 58 !! Software governed by the CeCILL license (see ./LICENSE) 60 59 !!---------------------------------------------------------------------- … … 97 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices 98 97 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta 99 REAL(wp), DIMENSION( jpi,jpj,jpk) :: ze3t98 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zwrk 100 99 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts 101 100 !!---------------------------------------------------------------------- … … 104 103 ! 105 104 IF( l_trdtra .OR. iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN !* Save ta and sa trends 106 ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 107 ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) 105 ALLOCATE( ztrdts(A2D(nn_hls),jpk,jpts) ) 106 DO jn = 1, jpts 107 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 108 ztrdts(ji,jj,jk,jn) = pts(ji,jj,jk,jn,Krhs) 109 END_3D 110 END DO 108 111 ENDIF 109 112 ! !== input T-S data at kt ==! … … 143 146 ! 144 147 ! outputs (clem trunk) 145 DO jk = 1, jpk 146 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 147 END DO 148 ! 149 IF( iom_use('hflx_dmp_cea') ) & 150 & CALL iom_put('hflx_dmp_cea', & 151 & SUM( ( pts(:,:,:,jp_tem,Krhs) - ztrdts(:,:,:,jp_tem) ) * ze3t(:,:,:), dim=3 ) * rcp * rho0 ) ! W/m2 152 IF( iom_use('sflx_dmp_cea') ) & 153 & CALL iom_put('sflx_dmp_cea', & 154 & SUM( ( pts(:,:,:,jp_sal,Krhs) - ztrdts(:,:,:,jp_sal) ) * ze3t(:,:,:), dim=3 ) * rho0 ) ! g/m2/s 148 IF( iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN 149 ALLOCATE( zwrk(A2D(nn_hls),jpk) ) ! Needed to handle expressions containing e3t when using key_qco or key_linssh 150 zwrk(:,:,:) = 0._wp 151 152 IF( iom_use('hflx_dmp_cea') ) THEN 153 DO_3D( 0, 0, 0, 0, 1, jpk ) 154 zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_tem,Krhs) - ztrdts(ji,jj,jk,jp_tem) ) * e3t(ji,jj,jk,Kmm) 155 END_3D 156 CALL iom_put('hflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rcp * rho0 ) ! W/m2 157 ENDIF 158 IF( iom_use('sflx_dmp_cea') ) THEN 159 DO_3D( 0, 0, 0, 0, 1, jpk ) 160 zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_sal,Krhs) - ztrdts(ji,jj,jk,jp_sal) ) * e3t(ji,jj,jk,Kmm) 161 END_3D 162 CALL iom_put('sflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rho0 ) ! g/m2/s 163 ENDIF 164 165 DEALLOCATE( zwrk ) 166 ENDIF 155 167 ! 156 168 IF( l_trdtra ) THEN ! trend diagnostic
Note: See TracChangeset
for help on using the changeset viewer.
