New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5236 for branches/2015/dev_r5204_CNRS_PISCES_dcy – NEMO

Ignore:
Timestamp:
2015-04-24T14:08:11+02:00 (9 years ago)
Author:
cetlod
Message:

NEMOGCM_dev_r5204_CNRS_PISCES_dcy : update routines according to the new strategy, see ticket #1484

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  
    3232%HDF5_HOME           /smplocal/pub/HDF5/1.8.9/par 
    3333%XIOS_HOME           $WORKDIR/XIOS 
    34 %OASIS_HOME          /not/yet/defined 
     34####%OASIS_HOME          $WORKDIR/oasis3-mct/BLD 
     35%OASIS_HOME          /not/defined 
    3536 
    3637%NCDF_INC            -I%NCDF_HOME/include  
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/CONFIG/SHARED/field_def.xml

    r5206 r5236  
    262262         <field id="qns_ice"      long_name="non-solar heat flux at ice surface"                           unit="W/m2"     /> 
    263263         <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"     /> 
    267264         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     /> 
    268265         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     /> 
     
    648645       <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" /> 
    649646       <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" /> 
    650648       <field id="PPPHY"       long_name="Primary production of nanophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    651649       <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  
    124124      END SELECT                                 !     
    125125 
    126       ! make calls for heat fluxes before it is modified 
    127       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
    128       IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , qsr_ice(:,:,1) * pfrld(:,:) ) !     solar flux at ice surface 
    129       IF( l_trcdm2dc ) THEN 
    130         IF( iom_use('qsr_oce_mean') )   CALL iom_put( "qsr_oce_mean" , qsr_mean(:,:) * pfrld(:,:) )   !   daily mean solar flux at ocean surface 
    131         IF( iom_use('qsr_ice_mean') )   CALL iom_put( "qsr_ice_mean" , qsr_ice_mean(:,:,1) * pfrld(:,:) ) !  daily mean solar flux at ice surface 
    132       ENDIF 
    133126      !------------------------------------------! 
    134127      !      heat flux at the ocean surface      ! 
     
    269262         IF( iom_use('icealb_cea' ) )   CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
    270263      ENDIF 
    271  
    272       !   daily mean qsr when diurnal cycle is applied on physics - for BGC models 
    273       IF( l_trcdm2dc ) THEN  
    274          !   computation the solar flux at ocean surface 
    275          IF( lk_cpl ) THEN 
    276             qsr_mean(:,:) = qsr_mean(:,:) + ( fstric_mean(:,:) - qsr_ice_mean(:,:,1) ) * ( 1.0 - pfrld(:,:) )  ! qsr_mean = qsr_tot 
    277          ELSE 
    278             qsr_mean(:,:) =  pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_mean(:,:) 
    279          ENDIF 
    280       ENDIF 
    281  
    282264 
    283265      IF(ln_ctl) THEN            ! control print 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r5207 r5236  
    114114      CALL wrk_alloc( jpi, jpj, jpk, zmsk ) 
    115115 
    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 
    120117    
    121118      !-------------------------------------------! 
     
    140137      rdq_ice(:,:) = 0.e0   ! heat content associated with rdm_ice 
    141138      zmsk (:,:,:) = 0.e0 
    142       ! 
    143       IF( l_trcdm2dc  ) fstric_mean(:,:) = 0.e0   ! part of solar radiation absorbing inside the ice 
    144139 
    145140      ! set to zero snow thickness smaller than epsi04 
     
    289284         CALL tab_2d_1d_2( nbpb, tbif_1d    (1:nbpb , 3 ), tbif(:,:,3)    , jpi, jpj, npb(1:nbpb) ) 
    290285         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) ) 
    293286         CALL tab_2d_1d_2( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0         , jpi, jpj, npb(1:nbpb) ) 
    294287         CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0         , jpi, jpj, npb(1:nbpb) ) 
     
    340333         CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb)  , jpi, jpj ) 
    341334         CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb)  , jpi, jpj ) 
    342          IF( l_trcdm2dc ) THEN 
    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 ) 
    345          ENDIF 
    346335         IF( .NOT. lk_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 
    347336         ! 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r5207 r5236  
    1818   USE ice_2 
    1919   USE limistate_2 
    20    USE sbc_oce, ONLY : lk_cpl, l_trcdm2dc 
     20   USE sbc_oce, ONLY : lk_cpl 
    2121   USE in_out_manager 
    2222   USE lib_mpp          ! MPP library 
     
    273273       END DO 
    274274 
    275        IF( l_trcdm2dc )THEN 
    276           ! 
    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 ) ) 
    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) * zexp 
    283           END DO 
    284           ! 
    285        ENDIF 
    286  
    287275       !-------------------------------------------------------------------------------- 
    288276       !  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  
    5555      fstbif_1d   ,     &  !:    "                  "      fstric 
    5656      fltbif_1d   ,     &  !:    "                  "      ffltbif 
    57       fstbif_mean_1d,   & !:    "                   "      fstric_mean 
    5857      fscbq_1d    ,     &  !:    "                  "      fscmcbq 
    5958      qsr_ice_1d  ,     &  !:    "                  "      qsr_ice 
    60       qsr_ice_mean_1d , &  !:    "                  "      qsr_ice_mean 
    6159      fr1_i0_1d   ,     &  !:    "                  "      fr1_i0 
    6260      fr2_i0_1d   ,     &  !:    "                  "      fr2_i0 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5222 r5236  
    118118      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
    119119      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 
    125120 
    126121      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
     
    231226             zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 
    232227          END DO 
    233       ENDIF 
    234  
    235       !   daily mean qsr when diurnal cycle is applied on physics - for BGC models 
    236       IF( l_trcdm2dc ) THEN 
    237          IF( lk_cpl ) THEN  
    238             DO jj = 1, jpj 
    239                DO ji = 1, jpi 
    240                   zfcm1 = qsr_mean(ji,jj) 
    241                   DO jl = 1, jpl 
    242                     zfcm1 = zfcm1 + ftr_ice_mean(ji,jj,jl) - qsr_ice_mean(ji,jj,jl) * a_i_b(ji,jj,jl) 
    243                  END DO 
    244                  qsr_mean(ji,jj) = zfcm1                                       
    245                ENDDO 
    246             ENDDO 
    247          ELSE 
    248             DO jj = 1, jpj 
    249                DO ji = 1, jpi 
    250                   zfcm1 = pfrld(ji,jj) * qsr_mean(ji,jj) 
    251                   DO jl = 1, jpl 
    252                      zfcm1 = zfcm1 + ftr_ice_mean(ji,jj,jl) 
    253                   END DO 
    254                   qsr_mean(ji,jj) = zfcm1                                       
    255                ENDDO 
    256             ENDDO 
    257          ENDIF 
    258228      ENDIF 
    259229 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5207 r5236  
    9898      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    9999 
    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  
    102100      ! conservation test 
    103101      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     
    580578         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    581579         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 
    586580         IF( .NOT. lk_cpl ) THEN 
    587581            CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     
    679673         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    680674         !          
    681          IF( l_trcdm2dc )  THEN 
    682             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          ENDIF 
    685          ! 
    686675      END SELECT 
    687676 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r5207 r5236  
    2424   USE wrk_nemo       ! work arrays 
    2525   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    26    USE sbc_oce, ONLY : lk_cpl, l_trcdm2dc 
     26   USE sbc_oce, ONLY : lk_cpl 
    2727 
    2828   IMPLICIT NONE 
     
    175175      CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis  ) 
    176176      CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 
    177       IF( l_trcdm2dc )  CALL wrk_alloc( jpij, zftrice_mean ) 
    178177 
    179178      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
     
    251250      END DO 
    252251 
    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  
    259252      !--------------------------------------------------------- 
    260253      ! Transmission - absorption of solar radiation in the ice 
     
    291284      END DO 
    292285 
    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 , ht_i_1d(ji) ) ) ) & 
    299                  &                             * EXP( - zraext_s   * ( MAX ( 0._wp , ht_s_1d(ji) ) ) ) 
    300          END DO 
    301       ENDIF 
    302  
    303       ! 
    304286      !------------------------------------------------------------------------------| 
    305287      !  3) Iterative procedure begins                                               | 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r5206 r5236  
    5858   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2] 
    5959   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] 
    6160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2] 
    6261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K] 
     
    152151#endif 
    153152         ! 
    154 #if defined key_lim3 || defined key_lim2  
    155       IF( l_trcdm2dc )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 
    156 #endif 
    157          ! 
    158153#if defined key_cice || defined key_lim2 
    159154      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  
    8181   !!              Ocean Surface Boundary Condition fields 
    8282   !!---------------------------------------------------------------------- 
    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 
    8584   ! 
    8685   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress) 
     
    9291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
    9392   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] 
    9593   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
    9694   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2] 
     
    146144         ! 
    147145      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) ,                        & 
    149147         &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        & 
    150148         &      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  
    2222   !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean 
    2323   !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice 
    24    !!   blk_bio_meanqsr : compute daily mean short wave radiation over the ocean 
    25    !!   blk_ice_meanqsr : compute daily mean short wave radiation over the ice 
    2624   !!   turb_core_2z    : Computes turbulent transfert coefficients 
    2725   !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m 
     
    5250   PUBLIC   sbc_blk_core         ! routine called in sbcmod module 
    5351   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
    54    PUBLIC   blk_ice_meanqsr      ! routine called in sbc_ice_lim module 
    5552   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    5653 
     
    195192      !                                            ! compute the surface ocean fluxes using CORE bulk formulea 
    196193      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 biogeochemistery 
    199194 
    200195#if defined key_cice 
     
    301296      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    302297      ENDIF 
     298 
    303299      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    304300      ! ----------------------------------------------------------------------------- ! 
     
    610606      ! 
    611607   END SUBROUTINE blk_ice_core 
    612  
    613  
    614    SUBROUTINE blk_bio_meanqsr 
    615       !!--------------------------------------------------------------------- 
    616       !!                     ***  ROUTINE blk_bio_meanqsr 
    617       !!                      
    618       !! ** Purpose :   provide daily qsr_mean for PISCES when 
    619       !!                analytic diurnal cycle is applied in physic 
    620       !!                 
    621       !! ** Method  :   add part where there is no ice 
    622       !!  
    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_meanqsr 
    631   
    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 when 
    637       !!                analytic diurnal cycle is applied in physic 
    638       !! 
    639       !! ** Method  :   compute qsr 
    640       !!  
    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 categories 
    645       ! 
    646       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    647       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    648       REAL(wp) ::   zztmp         ! temporary variable 
    649       !!--------------------------------------------------------------------- 
    650       IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr') 
    651       ! 
    652       ijpl  = pdim                            ! number of ice categories 
    653       zztmp = 1. / ( 1. - albo ) 
    654       !                                     ! ========================== ! 
    655       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    656          !                                  ! ========================== ! 
    657          DO jj = 1 , jpj 
    658             DO ji = 1, jpi 
    659                   p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
    660             END DO 
    661          END DO 
    662       END DO 
    663       ! 
    664       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr') 
    665       ! 
    666    END SUBROUTINE blk_ice_meanqsr   
    667  
    668608 
    669609   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  
    135135 
    136136   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 day 
    139    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: qsr_ice_tmp     !  ===                        ===  
    140137 
    141138   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
     
    586583      ENDIF 
    587584      ! 
    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 )   & 
    591588         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    592589 
     
    12901287      ENDIF 
    12911288      ! 
    1292       IF( l_trcdm2dc )  CALL sbc_cpl_qsr_mean( it )    ! computation of daily mean qsr for biogeochemical model if needed 
    1293  
    1294       !                                                      ! ========================= ! 
    12951289      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        ! 
    12961290      !                                                      ! ========================= ! 
     
    13271321   END SUBROUTINE sbc_cpl_ice_flx 
    13281322 
    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 
    13651324   SUBROUTINE sbc_cpl_snd( kt ) 
    13661325      !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5222 r5236  
    172172            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    173173               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    174  
    175             IF( l_trcdm2dc )       CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
    176174            ! 
    177175         CASE ( jp_cpl ) 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r5222 r5236  
    195195               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    196196 
    197             IF( l_trcdm2dc )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
    198  
    199197         CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    200198            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  
    226226         & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 
    227227      ENDIF  
    228        
    229228      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    230229      icpt = 0 
     
    269268      IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
    270269       
    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  
    276270   END SUBROUTINE sbc_init 
    277271 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r5230 r5236  
    4545   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle 
    4646   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) 
    4748 
    4849   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     
    7677      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    7778      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, zekg, zekr, zekb, ze0, ze1, ze2, ze3 
     79      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 
    7980      !!--------------------------------------------------------------------- 
    8081      ! 
     
    8384      ! Allocate temporary workspace 
    8485      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      CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 
    8687 
    8788      IF( jnt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 
     
    102103               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    103104               !                                                          
    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) 
    107108            END DO 
    108109         END DO 
     
    110111      !                                        !* Photosynthetically Available Radiation (PAR) 
    111112      !                                        !  -------------------------------------- 
    112       IF( ln_dm2dc ) THEN                     !  diurnal cycle 
     113      IF( l_trcdm2dc ) THEN                     !  diurnal cycle 
    113114         ! 1% of qsr to compute euphotic layer 
    114115         zqsr100(:,:) = 0.01 * qsr_mean(:,:)     !  daily mean qsr 
    115116         ! 
    116          CALL p4z_opt_par( kt, qsr_mean, zekb, zekg, zekr, ze1, ze2, ze3 )  
     117         CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 )  
    117118         ! 
    118119         DO jk = 1, nksrp       
     
    122123         END DO 
    123124         ! 
    124          CALL p4z_opt_par( kt, qsr, zekb, zekg, zekr, ze1, ze2, ze3 )  
     125         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )  
    125126         ! 
    126127         DO jk = 1, nksrp       
     
    132133         zqsr100(:,:) = 0.01 * qsr(:,:) 
    133134         ! 
    134          CALL p4z_opt_par( kt, qsr, zekb, zekg, zekr, ze1, ze2, ze3 )  
     135         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )  
    135136         ! 
    136137         DO jk = 1, nksrp       
     
    145146      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics) 
    146147         !                                     !  ------------------------ 
    147          CALL p4z_opt_par( kt, qsr, zekb, zekg, zekr, ze1, ze2, ze3, pe0=ze0 ) 
     148         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 
    148149         ! 
    149150         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
     
    214215      IF( lk_iomput ) THEN 
    215216        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 
    218220        ENDIF 
    219221      ELSE 
     
    225227      ! 
    226228      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 ) 
    228230      ! 
    229231      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt') 
     
    231233   END SUBROUTINE p4z_opt 
    232234 
    233    SUBROUTINE p4z_opt_par( kt, pqsr, pekb, pekg, pekr, pe1, pe2, pe3, pe0 )  
     235   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 )  
    234236      !!---------------------------------------------------------------------- 
    235237      !!                  ***  routine p4z_opt_par  *** 
     
    242244      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step 
    243245      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) 
    245246      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B) 
    246247      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0   
     
    268269               DO ji = 1, jpi 
    269270                  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 ) ) 
    273274               END DO 
    274275              ! 
     
    279280      ELSE   ! T- level 
    280281        ! 
    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) ) 
    284285        ! 
    285286        DO jk = 2, nksrp       
     
    288289!CDIR NOVERRCHK 
    289290              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) ) ) 
    293294              END DO 
    294295           END DO 
     
    402403      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 
    403404      ! 
     405                         ekr      (:,:,:) = 0._wp 
     406                         ekb      (:,:,:) = 0._wp 
     407                         ekg      (:,:,:) = 0._wp 
    404408                         etot     (:,:,:) = 0._wp 
    405409                         etot_ndcy(:,:,:) = 0._wp 
     
    417421      !!                     ***  ROUTINE p4z_opt_alloc  *** 
    418422      !!---------------------------------------------------------------------- 
    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), & 
    420425        &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc )  
    421426         ! 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r3680 r5236  
    6363   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
    6464   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
    65    INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration 
     65   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration 
    6666   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
    6767   INTEGER, PUBLIC, PARAMETER ::   jpnum = 15    !: Big iron particles Concentration 
    6868   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 16    !: number of particulate organic phosphate concentration 
    6969   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 17    !: Diatoms iron Concentration 
    70    INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: Diatoms Silicate Concentration 
     70   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: (big) Silicate Concentration 
    7171   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 19    !: Nano iron Concentration 
    7272   INTEGER, PUBLIC, PARAMETER ::   jpnch = 20    !: Nano Chlorophyll Concentration 
     
    102102   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
    103103   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
    104    INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration 
     104   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration 
    105105   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
    106106   INTEGER, PUBLIC, PARAMETER ::   jpbfe = 15    !: Big iron particles Concentration 
     
    108108   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 17    !: Small iron particles Concentration 
    109109   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 18    !: Diatoms iron Concentration 
    110    INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: Diatoms Silicate Concentration 
     110   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: (big) Silicate Concentration 
    111111   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 20    !: Nano iron Concentration 
    112112   INTEGER, PUBLIC, PARAMETER ::   jpnch = 21    !: Nano Chlorophyll Concentration 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5206 r5236  
    8383   USE sbc_oce , ONLY :   wndm       =>    wndm       !: 10m wind speed  
    8484   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 
    8685   USE sbc_oce , ONLY :   emp        =>    emp        !: freshwater budget: volume flux               [Kg/m2/s] 
    8786   USE sbc_oce , ONLY :   emp_b      =>    emp_b      !: freshwater budget: volume flux               [Kg/m2/s] 
    8887   USE sbc_oce , ONLY :   fmmflx     =>    fmmflx     !: freshwater budget: volume flux               [Kg/m2/s] 
    8988   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 
    9191   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths 
    9292   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  
    4444   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level 
    4545   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] 
    4647    
    4748   !! passive tracers  (input and output) 
     
    5657   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
    5758   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
    58    LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
     59   LOGICAL             , PUBLIC                                    ::  ln_top_euler   !: boolean term for euler integration  
    5960   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
    6061   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag 
    6162   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 
    6365 
    6466   !! information for outputs 
     
    189191         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
    190192         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
    191          &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )   
     193         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra) , qsr_mean(jpi,jpj)         ,  STAT = trc_alloc  )   
    192194 
    193195      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  
    7070 
    7171      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) ') 
    7278 
    7379      IF( nn_cla == 1 )   & 
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r5206 r5236  
    3030   PUBLIC   trc_stp    ! called by step 
    3131 
     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 
    3238   !! * Substitutions 
    3339#  include "domzgr_substitute.h90" 
     
    5460      CHARACTER (len=25)    ::  charout  
    5561 
    56       REAL(wp), DIMENSION(:,:), POINTER ::   zqsr_tmp ! save qsr during TOP time-step 
    5762      !!------------------------------------------------------------------- 
    5863      ! 
     
    6873         areatot         = glob_sum( cvol(:,:,:) ) 
    6974      ENDIF 
     75      ! 
     76      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt ) 
    7077      !     
    7178      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
     
    109116   END SUBROUTINE trc_stp 
    110117 
     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 
    111175#else 
    112176   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.