source: LMDZ6/trunk/libf/phylmdiso/infotrac_phy.F90 @ 4048

Last change on this file since 4048 was 4048, checked in by dcugnet, 2 years ago

Corrections to fix the isotopic version compilation.
File size: 9.5 KB
Line 
1
2! $Id: $
3
4MODULE infotrac_phy
5
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  USE readTracFiles_mod, ONLY: trac_type, maxlen, delPhase
11
12! nqtot : total number of tracers and higher order of moment, water vapor and liquid included
13  INTEGER, SAVE :: nqtot
14!$OMP THREADPRIVATE(nqtot)
15
16!CR: on ajoute le nombre de traceurs de l eau
17  INTEGER, SAVE :: nqo
18!$OMP THREADPRIVATE(nqo)
19
20! nbtr : number of tracers not including higher order of moment or water vapor or liquid
21!        number of tracers used in the physics
22  INTEGER, SAVE :: nbtr
23!$OMP THREADPRIVATE(nbtr)
24
25  INTEGER, SAVE :: nqtottr
26!$OMP THREADPRIVATE(nqtottr)
27
28! ThL : number of CO2 tracers                   ModThL
29  INTEGER, SAVE :: nqCO2
30!$OMP THREADPRIVATE(nqCO2)
31
32#ifdef CPP_StratAer
33! nbtr_bin: number of aerosol bins for StratAer model
34! nbtr_sulgas: number of sulfur gases for StratAer model
35  INTEGER, SAVE :: nbtr_bin, nbtr_sulgas
36!$OMP THREADPRIVATE(nbtr_bin,nbtr_sulgas)
37  INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat
38!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat)
39#endif
40
41! CRisi: nb traceurs pères= directement advectés par l'air
42  INTEGER, SAVE :: nqperes
43!$OMP THREADPRIVATE(nqperes)
44
45! Tracers parameters
46  TYPE(trac_type), TARGET, ALLOCATABLE, SAVE :: tracers(:)
47!$OMP THREADPRIVATE(tracers)
48
49! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
50!         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
51  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
52!$OMP THREADPRIVATE(niadv)
53
54! CRisi: tableaux de fils
55  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
56  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
57  INTEGER, SAVE :: nqdesc_tot
58  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
59  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
60!$OMP THREADPRIVATE(nqfils,nqdesc,nqdesc_tot,iqfils,iqpere)
61
62! conv_flg(it)=0 : convection desactivated for tracer number it
63  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: conv_flg
64!$OMP THREADPRIVATE(conv_flg)
65
66! pbl_flg(it)=0  : boundary layer diffusion desactivaded for tracer number it
67  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: pbl_flg
68!$OMP THREADPRIVATE(pbl_flg)
69
70  CHARACTER(len=4),SAVE :: type_trac
71!$OMP THREADPRIVATE(type_trac)
72  CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
73!$OMP THREADPRIVATE(solsym)
74   
75    ! CRisi: cas particulier des isotopes
76    LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso
77!$OMP THREADPRIVATE(ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso)
78    INTEGER :: niso_possibles   
79    PARAMETER ( niso_possibles=5)
80    real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal
81!$OMP THREADPRIVATE(tnat,alpha_ideal)
82    LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
83!$OMP THREADPRIVATE(use_iso)
84    INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
85!$OMP THREADPRIVATE(iqiso)
86    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
87!$OMP THREADPRIVATE(iso_num)
88    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
89!$OMP THREADPRIVATE(iso_indnum)
90    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
91!$OMP THREADPRIVATE(zone_num)
92    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
93!$OMP THREADPRIVATE(phase_num)
94    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
95!$OMP THREADPRIVATE(indnum_fn_num)
96    INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
97!$OMP THREADPRIVATE(index_trac)
98    INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
99!$OMP THREADPRIVATE(niso,ntraceurs_zone,ntraciso)
100
101    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  itr_indice ! numéro iq entre 1 et nqtot qui correspond au traceur itr entre 1 et nqtottr
102!$OMP THREADPRIVATE(itr_indice)
103 
104CONTAINS
105
106  SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tracers_,type_trac_,&
107                               niadv_,conv_flg_,pbl_flg_,solsym_,&
108                               nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,&
109                               ok_isotopes_,ok_iso_verif_,ok_isotrac_,&
110                               ok_init_iso_,niso_possibles_,tnat_,&
111                               alpha_ideal_,use_iso_,iqiso_,iso_num_,&
112                               iso_indnum_,zone_num_,phase_num_,&
113                               indnum_fn_num_,index_trac_,&
114                               niso_,ntraceurs_zone_,ntraciso_,itr_indice_&
115#ifdef CPP_StratAer
116                               ,nbtr_bin_,nbtr_sulgas_&
117                               ,id_OCS_strat_,id_SO2_strat_,id_H2SO4_strat_,id_BIN01_strat_&
118#endif
119                               )
120
121    ! transfer information on tracers from dynamics to physics
122    USE print_control_mod, ONLY: prt_level, lunout
123    IMPLICIT NONE
124
125    INTEGER,INTENT(IN) :: nqtot_
126    INTEGER,INTENT(IN) :: nqo_
127    INTEGER,INTENT(IN) :: nbtr_
128    INTEGER,INTENT(IN) :: nqtottr_
129    INTEGER,INTENT(IN) :: nqCO2_
130#ifdef CPP_StratAer
131    INTEGER,INTENT(IN) :: nbtr_bin_
132    INTEGER,INTENT(IN) :: nbtr_sulgas_
133    INTEGER,INTENT(IN) :: id_OCS_strat_
134    INTEGER,INTENT(IN) :: id_SO2_strat_
135    INTEGER,INTENT(IN) :: id_H2SO4_strat_
136    INTEGER,INTENT(IN) :: id_BIN01_strat_
137#endif
138    TYPE(trac_type), INTENT(IN) :: tracers_(nqtot_) ! tracers descriptors
139    CHARACTER(len=*),INTENT(IN) :: type_trac_
140    INTEGER,INTENT(IN) :: niadv_ (nqtot_) ! equivalent dyn / physique
141    INTEGER,INTENT(IN) :: conv_flg_(nbtr_)
142    INTEGER,INTENT(IN) :: pbl_flg_(nbtr_)
143    CHARACTER(len=*),INTENT(IN) :: solsym_(nbtr_)
144    ! Isotopes:
145    INTEGER,INTENT(IN) :: nqfils_(nqtot_)
146    INTEGER,INTENT(IN) :: nqdesc_(nqtot_)
147    INTEGER,INTENT(IN) :: nqdesc_tot_
148    INTEGER,INTENT(IN) :: iqfils_(nqtot_,nqtot_)
149    INTEGER,INTENT(IN) :: iqpere_(nqtot_)
150    LOGICAL,INTENT(IN) :: ok_isotopes_
151    LOGICAL,INTENT(IN) :: ok_iso_verif_
152    LOGICAL,INTENT(IN) :: ok_isotrac_
153    LOGICAL,INTENT(IN) :: ok_init_iso_
154    INTEGER,INTENT(IN) :: niso_possibles_
155    REAL,INTENT(IN) :: tnat_(niso_possibles_)
156    REAL,INTENT(IN) :: alpha_ideal_(niso_possibles_)
157    LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_)
158    INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_)
159    INTEGER,INTENT(IN) :: iso_num_(nqtot_)
160    INTEGER,INTENT(IN) :: iso_indnum_(nqtot_)
161    INTEGER,INTENT(IN) :: zone_num_(nqtot_)
162    INTEGER,INTENT(IN) :: phase_num_(nqtot_)
163    INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_)
164    INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_)
165    INTEGER,INTENT(IN) :: niso_
166    INTEGER,INTENT(IN) :: ntraceurs_zone_
167    INTEGER,INTENT(IN) :: ntraciso_
168    INTEGER,INTENT(IN) :: itr_indice_(nqtottr_)
169
170    CHARACTER(LEN=30) :: modname="init_infotrac_phy"
171
172    nqtot=nqtot_
173    nqo=nqo_
174    nbtr=nbtr_
175    nqCO2=nqCO2_
176    nqtottr=nqtottr_
177    ALLOCATE(tracers(nqtot)); tracers(:) = tracers_(:)
178#ifdef CPP_StratAer
179    nbtr_bin=nbtr_bin_
180    nbtr_sulgas=nbtr_sulgas_
181    id_OCS_strat=id_OCS_strat_
182    id_SO2_strat=id_SO2_strat_
183    id_H2SO4_strat=id_H2SO4_strat_
184    id_BIN01_strat=id_BIN01_strat_
185#endif
186    type_trac = type_trac_
187    ALLOCATE(niadv(nqtot))
188    niadv(:)=niadv_(:)
189    ALLOCATE(conv_flg(nbtr))
190    conv_flg(:)=conv_flg_(:)
191    ALLOCATE(pbl_flg(nbtr))
192    pbl_flg(:)=pbl_flg_(:)
193    ALLOCATE(solsym(nbtr))
194    solsym(:)=solsym_(:)
195     
196    IF(prt_level.ge.1) THEN
197      write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr,nqCO2",nqtot,nqo,nbtr,nqCO2
198    ENDIF
199   
200    ! Isotopes:
201   
202    ! First check that the "niso_possibles" has the correct value
203    IF (niso_possibles.ne.niso_possibles_) THEN
204      CALL abort_physic(modname,&
205           "wrong value for parameter niso_possibles in infotrac_phy",1)
206    ENDIF
207   
208    ok_isotopes=ok_isotopes_
209    ok_iso_verif=ok_iso_verif_
210    ok_isotrac=ok_isotrac_
211    ok_init_iso=ok_init_iso_
212   
213    niso=niso_
214    ntraceurs_zone=ntraceurs_zone_
215    ntraciso=ntraciso_
216   
217    IF (ok_isotopes) THEN
218      ALLOCATE(nqfils(nqtot))
219      nqfils(:)=nqfils_(:)
220      ALLOCATE(nqdesc(nqtot))
221      nqdesc(:)=nqdesc_(:)
222      nqdesc_tot=nqdesc_tot_
223      ALLOCATE(iqfils(nqtot,nqtot))
224      iqfils(:,:)=iqfils_(:,:)
225      ALLOCATE(iqpere(nqtot))
226      iqpere(:)=iqpere_(:)
227   
228      tnat(:)=tnat_(:)
229      alpha_ideal(:)=alpha_ideal_(:)
230      use_iso(:)=use_iso_(:)
231   
232      ALLOCATE(iqiso(ntraciso,nqo))
233      iqiso(:,:)=iqiso_(:,:)
234      ALLOCATE(iso_num(nqtot))
235      iso_num(:)=iso_num_(:)
236      ALLOCATE(iso_indnum(nqtot))
237      iso_indnum(:)=iso_indnum_(:)
238      ALLOCATE(zone_num(nqtot))
239      zone_num(:)=zone_num_(:)
240      ALLOCATE(phase_num(nqtot))
241      phase_num(:)=phase_num_(:)
242     
243      indnum_fn_num(:)=indnum_fn_num_(:)
244     
245      ALLOCATE(index_trac(ntraceurs_zone,niso))
246      index_trac(:,:)=index_trac_(:,:)
247
248    ENDIF ! of IF(ok_isotopes)
249
250      ALLOCATE(itr_indice(nqtottr))
251      itr_indice(:)=itr_indice_(:)
252
253        write(*,*) 'infotrac_phy 207: nqtottr=',nqtottr
254        write(*,*) 'ntraciso,niso=',ntraciso,niso
255        write(*,*) 'itr_indice=',itr_indice
256#ifdef ISOVERIF
257        write(*,*) 'iso_num=',iso_num
258#endif
259 
260  END SUBROUTINE init_infotrac_phy
261
262END MODULE infotrac_phy
Note: See TracBrowser for help on using the repository browser.