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

Last change on this file since 4007 was 4007, checked in by Ehouarn Millour, 3 years ago

Some fixes for phylmdiso:

  • serial advection scheme updated to match the ones in dyn3dmem
  • follow up on the changes in tracer name string length from r4005

EM

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