chem/module_cam_mam_mo_chem_utls.F

   1 #define WRF_PORT
   2 module mo_chem_utls
   3
   4   private
   5 #ifndef WRF_PORT
   6   public :: get_spc_ndx, get_het_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx
   7 #else
   8   public :: get_spc_ndx, get_het_ndx, get_inv_ndx
   9 #endif
  10
  11   save
  12
  13 contains
  14
  15   integer function get_spc_ndx( spc_name )
  16     !-----------------------------------------------------------------------
  17     !     ... return overall species index associated with spc_name
  18     !-----------------------------------------------------------------------
  19
  20 #ifndef WRF_PORT
  21     use chem_mods,     only : gas_pcnst
  22     use mo_tracname,   only : tracnam => solsym
  23 #else
  24     use constituents,        only : cnst_get_ind
  25     use module_cam_support, only : pcnst_non_chem => pcnst_non_chem_modal_aero
  26 #endif
  27
  28     implicit none
  29
  30     !-----------------------------------------------------------------------
  31     !     ... dummy arguments
  32     !-----------------------------------------------------------------------
  33     character(len=*), intent(in) :: spc_name
  34
  35     !-----------------------------------------------------------------------
  36     !     ... local variables
  37     !-----------------------------------------------------------------------
  38     integer :: m
  39
  40     get_spc_ndx = -1
  41 #ifndef WRF_PORT
  42     do m = 1,gas_pcnst
  43        if( trim( spc_name ) == trim( tracnam(m) ) ) then
  44           get_spc_ndx = m
  45           exit
  46        end if
  47     end do
  48 #else
  49     call cnst_get_ind(trim(adjustl(spc_name)),m,.false.)
  50     get_spc_ndx = m - pcnst_non_chem
  51 #endif
  52
  53   end function get_spc_ndx
  54
  55   integer function get_inv_ndx( invariant )
  56     !-----------------------------------------------------------------------
  57     !     ... return overall external frcing index associated with spc_name
  58     !-----------------------------------------------------------------------
  59
  60 #ifndef WRF_PORT
  61     use chem_mods,  only : nfs, inv_lst
  62 #endif
  63
  64     implicit none
  65
  66     !-----------------------------------------------------------------------
  67     !     ... dummy arguments
  68     !-----------------------------------------------------------------------
  69     character(len=*), intent(in) :: invariant
  70
  71     !-----------------------------------------------------------------------
  72     !     ... local variables
  73     !-----------------------------------------------------------------------
  74     integer :: m
  75
  76     get_inv_ndx = -1
  77 #ifndef WRF_PORT
  78     do m = 1,nfs
  79        if( trim( invariant ) == trim( inv_lst(m) ) ) then
  80           get_inv_ndx = m
  81           exit
  82        end if
  83     end do
  84
  85 #endif
  86   end function get_inv_ndx
  87
  88
  89   integer function get_het_ndx( het_name )
  90     !-----------------------------------------------------------------------
  91     !     ... return overall het process index associated with spc_name
  92     !-----------------------------------------------------------------------
  93 #ifndef WRF_PORT
  94     use gas_wetdep_opts,only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt
  95 #else
  96     use module_cam_support, only: gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt
  97 #endif
  98
  99     implicit none
 100
 101     !-----------------------------------------------------------------------
 102     !     ... dummy arguments
 103     !-----------------------------------------------------------------------
 104     character(len=*), intent(in) :: het_name
 105
 106     !-----------------------------------------------------------------------
 107     !     ... local variables
 108     !-----------------------------------------------------------------------
 109     integer :: m
 110
 111     get_het_ndx=-1
 112
 113     do m=1,gas_wetdep_cnt
 114
 115        if( trim( het_name ) == trim( gas_wetdep_list(m) ) ) then
 116           get_het_ndx = get_spc_ndx( gas_wetdep_list(m) )
 117           return
 118        endif
 119
 120     enddo
 121
 122   end function get_het_ndx
 123 #ifndef WRF_PORT
 124   integer function get_extfrc_ndx( frc_name )
 125     !-----------------------------------------------------------------------
 126     !     ... return overall external frcing index associated with spc_name
 127     !-----------------------------------------------------------------------
 128
 129     use chem_mods,  only : extcnt, extfrc_lst
 130
 131     implicit none
 132
 133     !-----------------------------------------------------------------------
 134     !     ... dummy arguments
 135     !-----------------------------------------------------------------------
 136     character(len=*), intent(in) :: frc_name
 137
 138     !-----------------------------------------------------------------------
 139     !     ... local variables
 140     !-----------------------------------------------------------------------
 141     integer :: m
 142
 143     get_extfrc_ndx = -1
 144     if( extcnt > 0 ) then
 145        do m = 1,max(1,extcnt)
 146           if( trim( frc_name ) == trim( extfrc_lst(m) ) ) then
 147              get_extfrc_ndx = m
 148              exit
 149           end if
 150        end do
 151     end if
 152
 153   end function get_extfrc_ndx
 154
 155   integer function get_rxt_ndx( rxt_tag )
 156     !-----------------------------------------------------------------------
 157     !     ... return overall external frcing index associated with spc_name
 158     !-----------------------------------------------------------------------
 159
 160     use chem_mods,  only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map
 161
 162     implicit none
 163
 164     !-----------------------------------------------------------------------
 165     !     ... dummy arguments
 166     !-----------------------------------------------------------------------
 167     character(len=*), intent(in) :: rxt_tag
 168
 169     !-----------------------------------------------------------------------
 170     !     ... local variables
 171     !-----------------------------------------------------------------------
 172     integer :: m
 173
 174     get_rxt_ndx = -1
 175     do m = 1,rxt_tag_cnt
 176        if( trim( rxt_tag ) == trim( rxt_tag_lst(m) ) ) then
 177           get_rxt_ndx = rxt_tag_map(m)
 178           exit
 179        end if
 180     end do
 181
 182   end function get_rxt_ndx
 183
 184 #endif
 185 end module mo_chem_utls