/[lmdze]/trunk/dyn3d/vlspltqs.f
ViewVC logotype

Contents of /trunk/dyn3d/vlspltqs.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 157 - (show annotations)
Mon Jul 20 16:01:49 2015 UTC (8 years, 10 months ago) by guez
Original Path: trunk/Sources/dyn3d/vlspltqs.f
File size: 3576 byte(s) 
Just encapsulated SUBROUTINE vlsplt in a module and cleaned it.

In procedure vlx, local variables dxqu and adxqu only need indices
iip2:ip1jm. Otherwise, just cleaned vlx.

Procedures dynredem0 and dynredem1 no longer have argument fichnom,
they just operate on a file named "restart.nc". The programming
guideline here is that gcm should not be more complex than it needs by
itself, other programs (ce0l etc.) just have to adapt to gcm. So ce0l
now creates files "restart.nc" and "restartphy.nc".

In order to facilitate decentralizing the writing of "restartphy.nc",
created a procedure phyredem0 out of phyredem. phyredem0 creates the
NetCDF header of "restartphy.nc" while phyredem writes the NetCDF
variables. As the global attribute itau_phy needs to be filled in
phyredem0, at the beginnig of the run, we must compute its value
instead of just using itap. So we have a dummy argument lmt_pas of
phyredem0. Also, the ncid of "startphy.nc" is upgraded from local
variable of phyetat0 to dummy argument. phyetat0 no longer closes
"startphy.nc".

Following the same decentralizing objective, the ncid of "restart.nc"
is upgraded from local variable of dynredem0 to module variable of
dynredem0_m. "restart.nc" is not closed at the end of dynredem0 nor
opened at the beginning of dynredem1.

In procedure etat0, instead of creating many vectors of size klon
which will be filled with zeroes, just create one array null_array.

In procedure phytrac, instead of writing trs(: 1) to a text file,
write it to "restartphy.nc" (following LMDZ). This is better because
now trs(: 1) is next to its coordinates. We can write to
"restartphy.nc" from phytrac directly, and not add trs(: 1) to the
long list of variables in physiq, thanks to the decentralizing of
"restartphy.nc".

