/[lmdze]/trunk/dyn3d/Vlsplt/vly.f
ViewVC logotype

Contents of /trunk/dyn3d/Vlsplt/vly.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 139 - (show annotations)
Tue May 26 17:46:03 2015 UTC (9 years ago) by guez
Original Path: trunk/Sources/dyn3d/Vlsplt/vly.f
File size: 7208 byte(s)
dynetat0 read rlonu, rlatu, rlonv, rlatv, cu_2d, cv_2d, aire_2d from
"start.nc" and then these variables were overwritten by
inigeom. Corrected this. Now, inigeom does not compute rlonu, rlatu,
rlonv and rlatv. Moreover, cu_2d, cv_2d, aire_2d are not written to
"restart.nc". Since xprimu, xprimv, xprimm025, xprimp025, rlatu1,
rlatu2, yprimu1, yprimu2 are computed at the same time as rlonu,
rlatu, rlonv, rlatv, and since it would not be convenient to separate
those computations, we decide to write xprimu, xprimv, xprimm025,
xprimp025, rlatu1, rlatu2, yprimu1, yprimu2 into "restart.nc", read
them from "start.nc" and not compute them in inigeom. So, in summary,
"start.nc" contains all the coordinates and their derivatives, and
inigeom only computes the 2D-variables.

Technical details:

Moved variables rlatu, rlonv, rlonu, rlatv, xprimu, xprimv from module
comgeom to module dynetat0_m. Upgraded local variables rlatu1,
yprimu1, rlatu2, yprimu2, xprimm025, xprimp025 of procedure inigeom to
variables of module dynetat0_m.

Removed unused local variable yprimu of procedure inigeom and
corresponding argument yyprimu of fyhyp.

Moved variables clat, clon, grossismx, grossismy, dzoomx, dzoomy,
taux, tauy from module serre to module dynetat0_m (since they are read
from "start.nc"). The default values are now defined in read_serre
instead of in the declarations. Changed name of module serre to
read_serre_m, no more module variable here.

The calls to fxhyp and fyhyp are moved from inigeom to etat0.

Side effects in programs other than gcm: etat0 and read_serre write
variables of module dynetat0; the programs test_fxyp and
test_inter_barxy need more source files.

Removed unused arguments len and nd of cv3_tracer. Removed unused
argument PPSOL of LWU.

Bug fix in test_inter_barxy: forgotten call to read_serre.

