/[lmdze]/trunk/libf/dyn3d/iniadvtrac.f90
ViewVC logotype

Contents of /trunk/libf/dyn3d/iniadvtrac.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 36 - (show annotations)
Thu Dec 2 17:11:04 2010 UTC (13 years, 5 months ago) by guez
File size: 6338 byte(s)
Now using the library "NR_util".

1 module iniadvtrac_m
2
3 ! From advtrac.h, v 1.1.1.1 2004/05/19 12:53:06
4
5 use dimens_m, only: nqmx
6
7 implicit none
8
9 private nqmx
10
11 INTEGER iadv(nqmx) ! indice schema de transport
12 INTEGER hadv(nqmx) ! indice schema transport horizontal
13 INTEGER vadv(nqmx) ! indice schema transport vertical
14 INTEGER niadv(nqmx) ! equivalent dyn / physique
15 character(len=8) tnom(nqmx) ! nom court du traceur
16 character(len=10) tname(nqmx) ! nom du traceur pour restart
17 character(len=13) ttext(nqmx) ! nom long du traceur pour sorties
18
19 contains
20
21 subroutine iniadvtrac
22
23 ! From dyn3d/iniadvtrac.F, version 1.3 2005/04/13 08:58:34
24
25 ! Authors : P. Le Van, L. Fairhead, F. Hourdin
26 ! Modification spéciale traceur F. Forget 05/94
27 ! Modification M.-A. Filiberti 02/02 lecture de "traceur.def"
28 ! Modification de l'intégration de "q" (26/04/94)
29
30 use nr_util, only: assert
31
32 ! Variables local to the procedure:
33
34 character(len=3) descrq(30)
35 character:: txts(3) = (/'x', 'y', 'z'/)
36 character(len=2) txtp(9)
37 character(len=13) str1, str2
38
39 integer iq, iiq, iiiq, ierr, ii, nq_local
40
41 data txtp/'x', 'y', 'z', 'xx', 'xy', 'xz', 'yy', 'yz', 'zz'/
42
43 !-----------------------------------------------------------------------
44
45 print *, "Call sequence information: iniadvtrac"
46
47 ! Initializations:
48 descrq(14)='VLH'
49 descrq(10)='VL1'
50 descrq(11)='VLP'
51 descrq(12)='FH1'
52 descrq(13)='FH2'
53 descrq(16)='PPM'
54 descrq(17)='PPS'
55 descrq(18)='PPP'
56 descrq(20)='SLP'
57 descrq(30)='PRA'
58
59 ! Choix des schemas d'advection pour l'eau et les traceurs
60
61 ! iadv = 1 schema transport type "humidite specifique LMD"
62 ! iadv = 2 schema amont
63 ! iadv = 14 schema Van-leer + humidite specifique
64 ! Modif F.Codron
65 ! iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide)
66 ! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone)
67 ! pour vadv
68 ! iadv = 12 schema Frederic Hourdin I
69 ! iadv = 13 schema Frederic Hourdin II
70 ! iadv = 16 schema PPM Monotone(Collela & Woodward 1984)
71 ! iadv = 17 schema PPM Semi Monotone (overshoots autorisés)
72 ! iadv = 18 schema PPM Positif Defini (overshoots undershoots autorisés)
73 ! iadv = 20 schema Slopes
74 ! iadv = 30 schema Prather
75
76 ! Dans le tableau q(ij, l, iq) : iq = 1 pour l'eau vapeur
77 ! iq = 2 pour l'eau liquide
78 ! Et éventuellement iq = 3, nqmx pour les autres traceurs
79
80 ! iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq.
81
82 ! Choix du schema d'advection
83 ! choix par defaut = van leer pour tous les traceurs
84 do iq=1, nqmx
85 iadv(iq)=10
86 str1(1:1)='q'
87 if (nqmx.le.99) then
88 WRITE(str1(2:3), '(i2.2)') iq
89 else
90 WRITE(str1(2:4), '(i3.3)') iq
91 endif
92 tnom(iq)=str1
93 tname(iq)=tnom(iq)
94 str2=tnom(iq)
95 ttext(iq) = trim(str2) // descrq(iadv(iq))
96 end do
97
98 ! Choix du schema pour l'advection dans fichier "traceur.def"
99
100 open(unit=90, file='traceur.def', form='formatted', status='old', &
101 iostat=ierr)
102 if (ierr == 0) then
103 print *, 'Ouverture de "traceur.def" ok'
104 read(unit=90, fmt=*) nq_local
105 print *, 'nombre de traceurs ', nq_local
106 call assert(nq_local == nqmx, "iniadvtrac nq_local")
107
108 do iq=1, nqmx
109 read(90, 999) hadv(iq), vadv(iq), tnom(iq)
110 end do
111 close(90)
112 PRINT *, 'lecture de traceur.def :'
113 do iq=1, nqmx
114 write(*, *) hadv(iq), vadv(iq), tnom(iq)
115 end do
116 else
117 print *, 'Problème à l''ouverture de "traceur.def"'
118 print *, 'Attention : on prend des valeurs par défaut.'
119 call assert(nqmx == 4, "iniadvtrac nqmx")
120 hadv(1) = 14
121 vadv(1) = 14
122 tnom(1) = 'H2Ov'
123 hadv(2) = 10
124 vadv(2) = 10
125 tnom(2) = 'H2Ol'
126 hadv(3) = 10
127 vadv(3) = 10
128 tnom(3) = 'RN'
129 hadv(4) = 10
130 vadv(4) = 10
131 tnom(4) = 'PB'
132 ENDIF
133 PRINT *, 'Valeur de traceur.def :'
134 do iq=1, nqmx
135 write(*, *) hadv(iq), vadv(iq), tnom(iq)
136 end do
137
138 ! À partir du nom court du traceur et du schéma d'advection, on
139 ! détemine le nom long :
140 iiq=0
141 ii=0
142 do iq=1, nqmx
143 iiq=iiq+1
144 if (hadv(iq) /= vadv(iq)) then
145 if (hadv(iq) == 10.and.vadv(iq) == 16) then
146 iadv(iiq)=11
147 else
148 print *, 'le choix des schemas d''advection H et V'
149 print *, 'est non disponible actuellement'
150 stop
151 endif
152 else
153 iadv(iiq)=hadv(iq)
154 endif
155 ! verification nombre de traceurs
156 if (iadv(iiq).lt.20) then
157 ii=ii+1
158 elseif (iadv(iiq) == 20) then
159 ii=ii+4
160 elseif (iadv(iiq) == 30) then
161 ii=ii+10
162 endif
163
164 str1=tnom(iq)
165 tname(iiq)=tnom(iq)
166 IF (iadv(iiq) == 0) THEN
167 ttext(iiq)=trim(str1)
168 ELSE
169 ttext(iiq)=trim(str1)//descrq(iadv(iiq))
170 endif
171 str2=ttext(iiq)
172 ! schemas tenant compte des moments d'ordre superieur.
173 if (iadv(iiq) == 20) then
174 do iiiq=1, 3
175 iiq=iiq+1
176 iadv(iiq)=-20
177 ttext(iiq)=trim(str2)//txts(iiiq)
178 tname(iiq)=trim(str1)//txts(iiiq)
179 enddo
180 elseif (iadv(iiq) == 30) then
181 do iiiq=1, 9
182 iiq=iiq+1
183 iadv(iiq)=-30
184 ttext(iiq)=trim(str2)//txtp(iiiq)
185 tname(iiq)=trim(str1)//txtp(iiiq)
186 enddo
187 endif
188 end do
189 if (ii /= nqmx) then
190 print *, 'WARNING'
191 print *, 'le nombre de traceurs et de moments eventuels'
192 print *, 'est inferieur a nqmx '
193 endif
194 if (iiq > nqmx) then
195 print *, 'le choix des schemas est incompatible avec '
196 print *, 'la dimension nqmx (nombre de traceurs)'
197 print *, 'verifier traceur.def ou la namelist INCA'
198 print *, 'ou recompiler avec plus de traceurs'
199 stop
200 endif
201 iiq=0
202 do iq=1, nqmx
203 if (iadv(iq).ge.0) then
204 iiq=iiq+1
205 niadv(iiq)=iq
206 endif
207 end do
208
209 999 format (i2, 1x, i2, 1x, a8)
210
211 END subroutine iniadvtrac
212
213 end module iniadvtrac_m

  ViewVC Help
Powered by ViewVC 1.1.21