source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/infotrac_phy.F90

Last change on this file was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

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