source: LMDZ4/trunk/libf/dyn3d/infotrac.F90 @ 1207

Last change on this file since 1207 was 1146, checked in by Laurent Fairhead, 16 years ago

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