Context Navigation

infotrac.F90 @ 6

Last change on this file since 6 was 6, checked in by slebonnois, 14 years ago

cf commit_v6.log :

manipulation traceurs
homogeneisation .def
bilan_dyn
etats initiaux start.nc
appels specifiques pour physique

File size: 12.3 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format