| [787] | 1 | |
|---|
| [1795] | 2 | MODULE tracer_h |
|---|
| 3 | !! Stores data related to physics tracers. |
|---|
| 4 | !! |
|---|
| 5 | !! The module stores public global variables related to the number of tracers |
|---|
| 6 | !! available in the physics and their kind: |
|---|
| 7 | !! |
|---|
| 8 | !! Currently, tracers can be used either for chemistry process (nchimi) or |
|---|
| 9 | !! microphysics (nmicro). |
|---|
| 10 | !! |
|---|
| 11 | !! The subroutine "initracer2" initializes and performs sanity check of |
|---|
| 12 | !! the tracer definitions given in traceur.def and the required tracers in physics |
|---|
| 13 | !! (based on the run parameters). |
|---|
| 14 | !! |
|---|
| 15 | !! The module provides additional methods: |
|---|
| 16 | !! |
|---|
| 17 | !! - indexOfTracer : search for the index of a tracer in the global table (tracers_h:noms) by name. |
|---|
| 18 | !! - nameOfTracer : get the name of tracer from a given index (of the global table). |
|---|
| 19 | !! - dumpTracers : print the names of all tracers indexes given in argument. |
|---|
| 20 | !! |
|---|
| 21 | IMPLICIT NONE |
|---|
| [787] | 22 | |
|---|
| [1795] | 23 | INTEGER, SAVE :: nqtot = 0 !! Total number of tracers |
|---|
| 24 | INTEGER, SAVE :: nmicro = 0 !! Number of microphysics tracers. |
|---|
| 25 | INTEGER, SAVE :: nice = 0 !! Number of microphysics ice tracers (subset of nmicro). |
|---|
| 26 | INTEGER, SAVE :: nchimi = 0 !! Number of chemical (gaz species) tracers. |
|---|
| 27 | !$OMP THREADPRIVATE(nqtot,nmicro,nice,nchimi) |
|---|
| [787] | 28 | |
|---|
| [1795] | 29 | INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: chimi_indx !! Indexes of all chemical species tracers |
|---|
| 30 | INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: micro_indx !! Indexes of all microphysical tracers |
|---|
| 31 | INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: ices_indx !! Indexes of all ice microphysical tracers |
|---|
| [1621] | 32 | |
|---|
| [1795] | 33 | CHARACTER(len=20), DIMENSION(:), ALLOCATABLE, SAVE :: noms !! name of the tracer |
|---|
| 34 | REAL, DIMENSION(:), ALLOCATABLE, SAVE :: mmol !! mole mass of tracer(g/mol-1) |
|---|
| 35 | REAL, DIMENSION(:), ALLOCATABLE, SAVE :: rat_mmol !! molar mass ratio |
|---|
| 36 | REAL, DIMENSION(:), ALLOCATABLE, SAVE :: rho_q !! tracer densities (kg.m-3) |
|---|
| 37 | !$OMP THREADPRIVATE(noms,mmol,rat_mmol,rho_q) |
|---|
| [787] | 38 | |
|---|
| 39 | |
|---|
| [1672] | 40 | |
|---|
| [1795] | 41 | ! tracer indexes: these are initialized in initracer and should be 0 if the |
|---|
| 42 | ! corresponding tracer does not exist |
|---|
| [787] | 43 | |
|---|
| 44 | |
|---|
| [1795] | 45 | CONTAINS |
|---|
| 46 | |
|---|
| 47 | SUBROUTINE initracer2(nq,nametrac,talk_to_me) |
|---|
| 48 | !! Initialize tracer names and attributes. |
|---|
| 49 | !! |
|---|
| 50 | !! The method initializes the list of tracer names used in the physics from their |
|---|
| 51 | !! dynamics counterpart. |
|---|
| 52 | !! |
|---|
| 53 | !! In addition, it initializes arrays of indexes for the different sub-processs of the physics: |
|---|
| 54 | !! |
|---|
| 55 | !! - tracers_h:micro_indxs, the array of tracers indexes used for the microphysics. |
|---|
| 56 | !! - tracers_h:chimi_indxs, the array of tracers indexes used for the chemistry. |
|---|
| 57 | !! |
|---|
| 58 | !! The method also initializes the molar mass array (tracers_h:mmol) for the chemistry and the |
|---|
| 59 | !! molar mass ratio (tracers_h:rat_mmol). |
|---|
| 60 | !! |
|---|
| 61 | !! @note |
|---|
| 62 | !! Strict checking of chemical species name is performed here if the chemistry is activated |
|---|
| 63 | !! (see callchim variable). All the values of 'cnames' must be found in the tracers names |
|---|
| 64 | !! related to chemistry. |
|---|
| 65 | !! @note |
|---|
| 66 | !! Tests are more permissive for the microphysics and is only based on the mimimum number of |
|---|
| 67 | !! tracers expected. Strict name checking is performed in inimufi. |
|---|
| 68 | USE callkeys_mod |
|---|
| 69 | USE comcstfi_mod, only: mugaz |
|---|
| 70 | IMPLICIT NONE |
|---|
| 71 | |
|---|
| 72 | INTEGER, INTENT(in) :: nq !! Total number of tracers (fixed at compile time) |
|---|
| 73 | character(len=20), DIMENSION(nq), INTENT(in) :: nametrac !! name of the tracer from dynamics (from 'traceurs.def') |
|---|
| 74 | LOGICAL, INTENT(in), OPTIONAL :: talk_to_me !! Enable verbose mode. |
|---|
| 75 | |
|---|
| 76 | LOGICAL :: verb,found |
|---|
| 77 | CHARACTER(len=20) :: str |
|---|
| 78 | !! Hard-coded chemical species for Titan chemistry |
|---|
| 79 | CHARACTER(len=10), DIMENSION(44), PARAMETER :: cnames = & |
|---|
| 80 | (/"H ", "H2 ", "CH ", "CH2s ", "CH2 ", "CH3 ", & |
|---|
| 81 | "CH4 ", "C2 ", "C2H ", "C2H2 ", "C2H3 ", "C2H4 ", & |
|---|
| 82 | "C2H5 ", "C2H6 ", "C3H3 ", "C3H5 ", "C3H6 ", "C3H7 ", & |
|---|
| 83 | "C4H ", "C4H3 ", "C4H4 ", "C4H2s ", "CH2CCH2 ", "CH3CCH ", & |
|---|
| 84 | "C3H8 ", "C4H2 ", "C4H6 ", "C4H10 ", "AC6H6 ", "C3H2 ", & |
|---|
| 85 | "C4H5 ", "AC6H5 ", "N2 ", "N4S ", "CN ", "HCN ", & |
|---|
| 86 | "H2CN ", "CHCN ", "CH2CN ", "CH3CN ", "C3N ", "HC3N ", & |
|---|
| 87 | "NCCN ", "C4N2 "/) |
|---|
| 88 | !! Hard-coded chemical species molar mass (g.mol-1), shares the same indexing than cnames. |
|---|
| 89 | REAL, DIMENSION(44), PARAMETER :: cmmol = (/ & |
|---|
| 90 | 1.01 , 2.0158, 13.02, 14.03, 14.03, 15.03, 16.04 , 24.02, 25.03, 26.04 , 27.05 , & |
|---|
| 91 | 28.05 , 29.06 , 30.07, 39.06, 41.07, 42.08, 43.09 , 49.05, 51.07, 52.08 , 50.06 , & |
|---|
| 92 | 40.07 , 40.07 , 44.11, 50.06, 54.09, 58.13, 78.1136, 38.05, 53.07, 77.1136, 28.0134, & |
|---|
| 93 | 14.01 , 26.02 , 27.04, 28.05, 39.05, 40.04, 41.05 , 50.04, 51.05, 52.04 , 76.1 /) |
|---|
| 94 | |
|---|
| 95 | INTEGER :: i,j,n |
|---|
| 96 | |
|---|
| 97 | verb = .true. ; IF (PRESENT(talk_to_me)) verb = talk_to_me |
|---|
| 98 | |
|---|
| 99 | ! nqtot could be used everywhere in the physic :) |
|---|
| 100 | nqtot=nq |
|---|
| 101 | |
|---|
| 102 | IF (.NOT.ALLOCATED(noms)) ALLOCATE(noms(nq)) |
|---|
| 103 | noms(:)=nametrac(:) |
|---|
| 104 | |
|---|
| 105 | ALLOCATE(rho_q(nq)) ! Defined for all tracers, currently initialized to 0.0 |
|---|
| 106 | rho_q(:) = 0.0 |
|---|
| 107 | |
|---|
| 108 | ALLOCATE(mmol(nq),rat_mmol(nq)) ! Defined for all tracers, (actually) initialized only for chemical tracers |
|---|
| 109 | mmol(:) = 0.0 |
|---|
| 110 | rat_mmol(:) = 1.0 |
|---|
| 111 | |
|---|
| 112 | ! Compute number of microphysics tracers: |
|---|
| 113 | ! By convention they all have the prefix "mu_" (case sensitive !) |
|---|
| 114 | nmicro = 0 |
|---|
| 115 | IF (callmufi) THEN |
|---|
| 116 | DO i=1,nq |
|---|
| 117 | str = noms(i) |
|---|
| 118 | IF (str(1:3) == "mu_") nmicro = nmicro+1 |
|---|
| 119 | ENDDO |
|---|
| 120 | ! Checking the expected number of tracers: |
|---|
| 121 | ! no cloud: 4 ; w cloud : 4 + 2 + (1+) |
|---|
| 122 | ! Note that we do not make assumptions on the number of chemical species for clouds, this |
|---|
| 123 | ! will be checked in inimufi. |
|---|
| 124 | IF (callclouds) THEN |
|---|
| 125 | IF (nmicro < 7) THEN |
|---|
| 126 | WRITE(*,'((a),I3,(a))') "initracer2:error: Inconsistent number of microphysical tracers & |
|---|
| 127 | &(expected at least 7 tracers,",nmicro," given)" |
|---|
| 128 | CALL abort_gcm("initracer2", "inconsistent number of tracers", 42) |
|---|
| 129 | STOP |
|---|
| 130 | ENDIF |
|---|
| 131 | ELSE IF (nmicro < 4) THEN |
|---|
| 132 | WRITE(*,'((a),I3,(a))') "initracer2:error: Inconsistent number of microphysical tracers & |
|---|
| 133 | &(expected at least 4 tracers,",nmicro," given)" |
|---|
| 134 | CALL abort_gcm("initracer2", "inconsistent number of tracers", 42) |
|---|
| 135 | ELSE IF (nmicro > 4) THEN |
|---|
| 136 | WRITE(*,'(a)') "initracer2:info: I was expecting only four tracers, you gave me & |
|---|
| 137 | &more. I'll just pretend nothing happen !" |
|---|
| 138 | ENDIF |
|---|
| 139 | ! microphysics indexes share the same values than original tracname. |
|---|
| 140 | ALLOCATE(micro_indx(nmicro)) |
|---|
| 141 | j = 1 |
|---|
| 142 | DO i=1,nq |
|---|
| 143 | str = noms(i) |
|---|
| 144 | IF (str(1:3) == "mu_") THEN |
|---|
| 145 | micro_indx(j) = i |
|---|
| 146 | j=j+1 |
|---|
| 147 | ENDIF |
|---|
| 148 | ENDDO |
|---|
| 149 | ELSE |
|---|
| 150 | ALLOCATE(micro_indx(nmicro)) |
|---|
| 151 | ENDIF |
|---|
| 152 | |
|---|
| 153 | ! Compute number of chemical species: |
|---|
| 154 | ! simply assume that all other tracers ARE chemical species |
|---|
| 155 | nchimi = nqtot - nmicro |
|---|
| 156 | |
|---|
| 157 | ! Titan chemistry requires exactly 44 tracers: |
|---|
| 158 | ! Test should be in callchim condition |
|---|
| 159 | |
|---|
| 160 | IF (callchim) THEN |
|---|
| 161 | IF (nchimi < SIZE(cnames)) THEN |
|---|
| 162 | WRITE(*,*) "initracer2:error: Inconsistent number of chemical species given (",SIZE(cnames)," expected)" |
|---|
| 163 | CALL abort_gcm("initracer2", "inconsistent number of tracers", 42) |
|---|
| 164 | ENDIF |
|---|
| 165 | ALLOCATE(chimi_indx(nchimi)) |
|---|
| 166 | n = 0 ! counter on chimi_indx |
|---|
| 167 | DO j=1,SIZE(cnames) |
|---|
| 168 | found = .false. |
|---|
| 169 | DO i=1,nq |
|---|
| 170 | IF (TRIM(cnames(j)) == TRIM(noms(i))) THEN |
|---|
| 171 | n = n + 1 |
|---|
| 172 | chimi_indx(n) = i |
|---|
| 173 | mmol(i) = cmmol(j) |
|---|
| 174 | rat_mmol(i) = cmmol(j)/mugaz |
|---|
| 175 | found = .true. |
|---|
| 176 | EXIT |
|---|
| 177 | ENDIF |
|---|
| 178 | ENDDO |
|---|
| 179 | IF (.NOT.found) THEN |
|---|
| 180 | WRITE(*,*) "initracer2:error: "//TRIM(cnames(j))//" is missing from tracers definition file." |
|---|
| 181 | ENDIF |
|---|
| 182 | ENDDO |
|---|
| 183 | IF (n < SIZE(cnames)) THEN |
|---|
| 184 | WRITE(*,*) "initracer2:error: Inconsistent number of chemical species given (",SIZE(cnames)," expected)" |
|---|
| 185 | CALL abort_gcm("initracer2", "inconsistent number of tracers", 42) |
|---|
| 186 | ENDIF |
|---|
| 187 | ELSE |
|---|
| 188 | ALLOCATE(chimi_indx(0)) |
|---|
| 189 | ENDIF |
|---|
| 190 | IF (verb) THEN |
|---|
| 191 | IF (callmufi.OR.callchim) WRITE(*,*) "===== INITRACER2 SPEAKING =====" |
|---|
| 192 | IF (callmufi) THEN |
|---|
| 193 | WRITE(*,*) "Found ",nmicro, "microphysical tracers" |
|---|
| 194 | call dumpTracers(micro_indx) |
|---|
| 195 | WRITE(*,*) "-------------------------------" |
|---|
| 196 | ENDIF |
|---|
| 197 | IF (callchim) THEN |
|---|
| 198 | WRITE(*,*) "Found ",nchimi, "chemical tracers" |
|---|
| 199 | call dumpTracers(chimi_indx) |
|---|
| 200 | WRITE(*,*) "-------------------------------" |
|---|
| 201 | ENDIF |
|---|
| 202 | ENDIF |
|---|
| 203 | |
|---|
| 204 | END SUBROUTINE initracer2 |
|---|
| 205 | |
|---|
| 206 | FUNCTION indexOfTracer(name, sensitivity) RESULT(idx) |
|---|
| 207 | !! Get the index of a tracer by name. |
|---|
| 208 | !! |
|---|
| 209 | !! The function searches in the global tracer table (tracer_h:noms) |
|---|
| 210 | !! for the given name and returns the first index matching "name". |
|---|
| 211 | !! |
|---|
| 212 | !! If no name in the table matches the given one, -1 is returned ! |
|---|
| 213 | !! |
|---|
| 214 | !! @warning |
|---|
| 215 | !! initracers must be called before any use of this function. |
|---|
| 216 | IMPLICIT NONE |
|---|
| 217 | CHARACTER(len=*), INTENT(in) :: name !! Name of the tracer to search. |
|---|
| 218 | LOGICAL, OPTIONAL, INTENT(in) :: sensitivity !! Case sensitivity (true by default). |
|---|
| 219 | INTEGER :: idx !! Index of the first tracer matching name or -1 if not found. |
|---|
| 220 | LOGICAL :: zsens |
|---|
| 221 | INTEGER :: j |
|---|
| 222 | CHARACTER(len=LEN(name)) :: zname |
|---|
| 223 | zsens = .true. ; IF(PRESENT(sensitivity)) zsens = sensitivity |
|---|
| 224 | idx = -1 |
|---|
| 225 | IF (.NOT.ALLOCATED(noms)) RETURN |
|---|
| 226 | IF (zsens) THEN |
|---|
| 227 | DO j=1,SIZE(noms) |
|---|
| 228 | IF (TRIM(noms(j)) == TRIM(name)) THEN |
|---|
| 229 | idx = j ; RETURN |
|---|
| 230 | ENDIF |
|---|
| 231 | ENDDO |
|---|
| 232 | ELSE |
|---|
| 233 | zname = to_lower(name) |
|---|
| 234 | DO j=1,SIZE(noms) |
|---|
| 235 | IF (TRIM(to_lower(noms(j))) == TRIM(zname)) THEN |
|---|
| 236 | idx = j ; RETURN |
|---|
| 237 | ENDIF |
|---|
| 238 | ENDDO |
|---|
| 239 | ENDIF |
|---|
| 240 | |
|---|
| 241 | CONTAINS |
|---|
| 242 | |
|---|
| 243 | FUNCTION to_lower(istr) RESULT(ostr) |
|---|
| 244 | !! Lower case conversion function. |
|---|
| 245 | IMPLICIT NONE |
|---|
| 246 | CHARACTER(len=*), INTENT(in) :: istr |
|---|
| 247 | CHARACTER(len=LEN(istr)) :: ostr |
|---|
| 248 | INTEGER :: i, ic |
|---|
| 249 | ostr = istr |
|---|
| 250 | DO i = 1, LEN_TRIM(istr) |
|---|
| 251 | ic = ICHAR(istr(i:i)) |
|---|
| 252 | IF (ic >= 65 .AND. ic < 90) ostr(i:i) = char(ic + 32) |
|---|
| 253 | ENDDO |
|---|
| 254 | END FUNCTION to_lower |
|---|
| 255 | END FUNCTION indexOfTracer |
|---|
| 256 | |
|---|
| 257 | FUNCTION nameOfTracer(indx) RESULT(name) |
|---|
| 258 | !! Get the name of a tracer by index. |
|---|
| 259 | !! |
|---|
| 260 | !! The function searches in the global tracer table (tracer_h:noms) |
|---|
| 261 | !! and returns the name of the tracer at given index. |
|---|
| 262 | !! |
|---|
| 263 | !! If the index is out of range an empty string is returned. |
|---|
| 264 | !! |
|---|
| 265 | !! @warning |
|---|
| 266 | !! initracers must be called before any use of this function. |
|---|
| 267 | IMPLICIT NONE |
|---|
| 268 | INTEGER, INTENT(in) :: indx !! Index of the tracer name to retrieve. |
|---|
| 269 | CHARACTER(len=20) :: name !! Name of the tracer at given index. |
|---|
| 270 | name = '' |
|---|
| 271 | IF (.NOT.ALLOCATED(noms)) RETURN |
|---|
| 272 | IF (indx <= 0 .OR. indx > SIZE(noms)) RETURN |
|---|
| 273 | name = noms(indx) |
|---|
| 274 | END FUNCTION nameOfTracer |
|---|
| 275 | |
|---|
| 276 | SUBROUTINE dumpTracers(indexes) |
|---|
| 277 | !! Print the names of the given list of tracers indexes. |
|---|
| 278 | INTEGER, DIMENSION(:), INTENT(in) :: indexes |
|---|
| 279 | INTEGER :: i,idx,nt |
|---|
| 280 | CHARACTER(len=:), ALLOCATABLE :: suffix |
|---|
| 281 | |
|---|
| 282 | IF (.NOT.ALLOCATED(noms)) THEN |
|---|
| 283 | WRITE(*,'(a)') "[tracers_h:dump_tracers] warning: 'noms' is not allocated, tracers_h:initracer2 has not be called yet" |
|---|
| 284 | RETURN |
|---|
| 285 | ENDIF |
|---|
| 286 | nt = size(noms) |
|---|
| 287 | WRITE(*,"(a)") "local -> global : name" |
|---|
| 288 | DO i=1,size(indexes) |
|---|
| 289 | idx = indexes(i) |
|---|
| 290 | IF (idx < 1 .OR. idx >= nt) THEN |
|---|
| 291 | ! WRITE(*,'((a),I3,(a),I3,(a))') "index out of range (",idx,"/",nt,")" |
|---|
| 292 | CYCLE |
|---|
| 293 | ENDIF |
|---|
| 294 | IF (ANY(chimi_indx == idx)) THEN |
|---|
| 295 | suffix = ' (chimi)' |
|---|
| 296 | ELSE IF (ANY(micro_indx == idx)) THEN |
|---|
| 297 | suffix = ' (micro' |
|---|
| 298 | IF (ALLOCATED(ices_indx)) THEN |
|---|
| 299 | IF (ANY(ices_indx == idx)) suffix=suffix//", ice" |
|---|
| 300 | ENDIF |
|---|
| 301 | suffix=suffix//")" |
|---|
| 302 | ELSE |
|---|
| 303 | suffix=" ()" |
|---|
| 304 | ENDIF |
|---|
| 305 | WRITE(*,'(I5,(a),I6,(a))') i," -> ",idx ," : "//TRIM(noms(i))//suffix |
|---|
| 306 | ENDDO |
|---|
| 307 | END SUBROUTINE dumpTracers |
|---|
| 308 | |
|---|
| 309 | |
|---|
| 310 | END MODULE tracer_h |
|---|
| 311 | |
|---|
