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

Contents of /trunk/Sources/dyn3d/limy.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: 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
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limy.F,v 1.1.1.1 2004/05/19
3 ! 12:53:07 lmdzadmin Exp $
4
5 SUBROUTINE limy(s0, sy, sm, pente_max)
6
7 ! Auteurs: P.Le Van, F.Hourdin, F.Forget
8
9 ! ********************************************************************
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
15
16 ! --------------------------------------------------------------------
17 USE comconst
18 use comgeom, only: aire
19 USE conf_gcm_m
20 USE dimens_m
21 USE disvert_m
22 USE dynetat0_m, only: rlonv, rlonu
23 USE nr_util, ONLY: pi
24 USE paramet_m
25
26 IMPLICIT NONE
27
28
29
30 ! Arguments:
31 ! ----------
32 REAL pente_max
33 REAL s0(ip1jmp1, llm), sy(ip1jmp1, llm), sm(ip1jmp1, llm)
34
35 ! Local
36 ! ---------
37
38 INTEGER i, ij, l
39
40 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
46 REAL qpns, qpsn, apn, aps, dyn1, dys1, dyn2, dys2
47 LOGICAL extremum, first
48 SAVE first
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
55
56 REAL ssum
57 INTEGER ismax, ismin
58 EXTERNAL ssum, convflu, ismin, ismax
59
60 DATA first/.TRUE./
61
62 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
77
78
79 DO l = 1, llm
80
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
86 ! --------------------------------
87 ! CALCUL EN LATITUDE
88 ! --------------------------------
89
90 ! 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
95 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