!BOI

!  !TITLE: GSI\_ChemGuess\_Mod: A GSI Bundle to handle Trace Gases and Aerosols

!  !AUTHORS: Ricardo Todling

!  !AFFILIATION: Global Modeling and Assimilation Office, NASA/GSFC, Greenbelt, MD 20771

!  !DATE: 12 Oct 2010

!  !INTRODUCTION: Overview
#ifdef __PROTEX__

This module defines to so-called GSI\_ChemGuess\_Bundle. Its main purpose is to
allow GSI to ingest guess fields related to trace gases, aerosols, and chemistry
in general. 

\begin{center}
\fbox{Chem Bundle is a way to ingest Chemistry-related backgrounds into GSI}
\end{center}

Before the introduction of this module, all guess fields entered GSI through the 
arrays ges\_x, with x standing for particular fields, defined in the guess\_grids module, 
e.g., ges\_u, ges\_tv, and so on. Extending this approach to handle chemistry-related fields
could become rather complex, particularly, because it is in principle not known which fields are
needed for given application. The GSI\_ChemGuess\_Bundle aims at allowing GSI to ingest 
a general set of fields without a given order or particular specification. 

\underline{Caution}: An important exception is ozone. Since guess\_grids already handles ozone, this
is the only chemistry field that should still be dealt through guess\_gridsi, as ges\_oz.

\begin{center}
\fbox{Chem Bundle is a GSI\_Bundle}
\end{center}

The GSI\_ChemGuess\_Bundle uses the GSI\_Bundle. But while the state and control vectors 
use the GSI\_Bundle to associate fields used by the observation operator and
those used in the cost function, respectively, the GSI\_ChemGuess\_Bundle
is simply aimed at allowing ingestion of Chemistry Guess fields into GSI. The translation
of these guess fields into state and control vectors is still done via the state and
control vectors defining mechanism. 

As guess\_grids does, this module still treats the Chemistry Guess fields via a
common-block-like structure. That is, the GSI\_Bundle defined here to hold the
Chemistry Guess fields is an internally defined type that cannot be passed
around. This will change in the future, but for the time being this is the
simplest thing to do given the current code design.

\begin{center}
\fbox{Chem Bundle Module provides an (almost) opaque access to the entries in
the object}
\end{center}

One of the ideas behind this module is that it defines an opaque-like object.
That is, functions related to contents of the Chem Bundle should can only be
extracted via inquires through a ``get-like'' procedures. This is why, only ``methods'' are 
made public to this module, that is, 

\begin{verbatim}
public :: gsi_chemguess_create_grids
public :: gsi_chemguess_destroy_grids
public :: gsi_chemguess_init
public :: gsi_chemguess_get
public :: gsi_chemguess_final
\end{verbatim}

