lw_rad_input_mod Module Reference

Functions/Subroutines
subroutine	lw_input (current_state, lw_control)

Variables
integer(kind=jpim), parameter, private	zhook_in = 0
integer(kind=jpim), parameter, private	zhook_out = 1

Function/Subroutine Documentation

lw_input()

subroutine lw_rad_input_mod::lw_input	(	type(model_state_type), intent(inout), target	current_state,
		type(strctrl), intent(inout)	lw_control
	)

Definition at line 38 of file lw_rad_input_mod.F90.

 
USE rad_pcf, ONLY: ip_cloud_mix_max, ip_cloud_mix_random,               &
  ip_cloud_triple, ip_cloud_part_corr, ip_cloud_part_corr_cnv,          &
  ip_cloud_mcica, ip_cloud_clear,                                       &
  ip_solver_homogen_direct, ip_solver_mix_direct_hogan,                 &
  ip_solver_triple_hogan, ip_solver_triple_app_scat,                    &
  ip_solver_mix_app_scat, ip_solver_no_scat,                            &
  ip_cloud_homogen, ip_cloud_ice_water, ip_cloud_conv_strat,            &
  ip_cloud_csiw,                                                        &
  ip_scaling, ip_mcica,                                                 &
  ip_max_rand, ip_exponential_rand, ip_rand,                            &
  ip_scatter_approx, ip_no_scatter_abs, ip_no_scatter_ext
USE ereport_mod, ONLY: ereport
USE def_control,  ONLY: strctrl
 
use state_mod, only : model_state_type
use optionsdatabase_mod, only : options_get_real, options_get_string,    & 
     options_get_integer, options_get_logical
 
IMPLICIT NONE
 
type(model_state_type), target, intent(inout) :: current_state
 
TYPE(StrCtrl),      INTENT(INOUT) :: lw_control
 
INTEGER :: j,                        &
     errorstatus      ! Return code : 0 Normal Exit : >0 Error
INTEGER :: namelist_unit
 
REAL(KIND=jprb)               :: zhook_handle
 
CHARACTER(LEN=*) :: RoutineName
parameter(   routinename='lw_rad_input_mod')
CHARACTER(LEN=errormessagelength) :: CMessage  ! Error message if Errorstatus >0
 
IF (lhook) CALL dr_hook('LW_INPUT',zhook_in,zhook_handle)
 
! Set default values of control variables.
 
CALL lw_control_default(lw_control)
 
  lw_control%spectral_file          =  &
       adjustl(options_get_string(current_state%options_database, "spectral_file_lw"))
  lw_control%i_gas_overlap          =  &
       options_get_integer(current_state%options_database, "i_gas_overlap_lw")
  lw_control%i_cloud_representation =  &
       options_get_integer(current_state%options_database, "i_cloud_representation")
  lw_control%i_st_water             =  &
       options_get_integer(current_state%options_database, "i_water_lw")
  lw_control%i_st_ice               =  &
       options_get_integer(current_state%options_database, "i_ice_lw")
  lw_control%i_scatter_method       =  & 
       options_get_integer(current_state%options_database, "i_scatter_method_lw")
 
