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

Annotation of /trunk/dyn3d/vlspltqs.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 157 - (hide 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 guez 108 module vlspltqs_m
2 guez 3
3 guez 108 IMPLICIT NONE
4 guez 3
5 guez 108 contains
6 guez 3
7 guez 108 SUBROUTINE vlspltqs(q, pente_max, masse, w, pbaru, pbarv, pdt, p, pk, teta)
8 guez 3
9 guez 108 ! From LMDZ4/libf/dyn3d/vlspltqs.F, version 1.2 2005/02/24 12:16:57 fairhead
10 guez 3
11 guez 108 ! Authors: P. Le Van, F. Hourdin, F. Forget, F. Codron
12 guez 3
13 guez 108 ! Schéma d'advection "pseudo amont"
14     ! + test sur humidité spécifique : Q advecté < Qsat aval
15     ! (F. Codron, 10/99)
16 guez 3
17 guez 108 ! q, pbaru, pbarv, w sont des arguments d'entree pour le sous-programme
18 guez 3
19 guez 108 ! 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 guez 3
24 guez 108 ! teta température potentielle, p pression aux interfaces,
25     ! pk exner au milieu des couches nécessaire pour calculer Qsat
26 guez 3
27 guez 108 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 guez 3
33 guez 108 ! Arguments:
34 guez 3
35 guez 108 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 guez 3
44 guez 108 ! Local
45 guez 3
46 guez 109 INTEGER ij, l
47 guez 3
48 guez 108 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 guez 3
56 guez 108 !--pour rapport de melange saturant--
57 guez 3
58 guez 108 REAL retv, r2es, play
59     logical zdelta
60     REAL tempe(ip1jmp1)
61 guez 3
62 guez 108 !------------------------------------------------------------------
63 guez 3
64 guez 108 r2es = 380.11733
65     retv = 0.6077667
66 guez 3
67 guez 108 !-- 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 guez 3
82 guez 108 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 guez 3
96 guez 108 DO ij=1, ip1jmp1
97     mw(ij, llm+1)=0.
98     ENDDO
99 guez 3
100 guez 108 CALL SCOPY(ijp1llm, q, 1, zq, 1)
101     CALL SCOPY(ijp1llm, masse, 1, zm, 1)
102 guez 3
103 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlxqs ')
104     call vlxqs(zq, pente_max, zm, mu, qsat)
105 guez 3
106 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlyqs ')
107 guez 3
108 guez 108 call vlyqs(zq, pente_max, zm, mv, qsat)
109 guez 3
110 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlz ')
111 guez 44
112 guez 108 call vlz(zq, pente_max, zm, mw)
113 guez 44
114 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlyqs ')
115     ! call minmaxq(zm, qmin, qmax, 'M avant vlyqs ')
116 guez 44
117 guez 108 call vlyqs(zq, pente_max, zm, mv, qsat)
118 guez 44
119 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlxqs ')
120     ! call minmaxq(zm, qmin, qmax, 'M avant vlxqs ')
121 guez 44
122 guez 108 call vlxqs(zq, pente_max, zm, mu, qsat)
123 guez 44
124 guez 108 ! call minmaxq(zq, qmin, qmax, 'apres vlxqs ')
125     ! call minmaxq(zm, qmin, qmax, 'M apres vlxqs ')
126 guez 44
127 guez 108 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