module opt_prop use vtype_module use opt_prop_kd, only : OptPropKDGetPFIntedRatio implicit none private public :: OptPropInit public :: OptPropFinalize public :: OptPropGetNWN public :: OptPropGetNPress public :: OptPropGetNMol public :: OptPropGetNBand public :: OptPropGetDelWN public :: OptPropGetWN public :: OptPropGetBandNum public :: OptPropGetBandWNBnds public :: OptPropGetBandBinIndexBnds !!$ public :: OptPropGetTotalStrFlux public :: OptPropGetAbsCoefProf public :: OptPropGetRayScatCoef public :: OptPropGetPtclParam public :: OptPropGetPFInted public :: OptPropGetStrPFInted public :: OptPropGetStrBandAvePF public :: OptPropGetPFIntedRatio public :: OptPropGetStrPFIntedRatio public :: OptPropPFTblGetPFDPFDT integer, save :: IDMethod integer, parameter :: IDMethodLBL = 1 integer, parameter :: IDMethodLBLConstPF = 2 integer, parameter :: IDMethodKDDevelop = 10 integer, parameter :: IDMethodKD = 11 ! Common character(128) , save :: OptPropNcFNSave character(128) , save :: StrSpeNcFNSave ! character(128) , save :: PressAxisName character(128) , save :: MolAxisName ! integer , save :: NPressSave integer , save :: NMolSave ! real(DP), allocatable, save :: p_PressSave(:) real(DP), allocatable, save :: m_MolNumSave(:) ! LBL integer , save :: NWaveNumSave real(DP), allocatable, save :: w_WaveNumSave(:) real(DP), allocatable, save :: w_StrSpeSave(:) real(DP), allocatable, save :: b_BandAveStrPFSave(:) real(DP), allocatable, save :: aa_BandWaveNumBndsSave (:,:) ! KDDevelop integer , parameter :: NBndSave = 2 integer , save :: NBinSave integer , save :: NBandSave integer , allocatable, save :: a_BinNumSave(:) !!$ integer , allocatable, save :: aa_BandWaveNumIndexBndsSave(:,:) integer , allocatable, save :: aa_BandBinIndexBndsSave (:,:) ! character(128), save :: WaveNumAxisName character(128), save :: AbsCoefVarName character(128), save :: AtmPFRatioVarName character(128), save :: StrPFRatioVarName character(128), save :: StrSpeVarName ! real(DP), allocatable, save :: a_DelWaveNum(:) ! ! KDDevelop only real(DP), allocatable, save :: za_AtmPFRatio (:,:) real(DP), allocatable, save :: zma_AbsCoef (:,:,:) integer , allocatable, save :: ma_IDAbsCoefType(:,:) real(DP), allocatable, save :: a_StrPFRatio(:) character(128), save :: ModuleName = 'opt_prop' logical, save :: FlagInited = .false. interface OptPropGetPFIntedRatio module procedure & & OptPropGetPFIntedRatioLBLKDDevelop, & & OptPropKDGetPFIntedRatio end interface OptPropGetPFIntedRatio interface OptPropPFTblGetPFDPFDT module procedure & OptPropPFTblGetPFDPFDT1D, & OptPropPFTblGetPFDPFDT0D end interface OptPropPFTblGetPFDPFDT !---------------------------------------------------------------------------- contains !---------------------------------------------------------------------------- subroutine OptPropInit( & & Type, & & OptPropNcFN, RayScatCoefNcFN, StrSpeNcFN & & ) #ifdef KDONLY #else use opt_prop_lbl , only : OptPropLBLInit use opt_prop_lblconstpf, only : OptPropLBLConstPFInit use opt_prop_kddevelop , only : OptPropKDDevelopInit #endif use opt_prop_kd , only : OptPropKDInit character(*), intent(in) :: Type character(*), intent(in) :: OptPropNcFN character(*), intent(in) :: RayScatCoefNcFN character(*), intent(in) :: StrSpeNcFN if ( FlagInited ) return select case ( Type ) case ( 'LBL' ) IDMethod = IDMethodLBL case ( 'LBLConstPF' ) IDMethod = IDMethodLBLConstPF case ( 'KDDevelop' ) IDMethod = IDMethodKDDevelop case ( 'KD' ) IDMethod = IDMethodKD case default write( 6, * ) 'In module, ', trim( ModuleName ) write( 6, * ) 'Unexpected type: ', trim( Type ) stop end select select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLInit( & & OptPropNcFN, RayScatCoefNcFN, StrSpeNcFN & & ) #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLConstPFInit( & & OptPropNcFN, StrSpeNcFN & & ) #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopInit( & & OptPropNcFN, RayScatCoefNcFN, StrSpeNcFN & & ) #endif case ( IDMethodKD ) call OptPropKDInit( & & OptPropNcFN & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select FlagInited = .true. end subroutine OptPropInit !---------------------------------------------------------------------------- subroutine OptPropFinalize #ifdef KDONLY #else use opt_prop_lbl, only : OptPropLBLFinalize use opt_prop_lblconstpf, only : OptPropLBLConstPFFinalize use opt_prop_kddevelop, only : OptPropKDDevelopFinalize #endif use opt_prop_kd, only : OptPropKDFinalize if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLFinalize #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLConstPFFinalize #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopFinalize #endif case ( IDMethodKD ) call OptPropKDFinalize case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select FlagInited = .false. end subroutine OptPropFinalize !---------------------------------------------------------------------------- function OptPropGetNWN() result( NWN ) #ifdef KDONLY #else use opt_prop_lbl , only : OptPropLBLGetNWN use opt_prop_lblconstpf, only : OptPropLBLConstPFGetNWN use opt_prop_kddevelop , only : OptPropKDDevelopGetNWN #endif use opt_prop_kd , only : OptPropKDGetNWN integer :: NWN ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else NWN = OptPropLBLGetNWN() #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else NWN = OptPropLBLConstPFGetNWN() #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else NWN = OptPropKDDevelopGetNWN() #endif case ( IDMethodKD ) NWN = OptPropKDGetNWN() case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end function OptPropGetNWN !---------------------------------------------------------------------------- function OptPropGetNPress() result( NPress ) #ifdef KDONLY #else use opt_prop_lbl, only : OptPropLBLGetNPress use opt_prop_lblconstpf, only : OptPropLBLConstPFGetNPress use opt_prop_kddevelop, only : OptPropKDDevelopGetNPress #endif use opt_prop_kd, only : OptPropKDGetNPress integer :: NPress ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else NPress = OptPropLBLGetNPress() #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else NPress = OptPropLBLConstPFGetNPress() #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else NPress = OptPropKDDevelopGetNPress() #endif case ( IDMethodKD ) NPress = OptPropKDGetNPress() case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end function OptPropGetNPress !---------------------------------------------------------------------------- function OptPropGetNMol() result( NMol ) #ifdef KDONLY #else use opt_prop_lbl, only : OptPropLBLGetNMol use opt_prop_lblconstpf, only : OptPropLBLConstPFGetNMol use opt_prop_kddevelop, only : OptPropKDDevelopGetNMol #endif use opt_prop_kd, only : OptPropKDGetNMol integer :: NMol ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else NMol = OptPropLBLGetNMol() #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else NMol = OptPropLBLConstPFGetNMol() #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else NMol = OptPropKDDevelopGetNMol() #endif case ( IDMethodKD ) NMol = OptPropKDGetNMol() case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end function OptPropGetNMol !---------------------------------------------------------------------------- function OptPropGetNBand() result( NBand ) #ifdef KDONLY #else use opt_prop_lblconstpf, only : OptPropLBLConstPFGetNBand use opt_prop_kddevelop, only : OptPropKDDevelopGetNBand #endif use opt_prop_kd, only : OptPropKDGetNBand integer :: NBand ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) write( 6, * ) "OptPropGetNband cannot be used when IDMethod is IDMethodLBL." stop case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else NBand = OptPropLBLConstPFGetNBand() #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else NBand = OptPropKDDevelopGetNBand() #endif case ( IDMethodKD ) NBand = OptPropKDGetNBand() case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end function OptPropGetNBand !---------------------------------------------------------------------------- function OptPropGetDelWN( iWaveNum ) result( DelWaveNum ) #ifdef KDONLY #else use opt_prop_lbl, only : OptPropLBLGetDelWN use opt_prop_lblconstpf, only : OptPropLBLConstPFGetDelWN use opt_prop_kddevelop, only : OptPropKDDevelopGetDelWN #endif use opt_prop_kd, only : OptPropKDGetDelWN integer, intent(in) :: iWaveNum real(DP) :: DelWaveNum ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else DelWaveNum = OptPropLBLGetDelWN() #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else DelWaveNum = OptPropLBLConstPFGetDelWN() #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else DelWaveNum = OptPropKDDevelopGetDelWN( iWaveNum ) #endif case ( IDMethodKD ) DelWaveNum = OptPropKDGetDelWN( iWaveNum ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end function OptPropGetDelWN !---------------------------------------------------------------------------- function OptPropGetWN( iWaveNum ) result( WaveNum ) #ifdef KDONLY #else use opt_prop_lbl, only : OptPropLBLGetWN use opt_prop_lblconstpf, only : OptPropLBLConstPFGetWN #endif integer, intent(in) :: iWaveNum real(DP) :: WaveNum ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else WaveNum = OptPropLBLGetWN( iWaveNum ) #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else WaveNum = OptPropLBLConstPFGetWN( iWaveNum ) #endif case ( IDMethodKDDevelop ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetWN cannot be used when IDMethod is IDMethodKDDevelop' stop case ( IDMethodKD ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetWN cannot be used when IDMethod is IDMethodKD' stop case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end function OptPropGetWN !---------------------------------------------------------------------------- function OptPropGetBandNum( iWaveNum ) result( BandNum ) #ifdef KDONLY #else !!$ use opt_prop_lbl, only : OptPropLBLFinalize use opt_prop_lblconstpf, only : OptPropLBLConstPFGetBandNum use opt_prop_kddevelop , only : OptPropKDDevelopGetBandNum #endif use opt_prop_kd , only : OptPropKDGetBandNum integer, intent(in ) :: iWaveNum integer :: BandNum if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) write( 6, * ) "OptPropGetBandNum cannot be used when IDMethod is IDMethodLBL" stop case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else BandNum = OptPropLBLConstPFGetBandNum( iWaveNum ) #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else BandNum = OptPropKDDevelopGetBandNum( iWaveNum ) #endif case ( IDMethodKD ) BandNum = OptPropKDGetBandNum( iWaveNum ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end function OptPropGetBandNum !---------------------------------------------------------------------------- subroutine OptPropGetBandWNBnds( & & NBand, & & aa_BandWNBnds & & ) #ifdef KDONLY #else use opt_prop_lblconstpf, only : OptPropLBLConstPFGetBandWNBnds use opt_prop_kddevelop, only : OptPropKDDevelopGetBandWNBnds #endif use opt_prop_kd, only : OptPropKDGetBandWNBnds integer , intent(in ) :: NBand real(DP), intent(out) :: aa_BandWNBnds(2,NBand) ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) write( 6, * ) "OptPropGetBandWNBnds cannot be called when IDMethod is IDMethod LBL." stop case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLConstPFGetBandWNBnds( & & NBand, & & aa_BandWNBnds & & ) #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopGetBandWNBnds( & & NBand, & & aa_BandWNBnds & & ) #endif case ( IDMethodKD ) call OptPropKDGetBandWNBnds( & & NBand, & & aa_BandWNBnds & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetBandWNBnds !---------------------------------------------------------------------------- subroutine OptPropGetBandBinIndexBnds( & & NBand, & & aa_BandBinIndexBnds & & ) #ifdef KDONLY #else use opt_prop_kddevelop, only : OptPropKDDevelopGetBandBinIndexBnds #endif use opt_prop_kd, only : OptPropKDGetBandBinIndexBnds integer, intent(in ) :: NBand integer, intent(out) :: aa_BandBinIndexBnds(2,NBand) ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) write( 6, * ) "OptPropGetBandBinIndexBnds cannot be called when IDMethod is IDMethodLBL." stop case ( IDMethodLBLConstPF ) write( 6, * ) "OptPropGetBandBinIndexBnds cannot be called when IDMethod is IDMethodLBLConstPF." stop case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopGetBandBinIndexBnds( & & NBand, & & aa_BandBinIndexBnds & & ) #endif case ( IDMethodKD ) call OptPropKDGetBandBinIndexBnds( & & NBand, & & aa_BandBinIndexBnds & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetBandBinIndexBnds !---------------------------------------------------------------------------- !!$ subroutine OptPropGetTotalStrFlux( & !!$ & TotalStrFlux & !!$ & ) !!$ !!$ use opt_prop_lbl , only : OptPropLBLGetTotalStrFlux !!$ use opt_prop_lblconstpf, only : OptPropLBLConstPFGetTotalStrFlux !!$ use opt_prop_kddevelop , only : OptPropKDDevelopGetTotalStrFlux !!$ use opt_prop_kd , only : OptPropKDGetTotalStrFlux !!$ !!$ real(DP), intent(out) :: TotalStrFlux !!$ !!$ !!$ ! local variables !!$ ! !!$ real(DP) :: DelWaveNum !!$ !!$ integer :: l !!$ !!$ !!$ select case ( IDMethod ) !!$ case ( IDMethodLBL ) !!$ !!$ call OptPropLBLGetTotalStrFlux( & !!$ & TotalStrFlux & !!$ & ) !!$ !!$ case ( IDMethodLBLConstPF ) !!$ !!$ call OptPropLBLConstPFGetTotalStrFlux( & !!$ & TotalStrFlux & !!$ & ) !!$ !!$ case ( IDMethodKDDevelop ) !!$ !!$ call OptPropKDDevelopGetTotalStrFlux( & !!$ & TotalStrFlux & !!$ & ) !!$ !!$ case ( IDMethodKD ) !!$ !!$ call OptPropKDGetTotalStrFlux( & !!$ & TotalStrFlux & !!$ & ) !!$ !!$ case default !!$ write( 6, * ) 'In ', trim( ModuleName ) !!$ write( 6, * ) ' Unexpected case default' !!$ stop !!$ end select !!$ !!$ !!$ end subroutine OptPropGetTotalStrFlux !---------------------------------------------------------------------------- subroutine OptPropGetAbsCoefProf( & & iWaveNum, kmax, NMol, m_MolNum, r_Press, r_Temp, rm_VMR, & & rm_AbsCoef, & & FlagRecalcWeight & & ) #ifdef KDONLY #else use opt_prop_lbl , only : OptPropLBLGetAbsCoefProf use opt_prop_lblconstpf, only : OptPropLBLConstPFGetAbsCoefProf use opt_prop_kddevelop , only : OptPropKDDevelopGetAbsCoefProf #endif use opt_prop_kd , only : OptPropKDGetAbsCoefProf integer , intent(in ) :: iWaveNum integer , intent(in ) :: kmax integer , intent(in ) :: NMol integer , intent(in ) :: m_MolNum (1:NMol) real(DP) , intent(in ) :: r_Press (1:kmax) real(DP) , intent(in ) :: r_Temp (1:kmax) real(DP) , intent(in ) :: rm_VMR (1:kmax,1:NMol) real(DP) , intent(out) :: rm_AbsCoef(1:kmax,1:NMol) logical , intent(in ), optional :: FlagRecalcWeight ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLGetAbsCoefProf( & & iWaveNum, kmax, NMol, m_MolNum, rm_VMR, & & rm_AbsCoef & & ) #endif case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLConstPFGetAbsCoefProf( & & iWaveNum, kmax, NMol, m_MolNum, rm_VMR, & & rm_AbsCoef & & ) #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopGetAbsCoefProf( & & iWaveNum, kmax, NMol, m_MolNum, rm_VMR, & & rm_AbsCoef & & ) #endif case ( IDMethodKD ) if ( .not. present( FlagRecalcWeight ) ) then write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' FlagRecalcWeight has to be present.' stop end if call OptPropKDGetAbsCoefProf( & & iWaveNum, kmax, NMol, m_MolNum, r_Press, r_Temp, rm_VMR, & & rm_AbsCoef, & & FlagRecalcWeight & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetAbsCoefProf !---------------------------------------------------------------------------- subroutine OptPropGetRayScatCoef( & & iWaveNum, & & NMol, m_MolNum, & & RayScatCoefNonRadAct, m_RayScatCoef & & ) #ifdef KDONLY #else use opt_prop_lbl , only : OptPropLBLGetRayScatCoef !!$ use opt_prop_lblconstpf, only : OptPropLBLConstPFGetAbsCoefProf use opt_prop_kddevelop , only : OptPropKDDevelopGetRayScatCoef #endif use opt_prop_kd , only : OptPropKDGetRayScatCoef integer , intent(in ) :: iWaveNum integer , intent(in ) :: NMol integer , intent(in ) :: m_MolNum(NMol) real(DP) , intent(out) :: RayScatCoefNonRadAct real(DP) , intent(out) :: m_RayScatCoef(NMol) ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLGetRayScatCoef( & & iWaveNum, & & NMol, m_MolNum, & & RayScatCoefNonRadAct, m_RayScatCoef & & ) #endif case ( IDMethodLBLConstPF ) RayScatCoefNonRadAct = 0.0d0 m_RayScatCoef = 0.0d0 !!$ call OptPropLBLConstPFGetAbsCoefProf( & !!$ & iWaveNum, kmax, NMol, rm_VMR, & !!$ & rm_AbsCoef & !!$ & ) case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopGetRayScatCoef( & & iWaveNum, & & NMol, m_MolNum, & & RayScatCoefNonRadAct, m_RayScatCoef & & ) #endif !!$ RayScatCoef = 0.0d0 case ( IDMethodKD ) call OptPropKDGetRayScatCoef( & & iWaveNum, & & NMol, m_MolNum, & & RayScatCoefNonRadAct, m_RayScatCoef & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetRayScatCoef !---------------------------------------------------------------------------- subroutine OptPropGetPtclParam( & & iWaveNum, & & kmax, NPtcl, a_PtclName, za_PtclRadius, & & za_QExt, za_SSA, za_AF & & ) #ifdef KDONLY #else use opt_prop_lbl , only : OptPropLBLGetPtclParam !!$ use opt_prop_lblconstpf, only : OptPropLBLConstPFGetAbsCoefProf !!$ use opt_prop_kddevelop , only : OptPropKDDevelopGetAbsCoefProf #endif use opt_prop_kd , only : OptPropKDGetPtclParam integer , intent(in ) :: iWaveNum integer , intent(in ) :: kmax integer , intent(in ) :: NPtcl character(*), intent(in ) :: a_PtclName(NPtcl) real(DP) , intent(in ) :: za_PtclRadius(kmax,NPtcl) real(DP) , intent(out) :: za_QExt(kmax,NPtcl) real(DP) , intent(out) :: za_SSA (kmax,NPtcl) real(DP) , intent(out) :: za_AF (kmax,NPtcl) ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLGetPtclParam( & & iWaveNum, & & kmax, NPtcl, a_PtclName, za_PtclRadius, & & za_QExt, za_SSA, za_AF & & ) #endif case ( IDMethodLBLConstPF ) za_QExt = 0.0d0 za_SSA = 0.0d0 za_AF = 0.0d0 !!$ call OptPropLBLConstPFGetAbsCoefProf( & !!$ & iWaveNum, kmax, NMol, rm_VMR, & !!$ & rm_AbsCoef & !!$ & ) case ( IDMethodKDDevelop ) za_QExt = 0.0d0 za_SSA = 0.0d0 za_AF = 0.0d0 !!$ call OptPropKDDevelopGetAbsCoefProf( & !!$ & iWaveNum, kmax, NMol, rm_VMR, & !!$ & rm_AbsCoef & !!$ & ) case ( IDMethodKD ) call OptPropKDGetPtclParam( & & iWaveNum, & & kmax, NPtcl, a_PtclName, za_PtclRadius, & & za_QExt, za_SSA, za_AF & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetPtclParam !---------------------------------------------------------------------------- subroutine OptPropGetPFInted( & & iWaveNum, & & kmax, & & r_Temp, SurfTemp, & & r_AtmPFInted, SurfPFInted, SurfDPFDTInted & & ) #ifdef KDONLY #else use opt_prop_lbl, only : OptPropLBLGetPFInted !!$ use opt_prop_lblconstpf, only : OptPropLBLConstPFGetPFInted #endif integer , intent(in ) :: iWaveNum integer , intent(in ) :: kmax real(DP), intent(in ) :: r_Temp (1:kmax) real(DP), intent(in ) :: SurfTemp real(DP), intent(out) :: r_AtmPFInted(1:kmax) real(DP), intent(out) :: SurfPFInted real(DP), intent(out) :: SurfDPFDTInted ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLGetPFInted( & & iWaveNum, & & kmax, & & r_Temp, SurfTemp, & & r_AtmPFInted, SurfPFInted, SurfDPFDTInted & & ) #endif case ( IDMethodLBLConstPF ) write( 6, * ) 'OptPropGetPFInted cannot be used when IDMethod is IDMethodLBLConstPF' stop !!$ call OptPropLBLConstPFGetPFInted( & !!$ & iWaveNum, & !!$ & kmax, & !!$ & r_Temp, SurfTemp, & !!$ & r_AtmPFInted, SurfPFInted, SurfDPFDTInted & !!$ & ) case ( IDMethodKDDevelop ) write( 6, * ) 'OptPropGetPFInted cannot be used when IDMethod is IDMethodKDDevelop' stop !!$ call OptPropGetPFIntedCore( & !!$ & iWaveNum, & !!$ & kmax, & !!$ & r_Temp, SurfTemp, & !!$ & r_AtmPFInted, SurfPFInted, SurfDPFDTInted & !!$ & ) case ( IDMethodKD ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFInted cannot be used when IDMethod is IDMethodKD' stop case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetPFInted !---------------------------------------------------------------------------- subroutine OptPropGetStrPFInted( & & iWaveNum, StrFluxTOA, & & StrPFInted & & ) #ifdef KDONLY #else use opt_prop_lbl, only : OptPropLBLGetStrPFInted !!$ use opt_prop_lblconstpf, only : OptPropLBLConstPFGetStrPFInted #endif integer , intent(in ) :: iWaveNum real(DP), intent(in ) :: StrFluxTOA real(DP), intent(out) :: StrPFInted ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLGetStrPFInted( & & iWaveNum, StrFluxTOA, & & StrPFInted & & ) #endif case ( IDMethodLBLConstPF ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFInted cannot be used when IDMethod is IDMethodLBLConstPF' stop !!$ call OptPropLBLConstPFGetStrPFInted( & !!$ & iWaveNum, & !!$ & StrPFInted & !!$ & ) case ( IDMethodKDDevelop ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFInted cannot be used when IDMethod is IDMethodKDDevelop' stop !!$ call OptPropGetStrPFIntedCore( & !!$ & iWaveNum, & !!$ & StrPFInted & !!$ & ) case ( IDMethodKD ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFInted cannot be used when IDMethod is IDMethodKD' stop case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetStrPFInted !---------------------------------------------------------------------------- subroutine OptPropGetStrBandAvePF( & & iBand, StrFluxTOA, & & StrBandAvePF & & ) #ifdef KDONLY #else use opt_prop_lblconstpf, only : OptPropLBLConstPFGetStrBandAvePF use opt_prop_kddevelop , only : OptPropKDDevelopGetStrBandAvePF #endif use opt_prop_kd , only : OptPropKDGetStrBandAvePF integer , intent(in ) :: iBand real(DP), intent(in ) :: StrFluxTOA real(DP), intent(out) :: StrBandAvePF ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFInted cannot be used when IDMethod is IDMethodLBL' stop case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLConstPFGetStrBandAvePF( & & iBand, StrFluxTOA, & & StrBandAvePF & & ) #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopGetStrBandAvePF( & & iBand, StrFluxTOA, & & StrBandAvePF & & ) #endif case ( IDMethodKD ) call OptPropKDGetStrBandAvePF( & & iBand, StrFluxTOA, & & StrBandAvePF & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetStrBandAvePF !---------------------------------------------------------------------------- !!$ subroutine OptPropGetPFIntedRatio( & subroutine OptPropGetPFIntedRatioLBLKDDevelop( & & iWaveNum, kmax, r_Temp, SurfTemp, & & r_AtmPFRatio, SurfPFRatio & & ) #ifdef KDONLY #else use opt_prop_lblconstpf, only : OptPropLBLConstPFGetPFIntedRatio use opt_prop_kddevelop , only : OptPropKDDevelopGetPFIntedRatio #endif !!$ use opt_prop_kd , only : OptPropKDGetPFIntedRatio integer , intent(in ) :: iWaveNum integer , intent(in ) :: kmax real(DP) , intent(in ) :: r_Temp (1:kmax) real(DP) , intent(in ) :: SurfTemp real(DP) , intent(out) :: r_AtmPFRatio(1:kmax) real(DP) , intent(out) :: SurfPFRatio ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFIntedRatio cannot be used when IDMethod is IDMethodLBL' stop case ( IDMethodLBLConstPF ) !!$ write( 6, * ) 'In ', trim( ModuleName ) !!$ write( 6, * ) ' function OptPropGetPFIntedRatio cannot be used when IDMethod is IDMethodLBLConst' !!$ stop #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLConstPFGetPFIntedRatio( & & iWaveNum, kmax, & & r_AtmPFRatio, SurfPFRatio & & ) #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopGetPFIntedRatio( & & iWaveNum, kmax, & & r_AtmPFRatio, SurfPFRatio & & ) #endif case ( IDMethodKD ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFIntedRatio cannot be used when IDMethod is IDMethodKD' stop !!$ call OptPropKDGetPFIntedRatio( & !!$ & iWaveNum, kmax, r_Temp, SurfTemp, & !!$ & r_AtmPFRatio, SurfPFRatio & !!$ & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select !!$ end subroutine OptPropGetPFIntedRatio end subroutine OptPropGetPFIntedRatioLBLKDDevelop !---------------------------------------------------------------------------- subroutine OptPropGetStrPFIntedRatio( & & iWaveNum, & & StrPFRatio & & ) #ifdef KDONLY #else use opt_prop_lblconstpf, only : OptPropLBLConstPFGetStrPFIntedRatio use opt_prop_kddevelop , only : OptPropKDDevelopGetStrPFIntedRatio #endif use opt_prop_kd , only : OptPropKDGetStrPFIntedRatio integer , intent(in ) :: iWaveNum real(DP) , intent(out) :: StrPFRatio ! local variables ! if ( .not. FlagInited ) then write( 6, * ) trim( ModuleName ), " is not initialized." stop end if select case ( IDMethod ) case ( IDMethodLBL ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropGetPFIntedRatio cannot be used when IDMethod is IDMethodLBL' stop end select select case ( IDMethod ) case ( IDMethodLBLConstPF ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropLBLConstPFGetStrPFIntedRatio( & & iWaveNum, & & StrPFRatio & & ) #endif case ( IDMethodKDDevelop ) #ifdef KDONLY stop 'This is not supported.' #else call OptPropKDDevelopGetStrPFIntedRatio( & & iWaveNum, & & StrPFRatio & & ) #endif case ( IDMethodKD ) call OptPropKDGetStrPFIntedRatio( & & iWaveNum, & & StrPFRatio & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropGetStrPFIntedRatio !---------------------------------------------------------------------------- subroutine OptPropPFTblGetPFDPFDT1D( & & iBand, NLev, a_Temp, & & a_PF, & & FlagDPFDT & & ) use opt_prop_kd, only : OptPropKDPFTblGetPFDPFDT integer , intent(in ) :: iBand integer , intent(in ) :: NLev real(dp), intent(in ) :: a_Temp(NLev) real(dp), intent(out) :: a_PF (NLev) logical , intent(in ), optional :: FlagDPFDT ! Local variables ! select case ( IDMethod ) case ( IDMethodLBL, IDMethodLBLConstPF, IDMethodKDDevelop ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropPFTblGetPFDPFDT1D cannot be used ' & & //' when IDMethod is IDMethodLBL, IDMethodLBLConstPF, IDMethodKDDevelop' stop case ( IDMethodKD ) call OptPropKDPFTblGetPFDPFDT( & & iBand, NLev, a_Temp, & & a_PF, & & FlagDPFDT & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropPFTblGetPFDPFDT1D !---------------------------------------------------------------------------- subroutine OptPropPFTblGetPFDPFDT0D( & & iBand, Temp, & & PF, & & FlagDPFDT & & ) use opt_prop_kd, only : OptPropKDPFTblGetPFDPFDT integer , intent(in ) :: iBand real(dp), intent(in ) :: Temp real(dp), intent(out) :: PF logical , intent(in ), optional :: FlagDPFDT ! Local variables ! select case ( IDMethod ) case ( IDMethodLBL, IDMethodLBLConstPF, IDMethodKDDevelop ) write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' function OptPropPFTblGetPFDPFDT0D cannot be used ' & & //' when IDMethod is IDMethodLBL, IDMethodLBLConstPF, IDMethodKDDevelop' stop case ( IDMethodKD ) call OptPropKDPFTblGetPFDPFDT( & & iBand, Temp, & & PF, & & FlagDPFDT & & ) case default write( 6, * ) 'In ', trim( ModuleName ) write( 6, * ) ' Unexpected case default' stop end select end subroutine OptPropPFTblGetPFDPFDT0D !---------------------------------------------------------------------------- end module opt_prop