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