source: LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/infotrac.F90 @ 1119

Last change on this file since 1119 was 1117, checked in by yann meurdesoif, 16 years ago

Correction pour bon fonctionnement en OpenMP suite à la mise à jour des modifications sur le nombre de traceur spécifié dynamiquement
YM
File size: 10.3 KB
RevLine 
[1114]1MODULE infotrac
2
3! nqtot : total number of tracers and higher order of moment, water vapor and liquid included
4  INTEGER, SAVE :: nqtot
[1117]5!!$OMP THREADPRIVATE(nqtot)   
[1114]6
7! nbtr : number of tracers not including higher order of moment or water vapor or liquid
8!        number of tracers used in the physics
9  INTEGER, SAVE :: nbtr
[1117]10!!$OMP THREADPRIVATE(nbtr)   
[1114]11
12! Name variables
13  CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
14  CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
[1117]15!!$OMP THREADPRIVATE(tname,ttext)   
[1114]16
17! iadv  : index of trasport schema for each tracer
18  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iadv
[1117]19!!$OMP THREADPRIVATE(iadv)   
[1114]20
21! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
22!         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
23  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
[1117]24!!$OMP THREADPRIVATE(niadv)   
[1114]25
26! Variables for INCA
27  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: conv_flg
28  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: pbl_flg
[1117]29!!$OMP THREADPRIVATE(conv_flg, pbl_flg)   
[1114]30
31CONTAINS
32
33  SUBROUTINE infotrac_init
34    IMPLICIT NONE
35!=======================================================================
36!
37!   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
38!   -------
39!   Modif special traceur F.Forget 05/94
40!   Modif M-A Filiberti 02/02 lecture de traceur.def
41!
42!   Objet:
43!   ------
44!   GCM LMD nouvelle grille
45!
46!=======================================================================
47!   ... modification de l'integration de q ( 26/04/94 ) ....
48!-----------------------------------------------------------------------
49! Declarations
50
51    INCLUDE "dimensions.h"
52    INCLUDE "control.h"
53    INCLUDE "iniprint.h"
54
55! Local variables
56    INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv  ! index of horizontal trasport schema
57    INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv  ! index of vertical trasport schema
58
59    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
60    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA
61    CHARACTER(len=3), DIMENSION(30) :: descrq
62    CHARACTER(len=1), DIMENSION(3)  :: txts
63    CHARACTER(len=2), DIMENSION(9)  :: txtp
64    CHARACTER(len=13)               :: str1,str2
65 
66    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
67    INTEGER :: iq, new_iq, iiq, jq, ierr
68    INTEGER, EXTERNAL :: lnblnk
69 
70!-----------------------------------------------------------------------
71! Initialization :
72!
73    txts=(/'x','y','z'/)
74    txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/)
75
76    descrq(14)='VLH'
77    descrq(10)='VL1'
78    descrq(11)='VLP'
79    descrq(12)='FH1'
80    descrq(13)='FH2'
81    descrq(16)='PPM'
82    descrq(17)='PPS'
83    descrq(18)='PPP'
84    descrq(20)='SLP'
85    descrq(30)='PRA'
86
87!-----------------------------------------------------------------------
88!
89! 1) Get the true number of tracers + water vapor/liquid
90!    Here true tracers (nqtrue) means declared tracers (only first order)
91!
92!-----------------------------------------------------------------------
93    IF (config_inca == 'none') THEN
94       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
95       IF(ierr.EQ.0) THEN
96          WRITE(lunout,*) 'Open traceur.def : ok'
97          READ(90,*) nqtrue
98       ELSE
99          WRITE(lunout,*) 'Problem in opening traceur.def'
100          WRITE(lunout,*) 'ATTENTION using defaut values'
101          nqtrue=4 ! Defaut value
102       END IF
103       ! Attention! Only for planet_type=='earth'
104       nbtr=nqtrue-2
105    ELSE
106       ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F
107       nqtrue=nbtr+2
108    END IF
109
110    IF (nqtrue < 2) THEN
111       WRITE(lunout,*) 'nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
112       CALL abort_gcm('infotrac_init','Not enough tracers',1)
113    END IF
114!
115! Allocate variables depending on nqtrue
116!
117    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
118
119    IF (config_inca /= 'none') THEN
120       ! Varaibles only needed in case of INCA
121       ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
122    END IF
123       
124!-----------------------------------------------------------------------
125! 2)     Choix  des schemas d'advection pour l'eau et les traceurs
126!
127!     iadv = 1    schema  transport type "humidite specifique LMD"
128!     iadv = 2    schema   amont
129!     iadv = 14   schema  Van-leer + humidite specifique
130!                            Modif F.Codron
131!     iadv = 10   schema  Van-leer (retenu pour l'eau vapeur et liquide)
132!     iadv = 11   schema  Van-Leer pour hadv et version PPM (Monotone) pour vadv
133!     iadv = 12   schema  Frederic Hourdin I
134!     iadv = 13   schema  Frederic Hourdin II
135!     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
136!     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
137!     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
138!     iadv = 20   schema  Slopes
139!     iadv = 30   schema  Prather
140!
141!        Dans le tableau q(ij,l,iq) : iq = 1  pour l'eau vapeur
142!                                     iq = 2  pour l'eau liquide
143!       Et eventuellement             iq = 3,nqtot pour les autres traceurs
144!
145!        iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
146!------------------------------------------------------------------------
147!
148!    Get choice of advection schema from file tracer.def or from INCA
149!---------------------------------------------------------------------
150    IF (config_inca == 'none') THEN
151       IF(ierr.EQ.0) THEN
152          ! Continue to read tracer.def
153          DO iq=1,nqtrue
154             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
155          END DO
156          CLOSE(90) 
157       ELSE ! Without tracer.def
158          hadv(1) = 14
159          vadv(1) = 14
160          tnom_0(1) = 'H2Ov'
161          hadv(2) = 10
162          vadv(2) = 10
163          tnom_0(2) = 'H2Ol'
164          hadv(3) = 10
165          vadv(3) = 10
166          tnom_0(3) = 'RN'
167          hadv(4) = 10
168          vadv(4) = 10
169          tnom_0(4) = 'PB'
170       END IF
171       
172       WRITE(lunout,*) 'Valeur de traceur.def :'
173       WRITE(lunout,*) 'nombre de traceurs ',nqtrue
174       DO iq=1,nqtrue
175          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
176       END DO
177
178    ELSE  ! config_inca='aero' ou 'chem'
179! le module de chimie fournit les noms des traceurs
180! et les schemas d'advection associes.
181     
182#ifdef INCA
183       CALL init_transport( &
184            hadv, &
185            vadv, &
186            conv_flg, &
187            pbl_flg,  &
188            tracnam)
189#endif
190       tnom_0(1)='H2Ov'
191       tnom_0(2)='H2Ol'
192
193       DO iq =3,nqtrue
194          tnom_0(iq)=tracnam(iq-2)
195       END DO
196
197    END IF ! config_inca
198
199!-----------------------------------------------------------------------
200!
201! 3) Verify if advection schema 20 or 30 choosen
202!    Calculate total number of tracers needed: nqtot
203!    Allocate variables depending on total number of tracers
204!-----------------------------------------------------------------------
205    new_iq=0
206    DO iq=1,nqtrue
207       ! Add tracers for certain advection schema
208       IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
209          new_iq=new_iq+1  ! no tracers added
210       ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
211          new_iq=new_iq+4  ! 3 tracers added
212       ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
213          new_iq=new_iq+10 ! 9 tracers added
214       ELSE
215          WRITE(lunout,*) 'This choice of advection schema is not available'
216          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
217       END IF
218    END DO
219   
220    IF (new_iq /= nqtrue) THEN
221       ! The choice of advection schema imposes more tracers
222       ! Assigne total number of tracers
223       nqtot = new_iq
224
225       WRITE(lunout,*) 'The choice of advection schema for one or more tracers'
226       WRITE(lunout,*) 'makes it necessary to add tracers'
227       WRITE(lunout,*) nqtrue,' is the number of true tracers'
228       WRITE(lunout,*) nqtot, ' is the total number of tracers needed'
229
230    ELSE
231       ! The true number of tracers is also the total number
232       nqtot = nqtrue
233    END IF
234
235!
236! Allocate variables with total number of tracers, nqtot
237!
238    ALLOCATE(tname(nqtot), ttext(nqtot))
239    ALLOCATE(iadv(nqtot), niadv(nqtot))
240
241!-----------------------------------------------------------------------
242!
243! 4) Determine iadv, long and short name
244!
245!-----------------------------------------------------------------------
246    new_iq=0
247    DO iq=1,nqtrue
248       new_iq=new_iq+1
249
250       ! Verify choice of advection schema
251       IF (hadv(iq)==vadv(iq)) THEN
252          iadv(new_iq)=hadv(iq)
253       ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
254          iadv(new_iq)=11
255       ELSE
256          WRITE(lunout,*)'This choice of advection schema is not available'
257          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
258       END IF
259     
260       str1=tnom_0(iq)
261       tname(new_iq)= tnom_0(iq)
262       IF (iadv(new_iq)==0) THEN
263          ttext(new_iq)=str1(1:lnblnk(str1))
264       ELSE
265          ttext(new_iq)=str1(1:lnblnk(str1))//descrq(iadv(new_iq))
266       END IF
267
268       ! schemas tenant compte des moments d'ordre superieur
269       str2=ttext(new_iq)
270       IF (iadv(new_iq)==20) THEN
271          DO jq=1,3
272             new_iq=new_iq+1
273             iadv(new_iq)=-20
274             ttext(new_iq)=str2(1:lnblnk(str2))//txts(jq)
275             tname(new_iq)=str1(1:lnblnk(str1))//txts(jq)
276          END DO
277       ELSE IF (iadv(new_iq)==30) THEN
278          DO jq=1,9
279             new_iq=new_iq+1
280             iadv(new_iq)=-30
281             ttext(new_iq)=str2(1:lnblnk(str2))//txtp(jq)
282             tname(new_iq)=str1(1:lnblnk(str1))//txtp(jq)
283          END DO
284       END IF
285    END DO
286
287!
288! Find vector keeping the correspodence between true and total tracers
289!
290    niadv(:)=0
291    iiq=0
292    DO iq=1,nqtot
293       IF(iadv(iq).GE.0) THEN
294          ! True tracer
295          iiq=iiq+1
296          niadv(iiq)=iq
297       ENDIF
298    END DO
299
300
301    WRITE(lunout,*) 'Information stored in dimtrac :'
302    WRITE(lunout,*) 'iadv  niadv tname  ttext :'
303    DO iq=1,nqtot
304       WRITE(lunout,*) iadv(iq),niadv(iq), tname(iq), ttext(iq)
305    END DO
306
307!-----------------------------------------------------------------------
308! Finalize :
309!
310    DEALLOCATE(tnom_0, hadv, vadv)
311    IF (config_inca /= 'none') DEALLOCATE(tracnam)
312
313999 FORMAT (i2,1x,i2,1x,a8)
314
315  END SUBROUTINE infotrac_init
316
317END MODULE infotrac
Note: See TracBrowser for help on using the repository browser.