Changeset 2068 for branches/DEV_r1837_MLF/NEMO/OPA_SRC/TRA
- Timestamp:
- 2010-09-06T17:56:51+02:00 (14 years ago)
- Location:
- branches/DEV_r1837_MLF/NEMO/OPA_SRC/TRA
- Files:
-
- 4 edited
-
trabbc.F90 (modified) (1 diff)
-
tranxt.F90 (modified) (7 diffs)
-
traqsr.F90 (modified) (2 diffs)
-
trasbc.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1837_MLF/NEMO/OPA_SRC/TRA/trabbc.F90
r1601 r2068 35 35 REAL(wp) :: rn_geoflx_cst = 86.4e-3 ! Constant value of geothermal heat flux 36 36 37 INTEGER , DIMENSION(jpi,jpj) :: nbotlevt ! ocean bottom level index at T-pt38 REAL(wp), DIMENSION(jpi,jpj) :: qgh_trd0 ! geothermal heating trend37 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: nbotlevt ! ocean bottom level index at T-pt 38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qgh_trd0 ! geothermal heating trend 39 39 40 40 !! * Substitutions -
branches/DEV_r1837_MLF/NEMO/OPA_SRC/TRA/tranxt.F90
r2005 r2068 178 178 !! 179 179 INTEGER :: ji, jj, jk ! dummy loop indices 180 REAL(wp) :: zt_ m, zs_m! temporary scalars180 REAL(wp) :: zt_d, zs_d ! temporary scalars 181 181 REAL(wp) :: ztn, zsn ! - - 182 182 !!---------------------------------------------------------------------- … … 203 203 ! ! time laplacian on tracers 204 204 ! ! used for both Asselin and Brown & Campana filters 205 zt_ m= ta(ji,jj,jk) - 2. * tn(ji,jj,jk) + tb(ji,jj,jk)206 zs_ m= sa(ji,jj,jk) - 2. * sn(ji,jj,jk) + sb(ji,jj,jk)205 zt_d = ta(ji,jj,jk) - 2. * tn(ji,jj,jk) + tb(ji,jj,jk) 206 zs_d = sa(ji,jj,jk) - 2. * sn(ji,jj,jk) + sb(ji,jj,jk) 207 207 ! 208 208 ! ! swap of arrays 209 tb(ji,jj,jk) = tn(ji,jj,jk) + atfp * zt_ m! tb <-- tn filtered210 sb(ji,jj,jk) = sn(ji,jj,jk) + atfp * zs_ m! sb <-- sn filtered209 tb(ji,jj,jk) = tn(ji,jj,jk) + atfp * zt_d ! tb <-- tn filtered 210 sb(ji,jj,jk) = sn(ji,jj,jk) + atfp * zs_d ! sb <-- sn filtered 211 211 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 212 212 sn(ji,jj,jk) = sa(ji,jj,jk) ! sn <-- sa 213 213 ! ! semi imlicit hpg computation (Brown & Campana) 214 214 IF( ln_dynhpg_imp ) THEN 215 ta(ji,jj,jk) = ztn + rbcp * zt_ m! ta <-- Brown & Campana average216 sa(ji,jj,jk) = zsn + rbcp * zs_ m! sa <-- Brown & Campana average215 ta(ji,jj,jk) = ztn + rbcp * zt_d ! ta <-- Brown & Campana average 216 sa(ji,jj,jk) = zsn + rbcp * zs_d ! sa <-- Brown & Campana average 217 217 ENDIF 218 218 END DO … … 254 254 REAL :: ztc_a, ztc_n, ztc_b ! - - 255 255 REAL :: zsc_a, zsc_n, zsc_b ! - - 256 REAL :: ztc_f, zsc_f, ztc_ m, zsc_m! - -257 REAL :: ze3t_f, ze3t_ m! - -256 REAL :: ztc_f, zsc_f, ztc_d, zsc_d ! - - 257 REAL :: ze3t_f, ze3t_d ! - - 258 258 REAL :: zfact1, zfact2 ! - - 259 259 !!---------------------------------------------------------------------- … … 274 274 ELSE ! apply filter on thickness weighted tracer and swap 275 275 DO jk = 1, jpkm1 276 zfact1 = atfp * r 2dt_t(jk)276 zfact1 = atfp * rdttra(jk) 277 277 zfact2 = zfact1 / rau0 278 278 DO jj = 1, jpj … … 282 282 ze3t_n = fse3t_n(ji,jj,jk) 283 283 ze3t_a = fse3t_a(ji,jj,jk) 284 ze3t_ m = fse3t_m(ji,jj,jk)284 ze3t_d = fse3t_d(ji,jj,jk) 285 285 ! ! tracer content at Before, now and after 286 286 ztc_b = tb(ji,jj,jk) * ze3t_b ; zsc_b = sb(ji,jj,jk) * ze3t_b … … 290 290 ! ! Time laplacian on tracer contents 291 291 ! ! used for both Asselin and Brown & Campana filters 292 ztc_ m = ztc_a - 2. * ztc_n+ ztc_b293 zsc_ m = zsc_a - 2. * zsc_n+ zsc_b292 ztc_d = ztc_a - 2. * ztc_n + ztc_b 293 zsc_d = zsc_a - 2. * zsc_n + zsc_b 294 294 ! ! Asselin Filter on thicknesses and tracer contents 295 ze3t_f = ze3t_n + atfp * ze3t_ m296 ztc_f = ztc_n + atfp * ztc_ m297 zsc_f = zsc_n + atfp * zsc_ m295 ze3t_f = ze3t_n + atfp * ze3t_d 296 ztc_f = ztc_n + atfp * ztc_d 297 zsc_f = zsc_n + atfp * zsc_d 298 298 ! ! Filter correction 299 299 IF( jk == 1 ) THEN 300 ze3t_f = ze3t_f - zfact2 * ( emp_b (ji,jj) - emp (ji,jj) ) 301 ztc_f = ztc_f - zfact1 * ( sbc_trd_hc_n(ji,jj) - sbc_trd_hc_b(ji,jj) ) 300 ! WRITE(numout,*) 'filter correction: sbc_trd_hc_n' 301 ze3t_f = ze3t_f - zfact2 * ( emp_b (ji,jj) - emp (ji,jj) ) 302 ztc_f = ztc_f - zfact1 * ( sbc_trd_hc_n(ji,jj) - sbc_trd_hc_b(ji,jj) ) 302 303 ENDIF 303 304 IF( ln_traqsr .AND. ( jk .LE. nksr ) ) THEN 305 ! WRITE(numout,*) 'jk =', jk 306 ! WRITE(numout,*) 'filter correction: qsr_trd_hc_n' 304 307 ztc_f = ztc_f - zfact1 * ( qsr_trd_hc_n(ji,jj,jk) - qsr_trd_hc_b(ji,jj,jk) ) 305 308 ENDIF 306 !! swap of arrays309 ! swap of arrays 307 310 ze3t_f = 1.e0 / ze3t_f 308 311 tb(ji,jj,jk) = ztc_f * ze3t_f ! tb <-- tn filtered … … 312 315 ! ! semi imlicit hpg computation (Brown & Campana) 313 316 IF( ln_dynhpg_imp ) THEN 314 ze3t_ m = 1.e0 / ( ze3t_n + rbcp * ze3t_m)315 ta(ji,jj,jk) = ze3t_ m * ( ztc_n + rbcp * ztc_m) ! ta <-- Brown & Campana average316 sa(ji,jj,jk) = ze3t_ m * ( zsc_n + rbcp * zsc_m) ! sa <-- Brown & Campana average317 ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d ) 318 ta(ji,jj,jk) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average 319 sa(ji,jj,jk) = ze3t_d * ( zsc_n + rbcp * zsc_d ) ! sa <-- Brown & Campana average 317 320 ENDIF 318 321 END DO -
branches/DEV_r1837_MLF/NEMO/OPA_SRC/TRA/traqsr.F90
r1975 r2068 112 112 ztrdt(:,:,:) = ta(:,:,:) 113 113 ztrds(:,:,:) = 0.e0 114 ENDIF 115 116 ! ! ---------------------------------------- ! 117 ! ! Swap of forcing field ! 118 ! ! ---------------------------------------- ! 119 IF( kt /= nit000 ) qsr_trd_hc_b(:,:,:) = qsr_trd_hc_n(:,:,:) 120 ! ! ---------------------------------------- ! 121 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 122 ! ! ---------------------------------------- ! 123 IF( ln_rstart .AND. & !* Restart: read in restart file 124 & iom_varid( numror, 'qsr_trd_hc_b', ldstop = .FALSE. ) > 0 ) THEN 125 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 126 CALL iom_get( numror, jpdom_autoglo, 'qsr_trd_hc_b', qsr_trd_hc_b ) ! before heat content trend due to Qsr flux 127 ENDIF 114 128 ENDIF 115 129 … … 225 239 END DO 226 240 END DO 241 ENDIF 242 243 ! ! ---------------------------------------- ! 244 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 245 ! ! ---------------------------------------- ! 246 IF(lwp) WRITE(numout,*) 247 IF(lwp) WRITE(numout,*) 'qsr : penetrative solar radiation forcing field written in ocean restart file ', & 248 & 'at it= ', kt,' date= ', ndastp 249 IF(lwp) WRITE(numout,*) '~~~~' 250 CALL iom_rstput( kt, nitrst, numrow, 'qsr_trd_hc_b', qsr_trd_hc_n ) 251 ! 227 252 ENDIF 228 253 -
branches/DEV_r1837_MLF/NEMO/OPA_SRC/TRA/trasbc.F90
r1975 r2068 20 20 USE trdmod ! ocean trends 21 21 USE trdmod_oce ! ocean variables trends 22 USE iom 22 23 USE in_out_manager ! I/O manager 24 USE restart ! ocean restart 23 25 USE prtctl ! Print control 24 26 … … 132 134 ENDIF 133 135 ENDIF 134 135 ! ! ---------------------- ! 136 IF( lk_vvl ) THEN ! Variable Volume case ! 137 ! ! ---------------------- ! 136 ! ! ---------------------------------------- ! 137 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 138 ! ! ---------------------------------------- ! 139 sbc_trd_hc_b(:,:) = sbc_trd_hc_n(:,:) ! Swap the ocean forcing fields except at nit000 140 IF ( .NOT. lk_vvl ) sbc_trd_sc_b(:,:) = sbc_trd_sc_n(:,:) 141 ENDIF 142 ! ! ---------------------------------------- ! 143 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 144 ! ! ---------------------------------------- ! 145 IF( ln_rstart .AND. & !* Restart: read in restart file 146 & iom_varid( numror, 'sbc_trd_hc_b', ldstop = .FALSE. ) > 0 ) THEN 147 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 148 CALL iom_get( numror, jpdom_autoglo, 'sbc_trd_hc_b', sbc_trd_hc_b ) ! before heat content sbc trend 149 CALL iom_get( numror, jpdom_autoglo, 'qsr_trd_hc_b', qsr_trd_hc_b ) ! before heat content trend due to Qsr flux 150 IF ( .NOT. lk_vvl ) THEN 151 CALL iom_get( numror, jpdom_autoglo, 'sbc_trd_sc_b', sbc_trd_sc_b ) ! before salt content sbc trend 152 ENDIF 153 ENDIF 154 ENDIF 155 ! ! ---------------------- ! 156 IF( lk_vvl ) THEN ! Variable Volume case ! 157 ! ! ---------------------- ! 138 158 !!gm BUG : in key_vvl emps must be modified to only include the salt flux due to sea-ice freezing/melting 139 159 !!gm otherwise this flux will be missing ==> modification required in limsbc, limsbc_2 and CICE interface.s … … 161 181 END DO 162 182 ENDIF 163 ! ! ---------------------- !164 ELSE ! Constant Volume case !165 ! ! ---------------------- !183 ! ! ---------------------- ! 184 ELSE ! Constant Volume case ! 185 ! ! ---------------------- ! 166 186 IF ( neuler == 0 .AND. kt == nit000 ) THEN 167 187 DO jj = 2, jpj … … 197 217 ENDIF 198 218 219 ! ! ---------------------------------------- ! 220 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 221 ! ! ---------------------------------------- ! 222 IF(lwp) WRITE(numout,*) 223 IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ', & 224 & 'at it= ', kt,' date= ', ndastp 225 IF(lwp) WRITE(numout,*) '~~~~' 226 CALL iom_rstput( kt, nitrst, numrow, 'sbc_trd_hc_b', sbc_trd_hc_n ) 227 IF ( .NOT. lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'sbc_trd_sc_b', sbc_trd_sc_n ) 228 ! 229 ENDIF 230 199 231 IF( l_trdtra ) THEN ! save the sbc trends for diagnostic 200 232 ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) … … 205 237 IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' sbc - Ta: ', mask1=tmask, & 206 238 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 207 !208 239 END SUBROUTINE tra_sbc 209 240
Note: See TracChangeset
for help on using the changeset viewer.