1 SUBROUTINE vly(q,pente_max,masse,masse_adv_v)
2 !
3 ! Auteurs: P.Le Van, F.Hourdin, F.Forget
4 !
5 ! ***********************************************************
6 ! Shema d'advection " pseudo amont " .
7 ! *************************************************************
8 ! q,masse_adv_v,w sont des arguments d'entree pour le s-pg ....
9 ! dq sont des arguments de sortie pour le s-pg ....
10
11 use comconst
12 use comgeom, only: aire
13 use conf_gcm_m
14 use dimens_m
15 use disvert_m
16 USE dynetat0_m, only: rlonv, rlonu
17 USE nr_util, ONLY : pi
18 use paramet_m
19
20 IMPLICIT NONE
21 !
22 !
23 !
24 ! Arguments:
25 ! ----------
26 REAL masse(ip1jmp1,llm),pente_max
27 REAL masse_adv_v( ip1jm,llm)
28 REAL q(ip1jmp1,llm), dq( ip1jmp1,llm)
29 !
30 ! Local
31 ! ---------
32 !
33 INTEGER i,ij,l
34 !
35 REAL airej2,airejjm,airescb(iim),airesch(iim)
36 REAL dyq(ip1jmp1,llm),dyqv(ip1jm),zdvm(ip1jmp1,llm)
37 REAL adyqv(ip1jm),dyqmax(ip1jmp1)
38 REAL qbyv(ip1jm,llm)
39
40 REAL qpns,qpsn,apn,aps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
41 ! REAL newq,oldmasse
42 Logical extremum,first,testcpu
43 REAL temps0,temps1,temps2,temps3,temps4,temps5,second
44 SAVE temps0,temps1,temps2,temps3,temps4,temps5
45 SAVE first,testcpu
46
47 REAL convpn,convps,convmpn,convmps
48 real massepn,masseps,qpn,qps
49 REAL sinlon(iip1),sinlondlon(iip1)
50 REAL coslon(iip1),coslondlon(iip1)
51 SAVE sinlon,coslon,sinlondlon,coslondlon
52 SAVE airej2,airejjm
53 !
54 !
55 REAL SSUM
56
57 DATA first,testcpu/.true.,.false./
58 DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
59
60 IF(first) THEN
61 PRINT*,'Shema Amont nouveau appele dans Vanleer '
62 first=.false.
63 do i=2,iip1
64 coslon(i)=cos(rlonv(i))
65 sinlon(i)=sin(rlonv(i))
66 coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
67 sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
68 ENDDO
69 coslon(1)=coslon(iip1)
70 coslondlon(1)=coslondlon(iip1)
71 sinlon(1)=sinlon(iip1)
72 sinlondlon(1)=sinlondlon(iip1)
73 airej2 = SSUM( iim, aire(iip2), 1 )
74 airejjm= SSUM( iim, aire(ip1jm -iim), 1 )
75 ENDIF
76
77 !
78 DO l = 1, llm
79 !
80 ! --------------------------------
81 ! CALCUL EN LATITUDE
82 ! --------------------------------
83
84 ! On commence par calculer la valeur du traceur moyenne sur le
85 ! premier cercle
86 ! de latitude autour du pole (qpns pour le pole nord et qpsn pour
87 ! le pole nord) qui sera utilisee pour evaluer les pentes au pole.
88
89 DO i = 1, iim
90 airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
91 airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
92 ENDDO
93 qpns = SSUM( iim, airescb ,1 ) / airej2
94 qpsn = SSUM( iim, airesch ,1 ) / airejjm
95
96 ! calcul des pentes aux points v
97
98 DO ij=1,ip1jm
99 dyqv(ij)=q(ij,l)-q(ij+iip1,l)
100 adyqv(ij)=abs(dyqv(ij))
101 ENDDO
102
103 ! calcul des pentes aux points scalaires
104
105 DO ij=iip2,ip1jm
106 dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
107 dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
108 dyqmax(ij)=pente_max*dyqmax(ij)
109 ENDDO
110
111 ! calcul des pentes aux poles
112
113 DO ij=1,iip1
114 dyq(ij,l)=qpns-q(ij+iip1,l)
115 dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
116 ENDDO
117
118 ! filtrage de la derivee
119 dyn1=0.
120 dys1=0.
121 dyn2=0.
122 dys2=0.
123 DO ij=1,iim
124 dyn1=dyn1+sinlondlon(ij)*dyq(ij,l)
125 dys1=dys1+sinlondlon(ij)*dyq(ip1jm+ij,l)
126 dyn2=dyn2+coslondlon(ij)*dyq(ij,l)
127 dys2=dys2+coslondlon(ij)*dyq(ip1jm+ij,l)
128 ENDDO
129 DO ij=1,iip1
130 dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
131 dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
132 ENDDO
133
134 ! calcul des pentes limites aux poles
135
136 goto 8888
137 fn=1.
138 fs=1.
139 DO ij=1,iim
140 IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
141 fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn)
142 ENDIF
143 IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
144 fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs)
145 ENDIF
146 ENDDO
147 DO ij=1,iip1
148 dyq(ij,l)=fn*dyq(ij,l)
149 dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
150 ENDDO
151 8888 continue
152 DO ij=1,iip1
153 dyq(ij,l)=0.
154 dyq(ip1jm+ij,l)=0.
155 ENDDO
156
157 ! calcul des pentes limitees
158
159 DO ij=iip2,ip1jm
160 IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
161 dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
162 ELSE
163 dyq(ij,l)=0.
164 ENDIF
165 ENDDO
166
167 ENDDO
168
169 DO l=1,llm
170 DO ij=1,ip1jm
171 IF(masse_adv_v(ij,l).gt.0) THEN
172 qbyv(ij,l)=q(ij+iip1,l)+dyq(ij+iip1,l)* &
173 & 0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l))
174 ELSE
175 qbyv(ij,l)=q(ij,l)-dyq(ij,l)* &
176 & 0.5*(1.+masse_adv_v(ij,l)/masse(ij,l))
177 ENDIF
178 qbyv(ij,l)=masse_adv_v(ij,l)*qbyv(ij,l)
179 ENDDO
180 ENDDO
181
182
183 DO l=1,llm
184 DO ij=iip2,ip1jm
185 newmasse=masse(ij,l) &
186 & +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
187 q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l)) &
188 & /newmasse
189 masse(ij,l)=newmasse
190 ENDDO
191 !.-. ancienne version
192 ! convpn=SSUM(iim,qbyv(1,l),1)/apoln
193 ! convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
194
195 convpn=SSUM(iim,qbyv(1,l),1)
196 convmpn=ssum(iim,masse_adv_v(1,l),1)
197 massepn=ssum(iim,masse(1,l),1)
198 qpn=0.
199 do ij=1,iim
200 qpn=qpn+masse(ij,l)*q(ij,l)
201 enddo
202 qpn=(qpn+convpn)/(massepn+convmpn)
203 do ij=1,iip1
204 q(ij,l)=qpn
205 enddo
206
207 ! convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
208 ! convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)/apols
209
210 convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
211 convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
212 masseps=ssum(iim, masse(ip1jm+1,l),1)
213 qps=0.
214 do ij = ip1jm+1,ip1jmp1-1
215 qps=qps+masse(ij,l)*q(ij,l)
216 enddo
217 qps=(qps+convps)/(masseps+convmps)
218 do ij=ip1jm+1,ip1jmp1
219 q(ij,l)=qps
220 enddo
221
222 !.-. fin ancienne version
223
224 !._. nouvelle version
225 ! convpn=SSUM(iim,qbyv(1,l),1)
226 ! convmpn=ssum(iim,masse_adv_v(1,l),1)
227 ! oldmasse=ssum(iim,masse(1,l),1)
228 ! newmasse=oldmasse+convmpn
229 ! newq=(q(1,l)*oldmasse+convpn)/newmasse
230 ! newmasse=newmasse/apoln
231 ! DO ij = 1,iip1
232 ! q(ij,l)=newq
233 ! masse(ij,l)=newmasse*aire(ij)
234 ! ENDDO
235 ! convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
236 ! convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
237 ! oldmasse=ssum(iim,masse(ip1jm-iim,l),1)
238 ! newmasse=oldmasse+convmps
239 ! newq=(q(ip1jmp1,l)*oldmasse+convps)/newmasse
240 ! newmasse=newmasse/apols
241 ! DO ij = ip1jm+1,ip1jmp1
242 ! q(ij,l)=newq
243 ! masse(ij,l)=newmasse*aire(ij)
244 ! ENDDO
245 !._. fin nouvelle version
246 ENDDO
247
248 RETURN
249 END

  ViewVC Help
Powered by ViewVC 1.1.21