source: LMDZ6/branches/Ocean_skin/libf/phylmd/infotrac_phy.F90

Last change on this file was 3798, checked in by lguez, 4 years ago

Sync latest trunk changes to Ocean_skin
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#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)
30#endif
31
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 
96CONTAINS
97
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_&
107#ifdef CPP_StratAer
108                               ,nbtr_bin_,nbtr_sulgas_&
109                               ,id_OCS_strat_,id_SO2_strat_,id_H2SO4_strat_,id_BIN01_strat_&
110#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
241
242END MODULE infotrac_phy
Note: See TracBrowser for help on using the repository browser.