! Set i_cloud from combination of i_overlap and i_representation
 
  IF (lw_control%i_cloud_representation == ip_cloud_homogen) THEN
 
    lw_control%i_solver=ip_solver_homogen_direct
    IF (lw_control%i_inhom == ip_mcica) THEN
       ! The code below builds but if options is selected, MONC WILL NOT 
       ! run as other modules required - AH, 26/06/15
      lw_control%i_cloud=ip_cloud_mcica
    ELSE
      IF (lw_control%i_overlap == ip_max_rand) THEN
        lw_control%i_cloud=ip_cloud_mix_max
      ELSE IF (lw_control%i_overlap == ip_exponential_rand) THEN
        lw_control%i_cloud=ip_cloud_part_corr
      ELSE IF (lw_control%i_overlap == ip_rand) THEN
        lw_control%i_cloud=ip_cloud_mix_random
      ELSE
        errorstatus = 100
        cmessage = 'The selected cloud overlap is not available'
        CALL ereport(routinename, errorstatus, cmessage)
      END IF
    END IF
 
  ELSE IF (lw_control%i_cloud_representation == ip_cloud_ice_water) THEN
 
    IF (lw_control%i_inhom == ip_mcica) THEN
      lw_control%i_cloud=ip_cloud_mcica
      IF ( (lw_control%i_scatter_method == ip_no_scatter_abs) .OR.   &
           (lw_control%i_scatter_method == ip_no_scatter_ext) ) THEN
         ! The code below builds but if options is selected, MONC WILL NOT 
         ! run as other modules required - AH, 26/06/15 
        lw_control%i_solver      =ip_solver_no_scat
        lw_control%i_solver_clear=ip_solver_no_scat
      ELSE
        lw_control%i_solver=ip_solver_homogen_direct
      END IF
    ELSE
      IF (lw_control%i_scatter_method == ip_scatter_approx) THEN
        lw_control%i_solver=ip_solver_mix_app_scat
      ELSE
        lw_control%i_solver=ip_solver_mix_direct_hogan
      END IF
      IF (lw_control%i_overlap == ip_max_rand) THEN
        lw_control%i_cloud=ip_cloud_mix_max
      ELSE IF (lw_control%i_overlap == ip_exponential_rand) THEN
        lw_control%i_cloud=ip_cloud_part_corr
      ELSE IF (lw_control%i_overlap == ip_rand) THEN
        lw_control%i_cloud=ip_cloud_mix_random
      ELSE
        errorstatus = 100
        cmessage = 'The selected cloud overlap is not available'
        CALL ereport(routinename, errorstatus, cmessage)
      END IF
    END IF
 
  ELSE IF ((lw_control%i_cloud_representation == ip_cloud_conv_strat) .OR.  &
           (lw_control%i_cloud_representation == ip_cloud_csiw)) THEN
 
    IF (lw_control%i_inhom == ip_mcica) THEN
      errorstatus = 100
      cmessage = 'McICA is not compatible with the selected'//                 &
                 ' cloud representation'
      CALL ereport(routinename, errorstatus, cmessage)
    ELSE
      IF (lw_control%i_scatter_method == ip_scatter_approx) THEN
        lw_control%i_solver=ip_solver_triple_app_scat
      ELSE
        lw_control%i_solver=ip_solver_triple_hogan
      END IF
      IF (lw_control%i_overlap == ip_max_rand) THEN
        lw_control%i_cloud=ip_cloud_triple
      ELSE IF (lw_control%i_overlap == ip_exponential_rand) THEN
        lw_control%i_cloud=ip_cloud_part_corr_cnv
      ELSE IF (lw_control%i_overlap == ip_rand) THEN
        lw_control%i_cloud=ip_cloud_mix_random
      ELSE
        errorstatus = 100
        cmessage = 'The selected cloud overlap is not available'
        CALL ereport(routinename, errorstatus, cmessage)
      END IF
    END IF
 
  ELSE
 
    ! No treatment of cloud for LW radiation
    lw_control%l_cloud=.false.
    lw_control%i_cloud=ip_cloud_clear
    IF ( (lw_control%i_scatter_method == ip_no_scatter_abs) .OR.            &
         (lw_control%i_scatter_method == ip_no_scatter_ext) ) THEN
      lw_control%i_solver      =ip_solver_no_scat
      lw_control%i_solver_clear=ip_solver_no_scat
    ELSE
      lw_control%i_solver=ip_solver_homogen_direct
    END IF
    lw_control%l_microphysics=.false.
  END IF
 
IF (lhook) CALL dr_hook('LW_INPUT',zhook_out,zhook_handle)
 

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

zhook_in

integer(kind=jpim), parameter, private lw_rad_input_mod::zhook_in = 0

private

Definition at line 30 of file lw_rad_input_mod.F90.

INTEGER(KIND=jpim), PARAMETER, PRIVATE :: zhook_in  = 0

zhook_out

integer(kind=jpim), parameter, private lw_rad_input_mod::zhook_out = 1

private

Definition at line 31 of file lw_rad_input_mod.F90.

INTEGER(KIND=jpim), PARAMETER, PRIVATE :: zhook_out = 1