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

Legend:

Unmodified
Added
Removed

  • 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   
Note: See TracChangeset for help on using the changeset viewer.