module gas_tf_mod ! ! fil ! ! ! ds ! ! ! Module that calculates gas transmission functions ! ! ! ! shared modules: use mpp_mod, only : input_nml_file use fms_mod, only : open_namelist_file, fms_init, & mpp_pe, mpp_root_pe, stdlog, & file_exist, write_version_number, & check_nml_error, error_mesg, & FATAL, close_file, & open_restart_file use constants_mod, only : constants_init, RDGAS, GRAV, pstd ! shared radiation package modules: use rad_utilities_mod, only : rad_utilities_init, Lw_control, & atmos_input_type, gas_tf_type use longwave_params_mod, only : longwave_params_init, NBCO215 !--------------------------------------------------------------------- implicit none private !--------------------------------------------------------------------- ! gas_tf_mod is the gas transmission functions module. !--------------------------------------------------------------------- !--------------------------------------------------------------------- !----------- version number for this module ------------------- character(len=128) :: version = '$Id: gas_tf.F90,v 19.0 2012/01/06 20:16:25 fms Exp $' character(len=128) :: tagname = '$Name: tikal $' !--------------------------------------------------------------------- !------ interfaces ------ public & gas_tf_init, co2coef, transcol, & transcolrow, trans_nearby, trans_sfc, & put_co2_stdtf_for_gas_tf, & put_co2_nbltf_for_gas_tf, & put_ch4_stdtf_for_gas_tf, & put_n2o_stdtf_for_gas_tf, & get_control_gas_tf, & process_co2_input_file, & process_ch4_input_file, & process_n2o_input_file, & gas_tf_dealloc, gas_tf_end private & ! called from gas_tf_init: ptz, & ! called from ptz: antemp, & ! called from process_co2_input_file, ! process_ch4_input_file and process_n2o_input_file: process_gas_input_file, & ! called from co2coef: transfn !--------------------------------------------------------------------- !------ namelist ----- character(len=16) :: interp_form='log' logical :: do_calcstdco2tfs = .true., & do_writestdco2tfs = .false., & do_readstdco2tfs = .false. logical :: do_calcstdch4tfs = .true., & do_writestdch4tfs = .false., & do_readstdch4tfs = .false. logical :: do_calcstdn2otfs = .true., & do_writestdn2otfs = .false., & do_readstdn2otfs = .false. namelist / gas_tf_nml / & interp_form, & do_calcstdch4tfs, & do_writestdch4tfs, & do_readstdch4tfs, & do_calcstdn2otfs, & do_writestdn2otfs, & do_readstdn2otfs, & do_calcstdco2tfs, & do_writestdco2tfs, & do_readstdco2tfs !--------------------------------------------------------------------- !---- public data ------- !--------------------------------------------------------------------- !---- private data ------- !--------------------------------------------------------------------- ! the following arrays are co2 transmission functions, temperature ! and pressure derivatives for the 560-800 cm-1 band, and standard ! temperature and weighting functions. ! ! co251 = transmission functions for t0 (standard profile) ! with p(surface)=1013.25 mb. ! ! co258 = transmission functions for t0 (standard profile) ! with p(surface)=810 mb. ! ! cdt51 = first temperature derivative of co251. ! ! cdt58 = first temperature derivative of co258. ! ! c2d51 = second temperature derivative of co251. ! ! c2d58 = second temperature derivative of co258. ! ! co2m51 = transmission functions for t0 for adjacent pressure ! levels, with no pressure quadrature. used for nearby ! layer computations. p(surface)=1013.25 mb. ! ! co2m58 = transmission functions for t0 for adjacent pressure ! levels, with no pressure quadrature. used for nearby ! layer computations. p(surface)=810 mb. ! ! cdtm51 = first temperature derivative of co2m51. ! ! cdtm58 = first temperature derivative of co2m58. ! ! c2dm51 = second temperature derivative of co2m51. ! ! c2dm58 = second temperature derivative of co2m58. !--------------------------------------------------------------------- real, allocatable, dimension (:,:) :: co251, co258, & cdt51, cdt58, & c2d51, c2d58 real, allocatable, dimension (:) :: co2m51, co2m58, & cdtm51, cdtm58, & c2dm51, c2dm58 !--------------------------------------------------------------------- ! the following arrays are co2 transmission functions for the 2270- ! 2380 cm-1 part of the 4.3 um co2 band. ! ! co211 = transmission functions for t0 (standard profile) ! with p(surface)=1013.25 mb. ! ! co218 = transmission functions for t0 (standard profile) ! with p(surface)=810 mb. !--------------------------------------------------------------------- real, allocatable, dimension (:) :: co211, co218 !--------------------------------------------------------------------- ! the following arrays are co2 transmission functions and temperature ! and pressure derivatives for (NBCO215) narrow bands in the 15um ! co2 band. ! ! co215nbps1 = transmission functions for USSTD profile ! with p(surface)=1013.25 mb. ! co215nbps8 = transmission functions for USSTD profile ! with p(surface)=810.2 mb. ! ! co2dt15nbps1 = temperature derivative of co215nbps1. ! ! co2dt15nbps8 = temperature derivative of co215nbps8. ! ! co2d2t15nbps1 = second temperature derivative of co215nbps1. ! ! co2d2t15nbps8 = second temperature derivative of co215nbps8. !--------------------------------------------------------------------- real, allocatable, dimension (:,:) :: co215nbps1, & co215nbps8, & co2dt15nbps1, & co2dt15nbps8, & co2d2t15nbps1, & co2d2t15nbps8 !--------------------------------------------------------------------- ! the following arrays are ch4 and n2o transmission functions for ! the 1200-1400 cm-1 band. ! ! ch451 = ch4 transmission functions for t0 (standard profile) ! with p(surface)=1013.25 mb. ! ! ch458 = ch4 transmission functions for t0 (standard profile) ! with p(surface)=810 mb. ! ! ch4dt51 = first temperature derivative of ch4 transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! ch4d2t51= second temperature derivative of ch4 transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! ch4dt58 = first temperature derivative of ch4 transmission ! functions for t0 profile with p(surface)=810 mb. ! ! ch4d2t58= second temperature derivative of ch4 transmission ! functions for t0 profile with p(surface)=810 mb. ! ! n2o51 = n2o transmission functions for t0 (standard profile) ! with p(surface)=1013.25 mb. ! ! n2o58 = n2o transmission functions for t0 (standard profile) ! with p(surface)=810 mb. ! ! n2odt51 = first temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! n2od2t51= second temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! n2odt58 = first temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=810 mb. ! ! n2od2t58= second temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=810 mb. !--------------------------------------------------------------------- real, allocatable, dimension (:,:) :: ch451, ch458, & ch4dt51, ch4dt58, & ch4d2t51, ch4d2t58 real, allocatable, dimension (:,:) :: n2o51, n2o58, & n2odt51, n2odt58, & n2od2t51, n2od2t58 !--------------------------------------------------------------------- ! the following arrays are n2o transmission functions for ! the 560-630 cm-1 band. ! ! n2o71 = n2o transmission functions for t0 (standard profile) ! with p(surface)=1013.25 mb. ! ! n2o78 = n2o transmission functions for t0 (standard profile) ! with p(surface)=810 mb. ! ! n2odt71 = first temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! n2od2t71= second temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! n2odt78 = first temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=810 mb. ! ! n2od2t78= second temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=810 mb. !--------------------------------------------------------------------- ! real, allocatable, dimension (:,:) :: n2o71, n2o78, & n2odt71, n2odt78, & n2od2t71, n2od2t78 !--------------------------------------------------------------------- ! the following arrays are n2o transmission functions for ! the 1070-1200 cm-1 band. ! ! n2o91 = n2o transmission functions for t0 (standard profile) ! with p(surface)=1013.25 mb. ! ! n2o98 = n2o transmission functions for t0 (standard profile) ! with p(surface)=810 mb. ! ! n2odt91 = first temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! n2od2t91= second temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=1013.25 mb. ! ! n2odt98 = first temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=810 mb. ! ! n2od2t98= second temperature derivative of n2o transmission ! functions for t0 profile with p(surface)=810 mb. !--------------------------------------------------------------------- real, allocatable, dimension (:,:) :: n2o91, n2o98, & n2odt91, n2odt98, & n2od2t91, n2od2t98 !---------------------------------------------------------------------- ! stemp = standard temperatures for model pressure level ! structure with p(surface)=1013.25 mb. ! gtemp = weighting function for model pressure level ! structure with p(surface)=1013.25 mb. !---------------------------------------------------------------------- real, dimension (:), allocatable :: stemp, gtemp !---------------------------------------------------------------------- ! define 4 coefficients (formerly in Id3). ! b0, b1, b2, b3 are coefficients used to correct for the use of ! 250k in the planck function used in evaluating planck-weighted co2 ! transmission functions. (see reference(1).) !---------------------------------------------------------------------- real :: b0 = -0.51926410E-04 real :: b1 = -0.18113332E-03 real :: b2 = -0.10680132E-05 real :: b3 = -0.67303519E-07 integer :: ksrad, kerad integer, parameter :: nvalids=1 integer :: ixprkminh2o logical :: do_linearlblint, do_loglblint character(len=8) :: co2_name_save, ch4_name_save, n2o_name_save real :: co2_amount_save, ch4_amount_save, & n2o_amount_save integer :: nstdlvls_save, kbegin_save, kend_save real, dimension(:), allocatable :: pa_save, pd_save, plm_save character(len=8), dimension(nvalids) :: valid_versions= 'v1.00' logical :: module_is_initialized = .false. ! module is initialized ? !--------------------------------------------------------------------- !--------------------------------------------------------------------- contains !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! PUBLIC SUBROUTINES ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !############################################################### ! ! ! Initialize gas transmission function calculation from input ! namelist, model pressure coordinate system, etc. ! ! ! Initialize gas transmission function calculation from input ! namelist, model pressure coordinate system, etc. ! ! ! ! Model pressure coordinate array ! ! ! subroutine gas_tf_init (pref) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- real, dimension(:,:), intent(in) :: pref !--------------------------------------------------------------------- ! intent(in) variables: ! ! pref ! !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables; real, dimension (size(pref,1)) :: plm real, dimension (size(pref,1)) :: pd real :: prkminh2o = 28.0 integer :: kmin, kmax integer :: ks = 1 integer :: unit, ierr, io, logunit integer :: k !-------------------------------------------------------------------- ! local variables: ! ! plm ! pd ! prkminh2o pressure above which h2o-co2 overlap affects ! nearby layer transmissivities [ mb ] ! kmin ! kmax ! ks ! unit ! ierr ! io ! k ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! if routine has already been executed, exit. !--------------------------------------------------------------------- if (module_is_initialized) return !--------------------------------------------------------------------- ! verify that modules used by this module that are not called later ! have already been initialized. !--------------------------------------------------------------------- call fms_init call constants_init call rad_utilities_init call longwave_params_init #ifdef INTERNAL_FILE_NML read (input_nml_file, nml=gas_tf_nml, iostat=io) ierr = check_nml_error(io,"gas_tf_nml") #else !----------------------------------------------------------------------- ! read namelist. !----------------------------------------------------------------------- if ( file_exist('input.nml')) then unit = open_namelist_file ( ) ierr=1; do while (ierr /= 0) read (unit, nml=gas_tf_nml, iostat=io, end=10) ierr = check_nml_error(io,'gas_tf_nml') end do 10 call close_file (unit) endif #endif !--------------------------------------------------------------------- ! write version number and namelist to logfile. !--------------------------------------------------------------------- call write_version_number(version, tagname) logunit = stdlog() if (mpp_pe() == mpp_root_pe() ) & write (logunit, nml=gas_tf_nml) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- kmin = 1 kerad = size(pref ,1) - 1 kmax = kerad ksrad = 1 ks = 1 !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- pd (:) = pref(:,1) plm (kmin) = 0. do k=kmin+1,kmax plm (k) = 0.5*(pd (k-1) + pd (k)) enddo plm (kmax+1) = pd (kmax+1) !--------------------------------------------------------------------- ! convert plm to mb. !--------------------------------------------------------------------- plm = plm *1.0E-02 pd = pd *1.0E-02 !-------------------------------------------------------------------- ! check on consistency between namelist values !-------------------------------------------------------------------- if ( (Lw_control%do_ch4lbltmpint) .and. & (.not.(Lw_control%do_ch4)) ) then call error_mesg ( 'gas_tf_mod', & 'cannot have do_ch4lbltmpint active when do_ch4 is off',& FATAL) endif if ( (Lw_control%do_n2olbltmpint) .and. & (.not.(Lw_control%do_n2o)) ) then call error_mesg ( 'gas_tf_mod', & 'cannot have do_n2olbltmpint active when do_n2o is off',& FATAL) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (trim(interp_form) == 'log') then do_loglblint = .true. do_linearlblint = .false. else if (trim(interp_form) == 'linear') then do_loglblint = .false. do_linearlblint = .true. else call error_mesg ( 'gas_tf_mod', & 'improper specification for gas lbl interpolation scheme', FATAL) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (Lw_control%do_co2_iz) then if (Lw_control%do_co2) then if (do_writestdco2tfs .and. do_readstdco2tfs) then call error_mesg ( 'gas_tf_mod', & ' cannot read and write std tfs in same job', FATAL) endif if (do_writestdco2tfs .and. .not. do_calcstdco2tfs) then call error_mesg ( 'gas_tf_mod', & ' cannot write std tfs without calculating them', FATAL) endif endif else call error_mesg ('gas_tf_mod', & 'do_co2 has not yet been defined', FATAL) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (Lw_control%do_ch4_iz) then if (Lw_control%do_ch4) then if (do_writestdch4tfs .and. do_readstdch4tfs) then call error_mesg ( 'gas_tf_mod', & ' cannot read and write std tfs in same job', FATAL) endif if (do_writestdch4tfs .and. .not. do_calcstdch4tfs) then call error_mesg ( 'gas_tf_mod', & ' cannot write std tfs without calculating them', FATAL) endif endif else call error_mesg ('gas_tf_mod', & 'do_ch4 has not yet been defined', FATAL) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (Lw_control%do_n2o_iz) then if (Lw_control%do_n2o) then if (do_writestdn2otfs .and. do_readstdn2otfs) then call error_mesg ( 'gas_tf_mod', & ' cannot read and write std tfs in same job', FATAL) endif if (do_writestdn2otfs .and. .not. do_calcstdn2otfs) then call error_mesg ( 'gas_tf_mod', & ' cannot write std tfs without calculating them', FATAL) endif endif else call error_mesg ('gas_tf_mod', & 'do_n2o has not yet been defined', FATAL) endif !-------------------------------------------------------------------- ! call ptz to compute standard temps and a pressure coefficient ! (gtemp) used in the radiation algorithm. !-------------------------------------------------------------------- call ptz (plm, pd) !-------------------------------------------------------------------- ! convert pressure specification for top (flux) pressure level ! for nearby layer calculation into an index (ixprkminh2o) ! note: minimum value of ixprkminh2o is KSRAD . (but if KSRAD = 1, ! plm(1) is zero, so minimum value of KSRAD is at least 2). ! if all levels used for radiative calculations are at pressures ! less than 28 mb, nearby layer effects are going to be ignored, ! so ixprkminh2o is set to KERAD+1 to avoid loop calculations. !-------------------------------------------------------------------- if (plm(ks) >= prkminh2o) then ixprkminh2o = 1 else if (plm(kmax ) < prkminh2o) then ixprkminh2o = (kmax - ks + 1) + 1 else do k=ks+1,kmax if ((plm(k) - prkminh2o) .LT. 0.0) then !! ixprkminh2o in radiation grid coordianates, not model grid coords else ixprkminh2o = k-ks + 1 exit endif enddo endif !---------------------------------------------------------------------- ! allocate co2 transmission function arrays to hold data which will ! either be read in or will be coming from lw_gases_stdtf module. !---------------------------------------------------------------------- if (Lw_control%do_co2) then allocate (cdtm51(KSRAD:KERAD) , & co2m51(KSRAD:KERAD) , & c2dm51(KSRAD:KERAD) , & cdtm58(KSRAD:KERAD) , & co2m58(KSRAD:KERAD) , & c2dm58(KSRAD:KERAD) ) allocate (co2dt15nbps1(KSRAD:KERAD+1, NBCO215) , & co215nbps1(KSRAD:KERAD+1, NBCO215) , & co2d2t15nbps1(KSRAD:KERAD+1, NBCO215) , & co2dt15nbps8(KSRAD:KERAD+1, NBCO215) , & co215nbps8(KSRAD:KERAD+1, NBCO215) , & co2d2t15nbps8(KSRAD:KERAD+1, NBCO215) ) allocate (cdt51(KSRAD:KERAD+1, KSRAD:KERAD+1) , & co251(KSRAD:KERAD+1, KSRAD:KERAD+1) , & c2d51(KSRAD:KERAD+1, KSRAD:KERAD+1) , & cdt58(KSRAD:KERAD+1, KSRAD:KERAD+1) , & co258(KSRAD:KERAD+1, KSRAD:KERAD+1) , & c2d58(KSRAD:KERAD+1, KSRAD:KERAD+1) ) allocate (co211(KSRAD:KERAD+1) , & co218(KSRAD:KERAD+1) ) endif !---------------------------------------------------------------------- ! allocate ch4 and n2o transmission function arrays to hold data ! which will either be read in or will be coming from ! lw_gases_stdtf module. !---------------------------------------------------------------------- if (Lw_control%do_ch4) then allocate (ch4dt51(KSRAD:KERAD+1, KSRAD:KERAD+1) , & ch451(KSRAD:KERAD+1, KSRAD:KERAD+1) , & ch4d2t51(KSRAD:KERAD+1, KSRAD:KERAD+1) , & ch4dt58(KSRAD:KERAD+1, KSRAD:KERAD+1) , & ch458(KSRAD:KERAD+1, KSRAD:KERAD+1) , & ch4d2t58(KSRAD:KERAD+1, KSRAD:KERAD+1) ) endif if (Lw_control%do_n2o) then allocate (n2odt51(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2o51(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2od2t51(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2odt58(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2o58(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2od2t58(KSRAD:KERAD+1, KSRAD:KERAD+1) ) allocate (n2odt91(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2o91(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2od2t91(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2odt98(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2o98(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2od2t98(KSRAD:KERAD+1, KSRAD:KERAD+1) ) allocate (n2odt71(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2o71(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2od2t71(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2odt78(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2o78(KSRAD:KERAD+1, KSRAD:KERAD+1) , & n2od2t78(KSRAD:KERAD+1, KSRAD:KERAD+1) ) endif !------------------------------------------------------------------- ! mark the module as initialized. !------------------------------------------------------------------- module_is_initialized = .true. !--------------------------------------------------------------------- end subroutine gas_tf_init !################################################################### ! ! ! Calculate CO2 absorption coefficients and transmission function ! ! ! Calculate CO2 absorption coefficients and transmission function ! ! ! ! The input data of the atmosphere structure and gas concentration ! ! ! The gas transmission function table ! ! ! subroutine co2coef (Atmos_input, Gas_tf) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- type(gas_tf_type), intent(inout) :: Gas_tf type(atmos_input_type), intent(in) :: Atmos_input !-------------------------------------------------------------------- ! intent(in) variables: ! ! Atmos_input ! ! intent(inout) variables: ! ! Gas_tf ! !------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: real, dimension (size(Atmos_input%pflux,1), & size(Atmos_input%pflux,2), & size(Atmos_input%pflux,3)-1) :: pdflux real, dimension (size(Atmos_input%pflux,1), & size(Atmos_input%pflux,2), & size(Atmos_input%pflux,3) ) :: & tdif, press, temp, pflux, tflux real :: palog8, alogps8 integer :: i, j, k integer :: israd, ierad, jsrad, jerad !--------------------------------------------------------------------- ! local variables: ! ! pdflux ! tdif ! press ! temp ! pflux ! tflux ! palog8 ! alogp8 ! i,j,k ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! convert press and pflux to cgs. !--------------------------------------------------------------------- press(:,:,:) = 10.0*Atmos_input%press(:,:,:) pflux(:,:,:) = 10.0*Atmos_input%pflux(:,:,:) tflux(:,:,:) = Atmos_input%tflux(:,:,:) temp(:,:,:) = Atmos_input%temp(:,:,:) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- israd = 1 ierad = size(Atmos_input%press,1) jsrad = 1 jerad = size(Atmos_input%press,2) !--------------------------------------------------------------------- ! allocate module variables !--------------------------------------------------------------------- allocate (Gas_tf%a1 (ISRAD:IERAD, JSRAD:JERAD )) allocate (Gas_tf%a2 (ISRAD:IERAD, JSRAD:JERAD )) allocate (Gas_tf%tdav (ISRAD:IERAD, JSRAD:JERAD,KSRAD:KERAD+1)) allocate (Gas_tf%tlsqu (ISRAD:IERAD, JSRAD:JERAD,KSRAD:KERAD+1)) allocate (Gas_tf%tmpdiff (ISRAD:IERAD, JSRAD:JERAD,KSRAD:KERAD+1)) allocate (Gas_tf%tstdav (ISRAD:IERAD, JSRAD:JERAD,KSRAD:KERAD+1)) allocate (Gas_tf%co2nbl (ISRAD:IERAD, JSRAD:JERAD,KSRAD:KERAD )) allocate (Gas_tf%n2o9c (ISRAD:IERAD, JSRAD:JERAD,KSRAD:KERAD+1)) allocate (Gas_tf%tn2o17 (ISRAD:IERAD, JSRAD:JERAD,KSRAD:KERAD+1)) allocate (Gas_tf%co2spnb (ISRAD:IERAD, JSRAD:JERAD, & KSRAD:KERAD+1, NBCO215)) Gas_tf%co2nbl = 1.0 Gas_tf%co2spnb = 1.0 Gas_tf%n2o9c = 0. Gas_tf%tn2o17 = 0.0 !-------------------------------------------------------------------- ! compute temperature difference between model profile and ! standard profile !--------------------------------------------------------------------- do k = KSRAD,KERAD+1 Gas_tf%tmpdiff(:,:,k) = temp(:,:,k) - stemp(k) enddo !----------------------------------------------------------------------- ! compute weighted temperature difference (tdav) and pressure ! integrals (tstdav) from level KSRAD to level KERAD. the quotient ! of these will be used to obtain the difference (dift) between the ! model temperature profile and the standard profile. !----------------------------------------------------------------------- Gas_tf%tstdav(:,:,KSRAD) = 0.0E+00 Gas_tf%tdav (:,:,KSRAD) = 0.0E+00 do k=KSRAD,KERAD pdflux(:,:,k) = pflux(:,:,k+1) - pflux(:,:,k) Gas_tf%tstdav(:,:,k+1) = Gas_tf%tstdav(:,:,k) + gtemp(k)* & pdflux(:,:,k) Gas_tf%tdav (:,:,k+1) = Gas_tf%tdav (:,:,k) + gtemp(k)* & pdflux(:,:,k)*Gas_tf%tmpdiff(:,:,k) enddo !---------------------------------------------------------------------- ! evaluate coefficients for co2 pressure interpolation (a1, a2). ! a linear interpolation is presently assumed, with the 2 ! 2nd pressure profile having pressures 0.8* the first, thus ! accounting for the 0.8 and 0.2 factors. !---------------------------------------------------------------------- if (do_linearlblint) then Gas_tf%a1(:,:) = (press(:,:,KERAD+1) - pstd*0.8E+00)/ & (pstd*0.2E+00) Gas_tf%a2(:,:) = (pstd - press(:,:,KERAD+1))/(pstd*0.2E+00) !---------------------------------------------------------------------- ! a logarithmic interpolation is presently assumed, with the 2 ! 2nd pressure profile having pressures 0.8* the first, thus ! accounting for the 0.8 and 0.2 factors. The denominator, which ! is (log(pstd) - log(0.8*pstd)) is a constant (-log(0.8)) so the ! expression can be replaced by the quantity palog8. !---------------------------------------------------------------------- else if (do_loglblint) then alogps8 = ALOG(pstd*0.8E+00) palog8 = -ALOG(0.8E+00) Gas_tf%a1(:,:) = (ALOG(press(:,:,KERAD+1)) - alogps8)/palog8 Gas_tf%a2(:,:) = 1.0E+00 - Gas_tf%a1(:,:) else call error_mesg ('gas_tf_mod', & 'neither linearlblint nor loglblint was specified.', & FATAL) endif !---------------------------------------------------------------------- ! compute temperature coefficient based on tflux. see fels and ! schwarzkopf (1981) for details. !---------------------------------------------------------------------- tdif(:,:,:) = tflux(:,:,:) - 2.5E+02 do k=KSRAD,KERAD+1 do j=JSRAD,JERAD do i=ISRAD,IERAD if (tflux(i,j,k) .LE. 2.5E+02) then Gas_tf%tlsqu(i,j,k) = b0 + tdif (i,j,k) * & (b1 + tdif (i,j,k) * & (b2 + b3* tdif (i,j,k) )) else Gas_tf%tlsqu(i,j,k) = b0 endif enddo enddo enddo !---------------------------------------------------------------------- ! call transfn to compute temperature-corrected co2 transmission ! functions (co2spnb and co2nbl). !--------------------------------------------------------------------- if (Lw_control%do_co2) then call transfn (Gas_tf) endif !------------------------------------------------------------------- end subroutine co2coef !##################################################################### ! ! ! Subroutine to compute temperature-corrected co2 transmission ! functions at a particular (krow). ! ! ! Subroutine to compute temperature-corrected co2 transmission ! functions at a particular (krow). ! ! ! ! Not used ! ! ! The row index where co2 transmission is calculated ! ! ! The starting column index number ! ! ! The ending column index number ! ! ! The column of transmission functions ! ! ! The pre temperature-corrected co2 transmission functions ! ! ! subroutine transcol (kcol, krow, kcols, kcole, co21c, Gas_tf) !--------------------------------------------------------------------- ! transcol computes temperature-corrected co2 transmission ! functions at a particular (krow). ! author: c. l. kerr ! revised: 11/11/93 ! certified: radiation version 1.0 !--------------------------------------------------------------------- integer, intent(in) :: krow, kcol, kcols, kcole real, dimension(:,:,:), intent(out) :: co21c type(gas_tf_type), intent(in) :: Gas_tf !------------------------------------------------------------------- ! intent(in) variables: ! ! krow ! kcol ! kcols ! kcole ! Gas_tf ! ! intent(out) variables: ! ! co21c column of transmission functions. ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: real, dimension (size(Gas_tf%tdav,1),& size(Gas_tf%tdav,2), & size(Gas_tf%tdav,3) ) :: & co2r, dift, d2cdt2, dco2dt integer :: kp !--------------------------------------------------------------------- ! local variables: ! ! co2r ! dift ! d2cdt2 ! dco2dt ! k,kp ! !---------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- co21c(:,:,KSRAD:KERAD+1) = 1.0E+00 !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- do kp = kcols,kcole if (kp .NE. krow) then dift(:,:,kp) = (Gas_tf%tdav (:,:,kp) - & Gas_tf%tdav(:,:,krow))/ & (Gas_tf%tstdav(:,:,kp) - & Gas_tf%tstdav(:,:,krow)) else if (krow .NE. KSRAD) then dift(:,:,kp) = 0.5E+00*(Gas_tf%tmpdiff(:,:,kp) + & Gas_tf%tmpdiff(:,:,kp-1)) else dift(:,:,kp) = 0.0E+00 endif end do !---------------------------------------------------------------------- ! obtain transmission functions used for the flux at a fixed level ! (krow). ie, tf's from varying flux levels (kp) to (krow) ! pressure interpolation !---------------------------------------------------------------------- do kp=kcols,kcole co2r (:,:,kp) = Gas_tf%a1(:,:)*co251(kp,krow) + & Gas_tf%a2(:,:)*co258(kp,krow) dco2dt(:,:,kp) = 1.0E-02*(Gas_tf%a1(:,:)*cdt51(kp,krow) + & Gas_tf%a2(:,:)*cdt58(kp,krow)) d2cdt2(:,:,kp) = 1.0E-03*(Gas_tf%a1(:,:)*c2d51(kp,krow) + & Gas_tf%a2(:,:)*c2d58(kp,krow)) enddo !---------------------------------------------------------------------- ! temperature interpolation !---------------------------------------------------------------------- do kp=kcols,kcole co21c (:,:,kp) = co2r(:,:,kp) + dift(:,:,kp)*(dco2dt(:,:,kp) + & 0.5E+00*dift(:,:,kp)*d2cdt2(:,:,kp)) enddo !---------------------------------------------------------------------- ! correction for finite width of co2 bands ! (Eqs. 7a-7c, Ref. (2)) !---------------------------------------------------------------------- do kp=kcols,kcole co21c(:,:,kp) = co21c(:,:,kp)*(1.0E+00 - & Gas_tf%tlsqu(:,:,kp)) + & Gas_tf%tlsqu(:,:,kp) enddo !---------------------------------------------------------------- end subroutine transcol !##################################################################### ! ! ! Subroutine to compute temperature-corrected co2/ch4/n2o transmission ! functions at a particular row and particular column. ! ! ! Subroutine to compute temperature-corrected co2/ch4/n2o transmission ! functions at a particular row and particular column. ! ! ! ! The column index of temperature-corrected transmission function ! ! ! The row index of temperature-corrected transmission function ! ! ! The starting column index number ! ! ! The ending column index number ! ! ! The starting row index number ! ! ! The ending row index number ! ! ! The column of transmission functions ! ! ! The row of transmission functions ! ! ! The ch4 and n2o transmission functions ! ! ! The pre temperature-corrected co2 transmission functions ! ! ! subroutine transcolrow (Gas_tf, kcol, krow, kcols, kcole, krows, krowe,& co21c, co21r, tch4n2oe) !---------------------------------------------------------------------- ! transcolrow computes the temperature-corrected co2 transmission ! functions for a particular (krow) (varying column index) and for ! a particular (kcol) (varying row index). ! transcolrow also computes the pressure-interpolated ch4 and n2o ! transmission functions for a particular (krow) and for a parti- ! cular (kcol). By assumption, no correction for finite bandwidth ! is performed. ! author: c. l. kerr ! revised: 11/11/93 ! certified: radiation version 1.0 !---------------------------------------------------------------------- integer, intent(in) :: kcol, krow, kcols, kcole, & krows, krowe type(gas_tf_type), intent(inout) :: Gas_tf real, dimension (:,:,:), intent(out) :: co21c, co21r real, dimension (:,:,:,:), intent(inout) :: tch4n2oe !---------------------------------------------------------------------- ! intent(in) variables: ! ! kcol ! krow ! kcols ! kcole ! krows ! krowe ! ! intent(inout) variables: ! ! Gas_tf ! tch4n2oe ! ! intent(out) variables: ! ! co21c column of transmission functions (fixed krow). ! co21r column of transmission functions (fixed kcol). ! !---------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real, dimension (size(Gas_tf%tdav,1), & size(Gas_tf%tdav,2), & size(Gas_tf%tdav,3) ) :: & ch41c, n2o1c, n2o17c,& co2p, dift, d2cdt2, dco2dt,& ch4p, d2ch4dt2, dch4dt, & d2n2odt2, dn2odt, & d2n2o17dt2, dn2o17dt, & d2n2o9dt2, dn2o9dt, n2op, & n2o17p, n2o9p integer :: kp !-------------------------------------------------------------------- ! local variables: ! ! ch41c = column of ch4 transmission functions (fixed krow). ! ch41r = column of ch4 transmission functions (fixed kcol). ! n2o1c = column of n2o transmission functions (fixed krow). ! n2o1r = column of n2o transmission functions (fixed kcol). ! n2o17c = column of n2o 17 um transmission functions (fixed krow). ! n2o17r = column of n2o 17 um transmission functions (fixed kcol). ! n2o9c = column of n2o 9 um transmission functions (fixed krow). ! n2o9r = column of n2o 9 um transmission functions (fixed kcol). ! kp ! !---------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !----------------------------------------------------------------------- ! initialization. !----------------------------------------------------------------------- co21c(:,:,kcols:kcole ) = 1.0E+00 co21r(:,:,KSRAD:KERAD+1) = 1.0E+00 ch41c(:,:,kcols:kcole ) = 1.0E+00 n2o1c(:,:,kcols:kcole) = 1.0E+00 n2o17c(:,:,KSRAD:KERAD+1) = 1.0E+00 Gas_tf%n2o9c(:,:,KSRAD:KERAD+1) = 1.0E+00 !----------------------------------------------------------------------- ! temperature difference averaged between levels k and kp !----------------------------------------------------------------------- do kp = kcols,kcole if (kp .NE. krow) then dift(:,:,kp) = (Gas_tf%tdav (:,:,kp) - & Gas_tf%tdav (:,:,krow))/ & (Gas_tf%tstdav(:,:,kp) - & Gas_tf%tstdav(:,:,krow)) elseif (krow .NE. KSRAD) then dift(:,:,kp) = 0.5E+00*(Gas_tf%tmpdiff(:,:,kp) + & Gas_tf%tmpdiff(:,:,kp-1)) else dift(:,:,kp) = 0.0E+00 endif end do !----------------------------------------------------------------------- ! obtain transmission functions used for the flux at a fixed level ! (krow). ie, tf's from varying flux levels (kp) to (krow) ! pressure interpolation !----------------------------------------------------------------------- do kp=kcols,kcole if (Lw_control%do_co2) then co2p (:,:,kp) = Gas_tf%a1(:,:)*co251(kp,krow) + & Gas_tf%a2(:,:)*co258(kp,krow) dco2dt(:,:,kp) = 1.0E-02*(Gas_tf%a1(:,:)*cdt51(kp,krow) + & Gas_tf%a2(:,:)*cdt58(kp,krow)) d2cdt2(:,:,kp) = 1.0E-03*(Gas_tf%a1(:,:)*c2d51(kp,krow) + & Gas_tf%a2(:,:)*c2d58(kp,krow)) endif if (Lw_control%do_ch4) then if (Lw_control%do_ch4lbltmpint) then ch4p (:,:,kp) = Gas_tf%a1(:,:)*ch451(kp,krow) + & Gas_tf%a2(:,:)*ch458(kp,krow) dch4dt(:,:,kp) = 1.0E-02*(Gas_tf%a1(:,:)*ch4dt51(kp,krow) +& Gas_tf%a2(:,:)*ch4dt58(kp,krow)) d2ch4dt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*ch4d2t51(kp,krow) + & Gas_tf%a2(:,:)*ch4d2t58(kp,krow)) else ch41c(:,:,kp) = Gas_tf%a1(:,:)*ch451(kp,krow) + & Gas_tf%a2(:,:)*ch458(kp,krow) endif endif if (Lw_control%do_n2o) then if (Lw_control%do_n2olbltmpint) then n2op (:,:,kp) = Gas_tf%a1(:,:)*n2o51(kp,krow) + & Gas_tf%a2(:,:)*n2o58(kp,krow) n2o17p(:,:,kp) = Gas_tf%a1(:,:)*n2o71(kp,krow) + & Gas_tf%a2(:,:)*n2o78(kp,krow) n2o9p(:,:,kp) = Gas_tf%a1(:,:)*n2o91(kp,krow) + & Gas_tf%a2(:,:)*n2o98(kp,krow) dn2odt(:,:,kp) = 1.0E-02*(Gas_tf%a1(:,:)*n2odt51(kp,krow) +& Gas_tf%a2(:,:)*n2odt58(kp,krow)) dn2o17dt(:,:,kp) = 1.0E-02* & (Gas_tf%a1(:,:)*n2odt71(kp,krow) +& Gas_tf%a2(:,:)*n2odt78(kp,krow)) dn2o9dt(:,:,kp) = 1.0E-02* & (Gas_tf%a1(:,:)*n2odt91(kp,krow) + & Gas_tf%a2(:,:)*n2odt98(kp,krow)) d2n2odt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*n2od2t51(kp,krow) + & Gas_tf%a2(:,:)*n2od2t58(kp,krow)) d2n2o17dt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*n2od2t71(kp,krow) + & Gas_tf%a2(:,:)*n2od2t78(kp,krow)) d2n2o9dt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*n2od2t91(kp,krow) + & Gas_tf%a2(:,:)*n2od2t98(kp,krow)) else n2o1c(:,:,kp) = Gas_tf%a1(:,:)*n2o51(kp,krow) + & Gas_tf%a2(:,:)*n2o58(kp,krow) n2o17c(:,:,kp) = Gas_tf%a1(:,:)*n2o71(kp,krow) + & Gas_tf%a2(:,:)*n2o78(kp,krow) Gas_tf%n2o9c(:,:,kp) = Gas_tf%a1(:,:)*n2o91(kp,krow) + & Gas_tf%a2(:,:)*n2o98(kp,krow) endif endif enddo !---------------------------------------------------------------------- ! temperature interpolation !---------------------------------------------------------------------- do kp=kcols,kcole if (Lw_control%do_co2) then co21c (:,:,kp) = co2p(:,:,kp) + dift(:,:,kp)*(dco2dt(:,:,kp) + & 0.5E+00*dift(:,:,kp)*d2cdt2(:,:,kp)) endif if (Lw_control%do_ch4lbltmpint) then ch41c (:,:,kp) = ch4p(:,:,kp) + dift(:,:,kp)* & (dch4dt(:,:,kp) + 0.5E+00*dift(:,:,kp)* & d2ch4dt2(:,:,kp)) endif if (Lw_control%do_n2olbltmpint) then n2o1c (:,:,kp) = n2op(:,:,kp) + dift(:,:,kp)* & (dn2odt(:,:,kp) + 0.5E+00*dift(:,:,kp)* & d2n2odt2(:,:,kp)) n2o17c(:,:,kp) = n2o17p(:,:,kp) + & dift(:,:,kp)*(dn2o17dt(:,:,kp) + & 0.5E+00*dift(:,:,kp)*d2n2o17dt2(:,:,kp)) Gas_tf%n2o9c(:,:,kp) = n2o9p(:,:,kp) + & dift(:,:,kp)*(dn2o9dt(:,:,kp) + & 0.5E+00*dift(:,:,kp)*d2n2o9dt2(:,:,kp)) endif enddo !--------------------------------------------------------------------- ! correction for finite width of co2 bands ! (Eqs. 7a-7c, Ref. (2)) !--------------------------------------------------------------------- do kp=kcols,kcole if (Lw_control%do_co2) then co21c(:,:,kp) = co21c(:,:,kp)*(1.0E+00 - & Gas_tf%tlsqu(:,:,kp)) + Gas_tf%tlsqu(:,:,kp) endif enddo !----------------------------------------------------------------------- ! obtain transmission functions used for the flux for varying levels ! (krow) from a fixed level (kcol). ie, tf's from a fixed flux ! level (kcol) to varying levels (krow). !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! temperature difference averaged between levels k and kp. This ! computation is made unless krow = kcol, and range (krows,krowe) is ! entirely within (kcols,kcole), in which case the dift computed ! for column tfs is applicable to row tfs. !----------------------------------------------------------------------- if (Lw_control%do_co2) then if (kcol .NE. krow .or. krows .LT. kcols .or. & krowe .GT. kcole) then do kp = krows,krowe if (kp .NE. krow) then dift(:,:,kp) = (Gas_tf%tdav(:,:,kp) - & Gas_tf%tdav(:,:,krow))/ & (Gas_tf%tstdav(:,:,kp) - & Gas_tf%tstdav(:,:,krow)) elseif (krow .NE. KSRAD) then dift(:,:,kp) = 0.5E+00*(Gas_tf%tmpdiff(:,:,kp) + & Gas_tf%tmpdiff(:,:,kp-1)) else dift(:,:,kp) = 0.0E+00 endif end do endif endif ! (do_co2) !-------------------------------------------------------------------- ! pressure interpolation !-------------------------------------------------------------------- do kp=krows,krowe if (Lw_control%do_co2) then co2p (:,:,kp) = Gas_tf%a1(:,:)*co251(kcol,kp) + & Gas_tf%a2(:,:)*co258(kcol,kp) dco2dt(:,:,kp) = 1.0E-02*(Gas_tf%a1(:,:)*cdt51(kcol,kp) + & Gas_tf%a2(:,:)*cdt58(kcol,kp)) d2cdt2(:,:,kp) = 1.0E-03*(Gas_tf%a1(:,:)*c2d51(kcol,kp) + & Gas_tf%a2(:,:)*c2d58(kcol,kp)) endif if (Lw_control%do_ch4) then if (Lw_control%do_ch4lbltmpint) then ch4p (:,:,kp) = Gas_tf%a1(:,:)*ch451(kcol,kp) + & Gas_tf%a2(:,:)*ch458(kcol,kp) dch4dt(:,:,kp) = 1.0E-02* & (Gas_tf%a1(:,:)*ch4dt51(kcol,kp) + & Gas_tf%a2(:,:)*ch4dt58(kcol,kp)) d2ch4dt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*ch4d2t51(kcol,kp) + & Gas_tf%a2(:,:)*ch4d2t58(kcol,kp)) endif endif if (Lw_control%do_n2o) then if (Lw_control%do_n2olbltmpint) then n2op (:,:,kp) = Gas_tf%a1(:,:)*n2o51(kcol,kp) +& Gas_tf%a2(:,:)*n2o58(kcol,kp) n2o17p(:,:,kp) = Gas_tf%a1(:,:)*n2o71(kcol,kp) + & Gas_tf%a2(:,:)*n2o78(kcol,kp) n2o9p(:,:,kp) = Gas_tf%a1(:,:)*n2o91(kcol,kp) + & Gas_tf%a2(:,:)*n2o98(kcol,kp) dn2odt(:,:,kp) = 1.0E-02* & (Gas_tf%a1(:,:)*n2odt51(kcol,kp) + & Gas_tf%a2(:,:)*n2odt58(kcol,kp)) dn2o17dt(:,:,kp) = 1.0E-02* & (Gas_tf%a1(:,:)*n2odt71(kcol,kp) + & Gas_tf%a2(:,:)*n2odt78(kcol,kp)) dn2o9dt(:,:,kp) = 1.0E-02* & (Gas_tf%a1(:,:)*n2odt91(kcol,kp) + & Gas_tf%a2(:,:)*n2odt98(kcol,kp)) d2n2odt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*n2od2t51(kcol,kp) + & Gas_tf%a2(:,:)*n2od2t58(kcol,kp)) d2n2o17dt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*n2od2t71(kcol,kp) + & Gas_tf%a2(:,:)*n2od2t78(kcol,kp)) d2n2o9dt2(:,:,kp) = 1.0E-03* & (Gas_tf%a1(:,:)*n2od2t91(kcol,kp) + & Gas_tf%a2(:,:)*n2od2t98(kcol,kp)) endif endif enddo !--------------------------------------------------------------------- ! temperature interpolation !--------------------------------------------------------------------- do kp=krows,krowe if (Lw_control%do_co2) then co21r (:,:,kp) = co2p(:,:,kp) + dift(:,:,kp)*(dco2dt(:,:,kp) +& 0.5E+00*dift(:,:,kp)*d2cdt2(:,:,kp)) endif enddo !--------------------------------------------------------------------- ! correction for finite width of co2 bands ! (Eqs. 7a-7c, Ref. (2)) !--------------------------------------------------------------------- do kp=krows,krowe if (Lw_control%do_co2) then co21r(:,:,kp) = co21r(:,:,kp)*(1.0E+00 - & Gas_tf%tlsqu(:,:,kcol)) + & Gas_tf%tlsqu(:,:,kcol) endif enddo !---------------------------------------------------------------------- ! save the values which are needed elsewhere ! tn2o17 results are for 560-630 cm-1 band. (if NBCO215=3) !---------------------------------------------------------------------- if (Lw_control%do_ch4 .or. Lw_control%do_n2o) then if (kcols == 1) then tch4n2oe(:,:,kcols,1) = ch41c(:,:,kcols)*n2o1c(:,:,kcols) endif tch4n2oe(:,:,kcols+1:kcole,1) = ch41c(:,:,kcols+1:kcole)* & n2o1c(:,:,kcols+1:kcole) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- Gas_tf%tn2o17(:,:,:) = n2o17c(:,:,:) !--------------------------------------------------------------------- end subroutine transcolrow !##################################################################### ! ! ! Compute nearby layer transmission functions at certain level in ! the frequency band at 15 um ! ! ! Compute "nearby layer" transmission functions at level k ! ( tau(p(k),p(k))) in the frequency band at 15 um. include all ! gases (co2, h2o, h2o cont) used in computing fluxes in this band. ! ! ! ! The gas transmission functions at model coordinate system ! ! ! The atmospheric input data ! ! ! CO2 data ! ! ! CO2 transmission function ! ! subroutine trans_nearby (Gas_tf, Atmos_input, overod, co21diag) !------------------------------------------------------------------- ! compute "nearby layer" transmission functions at level k ! ( tau(p(k),p(k))) in the frequency band at 15 um. include all ! gases (co2, h2o, h2o cont) used in computing fluxes in this band. ! the algorithm assumes that at pressures (p') near the pressure ! at level k (p(k)), the transmission function may be written as: ! ! tau(p',p(k)) = EXP(-alpha*SQRT(p'-p(k))) ! ! with alpha determined by the boundary condition(s) ! tau(p(k+1),p(k)) and tau(p(k-1),p(k)) = the values from "normal" ! calculations. An integration is performed over the "nearby" ! pressure layer to obtain tau(p(k),p(k)). ! the computation is not done for levels from KSRAD to KMINH2O-1 (if ! different), where it is assumed that the h2o transmissivities ! are near unity, and that the precomputed co2 transmissivities may ! be used. ! two "special case" transmissivities, viz., ! tau(p(KERAD),p(KERAD+1)) and tau(p(KERAD+1),p(KERAD)) are also ! evaluated using the above assumptions and an integration. !------------------------------------------------------------------- type(gas_tf_type), intent(in) :: Gas_tf type(atmos_input_type), intent(in) :: Atmos_input real, dimension (:,:,:), intent(in) :: overod real, dimension (:,:,:), intent(out) :: co21diag !-------------------------------------------------------------------- ! intent(in) variables: ! ! Gas_tf ! Atmos_input ! overod ! ! intent(out) variables: ! ! co21diag ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real, dimension (size(Atmos_input%pflux,1), & size(Atmos_input%pflux,2), & size(Atmos_input%pflux,3)-1) :: pdfinv real, dimension (size(Atmos_input%pflux,1), & size(Atmos_input%pflux,2), & size(Atmos_input%pflux,3)) :: & press, pflux, alpa, alpb, ca, cb, delpr1, delpr2, rlog integer :: k, km, kmp1 !------------------------------------------------------------------- ! local variables: ! ! pdfl ! pdfinv ! press ! ! k ! ! kmp1 ! !-------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! convert press and pflux to cgs. !--------------------------------------------------------------------- press(:,:,:) = 10.0*Atmos_input%press(:,:,:) pflux(:,:,:) = 10.0*Atmos_input%pflux(:,:,:) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- pdfinv(:,:,KSRAD:KERAD) = 1.0/(pflux(:,:,KSRAD+1:KERAD+1) - & pflux(:,:,KSRAD:KERAD) ) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- km= MAX(ixprkminh2o - 1, KSRAD) kmp1 = MAX(ixprkminh2o - 1, KSRAD+1) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- rlog (:,:,km:KERAD) = LOG(Gas_tf%co2nbl(:,:,km:KERAD)* & overod(:,:,km+1:KERAD+1)) delpr1(:,:,kmp1:KERAD) = pdfinv (:,:,kmp1:KERAD)* & (press(:,:,kmp1:KERAD) - & pflux(:,:,kmp1:KERAD)) alpb (:,:,kmp1:KERAD) = -SQRT(delpr1(:,:,kmp1:KERAD))* & rlog(:,:,kmp1:KERAD) delpr2(:,:,kmp1:KERAD+1) = pdfinv(:,:,kmp1-1:KERAD)* & (pflux(:,:,kmp1:KERAD+1) - & press(:,:,kmp1-1:KERAD)) alpa (:,:,km:KERAD) = -SQRT(delpr2(:,:,km+1:KERAD+1))* & rlog(:,:,km:KERAD) alpa (:,:,KERAD+1) = -rlog(:,:,KERAD) alpb (:,:,KERAD+1) = -rlog(:,:,KERAD)* & SQRT(pdfinv(:,:,KERAD)*& (pflux(:,:,KERAD+1) - & press(:,:,KERAD-1))) ca(:,:,km:KERAD+1) = alpa(:,:,km:KERAD+1)*(-0.66667E+00 + & alpa(:,:,km:KERAD+1)*(0.25E+00 + & alpa(:,:,km:KERAD+1)*(-0.066667E+00))) cb(:,:,kmp1:KERAD+1) = alpb(:,:,kmp1:KERAD+1)*(-0.66667E+00 + & alpb(:,:,kmp1:KERAD+1)*(0.25E+00 + & alpb(:,:,kmp1:KERAD+1)*(-0.066667E+00))) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- do k=ixprkminh2o,KERAD co21diag(:,:,k) = 1.0E+00 + 0.5E+00*(cb(:,:,k) + ca(:,:,k-1)) enddo co21diag(:,:,KERAD+1) = 1.0E+00 + ca(:,:,KERAD) !------------------------------------------------------------------- end subroutine trans_nearby !##################################################################### ! ! ! Compute nearby layer transmission functions at certain level in ! the frequency band at 15 um ! ! ! Compute "nearby layer" transmission functions at level k ! ( tau(p(k),p(k))) in the frequency band at 15 um. include all ! gases (co2, h2o, h2o cont) used in computing fluxes in this band. ! ! ! ! The gas transmission functions at model coordinate system ! ! ! The atmospheric input data ! ! ! CO2 data ! ! ! CO2 transmission function ! ! ! CO2 transmission function ! ! !subroutine trans_sfc (Gas_tf, Atmos_input, overod, co21c, co21diag, co21r) subroutine trans_sfc (Gas_tf, Atmos_input, overod, co21c, co21r) !------------------------------------------------------------------- ! compute "nearby layer" transmission functions at level k ! ( tau(p(k),p(k))) in the frequency band at 15 um. include all ! gases (co2, h2o, h2o cont) used in computing fluxes in this band. ! the algorithm assumes that at pressures (p') near the pressure ! at level k (p(k)), the transmission function may be written as: ! ! tau(p',p(k)) = EXP(-alpha*SQRT(p'-p(k))) ! ! with alpha determined by the boundary condition(s) ! tau(p(k+1),p(k)) and tau(p(k-1),p(k)) = the values from "normal" ! calculations. An integration is performed over the "nearby" ! pressure layer to obtain tau(p(k),p(k)). ! the computation is not done for levels from KSRAD to KMINH2O-1 (if ! different), where it is assumed that the h2o transmissivities ! are near unity, and that the precomputed co2 transmissivities may ! be used. ! two "special case" transmissivities, viz., ! tau(p(KERAD),p(KERAD+1)) and tau(p(KERAD+1),p(KERAD)) are also ! evaluated using the above assumptions and an integration. !------------------------------------------------------------------- type(gas_tf_type), intent(in) :: Gas_tf type(atmos_input_type), intent(in) :: Atmos_input real, dimension (:,:,:), intent(in) :: overod real, dimension (:,:), intent(out) :: co21c, co21r !-------------------------------------------------------------------- ! intent(in) variables: ! ! Gas_tf ! Atmos_input ! overod ! ! intent(out) variables: ! ! co21c ! co21r ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real, dimension (size(Atmos_input%pflux,1), & size(Atmos_input%pflux,2)) :: pdfl real, dimension (size(Atmos_input%pflux,1), & size(Atmos_input%pflux,2), & size(Atmos_input%pflux,3)-1) :: pdfinv real, dimension (size(Atmos_input%pflux,1), & size(Atmos_input%pflux,2), & size(Atmos_input%pflux,3)) :: & press, pflux, alpa, alpb, ca, cb, delpr1, delpr2, rlog integer :: km, kmp1 !------------------------------------------------------------------- ! local variables: ! ! pdfl ! pdfinv ! press ! ! k ! ! kmp1 ! !-------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! convert press and pflux to cgs. !--------------------------------------------------------------------- press(:,:,:) = 10.0*Atmos_input%press(:,:,:) pflux(:,:,:) = 10.0*Atmos_input%pflux(:,:,:) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- pdfinv(:,:,KSRAD:KERAD) = 1.0/(pflux(:,:,KSRAD+1:KERAD+1) - & pflux(:,:,KSRAD:KERAD) ) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- km= MAX(ixprkminh2o - 1, KSRAD) kmp1 = MAX(ixprkminh2o - 1, KSRAD+1) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- rlog (:,:,km:KERAD) = LOG(Gas_tf%co2nbl(:,:,km:KERAD)* & overod(:,:,km+1:KERAD+1)) delpr1(:,:,kmp1:KERAD) = pdfinv (:,:,kmp1:KERAD)* & (press(:,:,kmp1:KERAD) - & pflux(:,:,kmp1:KERAD)) alpb (:,:,kmp1:KERAD) = -SQRT(delpr1(:,:,kmp1:KERAD))* & rlog(:,:,kmp1:KERAD) delpr2(:,:,kmp1:KERAD+1) = pdfinv(:,:,kmp1-1:KERAD)* & (pflux(:,:,kmp1:KERAD+1) - & press(:,:,kmp1-1:KERAD)) alpa (:,:,km:KERAD) = -SQRT(delpr2(:,:,km+1:KERAD+1))* & rlog(:,:,km:KERAD) alpa (:,:,KERAD+1) = -rlog(:,:,KERAD) alpb (:,:,KERAD+1) = -rlog(:,:,KERAD)* & SQRT(pdfinv(:,:,KERAD)*& (pflux(:,:,KERAD+1) - & press(:,:,KERAD-1))) ca(:,:,km:KERAD+1) = alpa(:,:,km:KERAD+1)*(-0.66667E+00 + & alpa(:,:,km:KERAD+1)*(0.25E+00 + & alpa(:,:,km:KERAD+1)*(-0.066667E+00))) cb(:,:,kmp1:KERAD+1) = alpb(:,:,kmp1:KERAD+1)*(-0.66667E+00 + & alpb(:,:,kmp1:KERAD+1)*(0.25E+00 + & alpb(:,:,kmp1:KERAD+1)*(-0.066667E+00))) !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- pdfl(:,:) = pflux(:,:,KERAD+1) - pflux(:,:,KERAD) co21c(:,: ) = 1.0E+00 + & (pdfl (:,: )*ca(:,:,KERAD+1) - & (press(:,:,KERAD) - pflux(:,:,KERAD))* & cb(:,:,KERAD))/ & (pflux(:,:,KERAD+1) - press(:,:,KERAD)) co21r(:,: ) = 1.0E+00 + & ((pflux(:,:,KERAD+1) - & press(:,:,KERAD-1))* & cb(:,:,KERAD+1) - & (pflux(:,:,KERAD+1) - press(:,:,KERAD))* & ca(:,:,KERAD))/ & (press(:,:,KERAD) - press(:,:,KERAD-1)) !------------------------------------------------------------------- end subroutine trans_sfc !#################################################################### ! ! ! Assign co2 transmission functions ! ! ! Assign co2 transmission functions ! ! ! ! index variable ! ! ! CO2 transmission functions ! ! ! subroutine put_co2_stdtf_for_gas_tf (nf, co251_o, co258_o, & cdt51_o, cdt58_o, & c2d51_o, c2d58_o) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- integer, intent(in) :: nf real, dimension(:,:), intent(in) :: co251_o, co258_o, & cdt51_o, cdt58_o, & c2d51_o, c2d58_o !------------------------------------------------------------------- ! intent(in) variables: ! ! nf ! co251_o ! co258_o ! cdt51_o ! cdt58_o ! c2d51_o ! c2d58_o ! !-------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (nf == 1) then co251 = co251_o co258 = co258_o cdt51 = cdt51_o cdt58 = cdt58_o c2d51 = c2d51_o c2d58 = c2d58_o else if (nf == 5) then co211(:) = co251_o(:,1) co218(:) = co258_o(:,1) endif !-------------------------------------------------------------------- end subroutine put_co2_stdtf_for_gas_tf !##################################################################### ! ! ! Assign co2 transmission functions ! ! ! Assign co2 transmission functions ! ! ! ! index variable ! ! ! CO2 transmission functions ! ! ! CO2 transmission functions ! ! ! subroutine put_co2_nbltf_for_gas_tf (nf, & co2m51_o, cdtm51_o, c2dm51_o, & co2m58_o, cdtm58_o, c2dm58_o, & co215nbps1_o, co215nbps8_o, & co2dt15nbps1_o, co2dt15nbps8_o, & co2d2t15nbps1_o, co2d2t15nbps8_o ) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- integer, intent(in) :: nf real, dimension(:,:), intent(in) :: co2m51_o, cdtm51_o, c2dm51_o, & co2m58_o, cdtm58_o, c2dm58_o real, dimension(:), intent(in) :: co215nbps1_o, co215nbps8_o, & co2dt15nbps1_o, co2dt15nbps8_o, & co2d2t15nbps1_o, co2d2t15nbps8_o !-------------------------------------------------------------------- ! intent(in) variables: ! ! nf ! co2m51_o ! cdtm51_o ! c2dm51_o ! co2m58_o ! cdtm58_o ! c2dm58_o ! co215nbsp1_o ! co215nbsp8_o ! co2dt15nbsp1_o ! co2dt15nbsp8_o ! co2d2t15nbps1_o ! co2d2t15nbps8_o ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: integer :: k ! do-loop index !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (nf == 1) then do k=KSRAD,KERAD co2m51(k) = co2m51_o(k,k+1) co2m58(k) = co2m58_o(k,k+1) cdtm51(k) = cdtm51_o(k,k+1) cdtm58(k) = cdtm58_o(k,k+1) c2dm51(k) = c2dm51_o(k,k+1) c2dm58(k) = c2dm58_o(k,k+1) end do endif if (nf >= 2 .and. nf <= 4) then co215nbps1(:,nf-1) = co215nbps1_o(:) co215nbps8(:,nf-1) = co215nbps8_o(:) co2dt15nbps1(:,nf-1) = co2dt15nbps1_o(:) co2dt15nbps8(:,nf-1) = co2dt15nbps8_o(:) co2d2t15nbps1(:,nf-1) = co2d2t15nbps1_o(:) co2d2t15nbps8(:,nf-1) = co2d2t15nbps8_o(:) endif !-------------------------------------------------------------------- end subroutine put_co2_nbltf_for_gas_tf !##################################################################### ! ! ! Assign ch4 transmission functions ! ! ! Assign ch4 transmission functions ! ! ! ! index variable ! ! ! CH4 transmission functions ! ! ! subroutine put_ch4_stdtf_for_gas_tf ( & ch451_o, ch458_o, & ch4dt51_o, ch4dt58_o, & ch4d2t51_o, ch4d2t58_o) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- real, dimension (:,:), intent(in) :: ch451_o, ch458_o, & ch4dt51_o, ch4dt58_o, & ch4d2t51_o, ch4d2t58_o !------------------------------------------------------------------ ! intent(in) variables: ! ! ch451_o ! !------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- ch451 = ch451_o ch458 = ch458_o ch4dt51 = ch4dt51_o ch4dt58 = ch4dt58_o ch4d2t51 = ch4d2t51_o ch4d2t58 = ch4d2t58_o !-------------------------------------------------------------------- end subroutine put_ch4_stdtf_for_gas_tf !##################################################################### ! ! ! Assign n2o transmission functions ! ! ! Assign n2o transmission functions ! ! ! ! index variable ! ! ! N2O transmission functions ! ! ! subroutine put_n2o_stdtf_for_gas_tf (nf, & n2o1_o, n2o8_o, & n2odt1_o, n2odt8_o, & n2od2t1_o, n2od2t8_o) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- integer, intent(in) :: nf real, dimension (:,:), intent(in) :: n2o1_o, n2o8_o, & n2odt1_o, n2odt8_o, & n2od2t1_o, n2od2t8_o !------------------------------------------------------------------ ! intent(in) variables: ! ! nf ! !------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (nf == 1) then n2o51 = n2o1_o n2o58 = n2o8_o n2odt51 = n2odt1_o n2odt58 = n2odt8_o n2od2t51 = n2od2t1_o n2od2t58 = n2od2t8_o else if (nf == 3) then n2o71 = n2o1_o n2o78 = n2o8_o n2odt71 = n2odt1_o n2odt78 = n2odt8_o n2od2t71 = n2od2t1_o n2od2t78 = n2od2t8_o else if (nf == 2) then n2o91 = n2o1_o n2o98 = n2o8_o n2odt91 = n2odt1_o n2odt98 = n2odt8_o n2od2t91 = n2od2t1_o n2od2t98 = n2od2t8_o endif !--------------------------------------------------------------------- end subroutine put_n2o_stdtf_for_gas_tf !##################################################################### ! ! ! Turn on gas transmission function flag ! ! ! Turn on gas transmission function flag ! ! ! ! logical variables that determine whether gas transmission functions ! should be calculated. ! ! subroutine get_control_gas_tf (calc_co2, calc_ch4, calc_n2o) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- logical, intent(out), optional :: calc_co2, calc_ch4, calc_n2o !------------------------------------------------------------------ ! intent(out),optional variables: ! ! calc_co2 ! calc_ch4 ! calc_n2o ! !------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- calc_co2 = do_calcstdco2tfs calc_ch4 = do_calcstdch4tfs calc_n2o = do_calcstdn2otfs !--------------------------------------------------------------------- end subroutine get_control_gas_tf !#################################################################### ! ! ! gas_tf_dealloc deallocates the array components of the gas_tf_type ! input variable. ! ! ! gas_tf_dealloc deallocates the array components of the gas_tf_type ! input variable. ! ! ! ! gas_tf_type variable containing information needed ! to define the gas transmission functions ! ! subroutine gas_tf_dealloc (Gas_tf) !------------------------------------------------------------------ ! gas_tf_dealloc deallocates the array components of the gas_tf_type ! input variable. !-------------------------------------------------------------------- type(gas_tf_type), intent(inout) :: Gas_tf !--------------------------------------------------------------------- ! intent(inout) variables: ! ! Gas_tf gas_tf_type variable containing information needed ! to define the gas transmission functions ! !---------------------------------------------------------------------- !--------------------------------------------------------------------- ! deallocate the array components of Gas_tf. !--------------------------------------------------------------------- deallocate (Gas_tf%tdav) deallocate (Gas_tf%tlsqu ) deallocate (Gas_tf%tmpdiff ) deallocate (Gas_tf%tstdav ) deallocate (Gas_tf%co2nbl ) deallocate (Gas_tf%n2o9c ) deallocate (Gas_tf%tn2o17 ) deallocate (Gas_tf%co2spnb ) deallocate (Gas_tf%a1 ) deallocate (Gas_tf%a2 ) !-------------------------------------------------------------------- end subroutine gas_tf_dealloc !################################################################### ! ! ! End and clean up gas tranmission function calculation ! ! ! End and clean up gas tranmission function calculation ! ! ! ! subroutine gas_tf_end !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- !------------------------------------------------------------------- ! local variable: integer :: tfsunit ! unit number for i/o !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ( 'gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (do_writestdco2tfs) then if (mpp_pe() == mpp_root_pe() ) then tfsunit = open_restart_file ('stdco2tfs', action='write') write (tfsunit) valid_versions(nvalids) write (tfsunit) co2_name_save, co2_amount_save, & nstdlvls_save, kbegin_save, kend_save write (tfsunit) pd_save, plm_save, pa_save write (tfsunit) co215nbps1, co215nbps8, co2dt15nbps1, & co2dt15nbps8, co2d2t15nbps1, co2d2t15nbps8 write (tfsunit) co251, co258, cdt51, cdt58, c2d51, c2d58, & co2m51, co2m58, cdtm51, cdtm58, c2dm51, c2dm58 write (tfsunit) co211, co218 call close_file (tfsunit) endif endif if (do_writestdn2otfs) then if (mpp_pe() == mpp_root_pe()) then tfsunit = open_restart_file ('stdn2otfs', action='write') write (tfsunit) valid_versions(nvalids) write (tfsunit) n2o_name_save, n2o_amount_save, & nstdlvls_save, kbegin_save, kend_save write (tfsunit) pd_save, plm_save, pa_save write (tfsunit) n2o51, n2o58, n2odt51, n2odt58, n2od2t51, & n2od2t58 write (tfsunit) n2o71, n2o78, n2odt71, n2odt78, n2od2t71, & n2od2t78 write (tfsunit) n2o91, n2o98, n2odt91, n2odt98, n2od2t91, & n2od2t98 call close_file (tfsunit) endif endif if (do_writestdch4tfs) then if (mpp_pe() == mpp_root_pe()) then tfsunit = open_restart_file ('stdch4tfs', action='write') write (tfsunit) valid_versions(nvalids) write (tfsunit) ch4_name_save, ch4_amount_save, & nstdlvls_save, kbegin_save, kend_save write (tfsunit) pd_save, plm_save, pa_save write (tfsunit) ch451, ch458, ch4dt51, ch4dt58, ch4d2t51, & ch4d2t58 call close_file (tfsunit) endif endif !-------------------------------------------------------------------- ! mark this module as uninitialized. !-------------------------------------------------------------------- module_is_initialized = .false. !------------------------------------------------------------------- end subroutine gas_tf_end !################################################################### ! ! ! Subroutine to process co2 input file information ! ! ! Subroutine to process co2 input file information ! ! ! ! Name of the gas specy ! ! ! Amount of the gas specy ! ! ! Number of standard levels ! ! ! Index of the starting and ending vertical levels ! ! ! Pressure coordinate variables, at boundaries, mid points. ! ! ! subroutine process_co2_input_file (gas_name, gas_amount, nstdlvls, & kbegin, kend, pd, plm, pa) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- character(len=*), intent(in) :: gas_name real, intent(in) :: gas_amount integer, intent(in) :: nstdlvls, kbegin, kend real, dimension(:), intent(in) :: pd, plm, pa !------------------------------------------------------------------ ! intent(in) variables: ! ! gas_name ! !------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: integer :: unit !--------------------------------------------------------------------- ! local variables: ! ! pd_file ! !-------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (do_readstdco2tfs) then !-------------------------------------------------------------------- ! read the input tf file and verify that the current model config- ! uration matches that for which the tfs were generated. !-------------------------------------------------------------------- unit = open_restart_file ('INPUT/stdco2tfs', action='read') call process_gas_input_file (gas_name, gas_amount, nstdlvls, & kbegin, kend, pd, plm, pa, unit) read (unit) co215nbps1, co215nbps8, co2dt15nbps1, & co2dt15nbps8, co2d2t15nbps1, co2d2t15nbps8 read (unit) co251, co258, cdt51, cdt58, c2d51, c2d58, & co2m51, co2m58, cdtm51, cdtm58, c2dm51, c2dm58 read (unit) co211, co218 call close_file (unit) else if (do_writestdco2tfs) then !-------------------------------------------------------------------- ! save the data necessary to write a tf file at the end of this job ! if that is desired !-------------------------------------------------------------------- co2_name_save = gas_name co2_amount_save = gas_amount nstdlvls_save = nstdlvls kbegin_save = kbegin kend_save = kend if (.not. (allocated(pd_save) ) ) then allocate ( pd_save(kbegin:kend)) allocate ( plm_save(kbegin:kend)) allocate ( pa_save(nstdlvls)) endif pd_save(:) = pd(:) plm_save(:) = plm(:) pa_save(:) = pa(:) endif !-------------------------------------------------------------------- end subroutine process_co2_input_file !#################################################################### ! ! ! Subroutine to process ch4 input file information ! ! ! Subroutine to process ch4 input file information ! ! ! ! Name of the gas specy ! ! ! Amount of the gas specy ! ! ! Number of standard levels ! ! ! Index of the starting and ending vertical levels ! ! ! Pressure coordinate variables, at boundaries, mid points. ! ! ! subroutine process_ch4_input_file (gas_name, gas_amount, nstdlvls, & kbegin, kend, pd, plm, pa) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- character(len=*), intent(in) :: gas_name real, intent(in) :: gas_amount integer, intent(in) :: nstdlvls, kbegin, kend real, dimension(:), intent(in) :: pd, plm, pa !------------------------------------------------------------------ ! intent(in) variables: ! ! gas_name ! !------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: integer :: unit !--------------------------------------------------------------------- ! local variables: ! ! pd_file ! !-------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ( 'gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (do_readstdch4tfs) then !-------------------------------------------------------------------- ! read the input tf file and verify that the current model config- ! uration matches that for which the tfs were generated. !-------------------------------------------------------------------- unit = open_restart_file ('INPUT/stdch4tfs', action='read') call process_gas_input_file (gas_name, gas_amount, nstdlvls, & kbegin, kend, pd, plm, pa, unit) read (unit) ch451, ch458, ch4dt51, ch4dt58, ch4d2t51, ch4d2t58 call close_file (unit) !-------------------------------------------------------------------- ! save the data necessary to write a tf file at the end of this job ! if that is desired !-------------------------------------------------------------------- else if (do_writestdch4tfs) then ch4_name_save = gas_name ch4_amount_save = gas_amount nstdlvls_save = nstdlvls kbegin_save = kbegin kend_save = kend if (.not. (allocated(pd_save) ) ) then allocate ( pd_save(kbegin:kend)) allocate ( plm_save(kbegin:kend)) allocate ( pa_save(nstdlvls)) endif pd_save(:) = pd(:) plm_save(:) = plm(:) pa_save(:) = pa(:) endif !--------------------------------------------------------------------- end subroutine process_ch4_input_file !#################################################################### ! ! ! Subroutine to process n2o input file information ! ! ! Subroutine to process n2o input file information ! ! ! ! Name of the gas specy ! ! ! Amount of the gas specy ! ! ! Number of standard levels ! ! ! Index of the starting and ending vertical levels ! ! ! Pressure coordinate variables, at boundaries, mid points. ! ! ! subroutine process_n2o_input_file (gas_name, gas_amount, nstdlvls, & kbegin, kend, pd, plm, pa) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- character(len=*), intent(in) :: gas_name real, intent(in) :: gas_amount integer, intent(in) :: nstdlvls, kbegin, kend real, dimension(:), intent(in) :: pd, plm, pa !------------------------------------------------------------------ ! intent(in) variables: ! ! gas_name ! !------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: integer :: unit !--------------------------------------------------------------------- ! local variables: ! ! pd_file ! !-------------------------------------------------------------------- !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ( 'gas_tf_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! !--------------------------------------------------------------------- if (do_readstdn2otfs) then !-------------------------------------------------------------------- ! read the input tf file and verify that the current model config- ! uration matches that for which the tfs were generated. !-------------------------------------------------------------------- unit = open_restart_file ('INPUT/stdn2otfs', action='read') call process_gas_input_file (gas_name, gas_amount, nstdlvls, & kbegin, kend, pd, plm, pa, unit) read (unit) n2o51, n2o58, n2odt51, n2odt58, n2od2t51, n2od2t58 read (unit) n2o71, n2o78, n2odt71, n2odt78, n2od2t71, n2od2t78 read (unit) n2o91, n2o98, n2odt91, n2odt98, n2od2t91, n2od2t98 call close_file (unit) !-------------------------------------------------------------------- ! save the data necessary to write a tf file at the end of this job ! if that is desired !-------------------------------------------------------------------- else if (do_writestdn2otfs) then n2o_name_save = gas_name n2o_amount_save = gas_amount nstdlvls_save = nstdlvls kbegin_save = kbegin kend_save = kend if (.not. (allocated(pd_save) ) ) then allocate ( pd_save(kbegin:kend)) allocate ( plm_save(kbegin:kend)) allocate ( pa_save(nstdlvls)) endif pd_save(:) = pd(:) plm_save(:) = plm(:) pa_save(:) = pa(:) endif !-------------------------------------------------------------------- end subroutine process_n2o_input_file !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! PRIVATE SUBROUTINES ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !#################################################################### ! ! ! Subroutine to calculate temperatures at up to 200 user ! specified pressures. ! ! ! Subroutine to calculate temperatures at up to 200 user ! specified pressures. ! ! ! ! pressure at midpoint of layer (average of adjacent ! pd values) ! ! ! pressures (mb) for layer boundaries. (also known ! as flux levels). ! ! ! subroutine ptz (plm, pd) !-------------------------------------------------------------------- ! this program calculates temperatures at up to 200 user ! specified pressures. it makes use of an analytical ! function which approximates the us standard atm(1976). ! this is calculated in function 'antemp', which is called ! by ptz. the form of the analytical function was ! suggested to me (S.B. Fels) in 1971 by richard s. lindzen. ! !-------------------------------------------------------------------- real, dimension(:), intent(in) :: plm, pd !-------------------------------------------------------------------- ! intent(in) variables: ! ! pd: pressures (mb) for layer boundaries. (also known ! as flux levels). ! plm pressure at midpoint of layer (average of adjacent ! pd values) ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real, dimension(:), allocatable :: press, altquad, tempquad, & prsint, plmcgs, tmpint real :: delzap = 0.5 real :: dlogp, znint, dz, ht, rk1, & rk2, rk3, rk4 integer :: k, nlay, nint, m !-------------------------------------------------------------------- ! local variables: ! ! plmcgs : plm in cgs units. needed for gtemp calc. ! prsint: same as pd, but with indices reversed,index 1 at ! the surface, and index (nlev+1) at the top level. ! press: pressures used for quadratures (4 quad. pts.) ! indices run as in prsint. ! tempquad: temperature at quad. pts. index 1 is at the sfc. ! tmpint: temperature at quad. pts, saved over both height ! and quadrature index. values come from tempquad. ! tmpout: as in temp, but with indices reversed (index 1= ! temp at top data level),others are layer averages ! altquad: height values (km) generated by antemp. lowest ! index = surface. !-------------------------------------------------------------------- !----------------------------------------------------------------- ! !----------------------------------------------------------------- nlay = KERAD - KSRAD + 1 !------------------------------------------------------------------- ! !------------------------------------------------------------------- allocate ( gtemp (KSRAD:KERAD+1) ) allocate ( stemp (KSRAD:KERAD+1) ) allocate ( plmcgs (KSRAD:KERAD+1) ) allocate ( press (1:nlay+1) ) allocate ( altquad (1:nlay+1) ) allocate ( tempquad (1:nlay+1) ) allocate ( prsint (1:nlay+1) ) allocate ( tmpint (1:nlay+1) ) !-------------------------------------------------------------------- ! the gtemp code below assumes plmcgs in cgs units !-------------------------------------------------------------------- plmcgs(KSRAD:KERAD+1) = pd(KSRAD:KERAD+1)*1.0E+03 do k = KSRAD,KERAD gtemp(k) = plmcgs(k)**0.2*(1.+plmcgs(k)/30000.)**0.8/1013250. enddo gtemp(KERAD+1) = 1.0 altquad(1)=0.0 tempquad(1)=antemp(0.0) do k=KSRAD, KERAD+1 prsint(k)=plm(nlay+2-k) enddo !------------------------------------------------------------------- ! obtain layer-mean quantities by quadrature over the layers. ! the calculation is made to find the temperature at ! the layer-mean (plm) ! ! calculations are done (oddly!) 1 quad. interval at a time, with ! each going from the sfc upward to the top layer. !-------------------------------------------------------------------- press(1) = prsint(1) do k=2, nlay+1 press(k) = pd(nlay+KSRAD+1-k) enddo !--------------------------------------------------------------------- ! press is the pressure at the quadrature point; alt and temp ! are the heights and pressures for each ! such quadrature point. these are saved as tmpint and a. ! note that press is not explicitly saved. !-------------------------------------------------------------------- do k=1,nlay !------------------------------------------------------------------- ! establish computational levels between user levels at ! intervals of approximately 'delzap' km. ! special care is needed for the topmost layer, which usually ! goes to zero pressure. ! (special definition not needed; top pressure is nonzero) !------------------------------------------------------------------ dlogp=7.0*ALOG(press(k)/press(k+1)) nint=dlogp/delzap nint=nint+1 znint=nint !------------------------------------------------------------------ ! the conversion factor is used to convert dz from cm (using the ! model's values for rgas and grav) to km (as in this program) !------------------------------------------------------------------ dz = 1.0E-05*(1.0E+02*RDGAS)*dlogp/(7.0*GRAV*znint) ht=altquad(k) !--------------------------------------------------------------------- ! calculate height at next user level by means of ! runge-kutta integration. !------------------------------------------------------------------- do m=1,nint rk1=antemp(ht)*dz rk2=antemp(ht+0.5*rk1)*dz rk3=antemp(ht+0.5*rk2)*dz rk4=antemp(ht+rk3)*dz ht=ht+0.16666667*(rk1+rk2+rk2+rk3+rk3+rk4) enddo altquad(k+1)=ht tempquad(k+1)=antemp(ht) enddo !-------------------------------------------------------------------- ! save temperature (tmpint) at quadrature ! points for layer-mean evaluations by simpsons rule. !-------------------------------------------------------------------- do k=1,nlay+1 tmpint(k)=tempquad(k) enddo !-------------------------------------------------------------------- ! end of quadrature loop. !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! stemp is layer-mean temperature with index 1 ! at the top.applies for nq=5 !--------------------------------------------------------------------- do k=KSRAD,KERAD+1 stemp(k)=tmpint(nlay+KSRAD+1-k) enddo !-------------------------------------------------------------------- deallocate ( tmpint ) deallocate ( prsint ) deallocate ( tempquad ) deallocate ( altquad ) deallocate ( press ) deallocate ( plmcgs ) !------------------------------------------------------------------ end subroutine ptz !################################################################### ! ! ! Subroutine to analytically calculate temperature profiles of ! atmosphere with arbitrary levels ! ! ! Subroutine to analytically calculate temperature profiles of ! atmosphere with arbitrary levels ! ! ! ! Height ! ! ! real function antemp (z) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- real, intent(in) :: z !-------------------------------------------------------------------- ! intent(in) variables: ! ! z ! !-------------------------------------------------------------------- !------------------------------------------------------------------- ! local variables: real, dimension (10) :: zb, delta real, dimension (11) :: c real :: tstar, temp, expo, x, y, zlog, expp, & faclog integer :: n, nlast data zb/ & 11.0, 20.0, 32.0, 47.0, 51.0, & 71.0, 84.8520, 90.0, 91.0, 92.0/ data c/ & -6.5, 0.0, 1.0, 2.80, 0.0, & -2.80, -2.00, 0.0, 0.0, 0.0, 0.0/ data delta/ & 0.3, 1.0, 1.0, 1.0, 1.0, & 1.0, 1.0, 1.0, 1.0, 1.0/ data tstar/ & 288.15/ !------------------------------------------------------------------- ! local variables: ! ! zb ! !------------------------------------------------------------------- !------------------------------------------------------------------- ! !------------------------------------------------------------------- temp = tstar + c(1)*z !------------------------------------------------------------------- ! !------------------------------------------------------------------- nlast = 10 do n = 1,nlast expo = (z - zb(n))/delta(n) if (ABS(expo) .LE. 60.) then x = EXP(expo) y = x + 1.0/x zlog = ALOG(y) else zlog = ABS(expo) endif expp = zb(n)/delta(n) if (ABS(expp) .LE. 60.) then x = EXP(expp) y = x + 1.0/x faclog = ALOG(y) else faclog = ABS(expp) endif temp = temp + (c(n+1) - c(n))*0.5*(z + delta(n)* & (zlog - faclog)) enddo antemp = temp !-------------------------------------------------------------------- end function antemp !##################################################################### ! ! ! Subroutine to compute the temperature corrected co2 nearby layer ! transmission functions ! ! ! Subroutine to compute the temperature corrected co2 nearby layer ! transmission functions ! ! ! ! The output variable of temperature corrected co2 transmission ! functions ! ! ! subroutine transfn (Gas_tf) !---------------------------------------------------------------------- ! transfn computes the temperature-corrected co2 nearby layer ! transmission functions. ! author: m. d. schwarzkopf ! revised: 1/1/93 ! certified: radiation version 1.0 !---------------------------------------------------------------------- type(gas_tf_type), intent(inout) :: Gas_tf !-------------------------------------------------------------------- ! intent(inout) variables: ! ! Gas_tf ! co2nbl = co2 transmission functions (not pressure-integrated) ! for adjacent levels, over the 560-800 cm-1 range. ! co2spnb = co2 transmission functions between a flux level and ! space, for each of (NBCO215) frequency bands in ! the 15 um range. used for cool-to-space calculations. ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: real, dimension (size(Gas_tf%tdav,1), & size(Gas_tf%tdav,2), & size(Gas_tf%tdav,3)-1) :: co2m2d, co2md, co2mr real, dimension (size(Gas_tf%tdav,1), & size(Gas_tf%tdav,2), & size(Gas_tf%tdav,3) ) :: dift real, dimension (size(Gas_tf%tdav,1), & size(Gas_tf%tdav,2), & size(Gas_tf%tdav,3), NBCO215 ) :: & co215nb, co2dt15nb, co2d2t15nb integer :: inb, k !--------------------------------------------------------------------- ! local variables: ! ! co2m2d ! co2md ! co2mr ! dift ! co215nb ! co2dt15nb ! co2d2t15nb ! inb ! k ! !---------------------------------------------------------------------- !---------------------------------------------------------------------- ! perform co2 pressure interpolation on all inputted transmission ! functions and temperature derivatives successively computing ! co2r, dco2dt, and d2cdt2. !---------------------------------------------------------------------- do inb=1,NBCO215 do k=KSRAD,KERAD+1 co215nb(:,:,k,inb) = Gas_tf%a1(:,:)*co215nbps1(k,inb) + & Gas_tf%a2(:,:)*co215nbps8(k,inb) co2dt15nb(:,:,k,inb) = 1.0E-2*(Gas_tf%a1(:,:)* & co2dt15nbps1(k,inb) +& Gas_tf%a2(:,:)*co2dt15nbps8(k,inb)) co2d2t15nb(:,:,k,inb) = 1.0E-3*(Gas_tf%a1(:,:)* & co2d2t15nbps1(k,inb)+& Gas_tf%a2(:,:)*co2d2t15nbps8(k,inb)) enddo enddo !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- do k=KSRAD,KERAD co2mr (:,:,k) = Gas_tf%a1(:,:)*co2m51(k) + & Gas_tf%a2(:,:)*co2m58(k) co2md (:,:,k) = 1.0E-02*(Gas_tf%a1(:,:)*cdtm51(k) + & Gas_tf%a2(:,:)*cdtm58(k)) co2m2d(:,:,k) = 1.0E-03*(Gas_tf%a1(:,:)*c2dm51(k) + & Gas_tf%a2(:,:)*c2dm58(k)) enddo !---------------------------------------------------------------------- ! perform the temperature interpolation for these transmissivities !---------------------------------------------------------------------- dift(:,:,KSRAD+1:KERAD+1) = Gas_tf%tdav(:,:,KSRAD+1:KERAD+1)/ & Gas_tf%tstdav(:,:,KSRAD+1:KERAD+1) do inb=1,NBCO215 Gas_tf%co2spnb(:,:,KSRAD,inb) = 1.0E+00 Gas_tf%co2spnb(:,:,KSRAD+1:KERAD+1,inb) = & co215nb(:,:,KSRAD+1:KERAD+1,inb) + & dift(:,:,KSRAD+1:KERAD+1)* & (co2dt15nb(:,:,KSRAD+1:KERAD+1,inb) +& 0.5E+00*dift(:,:,KSRAD+1:KERAD+1)* & co2d2t15nb(:,:,KSRAD+1:KERAD+1,inb)) do k=KSRAD,KERAD+1 Gas_tf%co2spnb(:,:,k,inb) = Gas_tf%co2spnb(:,:,k,inb)* & (1.0E+00 - & Gas_tf%tlsqu(:,:,KSRAD)) + & Gas_tf%tlsqu(:,:,KSRAD) enddo enddo !---------------------------------------------------------------------- ! compute special nearby layer transmission functions for combined ! band in 15 um range. the transmissivities are not layer-averaged. !---------------------------------------------------------------------- Gas_tf%co2nbl(:,:,KSRAD:KERAD) = co2mr(:,:,KSRAD:KERAD) + & Gas_tf%tmpdiff(:,:,KSRAD:KERAD)*& (co2md (:,:,KSRAD:KERAD) + & 0.5E+00* & Gas_tf%tmpdiff(:,:,KSRAD:KERAD)*& co2m2d(:,:,KSRAD:KERAD)) Gas_tf%co2nbl(:,:,KSRAD:KERAD) = Gas_tf%co2nbl(:,:,KSRAD:KERAD)*& (1.0E+00 - & Gas_tf%tlsqu(:,:,KSRAD:KERAD)) +& Gas_tf%tlsqu(:,:,KSRAD:KERAD) !-------------------------------------------------------------------- end subroutine transfn !################################################################### ! ! ! Subroutine to process gas input file information ! ! ! Subroutine to process gas input file information ! ! ! ! Name of the gas specy ! ! ! Amount of the gas specy ! ! ! Number of standard levels ! ! ! Index of the starting and ending vertical levels ! ! ! Pressure coordinate variables, at boundaries, mid points. ! ! ! The input file descriptor ! ! ! subroutine process_gas_input_file (gas_name, gas_amount, nstdlvls, & kbegin, kend, pd, plm, pa, unit) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- character(len=*), intent(in) :: gas_name real, intent(in) :: gas_amount integer, intent(in) :: nstdlvls, kbegin, kend, unit real, dimension(:), intent(in) :: pd, plm, pa !--------------------------------------------------------------------- ! intent(in) variables: ! ! gas_nmae ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real, dimension(:), allocatable :: pd_file, plm_file, pa_file logical :: valid=.false. integer :: k, n character(len=8) :: gastf_version, gas_file real :: gas_amount_file integer :: nstdlvls_file, kbegin_file, kend_file !-------------------------------------------------------------------- ! local variables: ! ! pd_file ! !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- read (unit) gastf_version do n=1, nvalids if (gastf_version == valid_versions(n)) then valid = .true. exit endif end do if (.not.valid) then call error_mesg ( 'gas_tf_mod', & ' old gastf file -- no info on its contents ---'//& ' for safety, please recreate by running this code'// & ' with do_calc and do_write of stdtfs activated and'//& ' save the file thus generated to be read in future jobs', & FATAL) endif !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- read (unit) gas_file, gas_amount_file, nstdlvls_file, & kbegin_file, kend_file !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- if (trim(gas_file) /= trim(gas_name) ) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in gas name between input file and current job', & FATAL) endif if (gas_amount /= gas_amount_file) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in gas amount between input file and current job',& FATAL) endif if (nstdlvls /= nstdlvls_file) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in nstdlvls between input file and current job',& FATAL) endif if (kbegin_file /= KSRAD) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in KSRAD between input file and current job',& FATAL) endif if (kend_file /= KERAD) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in KERAD between input file and current job',& FATAL) endif !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- allocate ( pd_file (kbegin_file:kend_file) ) allocate ( plm_file(kbegin_file:kend_file) ) allocate ( pa_file (nstdlvls ) ) !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- read (unit) pd_file, plm_file, pa_file !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- do k=KSRAD,KERAD if (pd(k) /= pd_file(k)) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in pd between input file and current job'//& ' -- have the input files been constructed using'//& ' current model pressure levels ?', FATAL) endif if (plm(k) /= plm_file(k)) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in plm between input file and current job'//& ' -- have the input files been constructed using'//& ' current model pressure levels ?', FATAL) endif end do !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- do k=1,nstdlvls if (pa(k) /= pa_file(k)) then call error_mesg ( 'gas_tf_mod', & 'inconsistency in pa between input file and current job',& FATAL) endif end do !-------------------------------------------------------------------- ! !-------------------------------------------------------------------- deallocate ( pa_file ) deallocate ( plm_file ) deallocate ( pd_file ) !-------------------------------------------------------------------- end subroutine process_gas_input_file !##################################################################### end module gas_tf_mod