and never the variables themselves; the only exception being the GSI\_ChemGuess\_Bundle itself 
(until it is no longer treated as a common-block).  Some of the above public methods are 
overloaded and all  have internal interfaces (name of which appears in the index of this protex 
document. It should be a rule here that any new routine to be make public should
have a declared interface procedure.

\begin{center}
\fbox{Chem Bundle is defined via the {\it chem\_guess} table in a resource file}
\end{center}

\underline{Defining the Chem Bundle} is done via the table {\it chem\_guess}, usually 
embedded in the {\it anavinfo} file. An example of such table follows:
\begin{verbatim}
chem_guess::
!#var     level  itracer crtm_use   type              orig_name
  co       72      1        -1       n/a                co
  co2      72      1         0       n/a                co2
!#      GOCART Aerosols
!#    ------ Dust ------  
  du001     72      1         10      dust               DU001
  du002     72      1         10      dust               DU002
  du003     72      1         10      dust               DU003
  du004     72      1         10      dust               DU004
  du005     72      1         10      dust               DU005
!#     ------ Sea-salt ------
  ss001     72      1         10      ssam               SS001
  ss002     72      1         10      sscm1              SS002
  ss003     72      1         10      sscm2              SS003
  ss004     72      1         10      sscm3              SS004
  ss005     72      1         10      sscm4              SS005
!#     ------ Sulfates ------
  so4       72      1         10      sulfate            SO4
!#     ------ Carbonaceous (main) ------
  bcphobic  72      1         10      dry_black_carbon   BCphobic
  bcphilic  72      1         10      wet_black_carbon   BCphilic
  ocphobic  72      1         10      dry_organic_carbon OCphobic
  ocphilic  72      1         10      wet_organic_carbon OCphilic
::
\end{verbatim}
This is what GMAO plans to use in the near future. 

As usual, this table follows INPAK/ESMF convention, begining with a name
(chem\_guess), followed by double colons (::), and ending with double colons.
Any line starting with an exclamation mark or a pound sign is taken as a comment.

The current {\it chem\_guess} table has six columns defined as follows:

\begin{verbatim}
Column 1: variable name - refers to internally known GSI variable name
Column 2: indicates number of levels (used to distinguish between 2d and 3d fields)
Column 3: likely to be redefined sometime soon
Column 4: indicates whether variable is to be passed to CRTM or not according to 
          the following scheme:
          if<0    general chem variable; not used in CRTM 
          if=0    general chem variable; use prescribed global mean data to affect CRTM
          if=1    general chem variable; use variable in guess field to affect CRTM 
          if>10   aerosol variable
Column 5: type of chemical/aerosol
Column 6: original name in file where species is read from
\end{verbatim}

\begin{center}
\fbox{Examples of extracting information related to the Chem Bundle}
\end{center}

\underline{Examples} of accessing information related to fields in the Chem Bundle.
\begin{enumerate}
\item Say a routine wants to know how $CO_2$ is to be used in CRTM. 
      This is done via the {\it i4crtm::} tag, as in:
      \begin{verbatim}
      call gsi_chemguess_get ( 'i4crtm::co2', igfsco2, ier )
      \end{verbatim}
       where the value returned {\it igfsco2} is an integer following the 
       scheme laid out for entries in column 4 of the resource file (anavinfo). 

\item Say a routine wants to get the number of all 3d aerosols available in the
      Chem Bundle, this can use the tag {\it aerosols::3d}, as in:
      \begin{verbatim}
      call gsi_chemguess_get ( 'aerosols::3d',n_aerosols,ier )
      \end{verbatim}
      notice this uses the same interface as in the example above, but returns
      information about something else.

\item Say a routine wants the name of all 3d aerosols
      \begin{verbatim}
      call gsi_chemguess_get ('aerosols::3d',aero_names,ier)     
      \end{verbatim}
      now the returned variable {\it aero\_names} is a character array with the 
      names of all 3d-aerosols. Notice it is important to inquire before hand
      about the number of  3d-aerosols available and to properly allocate space
      for the character arrays {\it aero\_names}, and only then make the call above.

\end{enumerate}

More on the other possible mnemonics known by this package can be found in the 
prologue description of the {it get} routines.

\begin{center}
\fbox{Conventions and Remarks}
\end{center}

\underline{Conventions} proposed for entries in this module:
\begin{itemize}
  \item GSI-known variable names should all be lower-case, these are the variables
        defined in column 1 of {\it anavinfo} file.
  \item Only methods should be made public from this module.
  \item New routines should be defined via interface procedure.
\end{itemize}
 
A general remark about the correct {\it chem\_guess} table: it is recognized that
the format for general specification related to specific entries in the table is 
not general enough. A better approach is the one used by the Registry used in
GEOS-5 GOCART where a table exists to control a particular functionality
applicable to a certain set of constituents. For example, use of a variable in
CRTM could be control instead by a specific table listing constituents to be
used in the CRTM and at what extent, for example, a table of the form:
\begin{verbatim}
use_in_crtm::
 !var     use  
  co2      1
  co       0
::
\end{verbatim}
Something of this form should eventually replace some of the columns in the 
{\it chem\_guess} table. 

#endif
!EOI


!-------------------------------------------------------------------------
!  NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1, GMAO  !
!-------------------------------------------------------------------------
!BOP
!  
! !MODULE: ChemguessMod -- Implements Chem Guess capability for GSI
!
! !INTERFACE:

module gsi_chemguess_mod
!
! !DESCRIPTION: Module to handle chemistry fields, tracers, and aerosols.
!               This still uses wired-in type arrays to hold the guess. Soon
!               we'll generalize this.
!
! !REMARKS:
!   1. VERY IMPORTANT: No object from this file is to be make
!                      explicitly available to the outside world.
!                      Each object must be opaque with a get and
!                      a put method associated with it.
!   2. This is still functioning as a common-block when it comes
!      to the chem type itself - needs some work to make it into 
!      a self-contained type
! 
! !USES:

use kinds, only: i_kind,r_kind
use constants, only: max_varname_length
use mpimod, only : mype
use mpeu_util,only: die
use file_utility, only : get_lun
use gsi_bundlemod, only : GSI_BundleCreate
use gsi_bundlemod, only : GSI_BundleGetPointer
use gsi_bundlemod, only : GSI_Bundle
use gsi_bundlemod, only : GSI_BundlePrint
use gsi_bundlemod, only : GSI_BundleDestroy

use gsi_bundlemod, only : GSI_Grid
use gsi_bundlemod, only : GSI_GridCreate

use mpeu_util, only: gettablesize
use mpeu_util, only: gettable
use mpeu_util, only: getindex

implicit none
private
save

! ! !PUBLIC MEMBER FUNCTIONS:

public :: gsi_chemguess_create_grids
public :: gsi_chemguess_destroy_grids
public :: gsi_chemguess_init
public :: gsi_chemguess_get
public :: gsi_chemguess_final

public :: GSI_ChemGuess_Bundle   ! still a common for now, ultimately should 
                                 ! be a dynamic "type", passed around in arg list

! !INTERFACE:

interface gsi_chemguess_init
          module procedure init_
end interface
interface gsi_chemguess_final
          module procedure final_ 
end interface
interface gsi_chemguess_create_grids
          module procedure create_
end interface
interface gsi_chemguess_destroy_grids
          module procedure destroy_
end interface
interface gsi_chemguess_get
          module procedure get_int0d_
          module procedure get_char0d_
          module procedure get_char1d_
end interface

type(GSI_Bundle),pointer :: GSI_ChemGuess_Bundle(:)   ! still a common for now


! !REVISION HISTORY:
!
!   20Apr2010 Todling  Initial code.
!   03May2010 Treadon - add iostat error check to ibm_sp read(lu,chemguess) in init_
!   19May2010 Todling - porter Hou's igfsco2 flag from setup namelist to this namelist
!   30May2010 Todling - remove namelist; revamp the way fields/info read in (i90-style)
!   25Jun2010 Treadon - consistently intialize ivar; check/use length of desc (gsi_chemguess_get)
!   07Oct2010 Todling - add entry usrname to differentiate gsi-names w/ in-file names
!   01May2011 Todling - rename module and its bundle for parallelism w/ MetGuess
!
!EOP
!-------------------------------------------------------------------------

! !PRIVATE ROUTINES:
!BOC

integer(i_kind),parameter::MAXSTR=max_varname_length
logical:: chem_grid_initialized_=.false.
logical:: chem_initialized_=.false.
character(len=*), parameter :: myname = 'gsi_chemguess_mod'

integer(i_kind) :: nbundles=-1
integer(i_kind) :: ntgases=0
integer(i_kind) :: naero=0          ! number of aerosols
integer(i_kind) :: nghg =0          ! number of green-house gases
integer(i_kind) :: n2daero=0
integer(i_kind) :: n3daero=0
integer(i_kind) :: ng3d=-1
integer(i_kind) :: ng2d=-1
character(len=MAXSTR),allocatable :: tgases(:)     ! same as list above, but each var as element of array
character(len=MAXSTR),allocatable :: tgases3d(:)   ! same as list above, but each var as element of array
character(len=MAXSTR),allocatable :: tgases2d(:)   ! same as list above, but each var as element of array
character(len=MAXSTR),allocatable :: chemtype(:)   ! indicate type of chem (used for aerosols for now)
character(len=MAXSTR),allocatable :: chemty3d(:)   ! indicate 3d type of chem
character(len=MAXSTR),allocatable :: chemty2d(:)   ! indicate 3d type of chem
character(len=MAXSTR),allocatable :: usrname3d(:)  ! chem user-defined (original) 3d name (in file)
character(len=MAXSTR),allocatable :: usrname2d(:)  ! chem user-defined (original) 2d name (in file)
character(len=MAXSTR),allocatable :: usrname(:)    ! chem user-defined (original) name (in file)
integer(i_kind),allocatable,dimension(:) :: i4crtm ! controls use of gas in CRTM:
                                                   ! < 0 don't use in CRTM
                                                   ! = 0 use predefined global mean co2 mixing ration
                                                   ! = 1 use gfs yearly global annual mean historical co2 value
                                                   ! = 2 use gfs monthly horizontal 2-d historical co2 value
                                                   ! in interval [0,10)  general trace gas
                                                   ! in interval [10,20) indicates aerosol
integer(i_kind),allocatable,dimension(:) :: i4crtm2d ! as above but for 2d fields
integer(i_kind),allocatable,dimension(:) :: i4crtm3d ! as above but for 3d fields

logical:: verbose_=.true.

contains

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  init_ --- Initialize Chem Bundle (read resource table); alloc internal
!
! !INTERFACE:
!
subroutine init_ (iamroot)
! USES:
implicit none
! !INPUT PARAMETER:
   logical,optional,intent(in) :: iamroot 
! !DESCRIPTION: Define contents of Chem Bundle through rc file (typilcally
!               embedded in anavinfo text file.
!
! !REVISION HISTORY:
!   2010-04-10  todling  initial code
!   2013-09-30  todling  allow 40-char var description
!
! !REMARKS:
!   language: f90
!   machine:  discover
!
! !AUTHOR:
!   Ricardo Todling  org: gmao      date: 2010-04-10
!
!EOP
!-------------------------------------------------------------------------
!BOC
!character(len=*),parameter:: rcname='anavinfo.txt'
character(len=*),parameter:: rcname='anavinfo'  ! filename should have extension
character(len=*),parameter:: tbname='chem_guess::'
integer(i_kind) luin,i,ii,ntot,icrtmuse
character(len=256),allocatable,dimension(:):: utable
character(len=40) ctype
character(len=20) var,oname
character(len=*),parameter::myname_=myname//'*init_'
integer(i_kind) ilev, itracer
logical iamroot_

if(chem_initialized_) return

iamroot_=mype==0
if(present(iamroot)) iamroot_=iamroot 

! load file
luin=get_lun()
open(luin,file=rcname,form='formatted')

! Scan file for desired table first
! and get size of table
call gettablesize(tbname,luin,ntot,ntgases)
if(ntgases==0) then
   close(luin)
   return
endif

! Get contents of table
allocate(utable(ntgases))
call gettable(tbname,luin,ntot,ntgases,utable)

! release file unit
close(luin)

! Retrieve each token of interest from table and define
! variables participating in state vector

! Count variables first
ng3d=0; ng2d=0
do ii=1,ntgases
   read(utable(ii),*) var, ilev, itracer, icrtmuse
   if(ilev==1) then
       ng2d=ng2d+1
   else
       ng3d=ng3d+1
   endif
enddo

allocate(i4crtm(ntgases),usrname(ntgases),&
         tgases(ntgases),chemtype(ntgases))
if(ng3d > 0)allocate(tgases3d(ng3d),&
                     chemty3d(ng3d),&
                     i4crtm3d(ng3d),&
                     usrname3d(ng3d))
if(ng2d > 0)allocate(tgases2d(ng2d),&
                     chemty2d(ng2d),&
                     i4crtm2d(ng2d),&
                     usrname2d(ng2d))

! Now load information from table
ng3d=0;ng2d=0
do ii=1,ntgases
   read(utable(ii),*) var, ilev, itracer, icrtmuse, ctype, oname
   if(ilev==1) then
      ng2d=ng2d+1
      tgases2d(ng2d)=trim(adjustl(var))
      chemty2d(ng2d)=trim(adjustl(ctype))
      i4crtm2d(ng2d)=icrtmuse
      usrname2d(ng2d)=trim(adjustl(oname))
      if(abs(icrtmuse)>=10.and.abs(icrtmuse)<20) n2daero=n2daero+1 ! convention, for now
   else
      ng3d=ng3d+1
      tgases3d(ng3d)=trim(adjustl(var))
      chemty3d(ng3d)=trim(adjustl(ctype))
      i4crtm3d(ng3d)=icrtmuse
      usrname3d(ng3d)=trim(adjustl(oname))
      if(abs(icrtmuse)>=10.and.abs(icrtmuse)<20) n3daero=n3daero+1 ! convention, for now
   endif
   if(abs(icrtmuse)< 10)                      nghg =nghg +1 ! GHG  convention, for now
   if(abs(icrtmuse)>=10.and.abs(icrtmuse)<20) naero=naero+1 ! AERO convention, for now
enddo

deallocate(utable)

! Fill in array w/ all var names (must be 3d first, then 2d)
ii=0
do i=1,ng3d
   ii=ii+1
   tgases(ii)=tgases3d(i)
   i4crtm(ii)=i4crtm3d(i)
   usrname(ii)=usrname3d(i)
   chemtype(ii)=trim(adjustl(chemty3d(i)))
enddo
do i=1,ng2d
   ii=ii+1
   tgases(ii)=tgases2d(i)
   i4crtm(ii)=i4crtm2d(i)
   usrname(ii)=usrname2d(i)
   chemtype(ii)=trim(adjustl(chemty2d(i)))
enddo

if (iamroot_) then
   write(6,*) myname_,':  2D-CHEM STATE VARIABLES: '
   do i=1,ng2d
      write(6,*) trim(tgases2d(i))
   enddo
   write(6,*) myname_,':  3D-CHEM STATE VARIABLES:'
   do i=1,ng3d
      write(6,*) trim(tgases3d(i))
   enddo
   write(6,*) myname_,': ALL CHEM STATE VARIABLES:'
   do i=1,ntgases
      write(6,*) trim(tgases(i))
   enddo
end if
chem_initialized_=.true.

end subroutine init_
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  final_ --- Deallocate internal Chem Bundle info arrays
!
! !INTERFACE:
!
subroutine final_
implicit none

! !DESCRIPTION: Dealloc grids holding trace gases
!
! !REVISION HISTORY:
!   2010-04-10  todling  initial code
!
! !REMARKS:
!   language: f90
!   machine:  discover
!
! !AUTHOR:
!   Ricardo Todling  org: gmao      date: 2010-04-10
!
!EOP
!-------------------------------------------------------------------------
!BOC
if(.not.chem_initialized_) return

if(allocated(tgases))   deallocate(tgases)
if(allocated(i4crtm))   deallocate(i4crtm)
if(allocated(chemtype)) deallocate(chemtype)
if(allocated(usrname))  deallocate(usrname)
if(allocated(usrname3d))deallocate(usrname3d)
if(allocated(usrname2d))deallocate(usrname2d)
if(allocated(tgases3d)) deallocate(tgases3d)
if(allocated(tgases2d)) deallocate(tgases2d)
if(allocated(i4crtm3d)) deallocate(i4crtm3d)
if(allocated(i4crtm2d)) deallocate(i4crtm2d)
if(allocated(chemty3d)) deallocate(chemty3d)
if(allocated(chemty2d)) deallocate(chemty2d)

chem_initialized_=.false.
end subroutine final_
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  create_ --- Allocate grid and bundle holding chem guess
!
! !INTERFACE:
!
!!subroutine create_(GSI_ChemGuess_Bundle,im,jm,km,lm,istatus) ! ultimately
  subroutine create_(im,jm,km,lm,istatus)

! !USES:

    use constants,only: zero
    implicit none

! !INPUT PARAMETERS:
    integer(i_kind),intent(in)::im,jm,km,lm

! !OUTPUT PARAMETERS:
    integer(i_kind),intent(out)::istatus

! !INPUT/OUTPUT PARAMETERS:
!!  type(GSI_Bundle) :: GSI_ChemGuess_Bundle

! !DESCRIPTION: allocate grids to hold guess cloud fields
!
! !REVISION HISTORY:
!   2010-04-20  todling  initial code
!   2010-05-17  todling  update create interface to pass a grid
!   2011-07-03  todling  allow running single or double precision
!   2011-11-16  todling  allow 2d tracers (e.g., AOD)
!   2017-02-22  todling  initialized only what needed(2d,3d,or both)
!
! !AUTHOR:
!   Ricardo Todling  org: gmao      date: 2010-04-10
!
!EOP
!-------------------------------------------------------------------------
!BOC

    character(len=*), parameter :: myname_ = myname//'*create_'
    integer(i_kind) nt
    type(GSI_Grid):: grid

    istatus=0
    if(ntgases<=0) return

    if(chem_grid_initialized_) return

!   Create simple regular grid
    call gsi_gridcreate ( grid, im, jm, km )

    nbundles = lm
    allocate(GSI_ChemGuess_Bundle(nbundles))
    do nt=1,nbundles
       if (ng2d>0.and.ng3d>0) then
          call GSI_BundleCreate ( GSI_ChemGuess_Bundle(nt), grid, 'Trace Gases', istatus, &
                                  names2d=tgases2d,names3d=tgases3d,bundle_kind=r_kind )
       else if (ng2d>0) then
          call GSI_BundleCreate ( GSI_ChemGuess_Bundle(nt), grid, 'Trace Gases', istatus, &
                                  names2d=tgases2d,bundle_kind=r_kind )
       else if (ng3d>0) then
          call GSI_BundleCreate ( GSI_ChemGuess_Bundle(nt), grid, 'Trace Gases', istatus, &
                                  names3d=tgases3d,bundle_kind=r_kind )
       else
          istatus=99
       endif
    enddo

    if (istatus/=0) then
        if(mype==0) write(6,*)trim(myname_),':  allocate error1, istatus=',&
                              istatus,im,jm,km,lm
        return
    endif

    if (verbose_) then
       if(mype==0) write(6,*) trim(myname_),': alloc() for chem-tracer done'
    endif
    chem_grid_initialized_=.true.

    return
  end subroutine create_
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  destroy_ --- Deallocate grid and bundle holding chem guess
!
! !INTERFACE:
!
!!subroutine destroy_ (GSI_ChemGuess_Bundle, istatus) ! ultimately
  subroutine destroy_ (istatus)

! !USES:
    implicit none

! !INPUT PARAMETERS:

! !OUTPUT PARAMETERS:
  integer(i_kind), intent(out) :: istatus

! !INPPUT/OUTPUT PARAMETERS:
!!  type(GSI_Bundle) :: GSI_ChemGuess_Bundle

! !DESCRIPTION: Dealloc grids holding trace gases
!
! !REVISION HISTORY:
!   2010-04-10  todling  initial code
!
! !REMARKS:
!   language: f90
!   machine:  discover
!
! !AUTHOR:
!   Ricardo Todling  org: gmao      date: 2010-04-10
!
!EOP
!-------------------------------------------------------------------------
!BOC

    character(len=*), parameter :: myname_ = myname//'*destroy_'
    integer(i_kind) :: nt,ier
    istatus=0

    if(.not.chem_grid_initialized_) return

     do nt=1,nbundles
        call GSI_BundleDestroy ( GSI_ChemGuess_Bundle(nt), ier )
        istatus=istatus+ier
     enddo
     deallocate(GSI_ChemGuess_Bundle,stat=istatus)
     istatus=istatus+ier

    if (istatus/=0) then
        if(mype==0) write(6,*)trim(myname_),':  deallocate error1, istatus=',istatus
        return
    endif

    if (verbose_) then
       if(mype==0) write(6,*) trim(myname_),': dealloc() for chem-tracer done'
    endif
    chem_grid_initialized_=.false.

    return
  end subroutine destroy_
!EOC

! ----------------------------------------------------------
! From here down, inquiry function to make all object opaque
! ----------------------------------------------------------

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  get_int0d_ --- inquire rank-0 integer
!
! !INTERFACE:
  subroutine get_int0d_ ( desc, ivar, istatus )

! !USES:
  implicit none
!
! !DESCRIPTION: Rank-0 integer inquire routine; integer mnemonics:
! \begin{verbatim}
!      Known mnemonics        retrieve
!      ---------------        --------
!      dim                    total number of gases 
!      aerosols               number of aerosols
!      aerosols::3d           number of 3d aerosols
!      aerosols::2d           number of 2d aerosols
!      i4crtm::XXX            information related to CRTM usage of gas XXX
!      var::XXX               index of gas XXX in chem-bundle
! 
! \end{verbatim}
!  where XXX represents the name of the gas of interest. 
!
! !REVISION HISTORY:
!   2010-04-10  todling  initial code
!   2011-05-17  todling  protect against use of unavailable label
!   2015-09-05  zhu      change "i4crtm3d(ii)==11" to "i4crtm3d(ii)>=11" 
!                        for "aerosols_4crtm::3d"
!
! !REMARKS:
!   language: f90
!   machine:  discover
!
! !AUTHOR:
!   Ricardo Todling  org: gmao      date: 2010-04-10
!
!EOP
!-------------------------------------------------------------------------
!BOC
  character(len=*),intent(in):: desc
  integer(i_kind),intent(out):: ivar
  integer(i_kind),intent(out):: istatus
  character(len=*),parameter::myname_=myname//'*get_int0d_'
  character(len=MAXSTR):: work
  integer(i_kind) ii,id,ln
  istatus=1
  ivar=0
  if(.not.chem_initialized_) return
  if(trim(desc)=='dim') then
     ivar = ntgases
     istatus=0
  else if(trim(desc)=='ghg') then
     ivar = nghg
  else if(trim(desc)=='aerosols') then
     ivar = naero
     istatus=0
  else if(trim(desc)=='aerosols::3d') then
     ivar = n3daero
     istatus=0
  else if(trim(desc)=='aerosols::2d') then
     ivar = n2daero
     istatus=0
  else if(trim(desc)=='aerosols_4crtm::3d') then
     do ii=1,ng3d
        if (i4crtm3d(ii)>=11) ivar=ivar+1
     enddo
     istatus=0
  else if(trim(desc)=='aerosols_4crtm_jac::3d') then
     do ii=1,ng3d
        if (i4crtm3d(ii)==12) ivar=ivar+1
     enddo
     istatus=0
  else if(index(trim(desc),'i4crtm::')/=0) then
     ln=len_trim(desc)
     work=desc(9:ln)
     if(allocated(tgases)) then
        id=getindex(tgases,trim(work))
        if(id>0) ivar=i4crtm(id)
     else
        ivar=0
     endif
     istatus=0
  else if(desc(1:5)=='var::') then
     if(allocated(tgases)) then
        id=len_trim(desc)
        if(id>=6) ivar=getindex(tgases,desc(6:id))
     endif
     istatus=0
  else
     call die(myname_,'label unavailable :'//trim(desc),99)
  endif
  return
  end subroutine get_int0d_
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  get_char0d_ --- inquire rank-0 character 
!
! !INTERFACE:
  subroutine get_char0d_ ( desc, ivar, istatus )
! !USES:
  implicit none
!
! !DESCRIPTION: Character-string mnemonics (rank-0):
! \begin{verbatim}
!      Known mnemonics        retrieve
!      ---------------        --------
!      list                   list of all gases
!      list::aerolols         list of aerosols only
!      list::tracers          list of trace gases (non-aerosols) only
! 
! \end{verbatim}
!  where XXX represents the name of the gas of interest. 
!
! !REVISION HISTORY:
!   2010-04-10  todling  initial code
!   2011-05-17  todling  protect against use of unavailable label
!
! !REMARKS:
!   language: f90
!   machine:  discover
!
! !AUTHOR:
!   Ricardo Todling  org: gmao      date: 2010-04-10
!
!EOP
!-------------------------------------------------------------------------
!BOC
  character(len=*),intent(in):: desc
  character(len=*),intent(out):: ivar
  integer(i_kind),intent(out):: istatus
  character(len=*),parameter::myname_=myname//'*get_char0d_'
  character(len=MAXSTR):: gaslist
  character(len=MAXSTR),allocatable:: work(:)
  integer(i_kind) is,ie,i,i0
  logical labfound
  labfound=.false.
  istatus=1
  ivar=''
  if(.not.chem_initialized_) return
  if(trim(desc)=='list'.or.trim(desc)=='olist') then
     labfound=.true.
     if(ntgases>0) then
        allocate(work(size(tgases)))
        work=tgases
        if(desc(1:1)=='o') work=usrname
        gaslist=trim(work(1))
        do i=2,ntgases
           i0=len_trim(gaslist)
           is=i0+1
           ie=is+len_trim(work(i))+1
           gaslist(is:ie)=','//work(i)
        enddo
        if(ntgases>1.and.gaslist(1:1)==',') gaslist=gaslist(2:ie)
        ivar = trim(gaslist)
        if(ivar/='') istatus=0
        deallocate(work)
     endif
  endif
  if(trim(desc)=='list::aerosols'.or.trim(desc)=='olist::aerosols') then
     labfound=.true.
     if(naero>0) then
        allocate(work(size(tgases)))
        work=tgases
        if(desc(1:1)=='o') work=usrname
        gaslist=''
        if(abs(i4crtm(1))>=10.and.abs(i4crtm(1))<20) gaslist=trim(work(1))
        do i=2,ntgases
           if(abs(i4crtm(i))>=10.and.abs(i4crtm(i))<20) then
              i0=len_trim(gaslist)
              is=i0+1
              ie=is+len_trim(work(i))+1
              gaslist(is:ie)=','//work(i)
           endif
        enddo
        if(ntgases>1.and.gaslist(1:1)==',') gaslist=gaslist(2:ie)
        ivar = trim(gaslist)
        if(ivar/='') istatus=0
        deallocate(work)
     endif
  endif
  if(trim(desc)=='list::tracers'.or.trim(desc)=='olist::tracers') then
     labfound=.true.
     if(ntgases>0) then
        allocate(work(size(tgases)))
        work=tgases
        if(desc(1:1)=='o') work=usrname
        gaslist=''
        if(abs(i4crtm(1))>=0.and.abs(i4crtm(1))<10) gaslist=trim(work(1))
        do i=2,ntgases
           if(abs(i4crtm(i))>=0.and.abs(i4crtm(i))<10) then
              i0=len_trim(gaslist)
              is=i0+1
              ie=is+len_trim(work(i))+1
              gaslist(is:ie)=','//work(i)
           endif
        enddo
        if(ntgases>1.and.gaslist(1:1)==',') gaslist=gaslist(2:ie)
        ivar = trim(gaslist)
        if(ivar/='') istatus=0
        deallocate(work)
     endif
  endif
  if (.not.labfound) then
     call die(myname_,'label unavailable :'//trim(desc),99)
  endif
  end subroutine get_char0d_
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  get_char1d_ --- inquire rank-1 character 
!
! !INTERFACE:
  subroutine get_char1d_ ( desc, cvar, istatus )
! !USES:
  implicit none
!
! !DESCRIPTION: Rank-1 character inquire routine; character mnemonics:
! \begin{verbatim}
!      Known mnemonics        retrieve
!      ---------------        --------
!      gsinames               list of all trace gas names as known in GSI
!      usrnames               list of all user-defined gas names
!      aerosols               list of all aerosols
!      aerosols::3d           list of 3d aerosols
!      aerosols::2d           list of 2d aerosols
!      aerosols_4crtm::3d     list of 3d aerosols to be passed to CRTM
!      aerosols_4crtm_jac::3d list of 3d aerosols to participate in CRTM-Jac calc
! 
! \end{verbatim}
!  where XXX represents the name of the gas of interest. 
!
! !REVISION HISTORY:
!   2010-04-10  todling  initial code
!   2011-04-06  ho-chung fix return status code
!   2011-05-17  todling  protect against use of unavailable label
!   2012-05-12  todling  fix to return aero-4crtm of all aero's
!
! !REMARKS:
!   language: f90
!   machine:  discover
!
! !AUTHOR:
!   Ricardo Todling  org: gmao      date: 2010-04-10
!
!EOP
!-------------------------------------------------------------------------
!BOC
  character(len=*),intent(in):: desc
  character(len=*),intent(out):: cvar(:)
  integer(i_kind),intent(out):: istatus
  character(len=*),parameter::myname_=myname//'*get_char0d_'
  integer(i_kind) i,ii,nvar
  logical labfound
  labfound=.false.
  istatus=1
  cvar=''
  if(.not.chem_initialized_) return
  nvar=size(cvar)
  if(trim(desc)=='gsinames') then
     labfound=.true.
     if(nvar>=size(tgases)) then
        if(allocated(tgases))then
          cvar(1:size(tgases)) = tgases
          istatus=0
        endif
     endif
  endif
  if(trim(desc)=='usrnames') then
     labfound=.true.
     if(nvar>=size(usrname)) then
        if(allocated(usrname))then
          cvar(1:size(tgases)) = usrname
          istatus=0
        endif
     endif
  endif
  if(trim(desc)=='ghg') then
     labfound=.true.
     if(nvar>=nghg) then
        ii=0
        do i=1,ntgases
           if(abs(i4crtm(i))<10) then
              ii=ii+1
              cvar(ii)=tgases(ii) 
           endif
        enddo
        if(ii>0) istatus=0
     endif
  endif
  if(trim(desc)=='aerosols') then
     labfound=.true.
     if(nvar>=naero) then
        ii=0
        do i=1,ntgases
           if(abs(i4crtm(i))>=10.and.abs(i4crtm(i))<20) then
              ii=ii+1
              cvar(ii)=tgases(ii) 
           endif
        enddo
        if(ii>0) istatus=0
     endif
  endif
  if(trim(desc)=='aerosols_4crtm::3d') then
     labfound=.true.
     if(nvar>=0) then
        ii=0
        do i=1,ng3d
           if(i4crtm3d(i)>=11) then
              ii=ii+1
              if(ii>nvar)then
                 ii=-1 ! user did not allocate enough space
                 exit  ! exit in error
              endif
              cvar(ii)=tgases(i)
           endif
        enddo
        if(ii>0) istatus=0
     endif
  endif
  if(trim(desc)=='aerosols_4crtm_jac::3d') then
     labfound=.true.
     if(nvar>=0) then
        ii=0
        do i=1,ng3d
           if(i4crtm3d(i)==12) then
              ii=ii+1
              if(ii>nvar)then
                 ii=-1 ! user did not allocate enough space
                 exit  ! exit in error
              endif
              cvar(ii)=tgases(i)
           endif
        enddo
        if(ii>0) istatus=0
     endif
  endif
  if(trim(desc)=='aerosols::3d') then
     labfound=.true.
     if(nvar>=0) then
        ii=0
        do i=1,ng3d
           if(abs(i4crtm3d(i))>=10.and.abs(i4crtm3d(i))<20) then
              ii=ii+1
              if(ii>nvar)then
                 ii=-1 ! user did not allocate enough space
                 exit  ! exit in error
              endif
              cvar(ii)=tgases3d(i) 
           endif
        enddo
        if(ii>0) istatus=0
     endif
  endif
  if(trim(desc)=='aerosols::2d') then
     labfound=.true.
     if(nvar>=0) then
        ii=0
        do i=1,ng2d
           if(abs(i4crtm2d(i))>=10.and.abs(i4crtm2d(i))<20) then
              ii=ii+1
              if(ii>nvar)then
                 ii=-1 ! user did not allocate enough space
                 exit  ! exit in error
              endif
              cvar(ii)=tgases2d(i) 
           endif
        enddo
        if(ii>0) istatus=0
     endif
  endif
  if (.not.labfound) then
     call die(myname_,'label unavailable :'//trim(desc),99)
  endif
  end subroutine get_char1d_
end module gsi_chemguess_mod
!EOC