/[lmdze]/trunk/Sources/dyn3d/vlyqs.f
ViewVC logotype

Contents of /trunk/Sources/dyn3d/vlyqs.f

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.21