Changeset 5236 for branches/2015/dev_r5204_CNRS_PISCES_dcy
- Timestamp:
- 2015-04-24T14:08:11+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM
- Files:
-
- 22 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/ARCH/arch-X64_ADA.fcm
r4990 r5236 32 32 %HDF5_HOME /smplocal/pub/HDF5/1.8.9/par 33 33 %XIOS_HOME $WORKDIR/XIOS 34 %OASIS_HOME /not/yet/defined 34 ####%OASIS_HOME $WORKDIR/oasis3-mct/BLD 35 %OASIS_HOME /not/defined 35 36 36 37 %NCDF_INC -I%NCDF_HOME/include -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/CONFIG/SHARED/field_def.xml
r5206 r5236 262 262 <field id="qns_ice" long_name="non-solar heat flux at ice surface" unit="W/m2" /> 263 263 <field id="qtr_ice" long_name="solar heat flux transmitted thru the ice" unit="W/m2" /> 264 <field id="qsr_oce_mean" long_name="daily mean solar heat flux at ocean surface" unit="W/m2" />265 <field id="qsr_ice_mean" long_name="daily mean solar heat flux at ice surface" unit="W/m2" />266 <field id="qtr_ice_mean" long_name="daily meansolar heat flux transmitted thru the ice" unit="W/m2" />267 264 <field id="utau_ice" long_name="Wind stress along i-axis over the ice at i-point" unit="N/m2" /> 268 265 <field id="vtau_ice" long_name="Wind stress along j-axis over the ice at i-point" unit="N/m2" /> … … 648 645 <field id="CO3sat" long_name="CO3 saturation" unit="mol/m3" grid_ref="grid_T_3D" /> 649 646 <field id="PAR" long_name="Photosynthetically Available Radiation" unit="W/m2" grid_ref="grid_T_3D" /> 647 <field id="PARDM" long_name="Daily mean PAR" unit="W/m2" grid_ref="grid_T_3D" /> 650 648 <field id="PPPHY" long_name="Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 651 649 <field id="PPPHY2" long_name="Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" /> -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r5226 r5236 124 124 END SELECT ! 125 125 126 ! make calls for heat fluxes before it is modified127 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface128 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , qsr_ice(:,:,1) * pfrld(:,:) ) ! solar flux at ice surface129 IF( l_trcdm2dc ) THEN130 IF( iom_use('qsr_oce_mean') ) CALL iom_put( "qsr_oce_mean" , qsr_mean(:,:) * pfrld(:,:) ) ! daily mean solar flux at ocean surface131 IF( iom_use('qsr_ice_mean') ) CALL iom_put( "qsr_ice_mean" , qsr_ice_mean(:,:,1) * pfrld(:,:) ) ! daily mean solar flux at ice surface132 ENDIF133 126 !------------------------------------------! 134 127 ! heat flux at the ocean surface ! … … 269 262 IF( iom_use('icealb_cea' ) ) CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 270 263 ENDIF 271 272 ! daily mean qsr when diurnal cycle is applied on physics - for BGC models273 IF( l_trcdm2dc ) THEN274 ! computation the solar flux at ocean surface275 IF( lk_cpl ) THEN276 qsr_mean(:,:) = qsr_mean(:,:) + ( fstric_mean(:,:) - qsr_ice_mean(:,:,1) ) * ( 1.0 - pfrld(:,:) ) ! qsr_mean = qsr_tot277 ELSE278 qsr_mean(:,:) = pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_mean(:,:)279 ENDIF280 ENDIF281 282 264 283 265 IF(ln_ctl) THEN ! control print -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r5207 r5236 114 114 CALL wrk_alloc( jpi, jpj, jpk, zmsk ) 115 115 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 116 IF( kt == nit000 ) CALL lim_thd_init_2 120 117 121 118 !-------------------------------------------! … … 140 137 rdq_ice(:,:) = 0.e0 ! heat content associated with rdm_ice 141 138 zmsk (:,:,:) = 0.e0 142 !143 IF( l_trcdm2dc ) fstric_mean(:,:) = 0.e0 ! part of solar radiation absorbing inside the ice144 139 145 140 ! set to zero snow thickness smaller than epsi04 … … 289 284 CALL tab_2d_1d_2( nbpb, tbif_1d (1:nbpb , 3 ), tbif(:,:,3) , jpi, jpj, npb(1:nbpb) ) 290 285 CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb) , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) ) 291 IF( l_trcdm2dc ) &292 & CALL tab_2d_1d_2( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,1), jpi, jpj, npb(1:nbpb) )293 286 CALL tab_2d_1d_2( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) ) 294 287 CALL tab_2d_1d_2( nbpb, fr2_i0_1d (1:nbpb) , fr2_i0 , jpi, jpj, npb(1:nbpb) ) … … 340 333 CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) 341 334 CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) 342 IF( l_trcdm2dc ) THEN343 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 )345 ENDIF346 335 IF( .NOT. lk_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 347 336 ! -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r5207 r5236 18 18 USE ice_2 19 19 USE limistate_2 20 USE sbc_oce, ONLY : lk_cpl , l_trcdm2dc20 USE sbc_oce, ONLY : lk_cpl 21 21 USE in_out_manager 22 22 USE lib_mpp ! MPP library … … 273 273 END DO 274 274 275 IF( l_trcdm2dc )THEN276 !277 DO ji = kideb , kiut278 zihsn = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )279 zihic = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )280 zi0(ji) = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )281 zexp = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )282 fstbif_mean_1d(ji) = zi0(ji) * qsr_ice_mean_1d(ji) * zexp283 END DO284 !285 ENDIF286 287 275 !-------------------------------------------------------------------------------- 288 276 ! 4. Computation of the surface temperature : determined by considering the -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
r5206 r5236 55 55 fstbif_1d , & !: " " fstric 56 56 fltbif_1d , & !: " " ffltbif 57 fstbif_mean_1d, & !: " " fstric_mean58 57 fscbq_1d , & !: " " fscmcbq 59 58 qsr_ice_1d , & !: " " qsr_ice 60 qsr_ice_mean_1d , & !: " " qsr_ice_mean61 59 fr1_i0_1d , & !: " " fr1_i0 62 60 fr2_i0_1d , & !: " " fr2_i0 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5222 r5236 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 ) THEN121 IF( iom_use('qsr_oce_mean') ) CALL iom_put( "qsr_oce_mean" , qsr_mean(:,:) * pfrld(:,:) ) ! daily mean solar flux at ocean surface122 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 surface123 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 ice124 ENDIF125 120 126 121 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) … … 231 226 zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 232 227 END DO 233 ENDIF234 235 ! daily mean qsr when diurnal cycle is applied on physics - for BGC models236 IF( l_trcdm2dc ) THEN237 IF( lk_cpl ) THEN238 DO jj = 1, jpj239 DO ji = 1, jpi240 zfcm1 = qsr_mean(ji,jj)241 DO jl = 1, jpl242 zfcm1 = zfcm1 + ftr_ice_mean(ji,jj,jl) - qsr_ice_mean(ji,jj,jl) * a_i_b(ji,jj,jl)243 END DO244 qsr_mean(ji,jj) = zfcm1245 ENDDO246 ENDDO247 ELSE248 DO jj = 1, jpj249 DO ji = 1, jpi250 zfcm1 = pfrld(ji,jj) * qsr_mean(ji,jj)251 DO jl = 1, jpl252 zfcm1 = zfcm1 + ftr_ice_mean(ji,jj,jl)253 END DO254 qsr_mean(ji,jj) = zfcm1255 ENDDO256 ENDDO257 ENDIF258 228 ENDIF 259 229 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5207 r5236 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 102 100 ! conservation test 103 101 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) … … 580 578 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 581 579 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 582 IF( l_trcdm2dc ) THEN583 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 ENDIF586 580 IF( .NOT. lk_cpl ) THEN 587 581 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 679 673 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 680 674 ! 681 IF( l_trcdm2dc ) THEN682 CALL tab_1d_2d( nbpb, qsr_ice_mean(:,:,jl), npb, qsr_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 ENDIF685 !686 675 END SELECT 687 676 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5207 r5236 24 24 USE wrk_nemo ! work arrays 25 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 USE sbc_oce, ONLY : lk_cpl , l_trcdm2dc26 USE sbc_oce, ONLY : lk_cpl 27 27 28 28 IMPLICIT NONE … … 175 175 CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 176 176 CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 177 IF( l_trcdm2dc ) CALL wrk_alloc( jpij, zftrice_mean )178 177 179 178 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) … … 251 250 END DO 252 251 253 IF( l_trcdm2dc ) THEN254 DO ji = kideb , kiut255 zftrice_mean(ji) = qsr_ice_mean_1d(ji) * i0(ji) ! Solar radiation transmitted below the surface layer256 END DO257 ENDIF258 259 252 !--------------------------------------------------------- 260 253 ! Transmission - absorption of solar radiation in the ice … … 291 284 END DO 292 285 293 294 IF( l_trcdm2dc ) THEN295 DO ji = kideb , kiut296 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 , ht_i_1d(ji) ) ) ) &299 & * EXP( - zraext_s * ( MAX ( 0._wp , ht_s_1d(ji) ) ) )300 END DO301 ENDIF302 303 !304 286 !------------------------------------------------------------------------------| 305 287 ! 3) Iterative procedure begins | -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5206 r5236 58 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 59 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: daily mean solar heat flux over ice [W/m2]61 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 62 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] … … 152 151 #endif 153 152 ! 154 #if defined key_lim3 || defined key_lim2155 IF( l_trcdm2dc ) ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) )156 #endif157 !158 153 #if defined key_cice || defined key_lim2 159 154 IF( lk_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5222 r5236 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 INTEGER , PUBLIC :: n_cpl_qsr !: qsr coupling frequency per days 83 INTEGER , PUBLIC :: ncpl_qsr_freq !: qsr coupling frequency per days from atmosphere 85 84 ! 86 85 LOGICAL , PUBLIC :: lhftau = .FALSE. !: HF tau used in TKE: mean(stress module) - module(mean stress) … … 92 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s] 93 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2] 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: daily mean sea heat flux: solar [W/m2]95 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2] 96 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2] … … 146 144 ! 147 145 ALLOCATE( qns_tot(jpi,jpj) , qns (jpi,jpj) , qns_b(jpi,jpj), & 148 & qsr_tot(jpi,jpj) , qsr (jpi,jpj) , qsr_mean(jpi,jpj),&146 & qsr_tot(jpi,jpj) , qsr (jpi,jpj) , & 149 147 & emp (jpi,jpj) , emp_b(jpi,jpj) , & 150 148 & sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) ) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5206 r5236 22 22 !! blk_oce_core : computes momentum, heat and freshwater fluxes over ocean 23 23 !! blk_ice_core : computes momentum, heat and freshwater fluxes over ice 24 !! blk_bio_meanqsr : compute daily mean short wave radiation over the ocean25 !! blk_ice_meanqsr : compute daily mean short wave radiation over the ice26 24 !! turb_core_2z : Computes turbulent transfert coefficients 27 25 !! cd_neutral_10m : Estimate of the neutral drag coefficient at 10m … … 52 50 PUBLIC sbc_blk_core ! routine called in sbcmod module 53 51 PUBLIC blk_ice_core ! routine called in sbc_ice_lim module 54 PUBLIC blk_ice_meanqsr ! routine called in sbc_ice_lim module55 52 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 56 53 … … 195 192 ! ! compute the surface ocean fluxes using CORE bulk formulea 196 193 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 197 198 IF( l_trcdm2dc ) CALL blk_bio_meanqsr ! diurnal cycle : daily mean short waves flux for biogeochemistery199 194 200 195 #if defined key_cice … … 301 296 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 302 297 ENDIF 298 303 299 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 304 300 ! ----------------------------------------------------------------------------- ! … … 610 606 ! 611 607 END SUBROUTINE blk_ice_core 612 613 614 SUBROUTINE blk_bio_meanqsr615 !!---------------------------------------------------------------------616 !! *** ROUTINE blk_bio_meanqsr617 !!618 !! ** Purpose : provide daily qsr_mean for PISCES when619 !! analytic diurnal cycle is applied in physic620 !!621 !! ** Method : add part where there is no ice622 !!623 !!---------------------------------------------------------------------624 IF( nn_timing == 1 ) CALL timing_start('blk_bio_meanqsr')625 !626 qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1)627 !628 IF( nn_timing == 1 ) CALL timing_stop('blk_bio_meanqsr')629 !630 END SUBROUTINE blk_bio_meanqsr631 632 633 SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim )634 !!---------------------------------------------------------------------635 !!636 !! ** Purpose : provide the daily qsr_mean over sea_ice for PISCES when637 !! analytic diurnal cycle is applied in physic638 !!639 !! ** Method : compute qsr640 !!641 !!---------------------------------------------------------------------642 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%]643 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr_mean ! solar heat flux over ice (T-point) [W/m2]644 INTEGER , INTENT(in ) :: pdim ! number of ice categories645 !646 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays)647 INTEGER :: ji, jj, jl ! dummy loop indices648 REAL(wp) :: zztmp ! temporary variable649 !!---------------------------------------------------------------------650 IF( nn_timing == 1 ) CALL timing_start('blk_ice_meanqsr')651 !652 ijpl = pdim ! number of ice categories653 zztmp = 1. / ( 1. - albo )654 ! ! ========================== !655 DO jl = 1, ijpl ! Loop over ice categories !656 ! ! ========================== !657 DO jj = 1 , jpj658 DO ji = 1, jpi659 p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj)660 END DO661 END DO662 END DO663 !664 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_meanqsr')665 !666 END SUBROUTINE blk_ice_meanqsr667 668 608 669 609 SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU, & -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5225 r5236 135 135 136 136 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 137 138 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_tot_tmp ! arrays containing consecutives qsr in a day139 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: qsr_ice_tmp ! === ===140 137 141 138 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument … … 586 583 ENDIF 587 584 ! 588 n _cpl_qsr= INT( 86400 / ( cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) ) )589 ! 590 IF( ln_dm2dc .AND. n _cpl_qsr/= 1 ) &585 ncpl_qsr_freq = INT( 86400 / ( cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) ) ) 586 ! 587 IF( ln_dm2dc .AND. ncpl_qsr_freq /= 1 ) & 591 588 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 592 589 … … 1290 1287 ENDIF 1291 1288 ! 1292 IF( l_trcdm2dc ) CALL sbc_cpl_qsr_mean( it ) ! computation of daily mean qsr for biogeochemical model if needed1293 1294 ! ! ========================= !1295 1289 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 1296 1290 ! ! ========================= ! … … 1327 1321 END SUBROUTINE sbc_cpl_ice_flx 1328 1322 1329 SUBROUTINE sbc_cpl_qsr_mean( kt ) 1330 !!---------------------------------------------------------------------- 1331 !! *** ROUTINE sbc_cpl_mean *** 1332 !! 1333 !! ** Purpose : Compute daily mean qsr for biogeochmeical model in case of diurnal cycle 1334 !! 1335 !!---------------------------------------------------------------------- 1336 INTEGER, INTENT(in) :: kt 1337 INTEGER :: jn 1338 1339 IF( kt == nit000 ) THEN 1340 ALLOCATE( qsr_tot_tmp(jpi,jpj,n_cpl_qsr), qsr_ice_tmp(jpi,jpj,jpl,n_cpl_qsr) ) 1341 DO jn = 1, n_cpl_qsr 1342 qsr_tot_tmp(:,: ,jn) = qsr_tot(:,: ) 1343 qsr_ice_tmp(:,:,:,jn) = qsr_ice(:,:,:) 1344 ENDDO 1345 qsr_mean (:,: ) = qsr_tot(:,: ) 1346 qsr_ice_mean(:,:,:) = qsr_ice(:,:,:) 1347 ENDIF 1348 ! 1349 IF( kt /= nit000 .AND. nrcvinfo(jpr_qsroce) == OASIS_Rcv ) THEN ! => need to be done only when we receive the field 1350 DO jn = 1, n_cpl_qsr - 1 1351 qsr_tot_tmp(:,: ,jn) = qsr_tot_tmp(:,: ,jn+1) 1352 qsr_ice_tmp(:,:,:,jn) = qsr_ice_tmp(:,:,:,jn+1) 1353 ENDDO 1354 qsr_tot_tmp(:,: ,n_cpl_qsr ) = qsr_tot(:,: ) 1355 qsr_ice_tmp(:,:,:,n_cpl_qsr ) = qsr_ice(:,:,:) 1356 ! 1357 qsr_mean (:,: ) = SUM( qsr_tot_tmp(:,:,: ), 3 ) / n_cpl_qsr 1358 qsr_ice_mean(:,:,:) = SUM( qsr_ice_tmp(:,:,:,:), 4 ) / n_cpl_qsr 1359 ! 1360 ENDIF 1361 ! 1362 END SUBROUTINE sbc_cpl_qsr_mean 1363 1364 1323 1365 1324 SUBROUTINE sbc_cpl_snd( kt ) 1366 1325 !!---------------------------------------------------------------------- -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5222 r5236 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 )176 174 ! 177 175 CASE ( jp_cpl ) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r5222 r5236 195 195 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 196 196 197 IF( l_trcdm2dc ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl )198 199 197 CASE( jp_cpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 200 198 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5230 r5236 226 226 & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 227 227 ENDIF 228 229 228 ! ! Choice of the Surface Boudary Condition (set nsbc) 230 229 icpt = 0 … … 269 268 IF( nsbc == jp_cpl ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step 270 269 271 l_trcdm2dc = lk_top .AND. ( ln_dm2dc .OR. ( lk_cpl .AND. n_cpl_qsr /= 1 ) )272 IF( l_trcdm2dc .AND. lwp ) &273 & CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &274 & Computation of a daily mean shortwave for some biogeochemical models) ')275 276 270 END SUBROUTINE sbc_init 277 271 -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r5230 r5236 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 46 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue) 47 48 48 49 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) … … 76 77 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 77 78 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze kg, zekr, zekb, ze0, ze1, ze2, ze379 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 79 80 !!--------------------------------------------------------------------- 80 81 ! … … 83 84 ! Allocate temporary workspace 84 85 CALL wrk_alloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 85 CALL wrk_alloc( jpi, jpj, jpk, zpar, ze kg, zekr, zekb, ze0, ze1, ze2, ze3 )86 CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 86 87 87 88 IF( jnt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) … … 102 103 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 103 104 ! 104 zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)105 zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)106 zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)105 ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 106 ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 107 ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 107 108 END DO 108 109 END DO … … 110 111 ! !* Photosynthetically Available Radiation (PAR) 111 112 ! ! -------------------------------------- 112 IF( l n_dm2dc ) THEN ! diurnal cycle113 IF( l_trcdm2dc ) THEN ! diurnal cycle 113 114 ! 1% of qsr to compute euphotic layer 114 115 zqsr100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr 115 116 ! 116 CALL p4z_opt_par( kt, qsr_mean, ze kb, zekg, zekr, ze1, ze2, ze3 )117 CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 ) 117 118 ! 118 119 DO jk = 1, nksrp … … 122 123 END DO 123 124 ! 124 CALL p4z_opt_par( kt, qsr, ze kb, zekg, zekr, ze1, ze2, ze3 )125 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 125 126 ! 126 127 DO jk = 1, nksrp … … 132 133 zqsr100(:,:) = 0.01 * qsr(:,:) 133 134 ! 134 CALL p4z_opt_par( kt, qsr, ze kb, zekg, zekr, ze1, ze2, ze3 )135 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 135 136 ! 136 137 DO jk = 1, nksrp … … 145 146 IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics) 146 147 ! ! ------------------------ 147 CALL p4z_opt_par( kt, qsr, ze kb, zekg, zekr, ze1, ze2, ze3, pe0=ze0 )148 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 148 149 ! 149 150 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) … … 214 215 IF( lk_iomput ) THEN 215 216 IF( jnt == nrdttrc ) THEN 216 IF( iom_use( "Heup" ) ) CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 217 IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 217 IF( iom_use( "Heup" ) ) CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 218 IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 219 IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 218 220 ENDIF 219 221 ELSE … … 225 227 ! 226 228 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 )229 CALL wrk_dealloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 228 230 ! 229 231 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') … … 231 233 END SUBROUTINE p4z_opt 232 234 233 SUBROUTINE p4z_opt_par( kt, pqsr, pe kb, pekg, pekr, pe1, pe2, pe3, pe0 )235 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 ) 234 236 !!---------------------------------------------------------------------- 235 237 !! *** routine p4z_opt_par *** … … 242 244 INTEGER, INTENT(in) :: kt ! ocean time-step 243 245 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 246 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 246 247 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 … … 268 269 DO ji = 1, jpi 269 270 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 ) )271 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 272 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) 273 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) ) 273 274 END DO 274 275 ! … … 279 280 ELSE ! T- level 280 281 ! 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) )282 pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) ) 283 pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) 284 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 284 285 ! 285 286 DO jk = 2, nksrp … … 288 289 !CDIR NOVERRCHK 289 290 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) ) )291 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 292 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 293 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 293 294 END DO 294 295 END DO … … 402 403 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 403 404 ! 405 ekr (:,:,:) = 0._wp 406 ekb (:,:,:) = 0._wp 407 ekg (:,:,:) = 0._wp 404 408 etot (:,:,:) = 0._wp 405 409 etot_ndcy(:,:,:) = 0._wp … … 417 421 !! *** ROUTINE p4z_opt_alloc *** 418 422 !!---------------------------------------------------------------------- 419 ALLOCATE( enano (jpi,jpj,jpk), ediat(jpi,jpj,jpk), & 423 ALLOCATE( ekb(jpi,jpj,jpk) , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk), & 424 & enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk), & 420 425 & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 421 426 ! -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
r3680 r5236 63 63 INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration 64 64 INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration 65 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: (big)Silicate Concentration65 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration 66 66 INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration 67 67 INTEGER, PUBLIC, PARAMETER :: jpnum = 15 !: Big iron particles Concentration 68 68 INTEGER, PUBLIC, PARAMETER :: jpsfe = 16 !: number of particulate organic phosphate concentration 69 69 INTEGER, PUBLIC, PARAMETER :: jpdfe = 17 !: Diatoms iron Concentration 70 INTEGER, PUBLIC, PARAMETER :: jpgsi = 18 !: DiatomsSilicate Concentration70 INTEGER, PUBLIC, PARAMETER :: jpgsi = 18 !: (big) Silicate Concentration 71 71 INTEGER, PUBLIC, PARAMETER :: jpnfe = 19 !: Nano iron Concentration 72 72 INTEGER, PUBLIC, PARAMETER :: jpnch = 20 !: Nano Chlorophyll Concentration … … 102 102 INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration 103 103 INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration 104 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: (big)Silicate Concentration104 INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration 105 105 INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration 106 106 INTEGER, PUBLIC, PARAMETER :: jpbfe = 15 !: Big iron particles Concentration … … 108 108 INTEGER, PUBLIC, PARAMETER :: jpsfe = 17 !: Small iron particles Concentration 109 109 INTEGER, PUBLIC, PARAMETER :: jpdfe = 18 !: Diatoms iron Concentration 110 INTEGER, PUBLIC, PARAMETER :: jpgsi = 19 !: DiatomsSilicate Concentration110 INTEGER, PUBLIC, PARAMETER :: jpgsi = 19 !: (big) Silicate Concentration 111 111 INTEGER, PUBLIC, PARAMETER :: jpnfe = 20 !: Nano iron Concentration 112 112 INTEGER, PUBLIC, PARAMETER :: jpnch = 21 !: Nano Chlorophyll Concentration -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r5206 r5236 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 flux86 85 USE sbc_oce , ONLY : emp => emp !: freshwater budget: volume flux [Kg/m2/s] 87 86 USE sbc_oce , ONLY : emp_b => emp_b !: freshwater budget: volume flux [Kg/m2/s] 88 87 USE sbc_oce , ONLY : fmmflx => fmmflx !: freshwater budget: volume flux [Kg/m2/s] 89 88 USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s] 90 USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) 89 USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Diurnal Cycle 90 USE sbc_oce , ONLY : ncpl_qsr_freq => ncpl_qsr_freq !: qsr coupling frequency per days from atmospher 91 91 USE sbc_oce , ONLY : ln_rnf => ln_rnf !: runoffs / runoff mouths 92 92 USE sbc_oce , ONLY : fr_i => fr_i !: ice fraction (between 0 to 1) -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/trc.F90
r4990 r5236 44 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrui !: hor. gradient at u-points at top ocean level 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrvi !: hor. gradient at v-points at top ocean level 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: i-horizontal velocity average [m/s] 46 47 47 48 !! passive tracers (input and output) … … 56 57 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 57 58 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttrc !: vertical profile of passive tracer time step 58 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration59 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 59 60 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files 60 61 LOGICAL , PUBLIC :: ln_trcdmp !: internal damping flag 61 62 LOGICAL , PUBLIC :: ln_trcdmp_clo !: internal damping flag on closed seas 62 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 63 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 64 LOGICAL , PUBLIC :: l_trcdm2dc !: Diurnal cycle for TOP 63 65 64 66 !! information for outputs … … 189 191 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , & 190 192 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 191 & ln_trc_ini(jptra) , ln_trc_wri(jptra) 193 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , STAT = trc_alloc ) 192 194 193 195 IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays') -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r5209 r5236 70 70 71 71 CALL top_alloc() ! allocate TOP arrays 72 73 l_trcdm2dc = ln_dm2dc .OR. ( lk_cpl .AND. ncpl_qsr_freq /= 1 ) 74 l_trcdm2dc = l_trcdm2dc .AND. .NOT. lk_offline 75 IF( l_trcdm2dc .AND. lwp ) & 76 & CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 77 & Computation of a daily mean shortwave for some biogeochemical models) ') 72 78 73 79 IF( nn_cla == 1 ) & -
branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r5206 r5236 30 30 PUBLIC trc_stp ! called by step 31 31 32 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step 33 REAL(wp) :: rdt_sampl 34 INTEGER :: nb_rec_per_days 35 INTEGER :: isecfst, iseclast 36 LOGICAL :: llnew 37 32 38 !! * Substitutions 33 39 # include "domzgr_substitute.h90" … … 54 60 CHARACTER (len=25) :: charout 55 61 56 REAL(wp), DIMENSION(:,:), POINTER :: zqsr_tmp ! save qsr during TOP time-step57 62 !!------------------------------------------------------------------- 58 63 ! … … 68 73 areatot = glob_sum( cvol(:,:,:) ) 69 74 ENDIF 75 ! 76 IF( l_trcdm2dc ) CALL trc_mean_qsr( kt ) 70 77 ! 71 78 IF( nn_dttrc /= 1 ) CALL trc_sub_stp( kt ) ! averaging physical variables for sub-stepping … … 109 116 END SUBROUTINE trc_stp 110 117 118 SUBROUTINE trc_mean_qsr( kt ) 119 !!---------------------------------------------------------------------- 120 !! *** ROUTINE trc_mean_qsr *** 121 !! 122 !! ** Purpose : Compute daily mean qsr for biogeochmeical model in case 123 !! of diurnal cycle 124 !! 125 !! ** Method : Store qsr coming from ocean every at 1 hour of every 126 !! coupling frequency in coupled mode, in one day 127 !! Compute the daily mean qsr 128 !!---------------------------------------------------------------------- 129 INTEGER, INTENT(in) :: kt 130 INTEGER :: jn 131 132 IF( kt == nittrc000 ) THEN 133 IF( lk_cpl ) THEN 134 rdt_sampl = 86400. / ncpl_qsr_freq 135 nb_rec_per_days = ncpl_qsr_freq 136 ELSE 137 rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 138 nb_rec_per_days = INT( 86400 / rdt_sampl ) 139 ENDIF 140 ! 141 IF( lwp ) THEN 142 WRITE(numout,*) 143 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_days 144 WRITE(numout,*) 145 ENDIF 146 ! 147 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 148 DO jn = 1, nb_rec_per_days 149 qsr_arr(:,:,jn) = qsr(:,:) 150 ENDDO 151 qsr_mean(:,:) = qsr(:,:) 152 ! 153 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 154 iseclast = isecfst 155 ! 156 ENDIF 157 ! 158 iseclast = nsec_year + nsec1jan000 159 llnew = ( iseclast - isecfst ) > INT( rdt_sampl ) ! new shortwave to store 160 IF( kt /= nittrc000 .AND. llnew ) THEN 161 IF( lwp ) WRITE(numout,9000) ' New shortwave to sample for TOP at time kt = ', kt, & 162 & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 163 isecfst = iseclast 164 DO jn = 1, nb_rec_per_days - 1 165 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 166 ENDDO 167 qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 168 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:) , 3 ) / nb_rec_per_days 169 ENDIF 170 ! 171 9000 FORMAT(i10,f10.1) 172 ! 173 END SUBROUTINE trc_mean_qsr 174 111 175 #else 112 176 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.