source: LMDZ4/branches/LMDZ4-dev/libf/dyn3d/infotrac.F90 @ 1179

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