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

Annotation of /trunk/Sources/dyn3d/limy.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: 4501 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 3
2 guez 81 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limy.F,v 1.1.1.1 2004/05/19
3     ! 12:53:07 lmdzadmin Exp $
4 guez 3
5 guez 81 SUBROUTINE limy(s0, sy, sm, pente_max)
6 guez 3
7 guez 81 ! Auteurs: P.Le Van, F.Hourdin, F.Forget
8 guez 3
9 guez 81 ! ********************************************************************
10     ! Shema d'advection " pseudo amont " .
11     ! ********************************************************************
12     ! q,w sont des arguments d'entree pour le s-pg ....
13     ! dq sont des arguments de sortie pour le s-pg ....
14 guez 3
15    
16 guez 81 ! --------------------------------------------------------------------
17 guez 139 USE comconst
18     use comgeom, only: aire
19     USE conf_gcm_m
20 guez 81 USE dimens_m
21     USE disvert_m
22 guez 139 USE dynetat0_m, only: rlonv, rlonu
23 guez 81 USE nr_util, ONLY: pi
24 guez 139 USE paramet_m
25    
26 guez 81 IMPLICIT NONE
27 guez 3
28    
29    
30 guez 81 ! Arguments:
31     ! ----------
32     REAL pente_max
33     REAL s0(ip1jmp1, llm), sy(ip1jmp1, llm), sm(ip1jmp1, llm)
34 guez 3
35 guez 81 ! Local
36     ! ---------
37 guez 3
38 guez 81 INTEGER i, ij, l
39 guez 3
40 guez 81 REAL q(ip1jmp1, llm)
41     REAL airej2, airejjm, airescb(iim), airesch(iim)
42     REAL sigv, dyq(ip1jmp1), dyqv(ip1jm)
43     REAL adyqv(ip1jm), dyqmax(ip1jmp1)
44     REAL qbyv(ip1jm, llm)
45 guez 3
46 guez 81 REAL qpns, qpsn, apn, aps, dyn1, dys1, dyn2, dys2
47     LOGICAL extremum, first
48     SAVE first
49 guez 3
50 guez 81 REAL convpn, convps, convmpn, convmps
51     REAL sinlon(iip1), sinlondlon(iip1)
52     REAL coslon(iip1), coslondlon(iip1)
53     SAVE sinlon, coslon, sinlondlon, coslondlon
54 guez 3
55    
56 guez 81 REAL ssum
57     INTEGER ismax, ismin
58     EXTERNAL ssum, convflu, ismin, ismax
59 guez 3
60 guez 81 DATA first/.TRUE./
61 guez 3
62 guez 81 IF (first) THEN
63     PRINT *, 'SCHEMA AMONT NOUVEAU'
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     END DO
71     coslon(1) = coslon(iip1)
72     coslondlon(1) = coslondlon(iip1)
73     sinlon(1) = sinlon(iip1)
74     sinlondlon(1) = sinlondlon(iip1)
75     END IF
76 guez 3
77    
78    
79 guez 81 DO l = 1, llm
80 guez 3
81 guez 81 DO ij = 1, ip1jmp1
82     q(ij, l) = s0(ij, l)/sm(ij, l)
83     dyq(ij) = sy(ij, l)/sm(ij, l)
84     END DO
85 guez 3
86 guez 81 ! --------------------------------
87     ! CALCUL EN LATITUDE
88     ! --------------------------------
89 guez 3
90 guez 81 ! On commence par calculer la valeur du traceur moyenne sur le premier
91     ! cercle
92     ! de latitude autour du pole (qpns pour le pole nord et qpsn pour
93     ! le pole nord) qui sera utilisee pour evaluer les pentes au pole.
94 guez 3
95 guez 81 airej2 = ssum(iim, aire(iip2), 1)
96     airejjm = ssum(iim, aire(ip1jm-iim), 1)
97     DO i = 1, iim
98     airescb(i) = aire(i+iip1)*q(i+iip1, l)
99     airesch(i) = aire(i+ip1jm-iip1)*q(i+ip1jm-iip1, l)
100     END DO
101     qpns = ssum(iim, airescb, 1)/airej2
102     qpsn = ssum(iim, airesch, 1)/airejjm
103    
104     ! calcul des pentes aux points v
105    
106     DO ij = 1, ip1jm
107     dyqv(ij) = q(ij, l) - q(ij+iip1, l)
108     adyqv(ij) = abs(dyqv(ij))
109     END DO
110    
111     ! calcul des pentes aux points scalaires
112    
113     DO ij = iip2, ip1jm
114     dyqmax(ij) = min(adyqv(ij-iip1), adyqv(ij))
115     dyqmax(ij) = pente_max*dyqmax(ij)
116     END DO
117    
118     ! calcul des pentes aux poles
119    
120     ! calcul des pentes limites aux poles
121    
122     ! cas ou on a un extremum au pole
123    
124     ! if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
125     ! & apn=0.
126     ! if(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
127     ! & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
128     ! & aps=0.
129    
130     ! limitation des pentes aux poles
131     ! do ij=1,iip1
132     ! dyq(ij)=apn*dyq(ij)
133     ! dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
134     ! enddo
135    
136     ! test
137     ! do ij=1,iip1
138     ! dyq(iip1+ij)=0.
139     ! dyq(ip1jm+ij-iip1)=0.
140     ! enddo
141     ! do ij=1,ip1jmp1
142     ! dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
143     ! enddo
144    
145     IF (dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1))<=0.) THEN
146     DO ij = 1, iip1
147     dyqmax(ij) = 0.
148     END DO
149     ELSE
150     DO ij = 1, iip1
151     dyqmax(ij) = pente_max*abs(dyqv(ij))
152     END DO
153     END IF
154    
155     IF (dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*dyqv(ismin(iim, &
156     dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)<=0.) THEN
157     DO ij = ip1jm + 1, ip1jmp1
158     dyqmax(ij) = 0.
159     END DO
160     ELSE
161     DO ij = ip1jm + 1, ip1jmp1
162     dyqmax(ij) = pente_max*abs(dyqv(ij-iip1))
163     END DO
164     END IF
165    
166     ! calcul des pentes limitees
167    
168     DO ij = 1, ip1jmp1
169     IF (dyqv(ij)*dyqv(ij-iip1)>0.) THEN
170     dyq(ij) = sign(min(abs(dyq(ij)),dyqmax(ij)), dyq(ij))
171     ELSE
172     dyq(ij) = 0.
173     END IF
174     END DO
175    
176     DO ij = 1, ip1jmp1
177     sy(ij, l) = dyq(ij)*sm(ij, l)
178     END DO
179    
180     END DO ! fin de la boucle sur les couches verticales
181    
182     RETURN
183     END SUBROUTINE limy
  ViewVC Help
Powered by ViewVC 1.1.21