Changeset 5206 for branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO
- Timestamp:
- 2015-04-13T12:13:10+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO
- Files:
-
- 27 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r5123 r5206 65 65 66 66 !!* Ice Rheology 67 68 LOGICAL , PUBLIC:: ltrcdm2dc_ice = .FALSE. !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux69 70 67 # if defined key_lim2_vp 71 68 ! !!* VP rheology * … … 113 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qdtcn !: energy from the ice to the ocean point (at a factor 2) 114 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: thcm !: part of the solar energy used in the lead heat budget 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric_ daymean!: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric_mean !: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle ) 116 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric !: Solar flux transmitted trough the ice 117 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ffltbif !: linked with the max heat contained in brine pockets (?) … … 173 170 & tbif (jpi,jpj,jplayersp1) , STAT=ierr(5)) 174 171 175 IF( ltrcdm2dc_ice ) ALLOCATE(fstric_daymean(jpi,jpj), STAT=ierr(6) )176 177 172 !* moment used in the advection scheme 178 173 ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) , & … … 201 196 !! Default option Empty module NO LIM 2.0 sea-ice model 202 197 !!---------------------------------------------------------------------- 203 LOGICAL , PUBLIC:: ltrcdm2dc_ice = .FALSE. !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux204 198 #endif 205 199 !!----------------------------------------------------------------- -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r4624 r5206 60 60 ENDIF 61 61 ! 62 ! When Diurnal cycle, core bulk and LIM2 are activated,63 ! a daily mean qsr is computed for tracer/biogeochemistery model !64 IF( ltrcdm2dc )THEN ; ltrcdm2dc_ice = .TRUE.65 ELSE ; ltrcdm2dc_ice = .FALSE.66 ENDIF67 62 ! ! Allocate the ice arrays 68 63 ierr = ice_alloc_2 () ! ice variables -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r4990 r5206 46 46 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 47 47 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 48 PUBLIC lim_bio_meanqsr_2 ! called by sbc_ice_lim_249 48 50 49 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 264 263 ENDIF 265 264 265 ! daily mean qsr when diurnal cycle is applied on physics - for BGC models 266 IF( l_trcdm2dc ) qsr_mean(:,:) = pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_mean(:,:) 267 268 266 269 IF(ln_ctl) THEN ! control print 267 270 CALL prt_ctl(tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ') … … 430 433 END SUBROUTINE lim_sbc_tau_2 431 434 432 SUBROUTINE lim_bio_meanqsr_2433 !!---------------------------------------------------------------------434 !! *** ROUTINE lim_bio_meanqsr435 !!436 !! ** Purpose : provide daily qsr_mean for PISCES when437 !! analytic diurnal cycle is applied in physic438 !!439 !! ** Method : add part under ice440 !!441 !!---------------------------------------------------------------------442 443 qsr_mean(:,:) = pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_daymean(:,:)444 445 END SUBROUTINE lim_bio_meanqsr_2446 435 447 436 SUBROUTINE lim_sbc_init_2 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r4990 r5206 114 114 CALL wrk_alloc( jpi, jpj, jpk, zmsk ) 115 115 116 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) 116 IF( kt == nit000 ) THEN 117 CALL lim_thd_init_2 ! Initialization (first time-step only) 118 IF( l_trcdm2dc ) ALLOCATE( fstric_mean(jpi,jpj), fstbif_mean_1d(jpij), qsr_ice_mean_1d(jpij) ) 119 ENDIF 117 120 118 121 !-------------------------------------------! … … 137 140 rdq_ice(:,:) = 0.e0 ! heat content associated with rdm_ice 138 141 zmsk (:,:,:) = 0.e0 139 IF( ltrcdm2dc_ice ) fstric_daymean (:,:) = 0.e0 ! part of solar radiation absorbing inside the ice 142 ! 143 IF( l_trcdm2dc ) fstric_mean(:,:) = 0.e0 ! part of solar radiation absorbing inside the ice 140 144 141 145 ! set to zero snow thickness smaller than epsi04 … … 285 289 CALL tab_2d_1d_2( nbpb, tbif_1d (1:nbpb , 3 ), tbif(:,:,3) , jpi, jpj, npb(1:nbpb) ) 286 290 CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb) , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) ) 287 IF( l trcdm2dc_ice) &291 IF( l_trcdm2dc ) & 288 292 & CALL tab_2d_1d_2( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,1), jpi, jpj, npb(1:nbpb) ) 289 293 CALL tab_2d_1d_2( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) ) … … 336 340 CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) 337 341 CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) 338 IF( l trcdm2dc_ice )THEN339 CALL tab_1d_2d_2( nbpb, fstric_ daymean , npb, fstbif_daymean_1d (1:nbpb), jpi, jpj )340 CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb, qsr_ice_mean_1d(1:nbpb), jpi, jpj )342 IF( l_trcdm2dc ) & 343 CALL tab_1d_2d_2( nbpb, fstric_mean , npb, fstbif_mean_1d (1:nbpb), jpi, jpj ) 344 CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb, qsr_ice_mean_1d(1:nbpb), jpi, jpj ) 341 345 ENDIF 342 IF( .NOT. lk_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb) 346 IF( .NOT. lk_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 343 347 ! 344 348 ENDIF -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r4990 r5206 273 273 END DO 274 274 275 IF( l trcdm2dc_ice)THEN276 275 IF( l_topdcy )THEN 276 ! 277 277 DO ji = kideb , kiut 278 zihsn = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )279 zihic = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )278 zihsn = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) ) 279 zihic = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) ) 280 280 zi0(ji) = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) ) 281 281 zexp = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) ) 282 fstbif_ daymean_1d(ji) = zi0(ji) * qsr_ice_mean_1d(ji) * zexp282 fstbif_mean_1d(ji) = zi0(ji) * qsr_ice_mean_1d(ji) * zexp 283 283 END DO 284 284 ! 285 285 ENDIF 286 286 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
r4306 r5206 55 55 fstbif_1d , & !: " " fstric 56 56 fltbif_1d , & !: " " ffltbif 57 fstbif_ daymean_1d, & !: " " fstric_daymean57 fstbif_mean_1d, & !: " " fstric_mean 58 58 fscbq_1d , & !: " " fscmcbq 59 59 qsr_ice_1d , & !: " " qsr_ice … … 122 122 & tbif_1d(jpij, jplayersp1), Stat=ierr(4)) 123 123 ! 124 IF( ltrcdm2dc_ice )ALLOCATE(fstbif_daymean_1d(jpij),qsr_ice_mean_1d(jpij),Stat=ierr(5))125 !126 124 thd_ice_alloc_2 = MAXVAL(ierr) 127 125 IF( thd_ice_alloc_2 /= 0 ) CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays') -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r5167 r5206 301 301 302 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice_mean !: transmitted daily mean solar radiation under ice (diurnal cycle) 304 303 305 304 306 !!-------------------------------------------------------------------------- -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5187 r5206 118 118 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 119 119 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 120 IF( l_trcdm2dc ) THEN 121 IF( iom_use('qsr_oce_mean') ) CALL iom_put( "qsr_oce_mean" , qsr_mean(:,:) * pfrld(:,:) ) ! daily mean solar flux at ocean surface 122 IF( iom_use('qsr_ice_mean') ) CALL iom_put( "qsr_ice_mean" , SUM( qsr_ice_mean(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! daily mean solar flux at ice surface 123 IF( iom_use('qtr_ice_mean') ) CALL iom_put( "qtr_ice_mean" , SUM( ftr_ice_mean(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! daily mean solar flux transmitted thru ice 124 ENDIF 120 125 121 126 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) … … 212 217 fr_i (:,:) = at_i(:,:) ! Sea-ice fraction 213 218 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 219 220 221 ! daily mean qsr when diurnal cycle is applied on physics - for BGC models 222 IF( l_trcdm2dc ) qsr_mean(:,:) = pfrld(:,:) * qsr_mean(:,:) + ftr_ice_mean(:,:) 214 223 215 224 !------------------------------------------------! -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5202 r5206 98 98 IF( nn_timing == 1 ) CALL timing_start('limthd') 99 99 100 IF( kt == nit000 .AND. l_trcdm2dc ) ALLOCATE( ftr_ice_mean(jpi,jpj,jpl), ftr_ice_mean_1d(jpij), qsr_ice_mean_1d(jpij) ) 101 100 102 ! conservation test 101 103 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) … … 106 108 !------------------------------------------------------------------------! 107 109 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 110 IF( l_trcdm2dc ) ftr_ice_mean(:,:,:) = 0._wp ! part of daily mean solar radiation absorbing inside the ice 111 108 112 109 113 !-------------------- … … 576 580 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 577 581 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 582 IF( l_trcdm2dc ) THEN 583 CALL tab_2d_1d( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 584 CALL tab_2d_1d( nbpb, ftr_ice_mean_1d (1:nbpb), ftr_ice_mean(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 585 ENDIF 578 586 IF( .NOT. lk_cpl ) THEN 579 587 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 670 678 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 671 679 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 672 680 ! 681 IF( l_trcdm2dc ) THEN 682 CALL tab_1d_2d( nbpb, qns_ice_mean(:,:,jl), npb, qns_ice_mean_1d(1:nbpb) , jpi, jpj) 683 CALL tab_1d_2d( nbpb, ftr_ice_mean(:,:,jl), npb, ftr_ice_mean_1d(1:nbpb) , jpi, jpj ) 684 ENDIF 685 ! 673 686 END SELECT 674 687 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5202 r5206 126 126 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 127 127 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 128 REAL(wp), POINTER, DIMENSION(:) :: zftrice_mean ! daily mean solar radiation transmitted through the ice 128 129 REAL(wp), POINTER, DIMENSION(:) :: zihic 129 130 … … 174 175 CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 175 176 CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 177 IF( l_trcdm2dc ) CALL wrk_alloc( jpij, zftrice_mean ) 176 178 177 179 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) … … 249 251 END DO 250 252 253 IF( l_trcdm2dc ) THEN 254 DO ji = kideb , kiut 255 zftrice_mean(ji) = qsr_ice_mean_1d(ji) * i0(ji) ! Solar radiation transmitted below the surface layer 256 END DO 257 ENDIF 258 251 259 !--------------------------------------------------------- 252 260 ! Transmission - absorption of solar radiation in the ice … … 282 290 ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 283 291 END DO 292 293 294 IF( l_trcdm2dc ) THEN 295 DO ji = kideb , kiut 296 ftr_ice_mean_1d(ji) = ftr_ice_mean_1d(ji) & 297 & + a_i_1d(ji) * zftrice_mean(ji) & 298 & * EXP( - rn_kappa_i * ( MAX ( 0._wp , h_i_1d(ji) ) ) ) & 299 * EXP( - zraext_s * ( MAX ( 0._wp , h_s_1d(ji) ) ) ) 300 END DO 301 ENDIF 284 302 285 303 ! -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r5167 r5206 41 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftr_ice_1d 42 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_mean_1d 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftr_ice_mean_1d 43 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr1_i0_1d 44 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr2_i0_1d -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5123 r5206 152 152 #endif 153 153 ! 154 #if defined key_lim 2155 IF( l trcdm2dc_ice) ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) )154 #if defined key_lim3 || defined key_lim2 155 IF( l_trcdm2dc ) ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 156 156 #endif 157 157 ! -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5120 r5206 81 81 !! Ocean Surface Boundary Condition fields 82 82 !!---------------------------------------------------------------------- 83 LOGICAL , PUBLIC :: l_trcdm2dc !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux 84 ! 83 85 LOGICAL , PUBLIC :: lhftau = .FALSE. !: HF tau used in TKE: mean(stress module) - module(mean stress) 84 LOGICAL , PUBLIC :: ltrcdm2dc !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux85 86 !! !! now ! before !! 86 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau , utau_b !: sea surface i-stress (ocean referential) [N/m2] … … 136 137 !! *** FUNCTION sbc_oce_alloc *** 137 138 !!--------------------------------------------------------------------- 138 INTEGER :: ierr( 5)139 INTEGER :: ierr(6) 139 140 !!--------------------------------------------------------------------- 140 141 ierr(:) = 0 … … 158 159 & ssv_m (jpi,jpj) , sss_m (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) ) 159 160 ! 161 IF( l_trcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) ) 162 ! 160 163 #if defined key_vvl 161 ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 162 #endif 163 ! 164 IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) ) 164 ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(6) ) 165 #endif 165 166 ! 166 167 sbc_oce_alloc = MAXVAL( ierr ) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5065 r5206 196 196 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 197 197 198 ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery 199 IF( ltrcdm2dc ) CALL blk_bio_meanqsr 198 IF( l_trcdm2dc ) CALL blk_bio_meanqsr ! diurnal cycle : daily mean short waves flux for biogeochemistery 200 199 201 200 #if defined key_cice -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5167 r5206 172 172 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 173 173 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 174 175 IF( l_trcdm2dc ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 174 176 ! 175 177 CASE ( jp_cpl ) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4990 r5206 194 194 & tprecip , sprecip , & 195 195 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 196 196 197 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 197 198 … … 237 238 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 238 239 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes 239 #if defined key_top240 IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2241 #endif242 240 243 241 IF( .NOT. lk_mpp )THEN -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5123 r5206 24 24 USE phycst ! physical constants 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 USE trc_oce ! shared ocean-passive tracers variables 26 27 USE sbc_ice ! Surface boundary condition: ice fields 27 28 USE sbcdcy ! surface boundary condition: diurnal cycle … … 151 152 END SELECT 152 153 ! 153 #if defined key_top && ! defined key_offline 154 ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2) 155 IF( ltrcdm2dc )THEN 156 IF(lwp)THEN 157 WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: " 158 WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers" 154 IF( ln_dm2dc .AND. lk_top ) THEN 155 l_trcdm2dc = .TRUE. 156 IF( lwp ) THEN 157 WRITE(numout,*) "In case of diurnal cycle coupled with passive tracers" 158 WRITE(numout,*) "Computation of a daily mean shortwave for some biogeochemical models" 159 159 ENDIF 160 ENDIF 161 #else 162 ltrcdm2dc = .FALSE. 163 #endif 164 165 ! 160 ELSE 161 l_trcdm2dc = .FALSE. 162 ENDIF 163 166 164 ! ! allocate sbc arrays 167 165 IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r4623 r5206 32 32 !! 'key_top' bio-model 33 33 !!---------------------------------------------------------------------- 34 LOGICAL, PUBLIC, PARAMETER :: lk_top = .TRUE. !: TOP model 34 35 LOGICAL, PUBLIC, PARAMETER :: lk_qsr_bio = .TRUE. !: bio-model light absorption flag 35 36 #else … … 37 38 !! Default option No bio-model light absorption 38 39 !!---------------------------------------------------------------------- 40 LOGICAL, PUBLIC, PARAMETER :: lk_top = .FALSE. !: TOP model 39 41 LOGICAL, PUBLIC, PARAMETER :: lk_qsr_bio = .FALSE. !: bio-model light absorption flag 40 42 #endif -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r4990 r5206 89 89 90 90 ! ! surface irradiance 91 zpar0m (:,:) = qsr (:,:) * 0.43 ! ------------------ 91 ! ! ------------------ 92 IF( ln_dm2dc ) THEN ; zpar0m(:,:) = qsr_mean(:,:) * 0.43 93 ELSE ; zpar0m(:,:) = qsr (:,:) * 0.43 94 ENDIF 92 95 zpar100(:,:) = zpar0m(:,:) * 0.01 93 96 zparr (:,:,1) = zpar0m(:,:) * 0.5 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r4996 r5206 172 172 ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 173 173 ztem2 = tsn(ji,jj,jk,jp_tem) - 10. 174 zetot1 = MAX( 0., etot (ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) )175 zetot2 = 30. / ( 30. + etot (ji,jj,jk) )174 zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 175 zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 176 176 177 177 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r4996 r5206 35 35 REAL(wp) :: parlux !: Fraction of shortwave as PAR 36 36 REAL(wp) :: xparsw !: parlux/3 37 REAL(wp) :: xsi0r !: 1. /rn_si0 37 38 38 39 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par … … 42 43 43 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat !: PAR for phyto, nano and diat 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 44 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 45 47 … … 71 73 INTEGER :: ji, jj, jk 72 74 INTEGER :: irgb 73 REAL(wp) :: zchl , zxsi0r75 REAL(wp) :: zchl 74 76 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 75 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp , zetmp1, zetmp276 REAL(wp), POINTER, DIMENSION(:,:,:) :: z ekg, zekr, zekb, ze0, ze1, ze2, ze377 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, zekg, zekr, zekb, ze0, ze1, ze2, ze3 77 79 !!--------------------------------------------------------------------- 78 80 ! … … 80 82 ! 81 83 ! Allocate temporary workspace 82 CALL wrk_alloc( jpi, jpj, z depmoy, zetmp, zetmp1, zetmp2 )83 CALL wrk_alloc( jpi, jpj, jpk, z ekg, zekr, zekb, ze0, ze1, ze2, ze3 )84 85 IF( jnt == 1 .AND. ln_varpar ) CALL p4z_opt sbc( kt )84 CALL wrk_alloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 85 CALL wrk_alloc( jpi, jpj, jpk, zpar, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 86 87 IF( jnt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 86 88 87 89 ! Initialisation of variables used to compute PAR 88 90 ! ----------------------------------------------- 89 ze1(:,:,jpk) = 0._wp 90 ze2(:,:,jpk) = 0._wp 91 ze3(:,:,jpk) = 0._wp 92 91 ze1(:,:,:) = 0._wp 92 ze2(:,:,:) = 0._wp 93 ze3(:,:,:) = 0._wp 93 94 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 94 95 DO jk = 1, jpkm1 ! -------------------------------------------------------- … … 107 108 END DO 108 109 END DO 109 110 111 110 ! !* Photosynthetically Available Radiation (PAR) 112 111 ! ! -------------------------------------- 113 114 IF( ln_varpar ) THEN 115 ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) ) 116 ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) ) 117 ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) ) 112 IF( ln_dm2dc ) THEN ! diurnal cycle 113 ! 1% of qsr to compute euphotic layer 114 zqsr100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr 115 ! 116 CALL p4z_opt_par( kt, qsr_mean, zekb, zekg, zekr, ze1, ze2, ze3 ) 117 ! 118 DO jk = 1, nksrp 119 etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 120 enano (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 121 ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 122 END DO 123 ! 124 CALL p4z_opt_par( kt, qsr, zekb, zekg, zekr, ze1, ze2, ze3 ) 125 ! 126 DO jk = 1, nksrp 127 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 128 END DO 129 ! 118 130 ELSE 119 ze1(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) ) 120 ze2(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) ) 121 ze3(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) ) 122 ENDIF 123 124 !CDIR NOVERRCHK 125 DO jj = 1, jpj 126 !CDIR NOVERRCHK 127 DO ji = 1, jpi 128 zc1 = ze1(ji,jj,1) 129 zc2 = ze2(ji,jj,1) 130 zc3 = ze3(ji,jj,1) 131 etot (ji,jj,1) = ( zc1 + zc2 + zc3 ) 132 enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 133 ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 134 END DO 135 END DO 136 137 138 DO jk = 2, nksrp 139 !CDIR NOVERRCHK 140 DO jj = 1, jpj 141 !CDIR NOVERRCHK 142 DO ji = 1, jpi 143 zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) ) 144 zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) ) 145 zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) ) 146 ze1 (ji,jj,jk) = zc1 147 ze2 (ji,jj,jk) = zc2 148 ze3 (ji,jj,jk) = zc3 149 etot (ji,jj,jk) = ( zc1 + zc2 + zc3 ) 150 enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 151 ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 152 END DO 153 END DO 154 END DO 131 ! 1% of qsr to compute euphotic layer 132 zqsr100(:,:) = 0.01 * qsr(:,:) 133 ! 134 CALL p4z_opt_par( kt, qsr, zekb, zekg, zekr, ze1, ze2, ze3 ) 135 ! 136 DO jk = 1, nksrp 137 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 138 enano(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 139 ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 140 END DO 141 etot_ndcy(:,:,:) = etot(:,:,:) 142 ENDIF 143 155 144 156 145 IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics) 157 146 ! ! ------------------------ 158 zxsi0r = 1.e0 / rn_si0 159 ! 160 ze0(:,:,1) = rn_abs * qsr(:,:) 161 ! ! surface value : separation in R-G-B + near surface 162 IF( ln_varpar ) THEN 163 ze0(:,:,1) = ( 1. - 3. * par_varsw(:,:) ) * qsr(:,:) 164 ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) 165 ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) 166 ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) 167 ELSE 168 ze0(:,:,1) = ( 1. - 3. * xparsw ) * qsr(:,:) 169 ze1(:,:,1) = xparsw * qsr(:,:) 170 ze2(:,:,1) = xparsw * qsr(:,:) 171 ze3(:,:,1) = xparsw * qsr(:,:) 172 ENDIF 147 CALL p4z_opt_par( kt, qsr, zekb, zekg, zekr, ze1, ze2, ze3, pe0=ze0 ) 148 ! 173 149 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 174 !175 !176 150 DO jk = 2, nksrp + 1 177 !CDIR NOVERRCHK 178 DO jj = 1, jpj 179 !CDIR NOVERRCHK 180 DO ji = 1, jpi 181 zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r ) 182 zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) ) 183 zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) ) 184 zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) ) 185 ze0(ji,jj,jk) = zc0 186 ze1(ji,jj,jk) = zc1 187 ze2(ji,jj,jk) = zc2 188 ze3(ji,jj,jk) = zc3 189 etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk) 190 END DO 191 ! 192 END DO 193 ! 194 END DO 195 ! 196 ENDIF 197 151 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 152 END DO 153 ! ! ------------------------ 154 ENDIF 198 155 ! !* Euphotic depth and level 199 156 neln(:,:) = 1 ! ------------------------ … … 203 160 DO jj = 1, jpj 204 161 DO ji = 1, jpi 205 IF( etot (ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) THEN162 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 * zqsr100(ji,jj) ) THEN 206 163 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 207 ! ! nb: ensure the compatibility with nmld_trc definition in trd_m xl_trc_zint164 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 208 165 heup(ji,jj) = fsdepw(ji,jj,jk+1) ! Euphotic layer depth 209 166 ENDIF … … 211 168 END DO 212 169 END DO 213 170 ! 214 171 heup(:,:) = MIN( 300., heup(:,:) ) 215 216 172 ! !* mean light over the mixed layer 217 173 zdepmoy(:,:) = 0.e0 ! ------------------------------- 218 zetmp (:,:) = 0.e0219 174 zetmp1 (:,:) = 0.e0 220 175 zetmp2 (:,:) = 0.e0 176 zetmp3 (:,:) = 0.e0 177 zetmp4 (:,:) = 0.e0 221 178 222 179 DO jk = 1, nksrp … … 226 183 DO ji = 1, jpi 227 184 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 228 zetmp (ji,jj) = zetmp (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 229 zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 230 zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 185 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation 186 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production 187 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * fse3t(ji,jj,jk) ! production 188 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * fse3t(ji,jj,jk) ! production 231 189 zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 232 190 ENDIF … … 235 193 END DO 236 194 ! 237 emoy(:,:,:) = etot(:,:,:) 195 emoy(:,:,:) = etot(:,:,:) ! remineralisation 196 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 238 197 ! 239 198 DO jk = 1, nksrp … … 244 203 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 245 204 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 246 emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 247 enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 248 ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 205 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 206 zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 207 enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 208 ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 249 209 ENDIF 250 210 END DO 251 211 END DO 252 212 END DO 253 213 ! 254 214 IF( lk_iomput ) THEN 255 215 IF( jnt == nrdttrc ) THEN … … 259 219 ELSE 260 220 IF( ln_diatrc ) THEN ! save output diagnostics 261 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 221 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 262 222 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 263 223 ENDIF 264 224 ENDIF 265 225 ! 266 CALL wrk_dealloc( jpi, jpj, z depmoy, zetmp, zetmp1, zetmp2)267 CALL wrk_dealloc( jpi, jpj, jpk, z ekg, zekr, zekb, ze0, ze1, ze2, ze3 )226 CALL wrk_dealloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 227 CALL wrk_dealloc( jpi, jpj, jpk, zpar, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 268 228 ! 269 229 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') … … 271 231 END SUBROUTINE p4z_opt 272 232 273 SUBROUTINE p4z_optsbc( kt ) 274 !!---------------------------------------------------------------------- 275 !! *** routine p4z_optsbc *** 233 SUBROUTINE p4z_opt_par( kt, pqsr, pekb, pekg, pekr, pe1, pe2, pe3, pe0 ) 234 !!---------------------------------------------------------------------- 235 !! *** routine p4z_opt_par *** 236 !! 237 !! ** purpose : compute PAR of each wavelength (Red-Green-Blue) 238 !! for a given shortwave radiation 239 !! 240 !!---------------------------------------------------------------------- 241 !! * arguments 242 INTEGER, INTENT(in) :: kt ! ocean time-step 243 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 244 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pekb, pekg, pekr ! wavelength (Red-Green-Blue) 245 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 246 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 247 !! * local variables 248 INTEGER :: ji, jj, jk ! dummy loop indices 249 REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave 250 !!---------------------------------------------------------------------- 251 252 ! Real shortwave 253 IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 254 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 255 ENDIF 256 ! 257 IF( PRESENT( pe0 ) ) THEN ! W-level 258 ! 259 pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q 260 pe1(:,:,1) = zqsr(:,:) 261 pe2(:,:,1) = zqsr(:,:) 262 pe3(:,:,1) = zqsr(:,:) 263 ! 264 DO jk = 2, nksrp + 1 265 !CDIR NOVERRCHK 266 DO jj = 1, jpj 267 !CDIR NOVERRCHK 268 DO ji = 1, jpi 269 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) 270 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -pekb(ji,jj,jk-1 ) ) 271 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -pekg(ji,jj,jk-1 ) ) 272 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -pekr(ji,jj,jk-1 ) ) 273 END DO 274 ! 275 END DO 276 ! 277 END DO 278 ! 279 ELSE ! T- level 280 ! 281 pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * pekb(:,:,1) ) 282 pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * pekg(:,:,1) ) 283 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * pekr(:,:,1) ) 284 ! 285 DO jk = 2, nksrp 286 !CDIR NOVERRCHK 287 DO jj = 1, jpj 288 !CDIR NOVERRCHK 289 DO ji = 1, jpi 290 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( pekb(ji,jj,jk-1) + pekb(ji,jj,jk) ) ) 291 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( pekg(ji,jj,jk-1) + pekg(ji,jj,jk) ) ) 292 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( pekr(ji,jj,jk-1) + pekr(ji,jj,jk) ) ) 293 END DO 294 END DO 295 END DO 296 ! 297 ENDIF 298 ! 299 END SUBROUTINE p4z_opt_par 300 301 302 SUBROUTINE p4z_opt_sbc( kt ) 303 !!---------------------------------------------------------------------- 304 !! *** routine p4z_opt_sbc *** 276 305 !! 277 306 !! ** purpose : read and interpolate the variable PAR fraction … … 284 313 !!---------------------------------------------------------------------- 285 314 !! * arguments 286 INTEGER , INTENT( in ) :: kt! ocean time step315 INTEGER , INTENT(in) :: kt ! ocean time step 287 316 288 317 !! * local declarations … … 297 326 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN 298 327 CALL fld_read( kt, 1, sf_par ) 299 par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) /3.0328 par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 300 329 ENDIF 301 330 ENDIF … … 303 332 IF( nn_timing == 1 ) CALL timing_stop('p4z_optsbc') 304 333 ! 305 END SUBROUTINE p4z_opt sbc334 END SUBROUTINE p4z_opt_sbc 306 335 307 336 SUBROUTINE p4z_opt_init … … 347 376 ! 348 377 xparsw = parlux / 3.0 378 xsi0r = 1.e0 / rn_si0 349 379 ! 350 380 ! Variable PAR at the surface of the ocean … … 372 402 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 373 403 ! 374 etot (:,:,:) = 0._wp 375 enano(:,:,:) = 0._wp 376 ediat(:,:,:) = 0._wp 377 IF( ln_qsr_bio ) etot3(:,:,:) = 0._wp 404 etot (:,:,:) = 0._wp 405 etot_ndcy(:,:,:) = 0._wp 406 enano (:,:,:) = 0._wp 407 ediat (:,:,:) = 0._wp 408 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 378 409 ! 379 410 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt_init') … … 386 417 !! *** ROUTINE p4z_opt_alloc *** 387 418 !!---------------------------------------------------------------------- 388 ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 419 ALLOCATE( enano (jpi,jpj,jpk), ediat(jpi,jpj,jpk), & 420 & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 389 421 ! 390 422 IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r4996 r5206 134 134 DO jj = 1 ,jpj 135 135 DO ji = 1, jpi 136 IF( etot (ji,jj,jk) > 1.E-3 ) THEN136 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 137 137 zval = MAX( 1., zstrn(ji,jj) ) 138 138 zval = 1.5 * zval / ( 12. + zval ) … … 157 157 DO ji = 1, jpi 158 158 ! Computation of the P-I slope for nanos and diatoms 159 IF( etot (ji,jj,jk) > 1.E-3 ) THEN159 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 160 160 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 161 161 zadap = xadap * ztn / ( 2.+ ztn ) … … 196 196 197 197 ! Computation of the P-I slope for nanos and diatoms 198 IF( etot (ji,jj,jk) > 1.E-3 ) THEN198 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 199 199 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 200 200 zadap = ztn / ( 2.+ ztn ) … … 252 252 DO ji = 1, jpi 253 253 254 IF( etot (ji,jj,jk) > 1.E-3 ) THEN254 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 255 255 ! Si/C of diatoms 256 256 ! ------------------------ … … 302 302 !CDIR NOVERRCHK 303 303 DO ji = 1, jpi 304 IF( etot (ji,jj,jk) > 1.E-3 ) THEN304 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 305 305 ! production terms for nanophyto. 306 306 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 … … 341 341 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 342 342 ENDIF 343 IF( etot (ji,jj,jk) > 1.E-3 ) THEN343 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 344 344 ! production terms for nanophyto. ( chlorophyll ) 345 345 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) … … 365 365 !CDIR NOVERRCHK 366 366 DO ji = 1, jpi 367 IF( etot (ji,jj,jk) > 1.E-3 ) THEN367 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 368 368 ! production terms for nanophyto. ( chlorophyll ) 369 369 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r4996 r5206 136 136 DO jj = 1, jpj 137 137 DO ji = 1, jpi 138 zcoef = ryyss * cvol(ji,jj,1)138 zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 139 139 rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) & 140 140 & * 1.E3 / ( 12. * zcoef + rtrn ) … … 187 187 INTEGER :: ierr, ierr1, ierr2, ierr3 188 188 INTEGER :: ios ! Local integer output status for namelist read 189 INTEGER :: ik50 ! last level where depth less than 50 m 189 190 REAL(wp) :: zexpide, zdenitide, zmaskt 190 191 REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep … … 247 248 ENDIF 248 249 250 ! set the number of level over which river runoffs are applied 251 ! online configuration : computed in sbcrnf 252 IF( lk_offline ) THEN 253 nk_rnf(:,:) = 1 254 h_rnf (:,:) = fsdept(:,:,1) 255 ENDIF 256 249 257 ! dust input from the atmosphere 250 258 ! ------------------------------ … … 410 418 CALL iom_close( numiron ) 411 419 ! 412 DO jk = 1, 5 420 ik50 = 5 ! last level where depth less than 50 m 421 DO jk = jpkm1, 1, -1 422 IF( gdept_1d(jk) > 50. ) ik50 = jk - 1 423 END DO 424 IF (lwp) WRITE(numout,*) 425 IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 426 IF (lwp) WRITE(numout,*) 427 DO jk = 1, ik50 413 428 DO jj = 2, jpjm1 414 429 DO ji = fs_2, fs_jpim1 … … 421 436 END DO 422 437 END DO 423 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN 424 ii0 = 176 ; ii1 = 176 ! Southern Island : Kerguelen 425 ij0 = 37 ; ij1 = 37 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 438 IF( cp_cfg == 'orca' ) THEN 439 IF( jp_cfg == 2 ) THEN 440 ii0 = 176 ; ii1 = 176 ! Southern Island : Kerguelen 441 ij0 = 37 ; ij1 = 37 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 442 ! 443 ii0 = 119 ; ii1 = 119 ! South Georgia 444 ij0 = 29 ; ij1 = 29 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 445 ! 446 ii0 = 111 ; ii1 = 111 ! Falklands 447 ij0 = 35 ; ij1 = 35 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 448 ! 449 ii0 = 168 ; ii1 = 168 ! Crozet 450 ij0 = 40 ; ij1 = 40 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 451 ! 452 ii0 = 119 ; ii1 = 119 ! South Orkney 453 ij0 = 28 ; ij1 = 28 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 454 ! 455 ii0 = 140 ; ii1 = 140 ! Bouvet Island 456 ij0 = 33 ; ij1 = 33 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 457 ! 458 ii0 = 178 ; ii1 = 178 ! Prince edwards 459 ij0 = 34 ; ij1 = 34 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 460 ! 461 ii0 = 43 ; ii1 = 43 ! Balleny islands 462 ij0 = 21 ; ij1 = 21 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 463 ! 464 ELSE IF( jp_cfg == 1 ) THEN 465 ! 466 ii0 = 357 ; ii1 = 357 ! Southern Island : Kerguelen 467 ij0 = 75 ; ij1 = 76 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 468 ! 469 ii0 = 243 ; ii1 = 243 ! South Georgia 470 ij0 = 57 ; ij1 = 59 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 471 ! 472 ii0 = 227 ; ii1 = 227 ! Falklands 473 ij0 = 71 ; ij1 = 73 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 474 ! 475 ii0 = 326 ; ii1 = 327 ! Crozet 476 ij0 = 79 ; ij1 = 79 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 477 ! 478 ii0 = 243 ; ii1 = 243 ! South Orkney 479 ij0 = 56 ; ij1 = 56 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 480 ! 481 ii0 = 283 ; ii1 = 286 ! Bouvet Island 482 ij0 = 66 ; ij1 = 66 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 483 ! 484 ii0 = 361 ; ii1 = 361 ! Prince edwards 485 ij0 = 67 ; ij1 = 68 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 486 ! 487 ii0 = 91 ; ii1 = 92 ! Balleny islands 488 ij0 = 42 ; ij1 = 43 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 489 ! 490 ELSE IF( jp_cfg == 05 ) THEN 491 ! 492 CALL ctl_warn( ' Coastal supply of iron modifications for southern Islands in ORCA_R05' ) 493 ! 494 ELSE IF( jp_cfg == 025 ) THEN 495 ! 496 CALL ctl_warn( ' Coastal supply of iron modifications for southern Islands in ORCA_R025' ) 497 ! 498 ENDIF 426 499 ! 427 ii0 = 119 ; ii1 = 119 ! South Georgia428 ij0 = 29 ; ij1 = 29 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp429 !430 ii0 = 111 ; ii1 = 111 ! Falklands431 ij0 = 35 ; ij1 = 35 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp432 !433 ii0 = 168 ; ii1 = 168 ! Crozet434 ij0 = 40 ; ij1 = 40 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp435 !436 ii0 = 119 ; ii1 = 119 ! South Orkney437 ij0 = 28 ; ij1 = 28 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp438 !439 ii0 = 140 ; ii1 = 140 ! Bouvet Island440 ij0 = 33 ; ij1 = 33 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp441 !442 ii0 = 178 ; ii1 = 178 ! Prince edwards443 ij0 = 34 ; ij1 = 34 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp444 !445 ii0 = 43 ; ii1 = 43 ! Balleny islands446 ij0 = 21 ; ij1 = 21 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp447 500 ENDIF 448 501 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r4996 r5206 167 167 ! ---------------------------------------------------------- 168 168 IF( ln_river ) THEN 169 trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivdip(:,:) * rfact2 170 trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + rivdin(:,:) * rfact2 171 trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivdic(:,:) * 5.e-5 * rfact2 172 trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + rivdsi(:,:) * rfact2 173 trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivdic(:,:) * rfact2 174 trn(:,:,1,jptal) = trn(:,:,1,jptal) + ( rivalk(:,:) - rno3 * rivdin(:,:) ) * rfact2 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 DO jk = 1, nk_rnf(ji,jj) 172 trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + rivdip(ji,jj) * rfact2 173 trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3) + rivdin(ji,jj) * rfact2 174 trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) + rivdic(ji,jj) * 5.e-5 * rfact2 175 trn(ji,jj,jk,jpsil) = trn(ji,jj,jk,jpsil) + rivdsi(ji,jj) * rfact2 176 trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic) + rivdic(ji,jj) * rfact2 177 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 178 ENDDO 179 ENDDO 180 ENDDO 175 181 ENDIF 176 182 … … 357 363 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 358 364 ztrpo4 = trn (ji,jj,jk,jppo4) / ( concnnh4 + trn (ji,jj,jk,jppo4) ) 359 zlight = ( 1.- EXP( -etot (ji,jj,jk) / diazolight ) )365 zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) 360 366 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) & 361 367 & * zfact * MIN( ztrfer, ztrpo4 ) * zlight -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r4990 r5206 83 83 USE sbc_oce , ONLY : wndm => wndm !: 10m wind speed 84 84 USE sbc_oce , ONLY : qsr => qsr !: penetrative solar radiation (w m-2) 85 USE sbc_oce , ONLY : qsr_mean => qsr_mean !: daily mean solar heat flux 85 86 USE sbc_oce , ONLY : emp => emp !: freshwater budget: volume flux [Kg/m2/s] 86 87 USE sbc_oce , ONLY : emp_b => emp_b !: freshwater budget: volume flux [Kg/m2/s] … … 96 97 USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.) 97 98 USE sbcrnf , ONLY : h_rnf => h_rnf !: river runoff [Kg/m2/s] 99 USE sbcrnf , ONLY : nk_rnf => nk_rnf !: depth of runoff in model level 98 100 99 101 USE trc_oce … … 135 137 # endif 136 138 139 USE diaar5 , ONLY : lk_diaar5 => lk_diaar5 137 140 #else 138 141 !!---------------------------------------------------------------------- -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r5120 r5206 71 71 CALL top_alloc() ! allocate TOP arrays 72 72 73 #if defined key_offline 74 ltrcdm2dc = .FALSE. 75 #endif 76 77 IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' ) 73 IF( lk_offline ) ln_dm2dc = .FALSE. 78 74 79 75 IF( nn_cla == 1 ) & -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r4990 r5206 69 69 ENDIF 70 70 ! 71 IF( ltrcdm2dc ) THEN72 ! When Diurnal cycle, core bulk and LIM2 are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step73 ! and save qsr with diurnal cycle in qsr_tmp74 CALL wrk_alloc( jpi,jpj, zqsr_tmp )75 zqsr_tmp(:,:) = qsr (:,:)76 qsr (:,:) = qsr_mean(:,:)77 ENDIF78 !79 71 IF( nn_dttrc /= 1 ) CALL trc_sub_stp( kt ) ! averaging physical variables for sub-stepping 80 72 ! … … 106 98 ENDIF 107 99 ! 108 IF( ltrcdm2dc ) THEN109 ! put back qsr with diurnal cycle in qsr110 qsr(:,:) = zqsr_tmp(:,:)111 CALL wrk_dealloc( jpi,jpj, zqsr_tmp )112 ENDIF113 !114 100 ztrai = 0._wp ! content of all tracers 115 101 DO jn = 1, jptra
Note: See TracChangeset
for help on using the changeset viewer.