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

Annotation of /trunk/dyn3d/vlspltqs.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 109 - (hide annotations)
Wed Sep 17 10:08:00 2014 UTC (9 years, 8 months ago) by guez
File size: 3799 byte(s) 
Moved a call to writefield from guide to tau2alpha. (dxdys does not
change with itau.) So dxdys does not need to be a module variable any
longer. Other variables of modules tau2alpha_m downgraded to local
variables of tau2alpha, since they were not used elsewhere.

Procedures write_field[13]d and formcoord were never called. Could
then remove int2str.

Inline writefield_gen into writefield.

CreateNewField takes an integer array argument instead of 3 scalar
integers. CreateNewField now creates a number of dimensions adapted to
the rank of the output field, instead of always 4 dimensions.

Changed names of variables of module write_field: fieldid to
ncid, fieldindex to record, fieldvarid to varid.

In writefield_gen, if index == -1, no need to call GetFieldIndex
again, we know that the result is nbfield.

In guide, moved calls to writefield for some variables inside if
first_call: those variables do not change with time. Removed ztau:
computed only to be output, does not seem meaningful. Removed
writefield for aire: does not change with time and is already in
"grilles_gcm.nc".
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 temps1, temps2, temps3
55     REAL zzpbar, zzw
56     LOGICAL testcpu
57     SAVE testcpu
58     SAVE temps1, temps2, temps3
59 guez 3
60 guez 108 REAL qmin, qmax
61     DATA qmin, qmax/0., 1.e33/
62     DATA testcpu/.false./
63     DATA temps1, temps2, temps3/0., 0., 0./
64 guez 3
65 guez 108 !--pour rapport de melange saturant--
66 guez 3
67 guez 108 REAL retv, r2es, play
68     logical zdelta
69     REAL tempe(ip1jmp1)
70 guez 3
71 guez 108 !------------------------------------------------------------------
72 guez 3
73 guez 108 r2es = 380.11733
74     retv = 0.6077667
75 guez 3
76 guez 108 !-- Calcul de Qsat en chaque point
77     !-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
78     ! pour eviter une exponentielle.
79     DO l = 1, llm
80     DO ij = 1, ip1jmp1
81     tempe(ij) = teta(ij, l) * pk(ij, l) /cpp
82     ENDDO
83     DO ij = 1, ip1jmp1
84     zdelta = rtt > tempe(ij)
85     play = 0.5*(p(ij, l)+p(ij, l+1))
86     qsat(ij, l) = MIN(0.5, r2es* FOEEW(tempe(ij), zdelta) / play)
87     qsat(ij, l) = qsat(ij, l) / (1. - retv * qsat(ij, l))
88     ENDDO
89     ENDDO
90 guez 3
91 guez 108 zzpbar = 0.5 * pdt
92     zzw = pdt
93     DO l=1, llm
94     DO ij = iip2, ip1jm
95     mu(ij, l)=pbaru(ij, l) * zzpbar
96     ENDDO
97     DO ij=1, ip1jm
98     mv(ij, l)=pbarv(ij, l) * zzpbar
99     ENDDO
100     DO ij=1, ip1jmp1
101     mw(ij, l)=w(ij, l) * zzw
102     ENDDO
103     ENDDO
104 guez 3
105 guez 108 DO ij=1, ip1jmp1
106     mw(ij, llm+1)=0.
107     ENDDO
108 guez 3
109 guez 108 CALL SCOPY(ijp1llm, q, 1, zq, 1)
110     CALL SCOPY(ijp1llm, masse, 1, zm, 1)
111 guez 3
112 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlxqs ')
113     call vlxqs(zq, pente_max, zm, mu, qsat)
114 guez 3
115 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlyqs ')
116 guez 3
117 guez 108 call vlyqs(zq, pente_max, zm, mv, qsat)
118 guez 3
119 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlz ')
120 guez 44
121 guez 108 call vlz(zq, pente_max, zm, mw)
122 guez 44
123 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlyqs ')
124     ! call minmaxq(zm, qmin, qmax, 'M avant vlyqs ')
125 guez 44
126 guez 108 call vlyqs(zq, pente_max, zm, mv, qsat)
127 guez 44
128 guez 108 ! call minmaxq(zq, qmin, qmax, 'avant vlxqs ')
129     ! call minmaxq(zm, qmin, qmax, 'M avant vlxqs ')
130 guez 44
131 guez 108 call vlxqs(zq, pente_max, zm, mu, qsat)
132 guez 44
133 guez 108 ! call minmaxq(zq, qmin, qmax, 'apres vlxqs ')
134     ! call minmaxq(zm, qmin, qmax, 'M apres vlxqs ')
135 guez 44
136 guez 108 DO l=1, llm
137     DO ij=1, ip1jmp1
138     q(ij, l)=zq(ij, l)
139     ENDDO
140     DO ij=1, ip1jm+1, iip1
141     q(ij+iim, l)=q(ij, l)
142     ENDDO
143     ENDDO
144    
145     END SUBROUTINE vlspltqs
146    
147     end module vlspltqs_m
  ViewVC Help
Powered by ViewVC 1.1.21