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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 139 - (hide annotations)
Tue May 26 17:46:03 2015 UTC (9 years 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 guez 43 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 guez 139 use comconst
15 guez 43 use dimens_m
16 guez 66 use disvert_m
17 guez 57 use conf_gcm_m
18 guez 139 use comgeom, only: aire, apoln, apols
19 guez 43 USE nr_util, ONLY : pi
20 guez 139 USE dynetat0_m, only: rlonv, rlonu
21     use paramet_m
22    
23 guez 43 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