source: trunk/LMDZ.PLUTO/libf/phypluto/tracer_h.F90 @ 3945

       module tracer_h
       !!------------------------------------------------------------------------------------------------------
       !! Stores data related to physics tracers.
       !!
       !! The module provides additional methods: 
       !!   - indexoftracer : search for the index of a tracer in the global table (tracers_h:noms) by name.
       !!   - nameoftracer  : get the name of tracer from a given index (of the global table).
       !!   - dumptracers   : print the names of all tracers indexes given in argument.
       !!------------------------------------------------------------------------------------------------------
       implicit none

       integer, save :: nqtot  ! total number of tracers
!$OMP THREADPRIVATE(nqtot)

       logical :: moderntracdef=.false. ! Standard or modern traceur.def
!$OMP THREADPRIVATE(moderntracdef)

       character*30, save, allocatable :: noms(:)! name of the tracer
       real, save, allocatable :: mmol(:)        ! mole mass of tracer (g/mol)
       real, save, allocatable :: aki(:)         ! to compute coefficient of thermal concduction if photochem
       real, save, allocatable :: cpi(:)         ! to compute cpnew in concentration.F if photochem
       real, save, allocatable :: radius(:)      ! dust and ice particle radius (m)
       real, save, allocatable :: rho_q(:)       ! tracer densities (kg.m-3)
       real, save, allocatable :: qext(:)        ! Single Scat. Extinction coeff at 0.67 um
       real, save, allocatable :: qextrhor(:)    ! Intermediate for computing opt. depth from q

       real,save :: varian      ! Characteristic variance of log-normal distribution
       real,save :: r3n_q       ! used to compute r0 from number and mass mixing ratio
       real,save :: rho_dust    ! Mars dust density (kg.m-3)
       real,save :: rho_ice     ! Water ice density (kg.m-3)
       real,save :: rho_ch4_ice ! ch4 ice density (kg.m-3)
       real,save :: rho_co_ice  ! co ice density (kg.m-3)
       real,save :: rho_n2      ! N2 ice density (kg.m-3)
       real,save :: lw_ch4      ! Latent heat CH4 gas -> solid
       real,save :: lw_co       ! Latent heat CO gas -> solid
       real,save :: lw_n2       ! Latent heat N2 gas -> solid
       integer,save :: nmono
       real,save :: ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
!$OMP THREADPRIVATE(noms,mmol,aki,cpi,radius,rho_q,qext,qextrhor, &
        !$OMP varian,r3n_q,rho_dust,rho_ice,rho_n2,lw_n2,ref_r0)

       integer, save, allocatable :: is_rad(:)  ! 1 if   ""    ""  in radiative transfer, else 0
!$OMP THREADPRIVATE(is_rad)

       integer, save, allocatable :: is_recomb(:)      ! 1 if tracer used in recombining scheme, else 0 (if 1, must have is_rad=1)
       integer, save, allocatable :: is_recomb_qset(:) ! 1 if tracer k-corr assume predefined vmr, else 0 (if 1, must have is_recomb=1)
       integer, save, allocatable :: is_recomb_qotf(:) ! 1 if tracer recombination is done on-the-fly, else 0 (if 1, must have is_recomb_qset=0)
!$OMP THREADPRIVATE(is_recomb,is_recomb_qset,is_recomb_qotf)
       ! Lists of constants for condensable tracers

! tracer indexes: these are initialized in initracer and should be 0 if the
!                 corresponding tracer does not exist

       ! Pluto chemistry
       integer,save :: igcm_co_gas
       integer,save :: igcm_n2
       integer,save :: igcm_ar
       integer,save :: igcm_ch4_gas ! methane gas
!$OMP THREADPRIVATE(igcm_co_gas,igcm_n2,igcm_ar,igcm_ch4_gas)
       ! Other tracers
       integer,save :: igcm_ar_n2   ! for simulations using co2 + neutral gaz
       integer,save :: igcm_ch4_ice ! methane ice
       integer,save :: igcm_co_ice  ! CO ice
!$OMP THREADPRIVATE(igcm_ar_n2,igcm_ch4_ice,igcm_co_ice)
       integer,save :: igcm_prec_haze
       integer,save :: igcm_haze
       integer,save :: igcm_haze10
       integer,save :: igcm_haze30
       integer,save :: igcm_haze50
       integer,save :: igcm_haze100
