[3184] | 1 | |
---|
| 2 | module tracer_h |
---|
[3557] | 3 | !!------------------------------------------------------------------------------------------------------ |
---|
| 4 | !! Stores data related to physics tracers. |
---|
| 5 | !! |
---|
| 6 | !! The module provides additional methods: |
---|
| 7 | !! - indexoftracer : search for the index of a tracer in the global table (tracers_h:noms) by name. |
---|
| 8 | !! - nameoftracer : get the name of tracer from a given index (of the global table). |
---|
| 9 | !! - dumptracers : print the names of all tracers indexes given in argument. |
---|
| 10 | !!------------------------------------------------------------------------------------------------------ |
---|
[3184] | 11 | implicit none |
---|
| 12 | |
---|
[3557] | 13 | integer, save :: nqtot ! total number of tracers |
---|
| 14 | integer, save :: nesp ! number of species in the chemistry |
---|
[3585] | 15 | !$OMP THREADPRIVATE(nqtot,nesp) |
---|
[3184] | 16 | |
---|
| 17 | logical :: moderntracdef=.false. ! Standard or modern traceur.def |
---|
| 18 | !$OMP THREADPRIVATE(moderntracdef) |
---|
| 19 | |
---|
[3557] | 20 | character*30, save, allocatable :: noms(:)! name of the tracer |
---|
| 21 | real, save, allocatable :: mmol(:) ! mole mass of tracer (g/mol) |
---|
| 22 | real, save, allocatable :: aki(:) ! to compute coefficient of thermal concduction if photochem |
---|
| 23 | real, save, allocatable :: cpi(:) ! to compute cpnew in concentration.F if photochem |
---|
| 24 | real, save, allocatable :: radius(:) ! dust and ice particle radius (m) |
---|
| 25 | real, save, allocatable :: rho_q(:) ! tracer densities (kg.m-3) |
---|
| 26 | real, save, allocatable :: qext(:) ! Single Scat. Extinction coeff at 0.67 um |
---|
[3184] | 27 | real, save, allocatable :: alpha_lift(:) ! saltation vertical flux/horiz flux ratio (m-1) |
---|
| 28 | real, save, allocatable :: alpha_devil(:) ! lifting coeeficient by dust devil |
---|
[3557] | 29 | real, save, allocatable :: qextrhor(:) ! Intermediate for computing opt. depth from q |
---|
[3184] | 30 | |
---|
| 31 | real,save :: varian ! Characteristic variance of log-normal distribution |
---|
[3557] | 32 | real,save :: r3n_q ! used to compute r0 from number and mass mixing ratio |
---|
| 33 | real,save :: rho_dust ! Mars dust density (kg.m-3) |
---|
[3184] | 34 | real,save :: rho_ice ! Water ice density (kg.m-3) |
---|
[3557] | 35 | real,save :: rho_ch4_ice ! ch4 ice density (kg.m-3) |
---|
| 36 | real,save :: rho_co_ice ! co ice density (kg.m-3) |
---|
| 37 | real,save :: rho_n2 ! N2 ice density (kg.m-3) |
---|
| 38 | real,save :: lw_ch4 ! Latent heat CH4 gas -> solid |
---|
| 39 | real,save :: lw_co ! Latent heat CO gas -> solid |
---|
| 40 | real,save :: lw_n2 ! Latent heat N2 gas -> solid |
---|
[3195] | 41 | integer,save :: nmono |
---|
[3184] | 42 | real,save :: ref_r0 ! for computing reff=ref_r0*r0 (in log.n. distribution) |
---|
| 43 | !$OMP THREADPRIVATE(noms,mmol,aki,cpi,radius,rho_q,qext,alpha_lift,alpha_devil,qextrhor, & |
---|
[3195] | 44 | !$OMP varian,r3n_q,rho_dust,rho_ice,rho_n2,lw_n2,ref_r0) |
---|
[3184] | 45 | |
---|
| 46 | integer, save, allocatable :: is_chim(:) ! 1 if tracer used in chemistry, else 0 |
---|
| 47 | integer, save, allocatable :: is_rad(:) ! 1 if "" "" in radiative transfer, else 0 |
---|
| 48 | !$OMP THREADPRIVATE(is_chim,is_rad) |
---|
| 49 | |
---|
| 50 | integer, save, allocatable :: is_recomb(:) ! 1 if tracer used in recombining scheme, else 0 (if 1, must have is_rad=1) |
---|
| 51 | integer, save, allocatable :: is_recomb_qset(:) ! 1 if tracer k-corr assume predefined vmr, else 0 (if 1, must have is_recomb=1) |
---|
| 52 | 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) |
---|
| 53 | !$OMP THREADPRIVATE(is_recomb,is_recomb_qset,is_recomb_qotf) |
---|
| 54 | ! Lists of constants for condensable tracers |
---|
| 55 | |
---|
| 56 | ! tracer indexes: these are initialized in initracer and should be 0 if the |
---|
| 57 | ! corresponding tracer does not exist |
---|
[3195] | 58 | |
---|
[3557] | 59 | ! Pluto chemistry |
---|
[3195] | 60 | integer,save :: igcm_co_gas |
---|
[3184] | 61 | integer,save :: igcm_n2 |
---|
| 62 | integer,save :: igcm_ar |
---|
[3195] | 63 | integer,save :: igcm_ch4_gas ! methane gas |
---|
[3557] | 64 | !$OMP THREADPRIVATE(igcm_co_gas,igcm_n2,igcm_ar,igcm_ch4_gas) |
---|
| 65 | ! Other tracers |
---|
| 66 | integer,save :: igcm_ar_n2 ! for simulations using co2 + neutral gaz |
---|
[3195] | 67 | integer,save :: igcm_ch4_ice ! methane ice |
---|
[3557] | 68 | integer,save :: igcm_co_ice ! CO ice |
---|
| 69 | !$OMP THREADPRIVATE(igcm_ar_n2,igcm_ch4_ice,igcm_co_ice) |
---|
[3195] | 70 | integer,save :: igcm_prec_haze |
---|
| 71 | integer,save :: igcm_haze |
---|
| 72 | integer,save :: igcm_haze10 |
---|
| 73 | integer,save :: igcm_haze30 |
---|
| 74 | integer,save :: igcm_haze50 |
---|
| 75 | integer,save :: igcm_haze100 |
---|
[3557] | 76 | !$OMP THREADPRIVATE(igcm_prec_haze,igcm_haze,igcm_haze10,igcm_haze30,igcm_haze50,igcm_haze100) |
---|
[3195] | 77 | integer,save :: igcm_eddy1e6 |
---|
| 78 | integer,save :: igcm_eddy1e7 |
---|
| 79 | integer,save :: igcm_eddy5e7 |
---|
| 80 | integer,save :: igcm_eddy1e8 |
---|
| 81 | integer,save :: igcm_eddy5e8 |
---|
[3557] | 82 | !$OMP THREADPRIVATE(igcm_eddy1e6,igcm_eddy1e7,igcm_eddy5e7,igcm_eddy1e8,igcm_eddy5e8) |
---|
[3184] | 83 | |
---|
[3557] | 84 | ! Microphysical model |
---|
| 85 | integer, save :: nmicro = 0 !! Number of microphysics tracers. |
---|
| 86 | integer, save, allocatable :: micro_indx(:) !! Indexes of all microphysical tracers |
---|
| 87 | !$OMP THREADPRIVATE(nmicro) |
---|
[3184] | 88 | |
---|
[3557] | 89 | CONTAINS |
---|
[3184] | 90 | |
---|
[3557] | 91 | FUNCTION indexoftracer(name, sensitivity) RESULT(idx) |
---|
| 92 | !! Get the index of a tracer by name. |
---|
| 93 | !! |
---|
| 94 | !! The function searches in the global tracer table (tracer_h:noms) |
---|
| 95 | !! for the given name and returns the first index matching "name". |
---|
| 96 | !! |
---|
| 97 | !! If no name in the table matches the given one, -1 is returned ! |
---|
| 98 | IMPLICIT NONE |
---|
| 99 | CHARACTER(len=*), INTENT(in) :: name !! Name of the tracer to search. |
---|
| 100 | LOGICAL, OPTIONAL, INTENT(in) :: sensitivity !! Case sensitivity (true by default). |
---|
| 101 | INTEGER :: idx !! Index of the first tracer matching name or -1 if not found. |
---|
| 102 | LOGICAL :: zsens |
---|
| 103 | INTEGER :: j |
---|
| 104 | CHARACTER(len=LEN(name)) :: zname |
---|
| 105 | zsens = .true. ; IF(PRESENT(sensitivity)) zsens = sensitivity |
---|
| 106 | idx = -1 |
---|
| 107 | IF (.NOT.ALLOCATED(noms)) RETURN |
---|
| 108 | IF (zsens) THEN |
---|
| 109 | DO j=1,SIZE(noms) |
---|
| 110 | IF (TRIM(noms(j)) == TRIM(name)) THEN |
---|
| 111 | idx = j ; RETURN |
---|
| 112 | ENDIF |
---|
| 113 | ENDDO |
---|
| 114 | ELSE |
---|
| 115 | zname = to_lower(name) |
---|
| 116 | DO j=1,SIZE(noms) |
---|
| 117 | IF (TRIM(to_lower(noms(j))) == TRIM(zname)) THEN |
---|
| 118 | idx = j ; RETURN |
---|
| 119 | ENDIF |
---|
| 120 | ENDDO |
---|
| 121 | ENDIF |
---|
| 122 | |
---|
| 123 | CONTAINS |
---|
| 124 | |
---|
| 125 | FUNCTION to_lower(istr) RESULT(ostr) |
---|
| 126 | !! Lower case conversion function. |
---|
| 127 | IMPLICIT NONE |
---|
| 128 | CHARACTER(len=*), INTENT(in) :: istr |
---|
| 129 | CHARACTER(len=LEN(istr)) :: ostr |
---|
| 130 | INTEGER :: i,ic |
---|
| 131 | ostr = istr |
---|
| 132 | DO i = 1, LEN_TRIM(istr) |
---|
| 133 | ic = ICHAR(istr(i:i)) |
---|
| 134 | IF (ic >= 65 .AND. ic < 90) ostr(i:i) = char(ic + 32) |
---|
| 135 | ENDDO |
---|
| 136 | END FUNCTION to_lower |
---|
| 137 | END FUNCTION indexoftracer |
---|
| 138 | |
---|
| 139 | FUNCTION nameoftracer(indx) RESULT(name) |
---|
| 140 | !! Get the name of a tracer by index. |
---|
| 141 | !! |
---|
| 142 | !! The function searches in the global tracer table (tracer_h:noms) |
---|
| 143 | !! and returns the name of the tracer at given index. |
---|
| 144 | !! |
---|
| 145 | !! If the index is out of range an empty string is returned. |
---|
| 146 | IMPLICIT NONE |
---|
| 147 | INTEGER, INTENT(in) :: indx !! Index of the tracer name to retrieve. |
---|
| 148 | CHARACTER(len=30) :: name !! Name of the tracer at given index. |
---|
| 149 | name = '' |
---|
| 150 | IF (.NOT.ALLOCATED(noms)) RETURN |
---|
| 151 | IF (indx <= 0 .OR. indx > SIZE(noms)) RETURN |
---|
| 152 | name = noms(indx) |
---|
| 153 | END FUNCTION nameoftracer |
---|
| 154 | |
---|
| 155 | SUBROUTINE dumptracers(indexes) |
---|
| 156 | !! Print the names of the given list of tracers indexes. |
---|
| 157 | INTEGER, DIMENSION(:), INTENT(in) :: indexes |
---|
| 158 | INTEGER :: i,idx |
---|
| 159 | CHARACTER(len=:), ALLOCATABLE :: suffix |
---|
| 160 | |
---|
| 161 | IF (.NOT.ALLOCATED(noms)) THEN |
---|
| 162 | WRITE(*,'(a)') "[tracers_h:dump_tracers] warning: 'noms' is not allocated, initracer has not be called yet" |
---|
| 163 | RETURN |
---|
| 164 | ENDIF |
---|
| 165 | |
---|
| 166 | DO i=1,size(indexes) |
---|
| 167 | idx = indexes(i) |
---|
| 168 | IF (ANY(micro_indx == idx)) THEN |
---|
| 169 | suffix = ' (micro)' |
---|
| 170 | ELSE |
---|
| 171 | suffix=" ()" |
---|
| 172 | ENDIF |
---|
| 173 | WRITE(*,'(I5,(a),I6,(a))') i," -> ",idx ," : "//TRIM(noms(idx))//suffix |
---|
| 174 | ENDDO |
---|
| 175 | END SUBROUTINE dumptracers |
---|
| 176 | |
---|
| 177 | end module tracer_h |
---|