Changeset 4758 for LMDZ6/branches


Ignore:
Timestamp:
Dec 1, 2023, 10:09:29 PM (6 months ago)
Author:
idelkadi
Message:
Location:
LMDZ6/branches/LMDZ_ECRad/libf/phylmd
Files:
18 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/clesphys.h

    r4727 r4758  
    109109!AI flags pour ECRAD       
    110110       LOGICAL :: ok_3Deffect
    111        CHARACTER(len=512) :: namelist_ecrad_file
    112111
    113112       COMMON/clesphys/                                                 &
    … …  
    162161     &     , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
    163162     &     ,  iflag_thermals,nsplit_thermals, tau_thermals              &
    164      &     , iflag_physiq, ok_3Deffect, namelist_ecrad_file
     163     &     , iflag_physiq, ok_3Deffect
    165164       save /clesphys/
    166165!$OMP THREADPRIVATE(/clesphys/)

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/CHANGELOG

    r4728 r4758  
    1313          saves look-up table averaged to the bands of the radiation scheme
    1414          (general cloud optics only)
     15        - Increased security value in single-precision SW
     16          reflectance-transmittance calculation from 1e-12 to 1e-6
    1517
    1618version 1.6.0 (27 April 2023)

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_aerosol_optics.F90

    r4728 r4758  
    3737    use yomhook,                       only : lhook, dr_hook, jphook
    3838    use radiation_config,              only : config_type
    39     use radiation_aerosol_optics_data, only : aerosol_optics_type, &
    40          data_setup_aerosol_optics => setup_aerosol_optics
     39    use radiation_aerosol_optics_data, only : aerosol_optics_type
    4140    use radiation_io,                  only : nulerr, radiation_abort
    4241
    … …  
    5857        ! Read file containing optical properties already in the bands
    5958        ! of the gas-optics scheme
    60          if (.not. associated(config%aerosol_optics%setup)) &
    61               config%aerosol_optics%setup => data_setup_aerosol_optics
    6259        call config%aerosol_optics%setup(trim(config%aerosol_optics_file_name), &
    6360             &                           iverbose=config%iverbosesetup)
    … …  
    346343    use easy_netcdf,                   only : netcdf_file
    347344    use radiation_config,              only : config_type
    348     use radiation_aerosol_optics_data, only : aerosol_optics_type, &
    349          data_setup_aerosol_optics => setup_aerosol_optics
     345    use radiation_aerosol_optics_data, only : aerosol_optics_type
    350346    use radiation_spectral_definition, only : SolarReferenceTemperature, &
    351347         &                                    TerrestrialReferenceTemperature
    … …  
    374370    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics_legacy',0,hook_handle)
    375371    ao => config%aerosol_optics
    376     ao_legacy%setup => data_setup_aerosol_optics
    377372
    378373    ! Load file into a local structure

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_data.F90

    r4728 r4758  
    135135     logical :: use_monochromatic = .false.
    136136
    137      procedure(setup_aerosol_optics), pointer:: setup => null()
    138 
    139137   contains
     138     procedure :: setup => setup_aerosol_optics
    140139     procedure :: save  => save_aerosol_optics
    141140     procedure :: allocate

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_cloud.F90

    r4728 r4758  
    6464    ! gridbox area for use in representing 3D effects. This variable
    6565    ! is dimensioned (ncol,nlev).
    66     real(jprb), allocatable, dimension(:,:) :: inv_cloud_effective_size ! m-1
     66    real(jprb), allocatable,  dimension(:,:) :: inv_cloud_effective_size ! m-1
    6767
    6868    ! Similarly for the in-cloud heterogeneities, used to compute the
    … …  
    606606
    607607    use yomhook,                  only : lhook, dr_hook, jphook
     608!    USE mod_phys_lmdz_para
    608609
    609610    class(cloud_type), intent(inout) :: this

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_cloud_generator.F90

    r4728 r4758  
    540540    use radiation_pdf_sampler, only : pdf_sampler_type
    541541    implicit none
    542 #if defined(__GFORTRAN__) || defined(__PGI) || defined(__NEC__)
    543 #else
    544     !$omp declare simd(sample_from_pdf_simd) uniform(this) &
    545     !$omp linear(ref(fsd)) linear(ref(cdf))
    546 #endif
     542!#if defined(__GFORTRAN__) || defined(__PGI) || defined(__NEC__)
     543!#else
     544!    !$omp declare simd(sample_from_pdf_simd) uniform(this) &
     545!    !$omp linear(ref(fsd)) linear(ref(cdf))
     546!#endif
    547547    type(pdf_sampler_type), intent(in)  :: this
    548548

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_ecckd_interface.F90

    r4728 r4758  
    5757      end if
    5858
    59       if (allocated(config%i_band_from_g_sw)) deallocate(config%i_band_from_g_sw)
    60        allocate(config%i_band_from_g_sw          (config%n_g_sw))
    61       if (allocated(config%i_band_from_reordered_g_sw)) deallocate(config%i_band_from_reordered_g_sw)
    62        allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
    63       if (allocated(config%i_g_from_reordered_g_sw)) deallocate(config%i_g_from_reordered_g_sw)
    64        allocate(config%i_g_from_reordered_g_sw   (config%n_g_sw))
     59!      if (allocated(config%i_band_from_g_sw)) deallocate(config%i_band_from_g_sw)
     60!      allocate(config%i_band_from_g_sw(config%n_g_sw))
     61!      if (allocated(config%i_band_from_reordered_g_sw)) deallocate(config%i_band_from_reordered_g_sw)
     62!      allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
     63!      if (allocated(config%i_g_from_reordered_g_sw)) deallocate(config%i_g_from_reordered_g_sw)
     64!      allocate(config%i_g_from_reordered_g_sw(config%n_g_sw))
     65      if (.not.allocated(config%i_band_from_g_sw)) &
     66              allocate(config%i_band_from_g_sw(config%n_g_sw))
     67      if (.not.allocated(config%i_band_from_reordered_g_sw)) &
     68              allocate(config%i_band_from_reordered_g_sw(config%n_g_sw))
     69      if (.not.allocated(config%i_g_from_reordered_g_sw)) &
     70              allocate(config%i_g_from_reordered_g_sw(config%n_g_sw))
    6571       
    6672      if (config%do_cloud_aerosol_per_sw_g_point) then
    … …  
    105111      end if
    106112
    107       if (allocated(config%i_band_from_g_lw)) deallocate(config%i_band_from_g_lw)
    108        allocate(config%i_band_from_g_lw          (config%n_g_lw))
    109       if (allocated(config%i_band_from_reordered_g_lw)) deallocate(config%i_band_from_reordered_g_lw)
    110        allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
    111       if (allocated(config%i_g_from_reordered_g_lw)) deallocate(config%i_g_from_reordered_g_lw)
    112        allocate(config%i_g_from_reordered_g_lw   (config%n_g_lw))
     113!      if (allocated(config%i_band_from_g_lw)) deallocate(config%i_band_from_g_lw)
     114!      allocate(config%i_band_from_g_lw          (config%n_g_lw))
     115!      if (allocated(config%i_band_from_reordered_g_lw)) deallocate(config%i_band_from_reordered_g_lw)
     116!      allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
     117!      if (allocated(config%i_g_from_reordered_g_lw)) deallocate(config%i_g_from_reordered_g_lw)
     118!      allocate(config%i_g_from_reordered_g_lw   (config%n_g_lw))
     119      if (.not.allocated(config%i_band_from_g_lw)) &
     120         allocate(config%i_band_from_g_lw          (config%n_g_lw))
     121      if (.not.allocated(config%i_band_from_reordered_g_lw)) &
     122         allocate(config%i_band_from_reordered_g_lw(config%n_g_lw))
     123      if (.not.allocated(config%i_g_from_reordered_g_lw)) &
     124         allocate(config%i_g_from_reordered_g_lw   (config%n_g_lw))
     125
    113126
    114127      if (config%do_cloud_aerosol_per_lw_g_point) then

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_general_cloud_optics.F90

    r4728 r4758  
    7575    ! Allocate structures
    7676    if (config%do_sw) then
    77      if (allocated(config%cloud_optics_sw)) deallocate(config%cloud_optics_sw)      
     77      if (allocated(config%cloud_optics_sw)) deallocate(config%cloud_optics_sw)     
    7878      allocate(config%cloud_optics_sw(config%n_cloud_types))
    7979    end if
    8080
    8181    if (config%do_lw) then
    82      if (allocated(config%cloud_optics_lw)) deallocate(config%cloud_optics_lw)      
     82      if (allocated(config%cloud_optics_lw)) deallocate(config%cloud_optics_lw)     
    8383      allocate(config%cloud_optics_lw(config%n_cloud_types))
    8484    end if

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_interface.F90

    r4728 r4758  
    227227    use radiation_general_cloud_optics, only : general_cloud_optics
    228228    use radiation_aerosol_optics, only : add_aerosol_optics
     229    USE mod_phys_lmdz_para
     230
    229231
    230232    ! Inputs
    … …  
    236238    type(thermodynamics_type),intent(in)   :: thermodynamics
    237239    type(gas_type),           intent(in)   :: gas
    238     type(cloud_type),         intent(inout):: cloud
     240    type(cloud_type),        intent(inout):: cloud
    239241    type(aerosol_type),       intent(in)   :: aerosol
    240242    ! Output
    … …  
    295297
    296298    real(jphook) :: hook_handle
     299    integer :: jcol, jlev
    297300
    298301    if (lhook) call dr_hook('radiation_interface:radiation',0,hook_handle)
     302
     303    if (config%i_solver_sw == ISolverSPARTACUS) then
     304         print*,'Dans radiation, mpi_rank, omp_rank, size, chape inv_cloud = ',&
     305              mpi_rank, omp_rank, &
     306              shape(cloud%inv_cloud_effective_size), &
     307              size(cloud%inv_cloud_effective_size)   
     308!         do jcol=istartcol, iendcol
     309!              do jlev=1,nlev
     310!              print*,'Entree radiation_interf, mpi_rank, omp_rank, jcol, jlev &
     311!           &  cloud%inv_cloud_effective_size =',mpi_rank, omp_rank, jcol, jlev, &
     312!           &  cloud%inv_cloud_effective_size(jcol,jlev)
     313!              enddo
     314!          enddo
     315    endif
     316!    cloud%inv_cloud_effective_size=0.05_jprb
    299317
    300318    if (thermodynamics%pressure_hl(istartcol,2) &
    … …  
    456474        else if (config%i_solver_sw == ISolverSPARTACUS) then
    457475          ! Compute fluxes using the SPARTACUS shortwave solver
     476!             cloud%inv_cloud_effective_size=0.05_jprb
     477!             do jcol=istartcol, iendcol
     478!              do jlev=1,nlev
     479!              print*,'jcol, jlev, dans radiation_interf i &
     480!               &       cloud%inv_cloud_effective_size =',jcol, jlev, &
     481!               cloud%inv_cloud_effective_size(jcol,jlev)
     482!              enddo
     483!             enddo
    458484          call solver_spartacus_sw(nlev,istartcol,iendcol, &
    459485               &  config, single_level, thermodynamics, cloud, &

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_spartacus_sw.F90

    r4728 r4758  
    8787    use radiation_constants, only      : Pi, GasConstantDryAir, &
    8888         &                               AccelDueToGravity
     89    USE mod_phys_lmdz_para
    8990
    9091    implicit none
    … …  
    326327      write(nulout,'(a)',advance='no') '  Processing columns'
    327328    end if
     329
     330      print*,'Dans radiation_spartacus, mpi_rank, omp_rank, &
     331              size, chape inv_cloud = ',&
     332              mpi_rank, omp_rank, &
     333              shape(cloud%inv_cloud_effective_size), &
     334              size(cloud%inv_cloud_effective_size)
    328335
    329336    ! Main loop over columns
    … …  
    497504               &  .not. (nreg == 2 .and. cloud%fraction(jcol,jlev) &
    498505               &  > 1.0-config%cloud_fraction_threshold)) then
     506!           print*,' Dans radiation_spartacus mpi_rank, omp_rank, jcol, jlev, &
     507!            &     cloud%inv_cloud_effective_size =', mpi_rank, &
     508!            &     omp_rank, jcol, jlev, &
     509!            &     cloud%inv_cloud_effective_size(jcol,jlev)
    499510            if (cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
    500511              ! 3D effects are only simulated if

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation/radiation_two_stream.F90

    r4728 r4758  
    2020!   2021-02-19  R Hogan  Security for shortwave singularity
    2121!   2022-11-22  P Ukkonen/R Hogan  Single precision uses no double precision
     22!   2023-09-28  R Hogan  Increased security for single-precision SW "k"
    2223
    2324module radiation_two_stream
    … …  
    212213      if (od(jg) > 1.0e-3_jprd) then
    213214        k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
    214              1.E-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
     215             1.0e-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
    215216        exponential = exp_fast(-k_exponent*od(jg))
    216217        exponential2 = exponential*exponential
    … …  
    235236      else
    236237        k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
    237              1.E-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
     238             1.0e-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
    238239        reflectance(jg) = gamma2(jg) * od(jg)
    239240        transmittance(jg) = (1.0_jprb - k_exponent*od(jg)) / (1.0_jprb + od(jg)*(gamma1(jg)-k_exponent))
    … …  
    312313      gamma2 = factor * (1.0_jprb - asymmetry(jg))
    313314      k_exponent = sqrt(max((gamma1 - gamma2) * (gamma1 + gamma2), &
    314            1.E-12_jprb)) ! Eq 18 of Meador & Weaver (1980)
     315           1.0e-12_jprb)) ! Eq 18 of Meador & Weaver (1980)
    315316      if (od(jg) > 1.0e-3_jprb) then
    316317        exponential = exp_fast(-k_exponent*od(jg))
    … …  
    646647      alpha2(jg) = gamma1(jg)*gamma3(jg) + gamma2(jg)*gamma4(jg) ! Eq. 17
    647648      ! The following line crashes inexplicably with gfortran 8.5.0 in
    648       ! single precision - try a later version
     649      ! single precision - try a later version. Note that the minimum
     650      ! value is needed to produce correct results for single
     651      ! scattering albedos very close to or equal to one.
     652#ifdef PARKIND1_SINGLE
     653      k_exponent(jg) = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
     654           &       1.0e-6_jprb)) ! Eq 18
     655#else
    649656      k_exponent(jg) = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
    650657           &       1.0e-12_jprb)) ! Eq 18
     658#endif
    651659    end do
    652660
    … …  
    665673      ! Meador & Weaver (1980) Eq. 25
    666674      ref_diff(jg) = gamma2(jg) * (1.0_jprb - exponential2) * reftrans_factor
    667        
    668       ! Meador & Weaver (1980) Eq. 26
    669       trans_diff(jg) = k_2_exponential * reftrans_factor
    670        
     675      !ref_diff(jg)       = max(0.0_jprb, min(ref_diff(jg)), 1.0_jprb)
     676
     677      ! Meador & Weaver (1980) Eq. 26, with security (which is
     678      ! sometimes needed, but apparently not on ref_diff)
     679      trans_diff(jg) = max(0.0_jprb, min(k_2_exponential * reftrans_factor, 1.0_jprb-ref_diff(jg)))
     680
    671681      ! Here we need mu0 even though it wasn't in Meador and Weaver
    672682      ! because we are assuming the incoming direct flux is defined to
    … …  
    694704      ref_dir(jg)        = max(0.0_jprb, min(ref_dir(jg), mu0*(1.0_jprb-trans_dir_dir(jg))))
    695705      trans_dir_diff(jg) = max(0.0_jprb, min(trans_dir_diff(jg), mu0*(1.0_jprb-trans_dir_dir(jg))-ref_dir(jg)))
    696 
    697706    end do
    698707   

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_ctrlout_mod.F90

    r4727 r4758  
    539539!AI Ecrad 3Deffect
    540540#ifdef CPP_ECRAD
     541  TYPE(ctrl_out), SAVE :: o_cloud_cover_sw = ctrl_out((/ 11, 11, 10, 10, 10, 10, 11, 11, 11, 11/), &
     542    'cloud_cover_sw', 'Ecrad SW cloud cover', '-', (/ ('', i=1, 10) /))
     543  TYPE(ctrl_out), SAVE :: o_cloud_cover_sw_s2 = ctrl_out((/ 11, 11, 10, 10, 10, 10, 11, 11, 11, 11/), &
     544    'cloud_cover_sw_s2', 'Ecrad SW cloud cover 2 call', '-', (/ ('', i=1, 10) /))
    541545  TYPE(ctrl_out), SAVE :: o_sols_s2 = ctrl_out((/ 11, 11, 10, 10, 10, 10, 11, 11, 11, 11/), &
    542546    'sols_s2', 'Solar rad. at surf.', 'W/m2', (/ ('', i=1, 10) /))

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_var_mod.F90

    r4727 r4758  
    174174  REAL, SAVE, ALLOCATABLE:: sss(:) ! (klon)
    175175  ! bulk salinity of the surface layer of the ocean, in ppt
    176  
    177176  !$OMP THREADPRIVATE(tkt, tks, taur, sss)
    178177
     178  !AI. cloud_cover_sw, cloud_cover_sw_s2 from Ecrad (1rt and 2 call)
     179  REAL, SAVE, ALLOCATABLE:: cloud_cover_sw(:), cloud_cover_sw_s2(:)
     180  !$OMP THREADPRIVATE(cloud_cover_sw, cloud_cover_sw_s2)
     181
    179182CONTAINS
    180183
    181   !======================================================================
     184  !=====================================================taur=================
    182185  SUBROUTINE phys_output_var_init
    183186    use dimphy
    … …  
    253256    ALLOCATE(icc3dstra(klon, klev))
    254257
     258! cloud_cover_sw, cloud_cover_sw_s2 from Ecrad
     259   ALLOCATE(cloud_cover_sw(klon))
     260   ALLOCATE(cloud_cover_sw_s2(klon))
     261
    255262  END SUBROUTINE phys_output_var_init
    256263
    … …  
    304311    DEALLOCATE(icc3dstra)
    305312
     313!AI cloud_cover_sw, cloud_cover_sw_s2 from Ecrad   
     314    DEALLOCATE(cloud_cover_sw, cloud_cover_sw_s2)
     315
    306316  END SUBROUTINE phys_output_var_end
    307317

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_write_mod.F90

    r4727 r4758  
    231231    USE phys_output_ctrlout_mod, ONLY:  &
    232232         o_soll0_s2,o_soll_s2,o_sols0_s2,o_sols_s2, &
    233          o_topl0_s2,o_topl_s2,o_tops0_s2,o_tops_s2   
     233         o_topl0_s2,o_topl_s2,o_tops0_s2,o_tops_s2, &
     234         o_SWupTOA_s2,o_SWupTOAclr_s2,o_cloud_cover_sw, &
     235         o_cloud_cover_sw_s2,o_SWdnTOA_s2,o_SWdnTOAclr_s2, &
     236         o_LWupSFCclr_s2, o_LWdnSFCclr_s2, o_SWupSFC_s2, &
     237         o_SWupSFCclr_s2, o_SWdnSFC_s2, o_SWdnSFCclr_s2, &
     238         o_LWupSFC_s2, o_LWdnSFC_s2
    234239#endif
    235240
    … …  
    290295    USE phys_state_var_mod, ONLY: &
    291296        sollw0_s2,sollw_s2,solsw0_s2,solsw_s2, &
    292         toplw0_s2,toplw_s2,topsw0_s2,topsw_s2
     297        toplw0_s2,toplw_s2,topsw0_s2,topsw_s2, &
     298        swup0_s2,swup_s2,swdn_s2,swdn0_s2,sollwdownclr_s2, &
     299        sollwdown_s2,lwdn0_s2
     300    USE phys_output_var_mod, ONLY: cloud_cover_sw, &
     301        cloud_cover_sw_s2
    293302#endif
     303
    294304
    295305
    … …  
    10681078!AI 08 2023 Ecrad 3Deffect
    10691079#ifdef CPP_ECRAD
     1080     CALL histwrite_phy(o_cloud_cover_sw, cloud_cover_sw)
    10701081     if (ok_3Deffect) then
    10711082        IF (vars_defined) THEN
    … …  
    10911102       CALL histwrite_phy(o_topl_s2, toplw_s2)
    10921103       CALL histwrite_phy(o_topl0_s2, toplw0_s2)
     1104
     1105       IF (vars_defined) THEN
     1106          zx_tmp_fi2d(:) = swup_s2(:,klevp1)*swradcorr(:)
     1107       ENDIF
     1108       CALL histwrite_phy(o_SWupTOA_s2, zx_tmp_fi2d)
     1109
     1110       IF (vars_defined) THEN
     1111          zx_tmp_fi2d(:) = swup0_s2(:,klevp1)*swradcorr(:)
     1112       ENDIF
     1113       CALL histwrite_phy(o_SWupTOAclr_s2, zx_tmp_fi2d)
     1114
     1115       IF (vars_defined) THEN
     1116          zx_tmp_fi2d(:) = swdn_s2(:,klevp1)*swradcorr(:)
     1117       ENDIF
     1118       CALL histwrite_phy(o_SWdnTOA_s2, zx_tmp_fi2d)
     1119
     1120       IF (vars_defined) THEN
     1121          zx_tmp_fi2d(:) = swdn0_s2(:,klevp1)*swradcorr(:)
     1122       ENDIF
     1123       CALL histwrite_phy(o_SWdnTOAclr_s2, zx_tmp_fi2d)
     1124
     1125       IF (vars_defined) THEN
     1126          zx_tmp_fi2d(:)=sollwdown_s2(:)-sollw_s2(:)
     1127       ENDIF
     1128       CALL histwrite_phy(o_LWupSFC_s2, zx_tmp_fi2d)
     1129       CALL histwrite_phy(o_LWdnSFC_s2, sollwdown_s2)
     1130
     1131       IF (vars_defined) THEN
     1132          sollwdownclr_s2(1:klon) = -1.*lwdn0_s2(1:klon,1)
     1133          zx_tmp_fi2d(1:klon)=sollwdownclr_s2(1:klon)-sollw0_s2(1:klon)
     1134       ENDIF
     1135       CALL histwrite_phy(o_LWupSFCclr_s2, zx_tmp_fi2d)
     1136       CALL histwrite_phy(o_LWdnSFCclr_s2, sollwdownclr_s2)
     1137
     1138       IF (vars_defined) THEN
     1139          zx_tmp_fi2d(:) = swup_s2(:,1)*swradcorr(:)
     1140       ENDIF
     1141       CALL histwrite_phy(o_SWupSFC_s2, zx_tmp_fi2d)
     1142
     1143       IF (vars_defined) THEN
     1144          zx_tmp_fi2d(:) = swup0_s2(:,1)*swradcorr(:)
     1145       ENDIF
     1146       CALL histwrite_phy(o_SWupSFCclr_s2, zx_tmp_fi2d)
     1147
     1148       IF (vars_defined) THEN
     1149          zx_tmp_fi2d(:) = swdn_s2(:,1)*swradcorr(:)
     1150       ENDIF
     1151       CALL histwrite_phy(o_SWdnSFC_s2, zx_tmp_fi2d)
     1152
     1153       IF (vars_defined) THEN
     1154          zx_tmp_fi2d(:) = swdn0_s2(:,1)*swradcorr(:)
     1155       ENDIF
     1156       CALL histwrite_phy(o_SWdnSFCclr_s2, zx_tmp_fi2d)
     1157
    10931158     endif
    10941159#endif       

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_state_var_mod.F90

    r4727 r4758  
    410410      REAL,ALLOCATABLE,SAVE :: solsw_s2(:), solswfdiff_s2(:), sollw_s2(:)
    411411!$OMP THREADPRIVATE(solsw_s2, solswfdiff_s2, sollw_s2)
    412       REAL,ALLOCATABLE,SAVE :: sollwdown_s2(:)
    413 !$OMP THREADPRIVATE(sollwdown_s2)
     412      REAL,ALLOCATABLE,SAVE :: sollwdown_s2(:), sollwdownclr_s2(:)
     413!$OMP THREADPRIVATE(sollwdown_s2, sollwdownclr_s2)
    414414      REAL,ALLOCATABLE,SAVE :: topsw0_s2(:),toplw0_s2(:)
    415415      REAL,ALLOCATABLE,SAVE :: solsw0_s2(:),sollw0_s2(:)
    … …  
    727727      ALLOCATE(albpla_s2(klon))
    728728      ALLOCATE(solsw_s2(klon), solswfdiff_s2(klon), sollw_s2(klon))
    729       ALLOCATE(sollwdown_s2(klon))
     729      ALLOCATE(sollwdown_s2(klon),sollwdownclr_s2(klon))
    730730      ALLOCATE(topsw0_s2(klon),toplw0_s2(klon))
    731731      ALLOCATE(solsw0_s2(klon),sollw0_s2(klon))
    … …  
    900900      DEALLOCATE(albpla_s2)
    901901      DEALLOCATE(solsw_s2, solswfdiff_s2, sollw_s2)
    902       DEALLOCATE(sollwdown_s2)
     902      DEALLOCATE(sollwdown_s2, sollwdownclr_s2)
    903903      DEALLOCATE(topsw0_s2,toplw0_s2)
    904904      DEALLOCATE(solsw0_s2,sollw0_s2)

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/physiq_mod.F90

    r4741 r4758  
    9292    USE lmdz_cloud_optics_prop_ini, ONLY : cloud_optics_prop_ini
    9393    USE phys_output_var_mod, ONLY :      cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
     94    USE phys_output_var_mod, ONLY : cloud_cover_sw, cloud_cover_sw_s2
    9495
    9596
    … …  
    12661267    REAL pi
    12671268    INTEGER ieru
     1269
     1270    CHARACTER(len=512) :: namelist_ecrad_file
    12681271
    12691272    !======================================================================!
    … …  
    45794582          ENDIF
    45804583          !
     4584           namelist_ecrad_file='namelist_ecrad'
     4585          !
    45814586          CALL radlwsw &
    45824587               (dist, rmu0, fract,  &
    … …  
    45974602               zqsat, flwc, fiwc, &
    45984603               ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
     4604               namelist_ecrad_file, &
    45994605               heat,heat0,cool,cool0,albpla, &
    46004606               heat_volc,cool_volc, &
    … …  
    46164622                                !-end
    46174623               ZLWFT0_i, ZFLDN0, ZFLUP0, &
    4618                ZSWFT0_i, ZFSDN0, ZFSUP0)
     4624               ZSWFT0_i, ZFSDN0, ZFSUP0, &
     4625               cloud_cover_sw)
    46194626
    46204627          !lwoff=y, betalwoff=1. : offset LW CRE for radiation code and other
    … …  
    46534660                ENDIF
    46544661                !
     4662                 namelist_ecrad_file='namelist_ecrad'
     4663                !
    46554664                CALL radlwsw &
    46564665                     (dist, rmu0, fract,  &
    … …  
    46714680                     zqsat, flwc, fiwc, &
    46724681                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
     4682                     namelist_ecrad_file, &
    46734683                     heatp,heat0p,coolp,cool0p,albplap, &
    46744684                     heat_volc,cool_volc, &
    … …  
    46904700                                !-end
    46914701                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
    4692                      ZSWFT0_i, ZFSDN0, ZFSUP0)
     4702                     ZSWFT0_i, ZFSDN0, ZFSUP0, &
     4703                     cloud_cover_sw)
    46934704          ENDIF !ok_4xCO2atm
    46944705
    … …  
    47144725                     zqsat, flwc, fiwc, &
    47154726                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
     4727                     namelist_ecrad_file, &
    47164728! A modifier             
    47174729                     heat_s2,heat0_s2,cool_s2,cool0_s2,albpla_s2, &
    … …  
    47344746                                !-end
    47354747                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
    4736                      ZSWFT0_i, ZFSDN0, ZFSUP0)
    4737              namelist_ecrad_file='namelist_ecrad'
     4748                     ZSWFT0_i, ZFSDN0, ZFSUP0, &
     4749                     cloud_cover_sw_s2)
    47384750          ENDIF ! ok_3Deffect
    47394751#endif

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/radiation_scheme.F90

    r4728 r4758  
    1212!             
    1313! ============================================================================
     14module interface_lmdz_ecrad
     15
     16IMPLICIT NONE       
     17
     18contains
    1419
    1520SUBROUTINE RADIATION_SCHEME &
    … …  
    3540     &  PFLUX_UV, PFLUX_PAR, PFLUX_PAR_CLEAR, &
    3641     &  PEMIS_OUT, PLWDERIVATIVE, &
    37      &  PSWDIFFUSEBAND, PSWDIRECTBAND)
    38 
     42     &  PSWDIFFUSEBAND, PSWDIRECTBAND, &
     43     &  ecrad_cloud_cover_sw)
    3944
    4045! RADIATION_SCHEME - Interface to modular radiation scheme
    … …  
    8489USE RADIATION_SETUP
    8590USE YOMCST   , ONLY : RSIGMA ! Stefan-Boltzmann constant
    86 USE RADIATION_SETUP, ONLY : SETUP_RADIATION_SCHEME, &
    87                          &  config_type, driver_config_type, &
    88                          &  NWEIGHT_UV,  IBAND_UV,  WEIGHT_UV, &
    89                          &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
    90                          &  ITYPE_TROP_BG_AER,  TROP_BG_AER_MASS_EXT, &
    91                          &  ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT, &
    92                          &  ISolverSpartacus
     91!USE RADIATION_SETUP, ONLY : SETUP_RADIATION_SCHEME, &
     92!                         &  config_type, driver_config_type, &
     93!                         &  NWEIGHT_UV,  IBAND_UV,  WEIGHT_UV, &
     94!                         &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
     95!                         &  ITYPE_TROP_BG_AER,  TROP_BG_AER_MASS_EXT, &
     96!                         &  ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT, &
     97!                         &  ISolverSpartacus
    9398
    9499! Modules from radiation library
    … …  
    176181REAL(KIND=JPRB), INTENT(IN)    :: TIME
    177182
     183! Name of file names specified on command line
     184character(len=512), INTENT(IN) :: namelist_file
     185logical, INTENT(IN)            :: ok_3Deffect
    178186
    179187! OUTPUT ARGUMENTS
    … …  
    222230REAL(KIND=JPRB),  INTENT(OUT) :: PSWDIFFUSEBAND(KLON,NSW)
    223231REAL(KIND=JPRB),  INTENT(OUT) :: PSWDIRECTBAND (KLON,NSW)
     232
     233!AI Nov 2023
     234REAL(KIND=JPRB),  INTENT(OUT) :: ecrad_cloud_cover_sw(KLON)
    224235
    225236! LOCAL VARIABLES
    … …  
    270281INTEGER, PARAMETER :: NAERMACC = 1
    271282
    272 ! Name of file names specified on command line
    273 character(len=512) :: namelist_file
    274 
    275283logical :: loutput=.true.
    276284logical :: lprint_input=.false.
    277 logical :: lprint_config=.true.
     285logical :: lprint_config=.false.
    278286logical, save :: debut_ecrad=.true.
    279287!$OMP THREADPRIVATE(debut_ecrad)
    280 integer, save :: itap_ecrad=1
    281 logical :: ok_3Deffect
     288integer, save :: itap_ecrad=0
     289!$OMP THREADPRIVATE(itap_ecrad)
     290
     291REAL(KIND=JPRB) ::  inv_cloud_effective_size(KLON,KLEV)
     292REAL(KIND=JPRB) ::  inv_inhom_effective_size(KLON,KLEV)
     293
     294integer :: irang
     295
    282296
    283297IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',0,ZHOOK_HANDLE)
    … …  
    298312! Fin partie initialisation et configuration
    299313
    300 !AI juillet 2023 : verif des param de config :
    301 if (lprint_config) then
    302 ! IF (is_master) THEN       
    303    print*,'Parametres de configuration de ecrad, etape ',itap_ecrad     
    304    print*,'Entree dans radiation_scheme'
    305    print*,'ok_3Deffect = ',ok_3Deffect
    306    print*,'Fichier namelist = ',namelist_file
    307 
    308    print*,'do_sw, do_lw, do_sw_direct, do_3d_effects = ', &
    309            rad_config%do_sw, rad_config%do_lw, rad_config%do_sw_direct, rad_config%do_3d_effects
    310    print*,'do_lw_side_emissivity, do_clear, do_save_radiative_properties = ', &
    311            rad_config%do_lw_side_emissivity, rad_config%do_clear, rad_config%do_save_radiative_properties
    312 !   print*,'sw_entrapment_name, sw_encroachment_name = ', &
    313 !           rad_config%sw_entrapment_name, rad_config%sw_encroachment_name
    314    print*,'do_3d_lw_multilayer_effects, do_fu_lw_ice_optics_bug = ', &
    315            rad_config%do_3d_lw_multilayer_effects, rad_config%do_fu_lw_ice_optics_bug
    316    print*,'do_save_spectral_flux, do_save_gpoint_flux = ', &
    317            rad_config%do_save_spectral_flux, rad_config%do_save_gpoint_flux
    318    print*,'do_surface_sw_spectral_flux, do_lw_derivatives = ', &
    319            rad_config%do_surface_sw_spectral_flux, rad_config%do_lw_derivatives
    320    print*,'do_lw_aerosol_scattering, do_lw_cloud_scattering = ', &
    321            rad_config%do_lw_aerosol_scattering, rad_config%do_lw_cloud_scattering
    322    print*, 'nregions, i_gas_model = ', &
    323            rad_config%nregions, rad_config%i_gas_model
    324 !   print*, 'ice_optics_override_file_name, liq_optics_override_file_name = ', &
    325 !           rad_config%ice_optics_override_file_name, rad_config%liq_optics_override_file_name
    326 !   print*, 'aerosol_optics_override_file_name, cloud_pdf_override_file_name = ', &
    327 !           rad_config%aerosol_optics_override_file_name, rad_config%cloud_pdf_override_file_name
    328 !   print*, 'gas_optics_sw_override_file_name, gas_optics_lw_override_file_name = ', &
    329 !           rad_config%gas_optics_sw_override_file_name, rad_config%gas_optics_lw_override_file_name
    330    print*, 'i_liq_model, i_ice_model, max_3d_transfer_rate = ', &
    331            rad_config%i_liq_model, rad_config%i_ice_model, rad_config%max_3d_transfer_rate
    332    print*, 'min_cloud_effective_size, overhang_factor = ', &
    333            rad_config%min_cloud_effective_size, rad_config%overhang_factor
    334    print*, 'use_canopy_full_spectrum_sw, use_canopy_full_spectrum_lw = ', &
    335            rad_config%use_canopy_full_spectrum_sw, rad_config%use_canopy_full_spectrum_lw
    336    print*, 'do_canopy_fluxes_sw, do_canopy_fluxes_lw = ', &
    337            rad_config%do_canopy_fluxes_sw, rad_config%do_canopy_fluxes_lw
    338    print*, 'do_canopy_gases_sw, do_canopy_gases_lw = ', &
    339            rad_config%do_canopy_gases_sw, rad_config%do_canopy_gases_lw
    340    print*, 'use_general_cloud_optics, use_general_aerosol_optics = ', &
    341            rad_config%use_general_cloud_optics, rad_config%use_general_aerosol_optics
    342    print*, 'do_sw_delta_scaling_with_gases, i_overlap_scheme = ', &
    343            rad_config%do_sw_delta_scaling_with_gases, rad_config%i_overlap_scheme
    344    print*, 'i_solver_sw, i_solver_sw, use_beta_overlap, use_vectorizable_generator = ', &
    345            rad_config%i_solver_sw, rad_config%i_solver_lw, &
    346            rad_config%use_beta_overlap, rad_config%use_vectorizable_generator
    347    print*, 'use_expm_everywhere, iverbose, iverbosesetup = ', &
    348            rad_config%use_expm_everywhere, rad_config%iverbose, rad_config%iverbosesetup
    349    print*, 'cloud_inhom_decorr_scaling, cloud_fraction_threshold = ', &
    350            rad_config%cloud_inhom_decorr_scaling, rad_config%cloud_fraction_threshold
    351    print*, 'clear_to_thick_fraction, max_gas_od_3d, max_cloud_od = ', &
    352            rad_config%clear_to_thick_fraction, rad_config%max_gas_od_3d, rad_config%max_cloud_od
    353    print*, 'cloud_mixing_ratio_threshold, overhead_sun_factor =', &
    354            rad_config%cloud_mixing_ratio_threshold, rad_config%overhead_sun_factor
    355    print*, 'n_aerosol_types, i_aerosol_type_map, use_aerosols = ', &
    356            rad_config%n_aerosol_types, rad_config%i_aerosol_type_map, rad_config%use_aerosols
    357    print*, 'mono_lw_wavelength, mono_lw_total_od, mono_sw_total_od = ', &
    358            rad_config%mono_lw_wavelength, rad_config%mono_lw_total_od,rad_config% mono_sw_total_od
    359    print*, 'mono_lw_single_scattering_albedo, mono_sw_single_scattering_albedo = ', &
    360            rad_config%mono_lw_single_scattering_albedo, rad_config%mono_sw_single_scattering_albedo
    361    print*, 'mono_lw_asymmetry_factor, mono_sw_asymmetry_factor = ', &
    362            rad_config%mono_lw_asymmetry_factor, rad_config%mono_sw_asymmetry_factor
    363    print*, 'i_cloud_pdf_shape = ', &
    364            rad_config%i_cloud_pdf_shape
    365 !           cloud_type_name, use_thick_cloud_spectral_averaging = ', &
    366 !           rad_config%i_cloud_pdf_shape, rad_config%cloud_type_name, &
    367 !           rad_config%use_thick_cloud_spectral_averaging
    368    print*, 'do_nearest_spectral_sw_albedo, do_nearest_spectral_lw_emiss = ', &
    369            rad_config%do_nearest_spectral_sw_albedo, rad_config%do_nearest_spectral_lw_emiss
    370    print*, 'sw_albedo_wavelength_bound, lw_emiss_wavelength_bound = ', &
    371            rad_config%sw_albedo_wavelength_bound, rad_config%lw_emiss_wavelength_bound
    372    print*, 'i_sw_albedo_index, i_lw_emiss_index = ', &
    373            rad_config%i_sw_albedo_index, rad_config%i_lw_emiss_index
    374    print*, 'do_cloud_aerosol_per_lw_g_point = ', &
    375            rad_config%do_cloud_aerosol_per_lw_g_point
    376    print*, 'do_cloud_aerosol_per_sw_g_point, do_weighted_surface_mapping = ', &
    377            rad_config%do_cloud_aerosol_per_sw_g_point, rad_config%do_weighted_surface_mapping
    378    print*, 'n_bands_sw, n_bands_lw, n_g_sw, n_g_lw = ', &
    379            rad_config%n_bands_sw, rad_config%n_bands_lw, rad_config%n_g_sw, rad_config%n_g_lw
    380 
    381            itap_ecrad=itap_ecrad+1
    382 !   ENDIF         
    383 endif           
    384 
     314!AI print fichiers namelist utilise
     315!if (is_omp_root) then
     316! itap_ecrad=itap_ecrad+1
     317! print*,'Dans radiation_scheme itap_ecrad, mpi_rank, omp_rank, namelist_file : ', &
     318!         itap_ecrad, mpi_rank, omp_rank, namelist_file
     319!else
     320! print*,'mpi_rank omp_rank, namelist_file :', mpi_rank, omp_rank, namelist_file
     321!endif
     322
     323! AI 11 23 Allocates depplaces au debut
     324print*,'*********** ALLOCATES *******************************'
    385325! AI ATTENTION
    386326! Allocate memory in radiation objects
    … …  
    388328CALL single_level%allocate(KLON, NSW, 1, &
    389329     &                     use_sw_albedo_direct=.TRUE.)
    390 
    391 print*,'************* THERMO (allocate + input) ************************************'
     330CALL thermodynamics%allocate(KLON, KLEV, use_h2o_sat=.true.)
     331CALL cloud%allocate(KLON, KLEV)
     332CALL aerosol%allocate(KLON, 1, KLEV, KAEROSOL)
     333CALL gas%allocate(KLON, KLEV)
     334CALL flux%allocate(rad_config, 1, KLON, KLEV)
     335
     336print*,'************* THERMO (input) ************************************'
    392337! Set thermodynamic profiles: simply copy over the half-level
    393338! pressure and temperature
    394 !print*,'Appel allocate thermo'
    395 CALL thermodynamics%allocate(KLON, KLEV, use_h2o_sat=.true.)
    396 !print*,'Definir les champs thermo'
    397339! AI
    398340! pressure_hl > paprs
    … …  
    400342thermodynamics%pressure_hl   (KIDIA:KFDIA,:) = PPRESSURE_H   (KIDIA:KFDIA,:)
    401343thermodynamics%temperature_hl(KIDIA:KFDIA,:) = PTEMPERATURE_H(KIDIA:KFDIA,:)
    402 
    403344!print*,'Compute saturation specific humidity'
    404345! Compute saturation specific humidity, used to hydrate aerosols. The
    … …  
    429370!cur_day
    430371!ITIM = NINT(NSTEP * YRRIP%TSTEP / 60.0_JPRB)
    431 ITIM = NINT(TIME / 60.0_JPRB)
     372!ITIM = NINT(TIME / 60.0_JPRB)
    432373!current_time
    433374!allocate(single_level%iseed(KIDIA:KFDIA))
    434 DO JLON = KIDIA, KFDIA
     375!DO JLON = KIDIA, KFDIA
    435376  ! This method gives a unique value for roughly every 1-km square
    436377  ! on the globe and every minute.  ASIN(PGEMU)*60 gives rough
    … …  
    442383  ! since random numbers are generated with the help of integer
    443384  ! overflow, it should not matter if the number did overflow).
    444   single_level%iseed(JLON) = ITIM + IDAY &
    445        &  +  NINT(PGELAM(JLON)*108000000.0_JPRB &
    446        &          + ASIN(PGEMU(JLON))*6000.0_JPRB)
    447 ENDDO
     385!  single_level%iseed(JLON) = ITIM + IDAY &
     386!       &  +  NINT(PGELAM(JLON)*108000000.0_JPRB &
     387!       &          + ASIN(PGEMU(JLON))*6000.0_JPRB)
     388!ENDDO
     389!AI Nov 23
     390! Simple initialization of the seeds for the Monte Carlo scheme
     391call single_level%init_seed_simple(kidia, kfdia)
    448392
    449393print*,'********** CLOUDS (allocate + input) *******************************************'
    450394!print*,'Appel Allocate clouds'
    451 CALL cloud%allocate(KLON, KLEV)
    452395! Set cloud fields
    453396cloud%q_liq(KIDIA:KFDIA,:)    = PQ_LIQUID(KIDIA:KFDIA,:)
    454397cloud%q_ice(KIDIA:KFDIA,:)    = PQ_ICE(KIDIA:KFDIA,:) + PQ_SNOW(KIDIA:KFDIA,:)
    455398cloud%fraction(KIDIA:KFDIA,:) = PCLOUD_FRAC(KIDIA:KFDIA,:)
    456 
    457399!!! ok AI ATTENTION a voir avec JL
    458400! Compute effective radi and convert to metres
    … …  
    460402cloud%re_liq(KIDIA:KFDIA,:) = ZRE_LIQUID_UM(KIDIA:KFDIA,:)
    461403cloud%re_ice(KIDIA:KFDIA,:) = ZRE_ICE_UM(KIDIA:KFDIA,:)
    462 
    463404! Get the cloud overlap decorrelation length (for cloud boundaries),
    464405! in km, according to the parameterization specified by NDECOLAT,
    … …  
    471412! AI valeur dans namelist
    472413! rad_config%cloud_inhom_decorr_scaling = ZDECORR_LEN_RATIO
    473 
    474414!AI ATTENTION meme valeur que dans offline
    475415! A mettre dans namelist
    … …  
    480420       &                 istartcol=JLON, iendcol=JLON)
    481421ENDDO
    482 
    483422! IFS :
    484423! Cloud water content fractional standard deviation is configurable
    … …  
    489428CALL cloud%create_fractional_std(KLON, KLEV, driver_config%frac_std)
    490429
    491 if (rad_config%i_solver_sw == ISolverSPARTACUS &
    492       & .or.   rad_config%i_solver_lw == ISolverSPARTACUS) then
    493 ! AI ! Read cloud properties needed by SPARTACUS
    494 !AI ATTENTION meme traitement dans le version offline
    495 
    496 ! By default mid and high cloud effective size is 10 km
    497 !CALL cloud%create_inv_cloud_effective_size(KLON,KLEV,1.0_JPRB/10000.0_JPRB)
    498 
    499 !  if (driver_config%low_inv_effective_size >= 0.0_jprb &
    500 !     & .or. driver_config%middle_inv_effective_size >= 0.0_jprb &
    501 !     & .or. driver_config%high_inv_effective_size >= 0.0_jprb) then
    502   if (driver_config%ok_effective_size) then
     430if (ok_3Deffect) then
     431 if (driver_config%ok_effective_size) then
    503432     call cloud%create_inv_cloud_effective_size_eta(klon, klev, &
    504433               &  thermodynamics%pressure_hl, &
    505434               &  driver_config%low_inv_effective_size, &
    506435               &  driver_config%middle_inv_effective_size, &
    507                &  driver_config%high_inv_effective_size, 0.8_jprb, 0.45_jprb)
    508 !  else if (driver_config%cloud_separation_scale_surface > 0.0_jprb &
    509 !         .and. driver_config%cloud_separation_scale_toa > 0.0_jprb) then
    510   else if (driver_config%ok_separation) then
    511       call cloud%param_cloud_effective_separation_eta(klon, klev, &
     436               &  driver_config%high_inv_effective_size, 0.8_jprb, 0.45_jprb, &
     437               &  KIDIA, KFDIA)
     438   else if (driver_config%ok_separation) then
     439     call cloud%param_cloud_effective_separation_eta(klon, klev, &
    512440               &  thermodynamics%pressure_hl, &
    513441               &  driver_config%cloud_separation_scale_surface, &
    514442               &  driver_config%cloud_separation_scale_toa, &
    515443               &  driver_config%cloud_separation_scale_power, &
    516                &  driver_config%cloud_inhom_separation_factor)
    517   endif
    518 endif 
    519 
    520 print*,'******** AEROSOLS (allocate + input) **************************************'
     444               &  driver_config%cloud_inhom_separation_factor, &
     445               &  KIDIA, KFDIA)
     446   endif     
     447 else 
     448 if (rad_config%i_solver_sw == ISolverSPARTACUS &
     449      & .or.   rad_config%i_solver_lw == ISolverSPARTACUS) then
     450   ! AI ! Read cloud properties needed by SPARTACUS
     451   if (driver_config%ok_effective_size) then
     452     call cloud%create_inv_cloud_effective_size_eta(klon, klev, &
     453               &  thermodynamics%pressure_hl, &
     454               &  driver_config%low_inv_effective_size, &
     455               &  driver_config%middle_inv_effective_size, &
     456               &  driver_config%high_inv_effective_size, 0.8_jprb, 0.45_jprb, &
     457               &  KIDIA, KFDIA)
     458   else if (driver_config%ok_separation) then
     459     call cloud%param_cloud_effective_separation_eta(klon, klev, &
     460               &  thermodynamics%pressure_hl, &
     461               &  driver_config%cloud_separation_scale_surface, &
     462               &  driver_config%cloud_separation_scale_toa, &
     463               &  driver_config%cloud_separation_scale_power, &
     464               &  driver_config%cloud_inhom_separation_factor, &
     465               &  KIDIA, KFDIA)
     466   endif
     467 endif 
     468endif
     469
     470print*,'******** AEROSOLS (input) **************************************'
    521471!IF (NAERMACC > 0) THEN
    522   CALL aerosol%allocate(KLON, 1, KLEV, KAEROSOL) ! MACC climatology
    523472!ELSE
    524473!  CALL aerosol%allocate(KLON, 1, KLEV, 6) ! Tegen climatology
    … …  
    571520!    ENDDO
    572521!  ENDDO
    573 
    574522!ENDIF
    575523
    576 print*,'********** GAS (allocate + input) ************************************************'
     524print*,'********** GAS (input) ************************************************'
    577525!print*,'Appel Allocate gas'
    578 CALL gas%allocate(KLON, KLEV)
    579 
    580526! Convert ozone Pa*kg/kg to kg/kg
    581527! AI ATTENTION
    … …  
    586532!  ENDDO
    587533!ENDDO
    588 
    589534!  Insert gas mixing ratios
    590535!print*,'Insert gas mixing ratios'
    … …  
    603548call set_gas_units(rad_config, gas)
    604549
    605 print*,'************** FLUX (allocate) ***********************'
    606 CALL flux%allocate(rad_config, 1, KLON, KLEV)
    607 
    608550! Call radiation scheme
    609 print*,'******** Appel radiation scheme **************************'
     551!print*,'*** Appel radiation *** namelist **** omp_rank ****', &
     552!         omp_rank, namelist_file
     553!   if (rad_config%i_solver_sw == ISolverSPARTACUS) then
     554!    if (driver_config%ok_separation) then
     555!      print*,'Avant radiation, mpi_rank, omp_rank, size, chape inv_cloud = ',&
     556!              mpi_rank, omp_rank, &
     557!              shape(cloud%inv_cloud_effective_size), &
     558!              size(cloud%inv_cloud_effective_size)     
     559!      do jlon=KIDIA, KFDIA     
     560!        do jlev=1,klev
     561!         print*,' Avant radiation mpi_rank, omp_rank, jlon, jlev, &
     562!            &     cloud%inv_cloud_effective_size =', mpi_rank, &
     563!            &     omp_rank, jlon, jlev, &
     564!            &     cloud%inv_cloud_effective_size(jlon,jlev)
     565!        enddo
     566!      enddo
     567!       cloud%inv_cloud_effective_size=inv_cloud_effective_size
     568!       cloud%inv_inhom_effective_size=inv_inhom_effective_size
     569!    endif
     570!   endif
    610571CALL radiation(KLON, KLEV, KIDIA, KFDIA, rad_config, &
    611572     &  single_level, thermodynamics, gas, cloud, aerosol, flux)
    612573
     574print*,'*********** Sortie flux ****************'
     575
     576! Cloud cover
     577ecrad_cloud_cover_sw = flux%cloud_cover_sw
    613578! Compute required output fluxes
    614579! DN and UP flux
    … …  
    621586PFLUX_LW_DN_CLEAR(KIDIA:KFDIA,:) = flux%lw_dn_clear(KIDIA:KFDIA,:)
    622587PFLUX_LW_UP_CLEAR(KIDIA:KFDIA,:) = flux%lw_up_clear(KIDIA:KFDIA,:)
    623 
    624588! First the net fluxes
    625589PFLUX_SW(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:) - flux%sw_up(KIDIA:KFDIA,:)
    … …  
    629593PFLUX_LW_CLEAR(KIDIA:KFDIA,:) &
    630594     &  = flux%lw_dn_clear(KIDIA:KFDIA,:) - flux%lw_up_clear(KIDIA:KFDIA,:)
    631 
    632595! Now the surface fluxes
    633596!PFLUX_SW_DN_SURF(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,KLEV+1)
    … …  
    645608  PFLUX_DIR_INTO_SUN(KIDIA:KFDIA) = PFLUX_DIR(KIDIA:KFDIA) / PMU0(KIDIA:KFDIA)
    646609END WHERE
    647 
    648610! Top-of-atmosphere downwelling flux
    649611!PFLUX_SW_DN_TOA(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,1)
    … …  
    651613!PFLUX_LW_DN_TOA(KIDIA:KFDIA) = flux%lw_dn(KIDIA:KFDIA,1)
    652614!PFLUX_LW_UP_TOA(KIDIA:KFDIA) = flux%lw_up(KIDIA:KFDIA,1)
    653 
    654 ! Compute UV fluxes as weighted sum of appropriate shortwave bands
    655615!AI ATTENTION
    656616if (0.eq.1) then
    … …  
    660620       &  * flux%sw_dn_surf_band(IBAND_UV(JBAND),KIDIA:KFDIA)
    661621ENDDO
    662 
    663622! Compute photosynthetically active radiation similarly
    664623PFLUX_PAR      (KIDIA:KFDIA) = 0.0_JPRB
    … …  
    679638  PEMIS_OUT(KIDIA:KFDIA) = PFLUX_LW(KIDIA:KFDIA,KLEV+1) / ZBLACK_BODY_NET_LW
    680639END WHERE
    681 
    682640! Copy longwave derivatives
    683641! AI ATTENTION
    … …  
    686644  PLWDERIVATIVE(KIDIA:KFDIA,:) = flux%lw_derivatives(KIDIA:KFDIA,:)
    687645END IF
    688 
    689646! Store the shortwave downwelling fluxes in each albedo band
    690647!AI ATTENTION
    … …  
    706663ENDIF
    707664endif
     665
     666print*,'********** DEALLOCATIONS ************************'
    708667CALL single_level%deallocate
    709668CALL thermodynamics%deallocate
    … …  
    716675
    717676END SUBROUTINE RADIATION_SCHEME
     677
     678end module interface_lmdz_ecrad

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/radlwsw_m.F90

    r4647 r4758  
    2424   qsat, flwc, fiwc, &
    2525   ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
     26   namelist_ecrad_file, &
    2627   heat,heat0,cool,cool0,albpla,&
    2728   heat_volc, cool_volc,&
    … …  
    4344!-end
    4445   ZLWFT0_i, ZFLDN0, ZFLUP0,&
    45    ZSWFT0_i, ZFSDN0, ZFSUP0)
     46   ZSWFT0_i, ZFSDN0, ZFSUP0,&
     47   cloud_cover_sw)
    4648
    4749! Modules necessaires
    … …  
    8486      USE time_phylmdz_mod, only: current_time
    8587      USE phys_cal_mod, only: day_cur
     88      USE interface_lmdz_ecrad
    8689#endif
    8790
    … …  
    245248  REAL,    INTENT(in)  :: ref_ice_pi(klon,klev) ! ice crystal radius   pre-industrial from newmicro
    246249
     250  CHARACTER(len=512), INTENT(in) :: namelist_ecrad_file
     251
    247252! Output arguments
    248253  REAL,    INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV)
    … …  
    333338               ZFLUX_PAR_CLEAR(klon), &     ! CS photosynthetically
    334339               ZFLUX_SW_DN_TOA(klon), &     ! DN SW flux at TOA
    335                ZEMIS_OUT(klon)              ! effective broadband emissivity
     340               ZEMIS_OUT(klon), &              ! effective broadband emissivity
     341               cloud_cover_sw(klon)
     342
    336343  REAL(KIND=8) ZLWDERIVATIVE(klon,klev+1)   ! LW derivatives
    337344  REAL(KIND=8) ZSWDIFFUSEBAND(klon,NSW), &  ! SW DN flux in diffuse albedo band
    … …  
    13841391!      & ZFLUX_SW_DN_TOA,
    13851392      & ZEMIS_OUT, ZLWDERIVATIVE, &
    1386       & PSFSWDIF, PSFSWDIR)
     1393      & PSFSWDIF, PSFSWDIR, &
     1394      & cloud_cover_sw)
    13871395
    13881396      print *,'========= RADLWSW: apres RADIATION_SCHEME ==================== '
Note: See TracChangeset for help on using the changeset viewer.