Ignore:
Timestamp:
Jul 22, 2024, 6:53:44 PM (4 months ago)
Author:
abarral
Message:

Remove CRAY key (obsolete calls to functions that don't exist anymore, bugs in some implementations, irrelevant now)
Replace usage of CPP_XIOS key by using_xios logical
Remove always unused testcpu bits
Replace most uses of CPP_StratAer by the corresponding logical defined in lmdz_cppkeys_wrapper.F90 [this breaks iso compilation because phyiso doesn't define all aerosols - to be fixed later]
Replaces uses of include "yomcst.h" by the lmdz_yomcst.f90 module in .[fF]90 files

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d_common
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.F

    r5082 r5098  
    3131      REAL w(ip1jmp1,llm),pdt
    3232c
    33 c      Local 
     33c      Local
    3434c   ---------
    3535c
    … …  
    4747      real zqh(ip1jmp1,llm),zqb(ip1jmp1,llm)
    4848      real temps0,temps1,temps2,temps3
    49       real ztemps1,ztemps2,ztemps3,ssum
    50       logical testcpu
    51       save testcpu
     49      real ztemps1,ztemps2,ssum
    5250      save temps1,temps2,temps3
    5351      real zzpbar,zzw
    5452
    55 #ifdef CRAY
    56       real second
    57 #endif
    58 
    5953      real qmin,qmax
    6054      data qmin,qmax/0.,1./
    61       data testcpu/.false./
    6255      data temps1,temps2,temps3/0.,0.,0./
    6356
    … …  
    120113c     call minmaxq(zq,qmin,qmax,'apres vlx     ')
    121114
    122 #ifdef CRAY
    123       if(testcpu) then
    124          ztemps1=second(0.)
    125          temps1=temps1+ztemps1-ztemps2
    126             print*,'VLSPLT X:',temps1,'   Y:',temps2,'   Z:',temps3
    127       endif
    128 #endif
    129115      do l=1,llm
    130116         do ij=1,ip1jmp1
    … …  
    155141      real q(ip1jmp1,llm),qg(ip1jmp1,llm),qd(ip1jmp1,llm)
    156142c
    157 c      Local 
     143c      Local
    158144c   ---------
    159145c
    … …  
    272258      real q(ip1jmp1,llm),qs(ip1jmp1,llm),qn(ip1jmp1,llm)
    273259c
    274 c      Local 
     260c      Local
    275261c   ---------
    276262c
    … …  
    368354      real q(ip1jmp1,llm),qh(ip1jmp1,llm),qb(ip1jmp1,llm)
    369355c
    370 c      Local 
     356c      Local
    371357c   ---------
    372358c
    … …  
    493479      real q(ip1jmp1,llm),qd(ip1jmp1,llm),qg(ip1jmp1,llm)
    494480c
    495 c      Local 
     481c      Local
    496482c   ---------
    497483c
    … …  
    510496      save prec
    511497
    512 #ifdef CRAY
    513       data prec/1.e-24/
    514 #else
    515498      data prec/1.e-15/
    516 #endif
    517499
    518500      do l=1,llm
    … …  
    573555                 u_mq(ij,l)=
    574556     s           sign(zm,u_m(ij,l))*(zsigp*zqp+(zsig-zsigp)*zqm)
    575              endif 
     557             endif
    576558          else
    577559             if (zsig<=zsigp) then
    … …  
    703685            endif
    704686         enddo
    705       endif  ! n0.gt.0 
     687      endif  ! n0.gt.0
    706688
    707689c   bouclage en latitude
    … …  
    758740      real q(ip1jmp1,llm),qn(ip1jmp1,llm),qs(ip1jmp1,llm)
    759741c
    760 c      Local 
     742c      Local
    761743c   ---------
    762744c
    … …  
    772754      save prec
    773755
    774 #ifdef CRAY
    775       data prec/1.e-24/
    776 #else
    777756      data prec/1.e-15/
    778 #endif
    779757      do l=1,llm
    780758            do ij=1,ip1jmp1
    … …  
    825803          else
    826804              zz=0.5*(zsig-zsigp)/zsigm
    827               v_mq(ij,l)=sign(zm,v_m(ij,l))*( 0.5*(zq+zqp)*zsigp 
     805              v_mq(ij,l)=sign(zm,v_m(ij,l))*( 0.5*(zq+zqp)*zsigp
    828806     s        +(zsig-zsigp)*(zq+zz*(zqm-zq)) )
    829807          endif
    … …  
    890868
    891869c
    892 c      Local 
     870c      Local
    893871c   ---------
    894872c
    … …  
    902880      save prec
    903881
    904 #ifdef CRAY
    905       data prec/1.e-24/
    906 #else
    907882      data prec/1.e-13/
    908 #endif
    909883
    910884      do l=1,llm

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/infotrac.F90

    r5091 r5098  
    33MODULE infotrac
    44
    5    USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
    6    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    7         delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    8         addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    9    IMPLICIT NONE
    10 
    11    PRIVATE
    12 
    13    !=== FOR TRACERS:
    14    PUBLIC :: init_infotrac                                 !--- Initialization of the tracers
    15    PUBLIC :: tracers, type_trac                            !--- Full tracers database, tracers type keyword
    16    PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,  nqtottr      !--- Main dimensions
    17    PUBLIC :: conv_flg, pbl_flg                             !--- Convection & boundary layer activation keys
    18 
    19    !=== FOR ISOTOPES: General
    20    PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
    21    PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
    22    !=== FOR ISOTOPES: Specific to water
    23    PUBLIC :: iH2O                                          !--- H2O isotopes class index
    24    PUBLIC :: min_qParent, min_qMass, min_ratio             !--- Min. values for various isotopic quantities
    25    !=== FOR ISOTOPES: Depending on the selected isotopes family
    26    PUBLIC :: isotope, isoKeys                              !--- Selected isotopes database + associated keys (cf. getKey)
    27    PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
    28    PUBLIC :: niso,    nzone,   nphas,  ntiso              !---  " " numbers + isotopes & tagging tracers number
    29    PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
    30    PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
    31    PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    32    !=== FOR BOTH TRACERS AND ISOTOPES
    33    PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
    34 
    35 !=== CONVENTIONS FOR TRACERS NUMBERS:
    36 !  |--------------------+-----------------------+-----------------+---------------+----------------------------|
    37 !  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
    38 !  | phases: H2O_[gls]  |      isotopes         |                 |               |  for higher order schemes  |
    39 !  |--------------------+-----------------------+-----------------+---------------+----------------------------|
    40 !  |                    |                       |                 |               |                            |
    41 !  |<--     nqo      -->|<-- nqo*niso* nzone -->|<-- nqo*niso  -->|<--  nbtr   -->|<--        (nmom)        -->|         
    42 !  |                    |                                         |                                            |
    43 !  |                    |<-- nqo*niso*(nzone+1)  =   nqo*ntiso -->|<--    nqtottr = nbtr + nmom             -->|
    44 !  |                                                                              = nqtot - nqo*(ntiso+1)      |
    45 !  |                                                                                                           |
    46 !  |<--                        nqtrue  =  nbtr + nqo*(ntiso+1)                 -->|                            |
    47 !  |                                                                                                           |
    48 !  |<--                        nqtot   =  nqtrue + nmom                                                     -->|
    49 !  |                                                                                                           |
    50 !  |-----------------------------------------------------------------------------------------------------------|
    51 !  NOTES FOR THIS TABLE:
    52 !  * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
    53 !    since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
    54 !  * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
    55 !  * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
    56 !
    57 !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
    58 !    Each entry is accessible using "%" sign.
    59 !  |-------------+------------------------------------------------------+-------------+------------------------+
    60 !  |  entry      | Meaning                                              | Former name | Possible values        |
    61 !  |-------------+------------------------------------------------------+-------------+------------------------+
    62 !  | name        | Name (short)                                         | tname       |                        |
    63 !  | gen0Name    | Name of the 1st generation ancestor                  | /           |                        |
    64 !  | parent      | Name of the parent                                   | /           |                        |
    65 !  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
    66 !  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
    67 !  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
    68 !  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
    69 !  | iGeneration | Generation (>=1)                                     | /           |                        |
    70 !  | iqParent    | Index of the parent tracer                           | iqpere      | 1:nqtot                |
    71 !  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
    72 !  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    73 !  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
    74 !  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
    75 !  | iadv        | Advection scheme number                              | iadv        | 1,2,10-20(exc.15,19),30|
    76 !  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
    77 !  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
    78 !  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    79 !  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    80 !  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
    81 !  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
    82 !  +-------------+------------------------------------------------------+-------------+------------------------+
    83 !
    84 !=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
    85 !    Each entry is accessible using "%" sign.
    86 !  |-----------------+--------------------------------------------------+--------------------+-----------------+
    87 !  |  entry | length | Meaning                                          |    Former name     | Possible values |
    88 !  |-----------------+--------------------------------------------------+--------------------+-----------------+
    89 !  | parent          | Parent tracer (isotopes family name)             |                    |                 |
    90 !  | keys   | niso   | Isotopes keys/values pairs list + number         |                    |                 |
    91 !  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |
    92 !  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
    93 !  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
    94 !  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
    95 !  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
    96 !  +-----------------+--------------------------------------------------+--------------------+-----------------+
    97 
    98    REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi
    99 
    100    !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
    101    INTEGER,               SAVE :: nqtot, &                     !--- Tracers nb in dynamics (incl. higher moments + H2O)
    102                                   nbtr,  &                     !--- Tracers nb in physics  (excl. higher moments + H2O)
    103                                   nqo,    &                     !--- Number of water phases
    104                                   nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)
    105                                   nqCO2                         !--- Number of tracers of CO2  (ThL)
    106    CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type
    107 
    108    !=== VARIABLES FOR INCA
    109    INTEGER,              SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
    110                                                 pbl_flg(:)      !--- Boundary layer activation ; needed for INCA        (nbtr)
     5  USE       strings_mod, ONLY : msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
     6  USE readTracFiles_mod, ONLY : trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
     7          delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
     8          addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck
     9  IMPLICIT NONE
     10
     11  PRIVATE
     12
     13  !=== FOR TRACERS:
     14  PUBLIC :: init_infotrac                                 !--- Initialization of the tracers
     15  PUBLIC :: tracers, type_trac                            !--- Full tracers database, tracers type keyword
     16  PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr      !--- Main dimensions
     17  PUBLIC :: conv_flg, pbl_flg                             !--- Convection & boundary layer activation keys
     18
     19  !=== FOR ISOTOPES: General
     20  PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
     21  PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
     22  !=== FOR ISOTOPES: Specific to water
     23  PUBLIC :: iH2O                                          !--- H2O isotopes class index
     24  PUBLIC :: min_qParent, min_qMass, min_ratio             !--- Min. values for various isotopic quantities
     25  !=== FOR ISOTOPES: Depending on the selected isotopes family
     26  PUBLIC :: isotope, isoKeys                              !--- Selected isotopes database + associated keys (cf. getKey)
     27  PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
     28  PUBLIC :: niso, nzone, nphas, ntiso              !---  " " numbers + isotopes & tagging tracers number
     29  PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
     30  PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
     31  PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
     32  !=== FOR BOTH TRACERS AND ISOTOPES
     33  PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
     34
     35  !=== CONVENTIONS FOR TRACERS NUMBERS:
     36  !  |--------------------+-----------------------+-----------------+---------------+----------------------------|
     37  !  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
     38  !  | phases: H2O_[gls]  |      isotopes         |                 |               |  for higher order schemes  |
     39  !  |--------------------+-----------------------+-----------------+---------------+----------------------------|
     40  !  |                    |                       |                 |               |                            |
     41  !  |<--     nqo      -->|<-- nqo*niso* nzone -->|<-- nqo*niso  -->|<--  nbtr   -->|<--        (nmom)        -->|
     42  !  |                    |                                         |                                            |
     43  !  |                    |<-- nqo*niso*(nzone+1)  =   nqo*ntiso -->|<--    nqtottr = nbtr + nmom             -->|
     44  !  |                                                                              = nqtot - nqo*(ntiso+1)      |
     45  !  |                                                                                                           |
     46  !  |<--                        nqtrue  =  nbtr + nqo*(ntiso+1)                 -->|                            |
     47  !  |                                                                                                           |
     48  !  |<--                        nqtot   =  nqtrue + nmom                                                     -->|
     49  !  |                                                                                                           |
     50  !  |-----------------------------------------------------------------------------------------------------------|
     51  !  NOTES FOR THIS TABLE:
     52  !  * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
     53  !    since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
     54  !  * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
     55  !  * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
     56  !
     57  !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
     58  !    Each entry is accessible using "%" sign.
     59  !  |-------------+------------------------------------------------------+-------------+------------------------+
     60  !  |  entry      | Meaning                                              | Former name | Possible values        |
     61  !  |-------------+------------------------------------------------------+-------------+------------------------+
     62  !  | name        | Name (short)                                         | tname       |                        |
     63  !  | gen0Name    | Name of the 1st generation ancestor                  | /           |                        |
     64  !  | parent      | Name of the parent                                   | /           |                        |
     65  !  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
     66  !  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
     67  !  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
     68  !  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
     69  !  | iGeneration | Generation (>=1)                                     | /           |                        |
     70  !  | iqParent    | Index of the parent tracer                           | iqpere      | 1:nqtot                |
     71  !  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
     72  !  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
     73  !  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
     74  !  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
     75  !  | iadv        | Advection scheme number                              | iadv        | 1,2,10-20(exc.15,19),30|
     76  !  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
     77  !  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
     78  !  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
     79  !  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
     80  !  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
     81  !  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
     82  !  +-------------+------------------------------------------------------+-------------+------------------------+
     83  !
     84  !=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
     85  !    Each entry is accessible using "%" sign.
     86  !  |-----------------+--------------------------------------------------+--------------------+-----------------+
     87  !  |  entry | length | Meaning                                          |    Former name     | Possible values |
     88  !  |-----------------+--------------------------------------------------+--------------------+-----------------+
     89  !  | parent          | Parent tracer (isotopes family name)             |                    |                 |
     90  !  | keys   | niso   | Isotopes keys/values pairs list + number         |                    |                 |
     91  !  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |
     92  !  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
     93  !  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
     94  !  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
     95  !  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
     96  !  +-----------------+--------------------------------------------------+--------------------+-----------------+
     97
     98  REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi
     99
     100  !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
     101  INTEGER, SAVE :: nqtot, &                     !--- Tracers nb in dynamics (incl. higher moments + H2O)
     102          nbtr, &                     !--- Tracers nb in physics  (excl. higher moments + H2O)
     103          nqo, &                     !--- Number of water phases
     104          nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)
     105          nqCO2                         !--- Number of tracers of CO2  (ThL)
     106  CHARACTER(LEN = maxlen), SAVE :: type_trac                     !--- Keyword for tracers type
     107
     108  !=== VARIABLES FOR INCA
     109  INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
     110          pbl_flg(:)      !--- Boundary layer activation ; needed for INCA        (nbtr)
    111111
    112112CONTAINS
    113113
    114 SUBROUTINE init_infotrac
    115    USE control_mod, ONLY: planet_type
     114  SUBROUTINE init_infotrac
     115    USE control_mod, ONLY : planet_type
    116116#ifdef REPROBUS
    117117   USE CHEM_REP,    ONLY: Init_chem_rep_trac
    118118#endif
    119    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
    120    IMPLICIT NONE
    121 !==============================================================================================================================
    122 !
    123 !   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
    124 !   -------
    125 !
    126 !   Modifications:
    127 !   --------------
    128 !   05/94: F.Forget      Modif special traceur
    129 !   02/02: M-A Filiberti Lecture de traceur.def
    130 !   01/22: D. Cugnet     Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
    131 !
    132 !   Objet:
    133 !   ------
    134 !   GCM LMD nouvelle grille
    135 !
    136 !==============================================================================================================================
    137 !   ... modification de l'integration de q ( 26/04/94 ) ....
    138 !------------------------------------------------------------------------------------------------------------------------------
    139 ! Declarations:
    140    INCLUDE "dimensions.h"
    141    INCLUDE "iniprint.h"
    142 
    143 !------------------------------------------------------------------------------------------------------------------------------
    144 ! Local variables
    145    INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
    146    INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
    147                            vad (:), vadv_inca(:), pbl_flg_inca(:)
    148    CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
    149    INTEGER :: nqINCA
    150    CHARACTER(LEN=2)      ::  suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)
    151    CHARACTER(LEN=3)      :: descrq(30)                               !--- Advection scheme description tags
    152    CHARACTER(LEN=maxlen) :: msg1, texp, ttp                          !--- Strings for messages and expanded tracers type
    153    INTEGER :: fType                                                  !--- Tracers description file type ; 0: none
    154                                                                      !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
    155    INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    156    INTEGER :: iad                                                    !--- Advection scheme number
    157    INTEGER :: iq, jq, nt, im, nm                                     !--- Indexes and temporary variables
    158    LOGICAL :: lerr, ll
    159    TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    160    TYPE(trac_type), POINTER            :: t1, t(:)
    161    CHARACTER(LEN=maxlen),  ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
    162 
    163    CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac"
    164 !------------------------------------------------------------------------------------------------------------------------------
    165 ! Initialization :
    166 !------------------------------------------------------------------------------------------------------------------------------
    167    suff          = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
    168    descrq( 1:30) = '   '
    169    descrq( 1: 2) = ['LMV','BAK']
    170    descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH','   ','PPM','PPS','PPP','   ','SLP']
    171    descrq(30)    = 'PRA'
    172    
    173    CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    174 
    175    lerr=strParse(type_trac, '|', types_trac, n=nt)
    176    IF (nt > 1) THEN
     119    USE lmdz_cppkeys_wrapper, ONLY : CPPKEY_INCA, CPPKEY_STRATAER
     120    IMPLICIT NONE
     121    !==============================================================================================================================
     122    !
     123    !   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
     124    !   -------
     125    !
     126    !   Modifications:
     127    !   --------------
     128    !   05/94: F.Forget      Modif special traceur
     129    !   02/02: M-A Filiberti Lecture de traceur.def
     130    !   01/22: D. Cugnet     Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
     131    !
     132    !   Objet:
     133    !   ------
     134    !   GCM LMD nouvelle grille
     135    !
     136    !==============================================================================================================================
     137    !   ... modification de l'integration de q ( 26/04/94 ) ....
     138    !------------------------------------------------------------------------------------------------------------------------------
     139    ! Declarations:
     140    INCLUDE "dimensions.h"
     141    INCLUDE "iniprint.h"
     142
     143    !------------------------------------------------------------------------------------------------------------------------------
     144    ! Local variables
     145    INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
     146    INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
     147            vad (:), vadv_inca(:), pbl_flg_inca(:)
     148    CHARACTER(LEN = 8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
     149    INTEGER :: nqINCA
     150    CHARACTER(LEN = 2) :: suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)
     151    CHARACTER(LEN = 3) :: descrq(30)                               !--- Advection scheme description tags
     152    CHARACTER(LEN = maxlen) :: msg1, texp, ttp                          !--- Strings for messages and expanded tracers type
     153    INTEGER :: fType                                                  !--- Tracers description file type ; 0: none
     154    !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
     155    INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
     156    INTEGER :: iad                                                    !--- Advection scheme number
     157    INTEGER :: iq, jq, nt, im, nm                                     !--- Indexes and temporary variables
     158    LOGICAL :: lerr, ll
     159    TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
     160    TYPE(trac_type), POINTER :: t1, t(:)
     161    CHARACTER(LEN = maxlen), ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
     162
     163    CHARACTER(LEN = *), PARAMETER :: modname = "init_infotrac"
     164    !------------------------------------------------------------------------------------------------------------------------------
     165    ! Initialization :
     166    !------------------------------------------------------------------------------------------------------------------------------
     167    suff = ['x ', 'y ', 'z ', 'xx', 'xy', 'xz', 'yy', 'yz', 'zz']
     168    descrq(1:30) = '   '
     169    descrq(1:2) = ['LMV', 'BAK']
     170    descrq(10:20) = ['VL1', 'VLP', 'FH1', 'FH2', 'VLH', '   ', 'PPM', 'PPS', 'PPP', '   ', 'SLP']
     171    descrq(30) = 'PRA'
     172
     173    CALL msg('type_trac = "' // TRIM(type_trac) // '"', modname)
     174
     175    lerr = strParse(type_trac, '|', types_trac, n = nt)
     176    IF (nt > 1) THEN
    177177      IF (nt > 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
    178       if (nt == 2) type_trac=types_trac(2)
    179    ENDIF
    180 
    181 
    182    
    183    !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
    184    msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
    185    SELECT CASE(type_trac)
    186       CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model',        modname)
    187       CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
    188       CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model',    modname)
    189       CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle',    modname)
    190       CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
    191       CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only',          modname)
    192       CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
    193    END SELECT
    194 
    195    !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
    196    SELECT CASE(type_trac)
    197       CASE('inca', 'inco')
     178      if (nt == 2) type_trac = types_trac(2)
     179    ENDIF
     180
     181
     182
     183    !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
     184    msg1 = 'For type_trac = "' // TRIM(type_trac) // '":'
     185    SELECT CASE(type_trac)
     186    CASE('inca'); CALL msg(TRIM(msg1) // ' coupling with INCA chemistry model', modname)
     187    CASE('inco'); CALL msg(TRIM(msg1) // ' coupling jointly with INCA and CO2 cycle', modname)
     188    CASE('repr'); CALL msg(TRIM(msg1) // ' coupling with REPROBUS chemistry model', modname)
     189    CASE('co2i'); CALL msg(TRIM(msg1) // ' you have chosen to run with CO2 cycle', modname)
     190    CASE('coag'); CALL msg(TRIM(msg1) // ' tracers are treated for COAGULATION tests', modname)
     191    CASE('lmdz'); CALL msg(TRIM(msg1) // ' tracers are treated in LMDZ only', modname)
     192    CASE DEFAULT; CALL abort_gcm(modname, 'type_trac=' // TRIM(type_trac) // ' not possible yet.', 1)
     193    END SELECT
     194
     195    !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
     196    SELECT CASE(type_trac)
     197    CASE('inca', 'inco')
    198198      IF (CPPKEY_INCA) THEN
    199          CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
     199        CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
    200200      END IF
    201       CASE('repr')
     201    CASE('repr')
    202202#ifndef REPROBUS
    203          CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
     203      CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
    204204#endif
    205       CASE('coag')
    206 #ifndef CPP_StratAer
    207          CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
    208 #endif
    209    END SELECT
    210 
    211    nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
    212 
    213 !==============================================================================================================================
    214 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
    215 !==============================================================================================================================
    216    texp = type_trac                                                  !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR
    217    IF(texp == 'inco') texp = 'co2i|inca'
    218    IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp)
    219 
    220    !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
    221    IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    222    ttp = type_trac; IF(fType /= 1) ttp = texp
    223 
    224    IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    225    !---------------------------------------------------------------------------------------------------------------------------
    226    IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
    227    !---------------------------------------------------------------------------------------------------------------------------
    228    IF(fType == 1 .AND. ANY(['inca','inco']==type_trac)) THEN         !=== FOUND OLD STYLE INCA "traceur.def"
    229    !---------------------------------------------------------------------------------------------------------------------------
    230    IF (CPPKEY_INCA) THEN
    231       nqo = SIZE(tracers) - nqCO2
    232       CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
    233       nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
    234       nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
    235       IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
    236       ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
    237       ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
    238       CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
    239       ALLOCATE(ttr(nqtrue))
    240       ttr(1:nqo+nqCO2)                  = tracers
    241       ttr(1    :      nqo   )%component = 'lmdz'
    242       ttr(1+nqo:nqCO2+nqo   )%component = 'co2i'
    243       ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
    244       ttr(1+nqo      :nqtrue)%name      = [('CO2     ', iq=1, nqCO2), solsym_inca]
    245       ttr(1+nqo+nqCO2:nqtrue)%parent    = tran0
    246       ttr(1+nqo+nqCO2:nqtrue)%phase    = 'g'
    247       lerr = getKey('hadv', had, ky=tracers(:)%keys)
    248       lerr = getKey('vadv', vad, ky=tracers(:)%keys)
    249       hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
    250       vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
    251       CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    252       DO iq = 1, nqtrue
    253          t1 => tracers(iq)
    254          CALL addKey('name',      t1%name,      t1%keys)
    255          CALL addKey('component', t1%component, t1%keys)
    256          CALL addKey('parent',    t1%parent,    t1%keys)
    257          CALL addKey('phase',     t1%phase,    t1%keys)
    258       END DO
    259       IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name
    260       DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
    261    END IF
    262    !---------------------------------------------------------------------------------------------------------------------------
    263    ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
    264    !---------------------------------------------------------------------------------------------------------------------------
    265       nqo    =        COUNT(delPhase(tracers(:)%name)     == 'H2O' &
    266                                .AND. tracers(:)%component == 'lmdz') !--- Number of water phases
     205    CASE('coag')
     206      IF (.NOT. CPPKEY_STRATAER) THEN
     207        CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
     208      END IF
     209    END SELECT
     210
     211    nqCO2 = COUNT([type_trac == 'inco', type_trac == 'co2i'])
     212
     213    !==============================================================================================================================
     214    ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
     215    !==============================================================================================================================
     216    texp = type_trac                                                  !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR
     217    IF(texp == 'inco') texp = 'co2i|inca'
     218    IF(texp /= 'lmdz') texp = 'lmdz|' // TRIM(texp)
     219
     220    !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
     221    IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)', 1)
     222    ttp = type_trac; IF(fType /= 1) ttp = texp
     223
     224    IF(readTracersFiles(ttp, lRepr = type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)', 1)
     225    !---------------------------------------------------------------------------------------------------------------------------
     226    IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.', 1)
     227    !---------------------------------------------------------------------------------------------------------------------------
     228    IF(fType == 1 .AND. ANY(['inca', 'inco']==type_trac)) THEN         !=== FOUND OLD STYLE INCA "traceur.def"
     229      !---------------------------------------------------------------------------------------------------------------------------
     230      IF (CPPKEY_INCA) THEN
     231        nqo = SIZE(tracers) - nqCO2
     232        CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
     233        nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
     234        nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
     235        IF(ALL([2, 3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo=' // TRIM(int2str(nqo)), 1)
     236        ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
     237        ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
     238        CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
     239        ALLOCATE(ttr(nqtrue))
     240        ttr(1:nqo + nqCO2) = tracers
     241        ttr(1:nqo)%component = 'lmdz'
     242        ttr(1 + nqo:nqCO2 + nqo)%component = 'co2i'
     243        ttr(1 + nqo + nqCO2:nqtrue)%component = 'inca'
     244        ttr(1 + nqo:nqtrue)%name = [('CO2     ', iq = 1, nqCO2), solsym_inca]
     245        ttr(1 + nqo + nqCO2:nqtrue)%parent = tran0
     246        ttr(1 + nqo + nqCO2:nqtrue)%phase = 'g'
     247        lerr = getKey('hadv', had, ky = tracers(:)%keys)
     248        lerr = getKey('vadv', vad, ky = tracers(:)%keys)
     249        hadv(1:nqo + nqCO2) = had(:); hadv(1 + nqo + nqCO2:nqtrue) = hadv_inca
     250        vadv(1:nqo + nqCO2) = vad(:); vadv(1 + nqo + nqCO2:nqtrue) = vadv_inca
     251        CALL MOVE_ALLOC(FROM = ttr, TO = tracers)
     252        DO iq = 1, nqtrue
     253          t1 => tracers(iq)
     254          CALL addKey('name', t1%name, t1%keys)
     255          CALL addKey('component', t1%component, t1%keys)
     256          CALL addKey('parent', t1%parent, t1%keys)
     257          CALL addKey('phase', t1%phase, t1%keys)
     258        END DO
     259        IF(setGeneration(tracers)) CALL abort_gcm(modname, 'See above', 1) !- SET FIELDS %iGeneration, %gen0Name
     260        DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
     261      END IF
     262      !---------------------------------------------------------------------------------------------------------------------------
     263    ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
     264      !---------------------------------------------------------------------------------------------------------------------------
     265      nqo = COUNT(delPhase(tracers(:)%name)     == 'H2O' &
     266              .AND. tracers(:)%component == 'lmdz') !--- Number of water phases
    267267      nqtrue = SIZE(tracers)                                         !--- Total number of "true" tracers
    268       nbtr   = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
    269                                .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
    270    IF (CPPKEY_INCA) THEN
    271       nqINCA = COUNT(tracers(:)%component == 'inca')
    272    END IF
    273       lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
    274       lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
    275    !---------------------------------------------------------------------------------------------------------------------------
    276    END IF
    277    !---------------------------------------------------------------------------------------------------------------------------
     268      nbtr = nqtrue - COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
     269              .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
     270      IF (CPPKEY_INCA) THEN
     271        nqINCA = COUNT(tracers(:)%component == 'inca')
     272      END IF
     273      lerr = getKey('hadv', hadv, ky = tracers(:)%keys)
     274      lerr = getKey('vadv', vadv, ky = tracers(:)%keys)
     275      !---------------------------------------------------------------------------------------------------------------------------
     276    END IF
     277    !---------------------------------------------------------------------------------------------------------------------------
    278278
    279279#ifdef REPROBUS
    … …  
    282282
    283283#endif
    284 !==============================================================================================================================
    285 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
    286 !==============================================================================================================================
    287    DO iq = 1, nqtrue
    288       IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
    289       WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
     284    !==============================================================================================================================
     285    ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
     286    !==============================================================================================================================
     287    DO iq = 1, nqtrue
     288      IF(hadv(iq)<20 .OR. (ANY(hadv(iq)==[20, 30]) .AND. hadv(iq)==vadv(iq))) CYCLE
     289      WRITE(msg1, '("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq), vadv(iq), ' for "' // TRIM(tracers(iq)%name) // '" is not available'
    290290      CALL abort_gcm(modname, TRIM(msg1), 1)
    291    END DO
    292    nqtot =    COUNT( hadv< 20 .AND. vadv< 20 ) &                     !--- No additional tracer
    293          +  4*COUNT( hadv==20 .AND. vadv==20 ) &                     !--- 3  additional tracers
    294          + 10*COUNT( hadv==30 .AND. vadv==30 )                       !--- 9  additional tracers
    295 
    296    !--- More tracers due to the choice of advection scheme => assign total number of tracers
    297    IF( nqtot /= nqtrue ) THEN
     291    END DO
     292    nqtot = COUNT(hadv< 20 .AND. vadv< 20) &                     !--- No additional tracer
     293            + 4 * COUNT(hadv==20 .AND. vadv==20) &                     !--- 3  additional tracers
     294            + 10 * COUNT(hadv==30 .AND. vadv==30)                       !--- 9  additional tracers
     295
     296    !--- More tracers due to the choice of advection scheme => assign total number of tracers
     297    IF(nqtot /= nqtrue) THEN
    298298      CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
    299       CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
    300       CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
    301    END IF
    302 
    303 !==============================================================================================================================
    304 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected.
    305 !     iadv = 1    "LMDZ-specific humidity transport" (for H2O vapour)          LMV
    306 !     iadv = 2    backward                           (for H2O liquid)          BAK
    307 !     iadv = 14   Van-Leer + specific humidity, modified by Francis Codron     VLH
    308 !     iadv = 10   Van-Leer (chosen for vapour and liquid water)                VL1
    309 !     iadv = 11   Van-Leer for hadv and PPM version (Monotonic) for vadv       VLP
    310 !     iadv = 12   Frederic Hourdin I                                           FH1
    311 !     iadv = 13   Frederic Hourdin II                                          FH2
    312 !     iadv = 16   Monotonic         PPM (Collela & Woodward 1984)              PPM
    313 !     iadv = 17   Semi-monotonic    PPM (overshoots allowed)                   PPS
    314 !     iadv = 18   Definite positive PPM (overshoots and undershoots allowed)   PPP
    315 !     iadv = 20   Slopes                                                       SLP
    316 !     iadv = 30   Prather                                                      PRA
    317 !
    318 !        In array q(ij,l,iq) : iq = 1/2[/3]    for vapour/liquid[/ice] water
    319 !        And optionaly:        iq = 3[4],nqtot for other tracers
    320 !==============================================================================================================================
    321    ALLOCATE(ttr(nqtot))
    322    jq = nqtrue+1; tracers(:)%iadv = -1
    323    DO iq = 1, nqtrue
     299      CALL msg('The number of true tracers is ' // TRIM(int2str(nqtrue)))
     300      CALL msg('The total number of tracers needed is ' // TRIM(int2str(nqtot)))
     301    END IF
     302
     303    !==============================================================================================================================
     304    ! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected.
     305    !     iadv = 1    "LMDZ-specific humidity transport" (for H2O vapour)          LMV
     306    !     iadv = 2    backward                           (for H2O liquid)          BAK
     307    !     iadv = 14   Van-Leer + specific humidity, modified by Francis Codron     VLH
     308    !     iadv = 10   Van-Leer (chosen for vapour and liquid water)                VL1
     309    !     iadv = 11   Van-Leer for hadv and PPM version (Monotonic) for vadv       VLP
     310    !     iadv = 12   Frederic Hourdin I                                           FH1
     311    !     iadv = 13   Frederic Hourdin II                                          FH2
     312    !     iadv = 16   Monotonic         PPM (Collela & Woodward 1984)              PPM
     313    !     iadv = 17   Semi-monotonic    PPM (overshoots allowed)                   PPS
     314    !     iadv = 18   Definite positive PPM (overshoots and undershoots allowed)   PPP
     315    !     iadv = 20   Slopes                                                       SLP
     316    !     iadv = 30   Prather                                                      PRA
     317    !
     318    !        In array q(ij,l,iq) : iq = 1/2[/3]    for vapour/liquid[/ice] water
     319    !        And optionaly:        iq = 3[4],nqtot for other tracers
     320    !==============================================================================================================================
     321    ALLOCATE(ttr(nqtot))
     322    jq = nqtrue + 1; tracers(:)%iadv = -1
     323    DO iq = 1, nqtrue
    324324      t1 => tracers(iq)
    325325
    326326      !--- VERIFY THE CHOICE OF ADVECTION SCHEME
    327327      iad = -1
    328       IF(hadv(iq)     ==    vadv(iq)    ) iad = hadv(iq)
     328      IF(hadv(iq)     ==    vadv(iq)) iad = hadv(iq)
    329329      IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
    330       WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
     330      WRITE(msg1, '("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
    331331      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
    332332
    333333      !--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics
    334       t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
    335       t1%iadv       = iad
     334      t1%longName = t1%name; IF(iad > 0) t1%longName = TRIM(t1%name) // descrq(iad)
     335      t1%iadv = iad
    336336      t1%isAdvected = iad >= 0
    337       t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
    338                           .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
    339       ttr(iq)       = t1
     337      t1%isInPhysics = delPhase(t1%gen0Name) /= 'H2O' &
     338              .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
     339      ttr(iq) = t1
    340340
    341341      !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
    … …  
    344344      IF(iad == 30) nm = 9                                           !--- 3rd order scheme
    345345      IF(nm == 0) CYCLE                                              !--- No higher moments
    346       ttr(jq+1:jq+nm)            = t1
    347       ttr(jq+1:jq+nm)%name        = [ (TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
    348       ttr(jq+1:jq+nm)%parent      = [ (TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
    349       ttr(jq+1:jq+nm)%longName    = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
    350       ttr(jq+1:jq+nm)%iadv        = [ (-iad,    im=1, nm) ]
    351       ttr(jq+1:jq+nm)%isAdvected  = [ (.FALSE., im=1, nm) ]
     346      ttr(jq + 1:jq + nm) = t1
     347      ttr(jq + 1:jq + nm)%name = [ (TRIM(t1%name) // '-' // TRIM(suff(im)), im = 1, nm) ]
     348      ttr(jq + 1:jq + nm)%parent = [ (TRIM(t1%parent) // '-' // TRIM(suff(im)), im = 1, nm) ]
     349      ttr(jq + 1:jq + nm)%longName = [ (TRIM(t1%longName) // '-' // TRIM(suff(im)), im = 1, nm) ]
     350      ttr(jq + 1:jq + nm)%iadv = [ (-iad, im = 1, nm) ]
     351      ttr(jq + 1:jq + nm)%isAdvected = [ (.FALSE., im = 1, nm) ]
    352352      jq = jq + nm
    353    END DO
    354    DEALLOCATE(hadv, vadv)
    355    CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    356 
    357    !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
    358    IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem with tracers indices update', 1)
    359 
    360    !=== TEST ADVECTION SCHEME
    361    DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv
    362 
    363       !--- ONLY TESTED VALUES FOR TRACERS FOR NOW:               iadv = 14, 10 (and 0 for non-transported tracers)
    364       IF(ALL([10,14,0] /= iad)) &
    365          CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1)
    366 
    367       !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
    368       IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) &
    369          CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1)
    370 
    371       !--- ONLY TESTED VALUES FOR CHILDS FOR NOW:                iadv = 10     (CHILDS:  TRACERS OF GENERATION GREATER THAN 1)
    372       IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',&
    373          modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10
    374 
    375       !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR:            iadv = 14
    376       ll = t1%name /= addPhase('H2O','g')
    377       IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', &
    378          modname, iad == 14 .AND. ll))                 t1%iadv = 10
    379    END DO
    380 
    381    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
    382    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
    383    IF(processIsotopes()) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
    384 
    385    !--- Convection / boundary layer activation for all tracers
    386    ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
    387    ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
    388 
    389    !--- Note: nqtottr can differ from nbtr when nmom/=0
    390    nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    391    IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    392       CALL abort_gcm(modname, 'problem with the computation of nqtottr', 1)
    393 
    394    !=== DISPLAY THE RESULTS
    395    CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    396    CALL msg('nbtr   = '//TRIM(int2str(nbtr)),  modname)
    397    CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    398    CALL msg('nqtot  = '//TRIM(int2str(nqtot)), modname)
    399    CALL msg('niso   = '//TRIM(int2str(niso)),  modname)
    400    CALL msg('ntiso  = '//TRIM(int2str(ntiso)), modname)
    401    IF (CPPKEY_INCA) THEN
    402       CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)), modname)
    403       CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    404    END IF
    405    t => tracers
    406    CALL msg('Information stored in infotrac :', modname)
    407 
    408    IF(dispTable('isssssssssiiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',    &
    409                 'isPh', 'isAd', 'iadv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],  &
    410       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
    411                                                                                   bool2str(t%isAdvected)), &
    412       cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
    413                   t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    414       CALL abort_gcm(modname, "problem with the tracers table content", 1)
    415    IF(niso > 0) THEN
    416       CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
    417       CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    418       CALL msg('  isoName = '//strStack(isoName),      modname)
    419       CALL msg('  isoZone = '//strStack(isoZone),      modname)
    420       CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
    421    ELSE
     353    END DO
     354    DEALLOCATE(hadv, vadv)
     355    CALL MOVE_ALLOC(FROM = ttr, TO = tracers)
     356
     357    !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
     358    IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem with tracers indices update', 1)
     359
     360    !=== TEST ADVECTION SCHEME
     361    DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv
     362
     363    !--- ONLY TESTED VALUES FOR TRACERS FOR NOW:               iadv = 14, 10 (and 0 for non-transported tracers)
     364    IF(ALL([10, 14, 0] /= iad)) &
     365            CALL abort_gcm(modname, 'Not tested for iadv=' // TRIM(int2str(iad)) // ' ; 10 or 14 only are allowed !', 1)
     366
     367    !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
     368    IF(ALL([10, 14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) &
     369            CALL abort_gcm(modname, 'iadv=' // TRIM(int2str(iad)) // ' not implemented for parents ; 10 or 14 only are allowed !', 1)
     370
     371    !--- ONLY TESTED VALUES FOR CHILDS FOR NOW:                iadv = 10     (CHILDS:  TRACERS OF GENERATION GREATER THAN 1)
     372    IF(fmsg('WARNING ! iadv=' // TRIM(int2str(iad)) // ' not implemented for childs. Setting iadv=10 for "' // TRIM(t1%name) // '"', &
     373            modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10
     374
     375    !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR:            iadv = 14
     376    ll = t1%name /= addPhase('H2O', 'g')
     377    IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "' // TRIM(t1%name) // '".', &
     378            modname, iad == 14 .AND. ll))                 t1%iadv = 10
     379    END DO
     380
     381    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
     382    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
     383    IF(processIsotopes()) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
     384
     385    !--- Convection / boundary layer activation for all tracers
     386    ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
     387    ALLOCATE(pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
     388
     389    !--- Note: nqtottr can differ from nbtr when nmom/=0
     390    nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
     391    IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
     392            CALL abort_gcm(modname, 'problem with the computation of nqtottr', 1)
     393
     394    !=== DISPLAY THE RESULTS
     395    CALL msg('nqo    = ' // TRIM(int2str(nqo)), modname)
     396    CALL msg('nbtr   = ' // TRIM(int2str(nbtr)), modname)
     397    CALL msg('nqtrue = ' // TRIM(int2str(nqtrue)), modname)
     398    CALL msg('nqtot  = ' // TRIM(int2str(nqtot)), modname)
     399    CALL msg('niso   = ' // TRIM(int2str(niso)), modname)
     400    CALL msg('ntiso  = ' // TRIM(int2str(ntiso)), modname)
     401    IF (CPPKEY_INCA) THEN
     402      CALL msg('nqCO2  = ' // TRIM(int2str(nqCO2)), modname)
     403      CALL msg('nqINCA = ' // TRIM(int2str(nqINCA)), modname)
     404    END IF
     405    t => tracers
     406    CALL msg('Information stored in infotrac :', modname)
     407
     408    IF(dispTable('isssssssssiiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', &
     409            'isPh', 'isAd', 'iadv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], &
     410            cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
     411                    bool2str(t%isAdvected)), &
     412            cat([(iq, iq = 1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
     413                    t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax = maxTableWidth, nHead = 2, sub = modname))   &
     414            CALL abort_gcm(modname, "problem with the tracers table content", 1)
     415    IF(niso > 0) THEN
     416      CALL msg('Where, for isotopes family "' // TRIM(isotope%parent) // '":', modname)
     417      CALL msg('  isoKeys%name = ' // strStack(isoKeys%name), modname)
     418      CALL msg('  isoName = ' // strStack(isoName), modname)
     419      CALL msg('  isoZone = ' // strStack(isoZone), modname)
     420      CALL msg('  isoPhas = ' // TRIM(isoPhas), modname)
     421    ELSE
    422422      CALL msg('No isotopes identified.', modname)
    423    END IF
    424    CALL msg('end', modname)
    425 
    426 END SUBROUTINE init_infotrac
     423    END IF
     424    CALL msg('end', modname)
     425
     426  END SUBROUTINE init_infotrac
    427427
    428428END MODULE infotrac

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.F

    r5082 r5098  
    4343      save first
    4444
    45       REAL      SSUM,CVMGP,CVMGT
     45      REAL      SSUM
    4646      integer ismax,ismin
    4747      EXTERNAL  SSUM, ismin,ismax

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.F

    r5082 r5098  
    4343      save first
    4444
    45       REAL      SSUM,CVMGP,CVMGT
     45      REAL      SSUM
    4646      integer ismax,ismin
    4747      EXTERNAL  SSUM, ismin,ismax
Note: See TracChangeset for help on using the changeset viewer.