Changeset 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
- Timestamp:
- 2015-05-12T12:37:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r3764 r5260 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 10 10 !! - ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 11 !! 3.6 ! 2014-11 (P. Mathiot) isf melting forcing 11 12 !!---------------------------------------------------------------------- 12 13 … … 18 19 USE dom_oce ! ocean space domain variables 19 20 USE phycst ! physical constant 21 USE sbcmod ! ln_rnf 22 USE sbcrnf ! River runoff 20 23 USE traqsr ! solar radiation penetration 21 USE trdmod_oce ! ocean trends 22 USE trdtra ! ocean trends 24 USE trd_oce ! trends: ocean variables 25 USE trdtra ! trends manager: tracers 26 ! 23 27 USE in_out_manager ! I/O manager 24 28 USE prtctl ! Print control 25 29 USE sbcrnf ! River runoff 30 USE sbcisf ! Ice shelf 26 31 USE sbcmod ! ln_rnf 27 32 USE iom … … 29 34 USE wrk_nemo ! Memory Allocation 30 35 USE timing ! Timing 36 USE eosbn2 31 37 32 38 IMPLICIT NONE … … 39 45 # include "vectopt_loop_substitute.h90" 40 46 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)47 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 42 48 !! $Id$ 43 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 91 97 !! where emp, the surface freshwater budget (evaporation minus 92 98 !! precipitation minus runoff) given in kg/m2/s is divided 93 !! by rau0 = 1020 kg/m3(density of sea water) to obtain m/s.99 !! by rau0 (density of sea water) to obtain m/s. 94 100 !! Note: even though Fwe does not appear explicitly for 95 101 !! temperature in this routine, the heat carried by the water … … 107 113 !! ** Action : - Update the 1st level of (ta,sa) with the trend associated 108 114 !! with the tracer surface boundary condition 109 !! - s ave the trend it in ttrd ('key_trdtra')115 !! - send trends to trdtra module (l_trdtra=T) 110 116 !!---------------------------------------------------------------------- 111 117 INTEGER, INTENT(in) :: kt ! ocean time-step index 112 118 !! 113 119 INTEGER :: ji, jj, jk, jn ! dummy loop indices 120 INTEGER :: ikt, ikb 121 INTEGER :: nk_isf 114 122 REAL(wp) :: zfact, z1_e3t, zdep 123 REAL(wp) :: zalpha, zhk 124 REAL(wp) :: zt_frz, zpress 115 125 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds 116 126 !!---------------------------------------------------------------------- … … 124 134 ENDIF 125 135 126 IF( l_trdtra ) 136 IF( l_trdtra ) THEN !* Save ta and sa trends 127 137 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 128 138 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 137 147 138 148 !---------------------------------------- 139 ! EMP, EMPSand QNS effects149 ! EMP, SFX and QNS effects 140 150 !---------------------------------------- 141 151 ! Set before sbc tracer content fields … … 146 156 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 147 157 IF(lwp) WRITE(numout,*) ' nit000-1 surface tracer content forcing fields red in the restart file' 148 zfact = 0.5 e0158 zfact = 0.5_wp 149 159 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 150 160 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 151 161 ELSE ! No restart or restart not found: Euler forward time stepping 152 zfact = 1. e0153 sbc_tsc_b(:,:,:) = 0. e0162 zfact = 1._wp 163 sbc_tsc_b(:,:,:) = 0._wp 154 164 ENDIF 155 165 ELSE ! Swap of forcing fields 156 166 ! ! ---------------------- 157 zfact = 0.5 e0167 zfact = 0.5_wp 158 168 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 159 169 ENDIF … … 182 192 END DO 183 193 END DO 184 CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )! c/d term on sst185 CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )! c/d term on sss194 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) ) ! c/d term on sst 195 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) ) ! c/d term on sss 186 196 ENDIF 187 197 ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff … … 205 215 ENDIF 206 216 ! 217 ! 218 !---------------------------------------- 219 ! Ice Shelf effects (ISF) 220 ! tbl treated as in Losh (2008) JGR 221 !---------------------------------------- 222 ! 223 IF( nn_isf > 0 ) THEN 224 zfact = 0.5e0 225 DO jj = 2, jpj 226 DO ji = fs_2, fs_jpim1 227 228 ikt = misfkt(ji,jj) 229 ikb = misfkb(ji,jj) 230 231 ! level fully include in the ice shelf boundary layer 232 ! if isfdiv, we have to remove heat flux due to inflow at 0oC (as in rnf when you add rnf at sst) 233 ! sign - because fwf sign of evapo (rnf sign of precip) 234 DO jk = ikt, ikb - 1 235 ! compute tfreez for the temperature correction (we add water at freezing temperature) 236 ! zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 237 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 238 ! compute trend 239 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 240 & + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) & 241 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 242 & * r1_hisf_tbl(ji,jj) 243 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 244 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) 245 END DO 246 247 ! level partially include in ice shelf boundary layer 248 ! compute tfreez for the temperature correction (we add water at freezing temperature) 249 ! zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04 250 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress ) 251 ! compute trend 252 tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem) & 253 & + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) & 254 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 255 & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 256 tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal) & 257 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 258 END DO 259 END DO 260 IF( lrst_oce ) THEN 261 IF(lwp) WRITE(numout,*) 262 IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ', & 263 & 'at it= ', kt,' date= ', ndastp 264 IF(lwp) WRITE(numout,*) '~~~~' 265 CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) ) 266 CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 267 CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 268 ENDIF 269 END IF 270 ! 207 271 !---------------------------------------- 208 272 ! River Runoff effects … … 226 290 ENDIF 227 291 228 IF( l_trdtra ) THEN ! s ave the horizontal diffusivetrends for further diagnostics292 IF( l_trdtra ) THEN ! send trends for further diagnostics 229 293 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 230 294 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 231 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_nsr, ztrdt )232 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_nsr, ztrds )295 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 296 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 233 297 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 234 298 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