!$OMP THREADPRIVATE(igcm_prec_haze,igcm_haze,igcm_haze10,igcm_haze30,igcm_haze50,igcm_haze100)
       integer,save :: igcm_eddy1e6
       integer,save :: igcm_eddy1e7
       integer,save :: igcm_eddy5e7
       integer,save :: igcm_eddy1e8
       integer,save :: igcm_eddy5e8
!$OMP THREADPRIVATE(igcm_eddy1e6,igcm_eddy1e7,igcm_eddy5e7,igcm_eddy1e8,igcm_eddy5e8)

       ! Microphysical model
       integer, save :: nmicro = 0                 !! Number of microphysics tracers.
       integer, save, allocatable :: micro_indx(:) !! Indexes of all microphysical tracers
!$OMP THREADPRIVATE(nmicro)

       CONTAINS

       FUNCTION indexoftracer(name, sensitivity) RESULT(idx)
          !! Get the index of a tracer by name.
          !!
          !! The function searches in the global tracer table (tracer_h:noms)
          !! for the given name and returns the first index matching "name".
          !! 
          !! If no name in the table matches the given one, -1 is returned !
          IMPLICIT NONE
          CHARACTER(len=*), INTENT(in)  :: name         !! Name of the tracer to search.
          LOGICAL, OPTIONAL, INTENT(in) :: sensitivity  !! Case sensitivity (true by default).
          INTEGER                       :: idx          !! Index of the first tracer matching name or -1 if not found.
          LOGICAL                       :: zsens
          INTEGER                       :: j
          CHARACTER(len=LEN(name))      :: zname
          zsens = .true. ; IF(PRESENT(sensitivity)) zsens = sensitivity
          idx = -1
          IF (.NOT.ALLOCATED(noms)) RETURN
          IF (zsens) THEN
             DO j=1,SIZE(noms) 
                IF (TRIM(noms(j)) == TRIM(name)) THEN
                   idx = j ; RETURN 
                ENDIF 
             ENDDO
          ELSE
             zname = to_lower(name)
             DO j=1,SIZE(noms) 
                IF (TRIM(to_lower(noms(j))) == TRIM(zname)) THEN
                   idx = j ; RETURN 
                ENDIF 
             ENDDO
          ENDIF

          CONTAINS

          FUNCTION to_lower(istr) RESULT(ostr)
             !! Lower case conversion function.
             IMPLICIT NONE
             CHARACTER(len=*), INTENT(in) :: istr
             CHARACTER(len=LEN(istr))     :: ostr
             INTEGER                      :: i,ic
             ostr = istr
             DO i = 1, LEN_TRIM(istr)
                ic = ICHAR(istr(i:i))
                IF (ic >= 65 .AND. ic < 90) ostr(i:i) = char(ic + 32)
             ENDDO 
          END FUNCTION to_lower
       END FUNCTION indexoftracer

       FUNCTION nameoftracer(indx) RESULT(name)
          !! Get the name of a tracer by index.
          !!
          !! The function searches in the global tracer table (tracer_h:noms)
          !! and returns the name of the tracer at given index.
          !!
          !! If the index is out of range an empty string is returned.
          IMPLICIT NONE
          INTEGER, INTENT(in) :: indx   !! Index of the tracer name to retrieve.
          CHARACTER(len=30)   :: name   !! Name of the tracer at given index.
          name = '' 
          IF (.NOT.ALLOCATED(noms)) RETURN
          IF (indx <= 0 .OR. indx > SIZE(noms)) RETURN
          name = noms(indx)
       END FUNCTION nameoftracer

       SUBROUTINE dumptracers(indexes)
          !! Print the names of the given list of tracers indexes.
          INTEGER, DIMENSION(:), INTENT(in) :: indexes
          INTEGER :: i,idx
          CHARACTER(len=:), ALLOCATABLE :: suffix

          IF (.NOT.ALLOCATED(noms)) THEN
             WRITE(*,'(a)') "[tracers_h:dump_tracers] warning: 'noms' is not allocated, initracer has not be called yet"
             RETURN
          ENDIF

          DO i=1,size(indexes)
             idx = indexes(i)
             IF (ANY(micro_indx == idx)) THEN
                suffix = ' (micro)'
             ELSE 
                suffix=" ()"
             ENDIF
             WRITE(*,'(I5,(a),I6,(a))') i," -> ",idx ," : "//TRIM(noms(idx))//suffix
          ENDDO
       END SUBROUTINE dumptracers

       end module tracer_h