In procedure phyetat0, we no longer write to standard output the
minimum and maximum values of read arrays. It is ok to check input and
abort on invalid values but just printing statistics on input seems too
much useless computation and out of place clutter.
1 module vlspltqs_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE vlspltqs(q, pente_max, masse, w, pbaru, pbarv, pdt, p, pk, teta)
8
9 ! From LMDZ4/libf/dyn3d/vlspltqs.F, version 1.2 2005/02/24 12:16:57 fairhead
10
11 ! Authors: P. Le Van, F. Hourdin, F. Forget, F. Codron
12
13 ! Schéma d'advection "pseudo amont"
14 ! + test sur humidité spécifique : Q advecté < Qsat aval
15 ! (F. Codron, 10/99)
16
17 ! q, pbaru, pbarv, w sont des arguments d'entree pour le sous-programme
18
19 ! pente_max facteur de limitation des pentes: 2 en général
20 ! 0 pour un schéma amont
21 ! pbaru, pbarv, w flux de masse en u , v , w
22 ! pdt pas de temps
23
24 ! teta température potentielle, p pression aux interfaces,
25 ! pk exner au milieu des couches nécessaire pour calculer Qsat
26
27 USE dimens_m, ONLY : iim, llm
28 use FCTTRE, only: foeew
29 USE paramet_m, ONLY : iip1, iip2, ijp1llm, ip1jm, ip1jmp1, llmp1
30 USE comconst, ONLY : cpp
31 use SUPHEC_M, only: rtt
32
33 ! Arguments:
34
35 REAL masse(ip1jmp1, llm), pente_max
36 REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
37 REAL q(ip1jmp1, llm)
38 REAL w(ip1jmp1, llm)
39 real, intent(in):: pdt
40 REAL, intent(in):: p(ip1jmp1, llmp1)
41 real, intent(in):: teta(ip1jmp1, llm)
42 real, intent(in):: pk(ip1jmp1, llm)
43
44 ! Local
45
46 INTEGER ij, l
47
48 REAL qsat(ip1jmp1, llm)
49 REAL zm(ip1jmp1, llm)
50 REAL mu(ip1jmp1, llm)
51 REAL mv(ip1jm, llm)
52 REAL mw(ip1jmp1, llm+1)
53 REAL zq(ip1jmp1, llm)
54 REAL zzpbar, zzw
55
56 !--pour rapport de melange saturant--
57
58 REAL retv, r2es, play
59 logical zdelta
60 REAL tempe(ip1jmp1)
61
62 !------------------------------------------------------------------
63
64 r2es = 380.11733
65 retv = 0.6077667
66
67 !-- Calcul de Qsat en chaque point
68 !-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
69 ! pour eviter une exponentielle.
70 DO l = 1, llm
71 DO ij = 1, ip1jmp1
72 tempe(ij) = teta(ij, l) * pk(ij, l) /cpp
73 ENDDO
74 DO ij = 1, ip1jmp1
75 zdelta = rtt > tempe(ij)
76 play = 0.5*(p(ij, l)+p(ij, l+1))
77 qsat(ij, l) = MIN(0.5, r2es* FOEEW(tempe(ij), zdelta) / play)
78 qsat(ij, l) = qsat(ij, l) / (1. - retv * qsat(ij, l))
79 ENDDO
80 ENDDO
81
82 zzpbar = 0.5 * pdt
83 zzw = pdt
84 DO l=1, llm
85 DO ij = iip2, ip1jm
86 mu(ij, l)=pbaru(ij, l) * zzpbar
87 ENDDO
88 DO ij=1, ip1jm
89 mv(ij, l)=pbarv(ij, l) * zzpbar
90 ENDDO
91 DO ij=1, ip1jmp1
92 mw(ij, l)=w(ij, l) * zzw
93 ENDDO
94 ENDDO
95
96 DO ij=1, ip1jmp1
97 mw(ij, llm+1)=0.
98 ENDDO
99
100 CALL SCOPY(ijp1llm, q, 1, zq, 1)
101 CALL SCOPY(ijp1llm, masse, 1, zm, 1)
102
103 ! call minmaxq(zq, qmin, qmax, 'avant vlxqs ')
104 call vlxqs(zq, pente_max, zm, mu, qsat)
105
106 ! call minmaxq(zq, qmin, qmax, 'avant vlyqs ')
107
108 call vlyqs(zq, pente_max, zm, mv, qsat)
109
110 ! call minmaxq(zq, qmin, qmax, 'avant vlz ')
111
112 call vlz(zq, pente_max, zm, mw)
113
114 ! call minmaxq(zq, qmin, qmax, 'avant vlyqs ')
115 ! call minmaxq(zm, qmin, qmax, 'M avant vlyqs ')
116
117 call vlyqs(zq, pente_max, zm, mv, qsat)
118
119 ! call minmaxq(zq, qmin, qmax, 'avant vlxqs ')
120 ! call minmaxq(zm, qmin, qmax, 'M avant vlxqs ')
121
122 call vlxqs(zq, pente_max, zm, mu, qsat)
123
124 ! call minmaxq(zq, qmin, qmax, 'apres vlxqs ')
125 ! call minmaxq(zm, qmin, qmax, 'M apres vlxqs ')
126
127 DO l=1, llm
128 DO ij=1, ip1jmp1
129 q(ij, l)=zq(ij, l)
130 ENDDO
131 DO ij=1, ip1jm+1, iip1
132 q(ij+iim, l)=q(ij, l)
133 ENDDO
134 ENDDO
135
136 END SUBROUTINE vlspltqs
137
138 end module vlspltqs_m
  ViewVC Help
Powered by ViewVC 1.1.21