Changeset 3852 for LMDZ6/branches/LMDZ-tracers/libf/phylmd
- Timestamp:
- Feb 22, 2021, 5:28:31 PM (3 years ago)
- Location:
- LMDZ6/branches/LMDZ-tracers/libf/phylmd
- Files:
-
- 9 edited
-
cvltr.F90 (modified) (1 diff)
-
cvltr_scav.F90 (modified) (1 diff)
-
cvltr_spl.F90 (modified) (1 diff)
-
infotrac_phy.F90 (modified) (1 diff)
-
phyetat0.F90 (modified) (2 diffs)
-
phyredem.F90 (modified) (2 diffs)
-
phys_output_mod.F90 (modified) (2 diffs)
-
phys_output_write_mod.F90 (modified) (2 diffs)
-
traclmdz_mod.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-tracers/libf/phylmd/cvltr.F90
r2320 r3852 12 12 USE IOIPSL 13 13 USE dimphy 14 USE infotrac_phy, ONLY : nbtr ,tname14 USE infotrac_phy, ONLY : nbtr 15 15 IMPLICIT NONE 16 16 !===================================================================== -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/cvltr_scav.F90
r2320 r3852 13 13 USE IOIPSL 14 14 USE dimphy 15 USE infotrac_phy, ONLY : nbtr ,tname15 USE infotrac_phy, ONLY : nbtr 16 16 IMPLICIT NONE 17 17 !===================================================================== -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/cvltr_spl.F90
r2320 r3852 13 13 USE IOIPSL 14 14 USE dimphy 15 USE infotrac_phy, ONLY : nbtr ,tname15 USE infotrac_phy, ONLY : nbtr 16 16 IMPLICIT NONE 17 17 !===================================================================== -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90
r3677 r3852 1 2 ! $Id: $3 4 1 MODULE infotrac_phy 5 2 6 ! Infotrac for physics; for now contains the same information as infotrac for 7 ! the dynamics (could be further cleaned) and is initialized using values 8 ! provided by the dynamics 9 10 ! nqtot : total number of tracers and higher order of moment, water vapor and liquid included 11 INTEGER, SAVE :: nqtot 12 !$OMP THREADPRIVATE(nqtot) 13 14 !CR: on ajoute le nombre de traceurs de l eau 15 INTEGER, SAVE :: nqo 16 !$OMP THREADPRIVATE(nqo) 17 18 ! nbtr : number of tracers not including higher order of moment or water vapor or liquid 19 ! number of tracers used in the physics 20 INTEGER, SAVE :: nbtr 21 !$OMP THREADPRIVATE(nbtr) 22 3 USE strings_mod, ONLY: msg, fmsg, test, strIdx, int2str 4 5 USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate 6 7 USE trac_types_mod, ONLY: tra, iso, kys 8 9 IMPLICIT NONE 10 11 PRIVATE 12 13 !=== FOR TRACERS: 14 PUBLIC :: tra, tracers, type_trac !--- Derived type, full database, tracers type keyword 15 PUBLIC :: nqtot, nbtr, nqo !--- Main dimensions 16 PUBLIC :: init_infotrac_phy !--- Initialization 17 PUBLIC :: itr_indice !--- Indexes of the tracers passed to phytrac 18 PUBLIC :: niadv !--- Indexes of true tracers (<=nqtot, such that iadv(idx)>0) 19 PUBLIC :: pbl_flg, conv_flg, solsym 20 21 !=== FOR ISOTOPES: General 22 !--- General 23 PUBLIC :: iso, isotopes, nbIso !--- Derived type, full isotopes families database + nb of families 24 PUBLIC :: isoSelect , ixIso !--- Isotopes family selection tool + selected family index 25 !=== FOR ISOTOPES: Specific to H2O isotopes 26 PUBLIC :: iH2O, tnat, alpha_ideal !--- H2O isotopes index, natural abundance, fractionning coeff. 27 !=== FOR ISOTOPES: Depending on selected isotopes family 28 PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey) 29 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 30 PUBLIC :: niso, nzon, npha, nitr !--- " " numbers + isotopes & tagging tracers number 31 PUBLIC :: iZonIso, iTraPha !--- 2D index tables to get "iq" index 32 PUBLIC :: isoCheck !--- Run isotopes checking routines 33 34 !=== FOR BOTH TRACERS AND ISOTOPES 35 PUBLIC :: getKey !--- Get a key from "tracers" or "isotope" 36 37 !=== FOR STRATOSPHERIC AEROSOLS 23 38 #ifdef CPP_StratAer 24 ! nbtr_bin: number of aerosol bins for StratAer model 25 ! nbtr_sulgas: number of sulfur gases for StratAer model 26 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas 27 !$OMP THREADPRIVATE(nbtr_bin,nbtr_sulgas) 28 INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat 29 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat) 39 PUBLIC :: nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat 30 40 #endif 31 41 32 ! CRisi: nb traceurs pères= directement advectés par l'air 33 INTEGER, SAVE :: nqperes 34 !$OMP THREADPRIVATE(nqperes) 35 36 ! Name variables 37 CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics 38 CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics 39 !$OMP THREADPRIVATE(tname,ttext) 40 41 !! iadv : index of trasport schema for each tracer 42 ! INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iadv 43 44 ! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the 45 ! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 46 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique 47 !$OMP THREADPRIVATE(niadv) 48 49 ! CRisi: tableaux de fils 50 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqfils 51 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations 52 INTEGER, SAVE :: nqdesc_tot 53 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqfils 54 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iqpere 55 !$OMP THREADPRIVATE(nqfils,nqdesc,nqdesc_tot,iqfils,iqpere) 56 57 ! conv_flg(it)=0 : convection desactivated for tracer number it 58 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg 59 !$OMP THREADPRIVATE(conv_flg) 60 61 ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it 62 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg 63 !$OMP THREADPRIVATE(pbl_flg) 64 65 CHARACTER(len=4),SAVE :: type_trac 66 !$OMP THREADPRIVATE(type_trac) 67 CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym 68 !$OMP THREADPRIVATE(solsym) 69 70 ! CRisi: cas particulier des isotopes 71 LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso 72 !$OMP THREADPRIVATE(ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso) 73 INTEGER :: niso_possibles 74 PARAMETER ( niso_possibles=5) 75 real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal 76 !$OMP THREADPRIVATE(tnat,alpha_ideal) 77 LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso 78 !$OMP THREADPRIVATE(use_iso) 79 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase) 80 !$OMP THREADPRIVATE(iqiso) 81 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot 82 !$OMP THREADPRIVATE(iso_num) 83 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot 84 !$OMP THREADPRIVATE(iso_indnum) 85 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: zone_num ! donne numéro de la zone de tracage en fn de nqtot 86 !$OMP THREADPRIVATE(zone_num) 87 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: phase_num ! donne numéro de la zone de tracage en fn de nqtot 88 !$OMP THREADPRIVATE(phase_num) 89 INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles 90 !$OMP THREADPRIVATE(indnum_fn_num) 91 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numéro ixt en fn izone, indnum entre 1 et niso 92 !$OMP THREADPRIVATE(index_trac) 93 INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso 94 !$OMP THREADPRIVATE(niso,ntraceurs_zone,ntraciso) 95 42 INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect 43 44 !=== CONVENTIONS FOR TRACERS NUMBERS: 45 ! |--------------------+----------------------+-----------------+---------------+----------------------------| 46 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 47 ! | phases: H2O-[gls] | isotopes | | | for higher order schemes | 48 ! |--------------------+----------------------+-----------------+---------------+----------------------------| 49 ! | | | | | | 50 ! |<-- nqo -->|<-- nqo*niso* nzon -->|<-- nqo*niso -->|<-- nbtr -->|<-- (nmom) -->| 51 ! | | | | 52 ! | |<-- nqo*niso*(nzon+1) = nqo*nitr -->|<-- nqtottr = nbtr + nmom -->| 53 ! | = nqtot - nqo*(nitr+1) | 54 ! | | 55 ! |<-- nqtrue = nbtr + nqo*(nitr+1) -->| | 56 ! | | 57 ! |<-- nqtot = nqtrue + nmom -->| 58 ! | | 59 ! |----------------------------------------------------------------------------------------------------------| 60 ! NOTES FOR THIS TABLE: 61 ! * The used "niso", "nzon" and "nitr" are the H2O components of "isotopes(ip)" (isotopes(ip)%prnt == 'H2O'), 62 ! since water is so far the sole tracers family removed from the main tracers table. 63 ! * For water, "nqo" is equal to the more general field "isotopes(ip)%npha". 64 ! * "niso", "nzon", "nitr", "npha" are defined for other isotopic tracers families, if any. 65 ! 66 !=== TRACERS DESCRIPTOR: DERIVED TYPE EMBEDDING MOST OF THE USEFUL QUANTITIES (LENGTH: nqtot) 67 ! Each entry is accessible using "%" sign. 68 ! |------------+-------------------------------------------------+-------------+------------------------+ 69 ! | entry | Meaning | Former name | Possible values | 70 ! |------------+-------------------------------------------------+-------------+------------------------+ 71 ! | name | Name (short) | tname | | 72 ! | nam1 | Name of the 1st generation ancestor | / | | 73 ! | prnt | Name of the parent | / | | 74 ! | lnam | Long name (with adv. scheme suffix) for outputs | ttext | | 75 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 76 ! | phas | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 77 ! | iadv | Advection scheme number | iadv | 1-20,30 exc. 3-9,15,19 | 78 ! | igen | Generation (>=1) | / | | 79 ! | itr | Index in "tr_seri" (0: absent from physics) | cf. niadv | 1:nqtottr | 80 ! | iprnt | Index of the parent tracer | iqpere | 1:nqtot | 81 ! | idesc | Indexes of the childs (all generations) | iqfils | 1:nqtot | 82 ! | ndesc | Number of the descendants (all generations) | nqdesc | 1:nqtot | 83 ! | nchld | Number of childs (first generation only) | nqfils | 1:nqtot | 84 ! | keys | key/val pairs accessible with "getKey" routine | / | | 85 ! | iso_num | Isotope name index in iso(igr)%name(:) | iso_indnum | 1:niso | 86 ! | iso_zon | Isotope zone index in iso(igr)%zone(:) | zone_num | 1:nzon | 87 ! | iso_pha | Isotope phase index in iso(igr)%phas | phase_num | 1:npha | 88 ! +------------+-------------------------------------------------+-------------+------------------------+ 89 ! 90 !=== ISOTOPES DESCRIPTOR: DERIVED TYPE EMBEDDING MOST OF THE USEFUL QUANTITIES (LENGTH: NUMBER OF ISOTOPES FAMILIES USED) 91 ! Each entry is accessible using "%" sign. 92 ! |------------+-------------------------------------------------+-------------+-----------------------+ 93 ! | entry | Meaning | Former name | Possible values | 94 ! |------------+-------------------------------------------------+-------------+-----------------------+ 95 ! | prnt | Parent tracer (isotopes family name) | | | 96 ! | trac, nitr | Isotopes & tagging tracers + number of elements | | | 97 ! | zone, nzon | Geographic tagging zones + number of elements | | | 98 ! | phas, npha | Phases list + number of elements | | [g][l][s], 1:3 | 99 ! | niso | Number of isotopes, excluding tagging tracers | | | 100 ! | iTraPha | Index in "xt" = f(iname(niso+1:nitr),iphas) | iqiso | 1:niso | 101 ! | iZonIso | Index in "xt" = f(izone, iname(1:niso)) | index_trac | 1:nzon | 102 ! |------------+-------------------------------------------------+-------------+-----------------------+ 103 104 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 105 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments & water) 106 nbtr, & !--- Tracers nb in physics (excl. higher moments & water) 107 nqo, & !--- Number of water phases 108 nbIso !--- Number of available isotopes family 109 CHARACTER(LEN=256), SAVE :: type_trac !--- Keyword for tracers type 110 111 !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES 112 TYPE(tra), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR 113 TYPE(iso), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR 114 !$OMP THREADPRIVATE(tracers, isotopes) 115 116 !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes" 117 TYPE(iso), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 118 INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family 119 LOGICAL, SAVE, POINTER :: isoCheck !--- Flag to trigger the checking routines 120 TYPE(kys), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 121 CHARACTER(LEN=256), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY 122 isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY 123 isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY 124 INTEGER, SAVE :: niso, nzon, npha, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES 125 nitr !--- NUMBER OF ISOTOPES + ISOTOPIC TAGGING TRACERS 126 INTEGER, SAVE, POINTER :: iZonIso(:,:) !--- INDEX IN "isoTrac" AS f(tagging zone, isotope) 127 INTEGER, SAVE, POINTER :: iTraPha(:,:) !=== INDEX IN "isoTrac" AS f(isotopic tracer, phase) 128 !$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzon,npha,nitr, iZonIso,iTraPha) 129 130 !=== VARIABLES EMBEDDED IN "tracers", BUT DUPLICATED, AS THEY ARE RATHER FREQUENTLY USED + VARIABLES FOR INCA 131 REAL, SAVE, ALLOCATABLE :: tnat(:), & !--- Natural relative abundance of water isotope (niso) 132 alpha_ideal(:) !--- Ideal fractionning coefficient (for initial state) (niso) 133 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 134 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 135 INTEGER, SAVE, ALLOCATABLE :: niadv(:), & 136 itr_indice(:) !--- Indexes of the tracers passed to phytrac (nqtottr) 137 CHARACTER(LEN=256), SAVE, ALLOCATABLE :: solsym(:) !--- Names from INCA (nbtr) 138 !OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, niadv, itr_indice, solsym) 139 140 #ifdef CPP_StratAer 141 !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB) 142 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat 143 !OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat) 144 #endif 145 96 146 CONTAINS 97 147 98 SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,tname_,ttext_,type_trac_,& 99 niadv_,conv_flg_,pbl_flg_,solsym_,& 100 nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,& 101 ok_isotopes_,ok_iso_verif_,ok_isotrac_,& 102 ok_init_iso_,niso_possibles_,tnat_,& 103 alpha_ideal_,use_iso_,iqiso_,iso_num_,& 104 iso_indnum_,zone_num_,phase_num_,& 105 indnum_fn_num_,index_trac_,& 106 niso_,ntraceurs_zone_,ntraciso_& 148 SUBROUTINE init_infotrac_phy(tracers_, isotopes_, type_trac_, solsym_, nbtr_, niadv_, pbl_flg_, conv_flg_) 149 ! transfer information on tracers from dynamics to physics 150 USE print_control_mod, ONLY: prt_level, lunout 151 IMPLICIT NONE 152 TYPE(tra), INTENT(IN) :: tracers_(:) 153 TYPE(iso), INTENT(IN) :: isotopes_(:) 154 CHARACTER(LEN=*), INTENT(IN) :: type_trac_, solsym_(:) 155 INTEGER, INTENT(IN) :: nbtr_, niadv_(:), pbl_flg_(:), conv_flg_(:) 156 157 CHARACTER(LEN=256) :: modname="init_infotrac_phy" 158 LOGICAL :: lerr 159 160 tracers = tracers_ 161 isotopes = isotopes_ 162 type_trac = type_trac_ 163 solsym = solsym_ 164 nqtot = SIZE(tracers_) 165 nbtr = nbtr_ 166 niadv = niadv_ 167 nbIso = SIZE(isotopes_) 168 pbl_flg = pbl_flg_ 169 conv_flg = conv_flg_ 170 171 !=== Specific to water 172 CALL getKey_init(tracers, isotopes) 173 IF(.NOT.isoSelect('H2O')) THEN 174 iH2O = ixIso 175 lerr = getKey('tnat' ,tnat, isoName) 176 lerr = getKey('alpha',alpha_ideal, isoName) 177 nqo = isotope%npha 178 END IF 179 IF(prt_level > 1) WRITE(lunout,*) TRIM(modname)//": nqtot, nqo, nbtr = ",nqtot, nqo, nbtr 180 itr_indice = PACK(tracers(:)%itr, MASK = tracers(:)%itr/=0) 181 print*,'66' 182 183 !? conv_flg, pbl_flg, solsym 184 !? isoInit 185 107 186 #ifdef CPP_StratAer 108 ,nbtr_bin_,nbtr_sulgas_& 109 ,id_OCS_strat_,id_SO2_strat_,id_H2SO4_strat_,id_BIN01_strat_& 187 IF (type_trac == 'coag') THEN 188 nbtr_bin=0 189 nbtr_sulgas=0 190 DO iq = 1, nqtrue 191 IF(tracers(iq)%name(1:3)=='BIN') nbtr_bin = nbtr_bin +1 192 IF(tracers(iq)%name(1:3)=='GAS') nbtr_sulgas = nbtr_sulgas+1 193 SELECT CASE(tracers(iq)%name) 194 CASE('BIN01'); id_BIN01_strat = iq - nqo; CALL msg('id_BIN01_strat=', id_BIN01_strat) 195 CASE('GASOCS'); id_OCS_strat = iq - nqo; CALL msg('id_OCS_strat =', id_OCS_strat) 196 CASE('GASSO2'); id_SO2_strat = iq - nqo; CALL msg('id_SO2_strat =', id_SO2_strat) 197 CASE('GASH2SO4'); id_H2SO4_strat = iq - nqo; CALL msg('id_H2SO4_strat=', id_H2SO4_strat) 198 CASE('GASTEST'); id_TEST_strat = iq - nqo; CALL msg('id_TEST_strat=' , id_TEST_strat) 199 END SELECT 200 END DO 201 CALL msg('nbtr_bin =',nbtr_bin) 202 CALL msg('nbtr_sulgas =',nbtr_sulgas) 203 END IF 110 204 #endif 111 ) 112 113 ! transfer information on tracers from dynamics to physics 114 USE print_control_mod, ONLY: prt_level, lunout 115 IMPLICIT NONE 116 117 INTEGER,INTENT(IN) :: nqtot_ 118 INTEGER,INTENT(IN) :: nqo_ 119 INTEGER,INTENT(IN) :: nbtr_ 120 #ifdef CPP_StratAer 121 INTEGER,INTENT(IN) :: nbtr_bin_ 122 INTEGER,INTENT(IN) :: nbtr_sulgas_ 123 INTEGER,INTENT(IN) :: id_OCS_strat_ 124 INTEGER,INTENT(IN) :: id_SO2_strat_ 125 INTEGER,INTENT(IN) :: id_H2SO4_strat_ 126 INTEGER,INTENT(IN) :: id_BIN01_strat_ 127 #endif 128 CHARACTER(len=20),INTENT(IN) :: tname_(nqtot_) ! tracer short name for restart and diagnostics 129 CHARACTER(len=23),INTENT(IN) :: ttext_(nqtot_) ! tracer long name for diagnostics 130 CHARACTER(len=4),INTENT(IN) :: type_trac_ 131 INTEGER,INTENT(IN) :: niadv_ (nqtot_) ! equivalent dyn / physique 132 INTEGER,INTENT(IN) :: conv_flg_(nbtr_) 133 INTEGER,INTENT(IN) :: pbl_flg_(nbtr_) 134 CHARACTER(len=8),INTENT(IN) :: solsym_(nbtr_) 135 ! Isotopes: 136 INTEGER,INTENT(IN) :: nqfils_(nqtot_) 137 INTEGER,INTENT(IN) :: nqdesc_(nqtot_) 138 INTEGER,INTENT(IN) :: nqdesc_tot_ 139 INTEGER,INTENT(IN) :: iqfils_(nqtot_,nqtot_) 140 INTEGER,INTENT(IN) :: iqpere_(nqtot_) 141 LOGICAL,INTENT(IN) :: ok_isotopes_ 142 LOGICAL,INTENT(IN) :: ok_iso_verif_ 143 LOGICAL,INTENT(IN) :: ok_isotrac_ 144 LOGICAL,INTENT(IN) :: ok_init_iso_ 145 INTEGER,INTENT(IN) :: niso_possibles_ 146 REAL,INTENT(IN) :: tnat_(niso_possibles_) 147 REAL,INTENT(IN) :: alpha_ideal_(niso_possibles_) 148 LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_) 149 INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_) 150 INTEGER,INTENT(IN) :: iso_num_(nqtot_) 151 INTEGER,INTENT(IN) :: iso_indnum_(nqtot_) 152 INTEGER,INTENT(IN) :: zone_num_(nqtot_) 153 INTEGER,INTENT(IN) :: phase_num_(nqtot_) 154 INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_) 155 INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_) 156 INTEGER,INTENT(IN) :: niso_ 157 INTEGER,INTENT(IN) :: ntraceurs_zone_ 158 INTEGER,INTENT(IN) :: ntraciso_ 159 160 CHARACTER(LEN=30) :: modname="init_infotrac_phy" 161 162 nqtot=nqtot_ 163 nqo=nqo_ 164 nbtr=nbtr_ 165 #ifdef CPP_StratAer 166 nbtr_bin=nbtr_bin_ 167 nbtr_sulgas=nbtr_sulgas_ 168 id_OCS_strat=id_OCS_strat_ 169 id_SO2_strat=id_SO2_strat_ 170 id_H2SO4_strat=id_H2SO4_strat_ 171 id_BIN01_strat=id_BIN01_strat_ 172 #endif 173 ALLOCATE(tname(nqtot)) 174 tname(:) = tname_(:) 175 ALLOCATE(ttext(nqtot)) 176 ttext(:) = ttext_(:) 177 type_trac = type_trac_ 178 ALLOCATE(niadv(nqtot)) 179 niadv(:)=niadv_(:) 180 ALLOCATE(conv_flg(nbtr)) 181 conv_flg(:)=conv_flg_(:) 182 ALLOCATE(pbl_flg(nbtr)) 183 pbl_flg(:)=pbl_flg_(:) 184 ALLOCATE(solsym(nbtr)) 185 solsym(:)=solsym_(:) 186 187 IF(prt_level.ge.1) THEN 188 write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr",nqtot,nqo,nbtr 189 ENDIF 190 191 ! Isotopes: 192 193 ! First check that the "niso_possibles" has the correct value 194 IF (niso_possibles.ne.niso_possibles_) THEN 195 CALL abort_physic(modname,& 196 "wrong value for parameter niso_possibles in infotrac_phy",1) 197 ENDIF 198 199 ok_isotopes=ok_isotopes_ 200 ok_iso_verif=ok_iso_verif_ 201 ok_isotrac=ok_isotrac_ 202 ok_init_iso=ok_init_iso_ 203 204 niso=niso_ 205 ntraceurs_zone=ntraceurs_zone_ 206 ntraciso=ntraciso_ 207 208 IF (ok_isotopes) THEN 209 ALLOCATE(nqfils(nqtot)) 210 nqfils(:)=nqfils_(:) 211 ALLOCATE(nqdesc(nqtot)) 212 nqdesc(:)=nqdesc_(:) 213 nqdesc_tot=nqdesc_tot_ 214 ALLOCATE(iqfils(nqtot,nqtot)) 215 iqfils(:,:)=iqfils_(:,:) 216 ALLOCATE(iqpere(nqtot)) 217 iqpere(:)=iqpere_(:) 218 219 tnat(:)=tnat_(:) 220 alpha_ideal(:)=alpha_ideal_(:) 221 use_iso(:)=use_iso_(:) 222 223 ALLOCATE(iqiso(ntraciso,nqo)) 224 iqiso(:,:)=iqiso_(:,:) 225 ALLOCATE(iso_num(nqtot)) 226 iso_num(:)=iso_num_(:) 227 ALLOCATE(iso_indnum(nqtot)) 228 iso_indnum(:)=iso_indnum_(:) 229 ALLOCATE(zone_num(nqtot)) 230 zone_num(:)=zone_num_(:) 231 ALLOCATE(phase_num(nqtot)) 232 phase_num(:)=phase_num_(:) 233 234 indnum_fn_num(:)=indnum_fn_num_(:) 235 236 ALLOCATE(index_trac(ntraceurs_zone,niso)) 237 index_trac(:,:)=index_trac_(:,:) 238 ENDIF ! of IF(ok_isotopes) 239 240 END SUBROUTINE init_infotrac_phy 205 206 END SUBROUTINE init_infotrac_phy 207 208 209 !============================================================================================================================== 210 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED 211 ! Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first time). 212 !============================================================================================================================== 213 LOGICAL FUNCTION isoSelectByName(iName) RESULT(lerr) 214 CHARACTER(LEN=*), INTENT(IN) :: iName 215 INTEGER :: iIso 216 iIso = strIdx(isotopes(:)%prnt, iName) 217 IF(test(fmsg(iIso == 0,'no isotope family named "'//TRIM(iName)//'"'),lerr)) RETURN 218 IF(isoSelectByIndex(iIso)) RETURN 219 END FUNCTION isoSelectByName 220 !============================================================================================================================== 221 LOGICAL FUNCTION isoSelectByIndex(iIso) RESULT(lerr) 222 INTEGER, INTENT(IN) :: iIso 223 lerr = .FALSE. 224 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK 225 IF(test(fmsg(iIso<=0 .OR. iIso>=nbIso,'Inconsistent isotopes family index '//TRIM(int2str(iIso))),lerr)) RETURN 226 ixIso = iIso !--- Update currently selected family index 227 isotope => isotopes(ixIso) !--- Select corresponding component 228 !--- VARIOUS ALIASES 229 isoKeys => isotope%keys; niso = isotope%niso 230 isoName => isotope%trac; nitr = isotope%nitr; isoCheck => isotope%check 231 isoZone => isotope%zone; nzon = isotope%nzon; iZonIso => isotope%iZonIso 232 isoPhas => isotope%phas; npha = isotope%npha; iTraPha => isotope%iTraPha 233 END FUNCTION isoSelectByIndex 234 !============================================================================================================================== 241 235 242 236 END MODULE infotrac_phy -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyetat0.F90
r3851 r3852 23 23 USE geometry_mod, ONLY : longitude_deg, latitude_deg 24 24 USE iostart, ONLY : close_startphy, get_field, get_var, open_startphy 25 USE infotrac_phy, only: nbtr, nqo, type_trac, t name, niadv25 USE infotrac_phy, only: nbtr, nqo, type_trac, tracers, niadv 26 26 USE traclmdz_mod, ONLY : traclmdz_from_restart 27 27 USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl, co2_send … … 443 443 !! iiq=niadv(it+2) ! jyg 444 444 iiq=niadv(it+nqo) ! jyg 445 found=phyetat0_get(1,trs(:,it),"trs_"//t name(iiq), &446 "Surf trac"//t name(iiq),0.)445 found=phyetat0_get(1,trs(:,it),"trs_"//tracers(iiq)%name, & 446 "Surf trac"//tracers(iiq)%name,0.) 447 447 ENDDO 448 448 CALL traclmdz_from_restart(trs) -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyredem.F90
r3851 r3852 33 33 USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var 34 34 USE traclmdz_mod, ONLY : traclmdz_to_restart 35 USE infotrac_phy, ONLY: type_trac, niadv, t name, nbtr, nqo35 USE infotrac_phy, ONLY: type_trac, niadv, tracers, nbtr, nqo 36 36 USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send 37 37 USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic, epsfra … … 311 311 !! iiq=niadv(it+2) ! jyg 312 312 iiq=niadv(it+nqo) ! jyg 313 CALL put_field(pass,"trs_"//t name(iiq), "", trs(:, it))313 CALL put_field(pass,"trs_"//tracers(iiq)%name, "", trs(:, it)) 314 314 END DO 315 315 IF (carbon_cycle_cpl) THEN -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_mod.F90
r3851 r3852 35 35 USE iophy 36 36 USE dimphy 37 USE infotrac_phy, ONLY: nqtot, nqo, niadv, t name, ttext, type_trac37 USE infotrac_phy, ONLY: nqtot, nqo, niadv, tracers, type_trac 38 38 USE ioipsl 39 39 USE phys_cal_mod, only : hour, calend … … 143 143 REAL, DIMENSION(NSW,2) :: spbnds_sun !bounds of spectband 144 144 145 CHARACTER(LEN=256), POINTER :: tname(:), ttext(:) 146 145 147 WRITE(lunout,*) 'Debut phys_output_mod.F90' 148 tname => tracers(:)%name 149 ttext => tracers(:)%lnam 150 146 151 ! Initialisations (Valeurs par defaut 147 152 -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/phys_output_write_mod.F90
r3851 r3852 363 363 USE pbl_surface_mod, ONLY: snow 364 364 USE indice_sol_mod, ONLY: nbsrf 365 USE infotrac_phy, ONLY: nqtot, nqo, type_trac, t name, niadv365 USE infotrac_phy, ONLY: nqtot, nqo, type_trac, tracers, niadv 366 366 USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg 367 367 USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, landice_opt … … 449 449 REAL,DIMENSION(klon,klev) :: z, dz 450 450 REAL,DIMENSION(klon) :: zrho, zt 451 CHARACTER(LEN=256), POINTER :: tname(:) 452 453 tname => tracers(:)%name 451 454 452 455 ! On calcul le nouveau tau: -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/traclmdz_mod.F90
r3581 r3852 67 67 68 68 USE dimphy 69 USE infotrac_phy 69 USE infotrac_phy, ONLY: nbtr 70 70 71 71 ! Input argument … … 89 89 ! Initialization of the tracers should be done here only for those not found in the restart file. 90 90 USE dimphy 91 USE infotrac_phy 91 USE infotrac_phy, ONLY: tracers, nqo, nbtr, niadv, pbl_flg, conv_flg 92 92 USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz 93 93 USE press_coefoz_m, ONLY: press_coefoz … … 175 175 !! iiq=niadv(it+2) ! jyg 176 176 iiq=niadv(it+nqo) ! jyg 177 IF ( tname(iiq) == "RN" ) THEN 178 id_rn=it ! radon 179 ELSE IF ( tname(iiq) == "PB") THEN 180 id_pb=it ! plomb 177 !----------------------------------------------------------------------- 178 SELECT CASE(tracers(iiq)%name) 179 !----------------------------------------------------------------------- 180 CASE("RN"); id_rn=it ! radon 181 !----------------------------------------------------------------------- 182 CASE("PB"); id_pb=it ! plomb 181 183 ! RomP >>> profil initial de PB210 182 184 open (ilesfil2,file='prof.pb210',status='old',iostat=irr2) … … 198 200 ENDIF 199 201 ! RomP <<< 200 ELSE IF ( tname(iiq) == "Aga" .OR. tname(iiq) == "AGA" ) THEN 201 ! Age of stratospheric air 202 id_aga=it 202 !----------------------------------------------------------------------- 203 CASE("Aga","AGA"); id_aga = it ! Age of stratospheric air 203 204 radio(id_aga) = .FALSE. 204 205 aerosol(id_aga) = .FALSE. … … 213 214 lev_1p5km=klev/2 214 215 END IF 215 ELSE IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR. & 216 tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN 217 ! Recherche du Beryllium 7 218 id_be=it 216 !----------------------------------------------------------------------- 217 CASE("BE","Be","BE7","Be7"); id_be = it ! Recherche du Beryllium 7 219 218 ALLOCATE( srcbe(klon,klev) ) 220 219 radio(id_be) = .TRUE. … … 243 242 ENDIF 244 243 ! RomP <<< 245 ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN 246 ! Recherche de l'ozone : parametrization de la chimie par Cariolle 247 id_o3=it 248 CALL alloc_coefoz ! allocate ozone coefficients 249 CALL press_coefoz ! read input pressure levels 250 ELSE IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN 251 id_pcsat=it 252 ELSE IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN 253 id_pcocsat=it 254 ELSE IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN 255 id_pcq=it 256 ELSE IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN 257 id_pcs0=it 258 conv_flg(it)=0 ! No transport by convection for this tracer 259 ELSE IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN 260 id_pcos0=it 261 conv_flg(it)=0 ! No transport by convection for this tracer 262 ELSE IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN 263 id_pcq0=it 264 conv_flg(it)=0 ! No transport by convection for this tracer 265 ELSE 266 WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tname(iiq)) 267 END IF 244 !----------------------------------------------------------------------- 245 CASE("O3","o3"); id_o3 = it 246 ! Recherche de l'ozone : parametrization de la chimie par Cariolle 247 CALL alloc_coefoz ! allocate ozone coefficients 248 CALL press_coefoz ! read input pressure levels 249 !----------------------------------------------------------------------- 250 CASE("pcsat" ,"Pcsat"); id_pcsat = it 251 !----------------------------------------------------------------------- 252 CASE("pcocsat","Pcocsat"); id_pcocsat = it 253 !----------------------------------------------------------------------- 254 CASE("pcq" ,"Pcq"); id_pcq = it 255 !----------------------------------------------------------------------- 256 CASE("pcs0" ,"Pcs0"); id_pcs0 = it 257 conv_flg(it)=0 ! No transport by convection for this tracer 258 !----------------------------------------------------------------------- 259 CASE("pcos0" ,"Pcos0"); id_pcos0 = it 260 conv_flg(it)=0 ! No transport by convection for this tracer 261 !----------------------------------------------------------------------- 262 CASE("pcq0" ,"Pcq0"); id_pcq0 = it 263 conv_flg(it)=0 ! No transport by convection for this tracer 264 !----------------------------------------------------------------------- 265 CASE DEFAULT 266 WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tracers(iiq)%name) 267 !----------------------------------------------------------------------- 268 END SELECT 269 !----------------------------------------------------------------------- 268 270 END DO 269 271 … … 309 311 IF (zero) THEN 310 312 ! The tracer was not found in restart file or it was equal zero everywhere. 311 WRITE(lunout,*) "The tracer ",trim(t name(iiq))," will be initialized"313 WRITE(lunout,*) "The tracer ",trim(tracers(iiq)%name)," will be initialized" 312 314 IF (it==id_pcsat .OR. it==id_pcq .OR. & 313 315 it==id_pcs0 .OR. it==id_pcq0) THEN
Note: See TracChangeset
for help on using the changeset viewer.
