/[lmdze]/trunk/Sources/dyn3d/Guide/guide.f
ViewVC logotype

Annotation of /trunk/Sources/dyn3d/Guide/guide.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: 7920 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 20 MODULE guide_m
2 guez 3
3 guez 29 ! From dyn3d/guide.F, version 1.3 2005/05/25 13:10:09
4     ! and dyn3d/guide.h, version 1.1.1.1 2004/05/19 12:53:06
5 guez 3
6 guez 37 IMPLICIT NONE
7    
8 guez 20 CONTAINS
9 guez 3
10 guez 102 SUBROUTINE guide(itau, ucov, vcov, teta, q, ps)
11 guez 3
12 guez 29 ! Author: F.Hourdin
13 guez 3
14 guez 115 USE comconst, ONLY: cpp, kappa
15     USE conf_gcm_m, ONLY: day_step
16     use conf_guide_m, only: guide_u, guide_v, guide_t, guide_q, ncep, &
17     ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, &
18     tau_max_t, tau_min_q, tau_max_q, online, factt
19 guez 88 USE dimens_m, ONLY: iim, jjm, llm
20 guez 135 USE disvert_m, ONLY: ap, bp, preff
21 guez 139 use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv
22 guez 83 USE exner_hyb_m, ONLY: exner_hyb
23 guez 115 use init_tau2alpha_m, only: init_tau2alpha
24 guez 107 use netcdf, only: nf90_nowrite
25     use netcdf95, only: nf95_close, nf95_inq_dimid, nf95_inquire_dimension, &
26     nf95_open
27 guez 39 use nr_util, only: pi
28 guez 103 USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
29 guez 83 USE q_sat_m, ONLY: q_sat
30 guez 88 use read_reanalyse_m, only: read_reanalyse
31 guez 109 use tau2alpha_m, only: tau2alpha
32 guez 108 use writefield_m, only: writefield
33 guez 3
34 guez 83 INTEGER, INTENT(IN):: itau
35 guez 102 REAL, intent(inout):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
36     REAL, intent(inout):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant
37    
38 guez 108 REAL, intent(inout):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
39     ! température potentielle
40    
41     REAL, intent(inout):: q(:, :, :) ! (iim + 1, jjm + 1, llm)
42 guez 88 REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
43 guez 3
44 guez 83 ! Local:
45    
46 guez 108 ! variables dynamiques pour les réanalyses
47 guez 102
48     REAL, save:: ucovrea1(iim + 1, jjm + 1, llm), vcovrea1(iim + 1, jjm, llm)
49     ! vents covariants reanalyses
50    
51 guez 90 REAL, save:: tetarea1(iim + 1, jjm + 1, llm) ! temp pot reales
52     REAL, save:: qrea1(iim + 1, jjm + 1, llm) ! temp pot reales
53 guez 102
54     REAL, save:: ucovrea2(iim + 1, jjm + 1, llm), vcovrea2(iim + 1, jjm, llm)
55     ! vents covariants reanalyses
56    
57 guez 90 REAL, save:: tetarea2(iim + 1, jjm + 1, llm) ! temp pot reales
58     REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales
59 guez 44 REAL, save:: masserea2(ip1jmp1, llm) ! masse
60 guez 3
61 guez 116 ! alpha détermine la part des injections de données à chaque étape
62 guez 112 ! alpha=0 signifie pas d'injection
63     ! alpha=1 signifie injection totale
64 guez 90 REAL, save:: alpha_q(iim + 1, jjm + 1)
65 guez 103 REAL, save:: alpha_t(iim + 1, jjm + 1)
66 guez 102 REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)
67    
68 guez 44 INTEGER, save:: step_rea, count_no_rea
69 guez 3
70 guez 115 INTEGER l
71 guez 108 INTEGER ncid, dimid
72 guez 102 REAL tau
73 guez 44 INTEGER, SAVE:: nlev
74 guez 3
75 guez 44 ! TEST SUR QSAT
76 guez 90 REAL p(iim + 1, jjm + 1, llmp1)
77     real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)
78     REAL qsat(iim + 1, jjm + 1, llm)
79 guez 3
80 guez 115 REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)
81    
82 guez 29 !-----------------------------------------------------------------------
83 guez 3
84 guez 108 !!PRINT *, 'Call sequence information: guide'
85 guez 3
86 guez 102 first_call: IF (itau == 0) THEN
87     IF (online) THEN
88 guez 115 IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
89     ! grille regulière
90     if (guide_u) alpha_u = factt / tau_max_u
91     if (guide_v) alpha_v = factt / tau_max_v
92     if (guide_t) alpha_t = factt / tau_max_t
93     if (guide_q) alpha_q = factt / tau_max_q
94     else
95     call init_tau2alpha(dxdys, dxdyu, dxdyv)
96 guez 3
97 guez 115 if (guide_u) then
98     CALL tau2alpha(dxdyu, rlatu, tau_min_u, tau_max_u, alpha_u)
99     CALL writefield("alpha_u", alpha_u)
100     end if
101 guez 3
102 guez 115 if (guide_v) then
103     CALL tau2alpha(dxdyv, rlatv, tau_min_v, tau_max_v, alpha_v)
104     CALL writefield("alpha_v", alpha_v)
105     end if
106 guez 3
107 guez 115 if (guide_t) then
108     CALL tau2alpha(dxdys, rlatu, tau_min_t, tau_max_t, alpha_t)
109     CALL writefield("alpha_t", alpha_t)
110     end if
111    
112     if (guide_q) then
113     CALL tau2alpha(dxdys, rlatu, tau_min_q, tau_max_q, alpha_q)
114     CALL writefield("alpha_q", alpha_q)
115     end if
116     end IF
117 guez 102 ELSE
118 guez 107 ! Cas où on force exactement par les variables analysées
119 guez 115 if (guide_u) alpha_u = 1.
120     if (guide_v) alpha_v = 1.
121     if (guide_t) alpha_t = 1.
122 guez 112 if (guide_q) alpha_q = 1.
123 guez 102 END IF
124 guez 3
125 guez 102 step_rea = 1
126     count_no_rea = 0
127 guez 3
128 guez 115 ! lecture d'un fichier netcdf pour determiner le nombre de niveaux :
129    
130 guez 112 if (guide_u) then
131     call nf95_open('u.nc',Nf90_NOWRITe,ncid)
132     else if (guide_v) then
133     call nf95_open('v.nc',nf90_nowrite,ncid)
134     else if (guide_T) then
135     call nf95_open('T.nc',nf90_nowrite,ncid)
136     else
137     call nf95_open('hur.nc',nf90_nowrite, ncid)
138     end if
139 guez 3
140 guez 102 IF (ncep) THEN
141 guez 108 call nf95_inq_dimid(ncid, 'LEVEL', dimid)
142 guez 102 ELSE
143 guez 108 call nf95_inq_dimid(ncid, 'PRESSURE', dimid)
144 guez 102 END IF
145 guez 108 call nf95_inquire_dimension(ncid, dimid, nclen=nlev)
146 guez 115 PRINT *, 'nlev = ', nlev
147 guez 108 call nf95_close(ncid)
148 guez 115
149     ! Lecture du premier état des réanalyses :
150 guez 102 CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
151     masserea2, nlev)
152     qrea2 = max(qrea2, 0.1)
153     END IF first_call
154 guez 3
155 guez 102 ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:
156 guez 3
157 guez 102 ! Nudging fields are given 4 times per day:
158     IF (mod(itau, day_step / 4) == 0) THEN
159     vcovrea1 = vcovrea2
160     ucovrea1 = ucovrea2
161     tetarea1 = tetarea2
162     qrea1 = qrea2
163 guez 3
164 guez 116 PRINT *, 'Lecture fichiers guidage, pas ', step_rea, 'apres ', &
165 guez 102 count_no_rea, ' non lectures'
166     step_rea = step_rea + 1
167     CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
168     masserea2, nlev)
169     qrea2 = max(qrea2, 0.1)
170 guez 112
171     if (guide_u) then
172     CALL writefield("ucov", ucov)
173     CALL writefield("ucovrea2", ucovrea2)
174     end if
175    
176     if (guide_t) then
177     CALL writefield("teta", teta)
178     CALL writefield("tetarea2", tetarea2)
179     end if
180    
181     if (guide_q) then
182     CALL writefield("qrea2", qrea2)
183     CALL writefield("q", q)
184     end if
185 guez 102 ELSE
186     count_no_rea = count_no_rea + 1
187     END IF
188 guez 3
189 guez 102 ! Guidage
190 guez 3
191 guez 102 tau = mod(real(itau) / real(day_step / 4), 1.)
192 guez 3
193 guez 102 ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses
194 guez 3
195 guez 102 IF (guide_u) THEN
196     IF (itau == 0 .AND. ini_anal) then
197     ucov = ucovrea1
198     else
199     forall (l = 1: llm) ucov(:, :, l) = (1. - alpha_u) * ucov(:, :, l) &
200     + alpha_u * ((1. - tau) * ucovrea1(:, :, l) &
201     + tau * ucovrea2(:, :, l))
202     end IF
203     END IF
204 guez 3
205 guez 102 IF (guide_t) THEN
206     IF (itau == 0 .AND. ini_anal) then
207     teta = tetarea1
208     else
209     forall (l = 1: llm) teta(:, :, l) = (1. - alpha_t) * teta(:, :, l) &
210     + alpha_t * ((1. - tau) * tetarea1(:, :, l) &
211     + tau * tetarea2(:, :, l))
212     end IF
213     END IF
214 guez 3
215 guez 102 IF (guide_q) THEN
216     ! Calcul de l'humidité saturante :
217     forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps
218     CALL exner_hyb(ps, p, pks, pk)
219     qsat = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa))
220 guez 3
221 guez 102 ! humidité relative en % -> humidité spécifique
222     IF (itau == 0 .AND. ini_anal) then
223     q = qsat * qrea1 * 0.01
224     else
225     forall (l = 1: llm) q(:, :, l) = (1. - alpha_q) * q(:, :, l) &
226     + alpha_q * (qsat(:, :, l) * ((1. - tau) * qrea1(:, :, l) &
227     + tau * qrea2(:, :, l)) * 0.01)
228     end IF
229     END IF
230 guez 3
231 guez 102 IF (guide_v) THEN
232     IF (itau == 0 .AND. ini_anal) then
233     vcov = vcovrea1
234     else
235     forall (l = 1: llm) vcov(:, :, l) = (1. - alpha_v) * vcov(:, :, l) &
236     + alpha_v * ((1. - tau) * vcovrea1(:, :, l) &
237     + tau * vcovrea2(:, :, l))
238     end IF
239     END IF
240 guez 3
241 guez 29 END SUBROUTINE guide
242 guez 20
243     END MODULE guide_m

  ViewVC Help
Powered by ViewVC 1.1.21