/[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 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 2 months ago) by guez
File size: 6518 byte(s) 
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

Added output of relative humidity.
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 guez 173 use conf_guide_m, only: guide_u, guide_v, guide_t, guide_q, ini_anal, &
17     tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t, &
18     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 178 USE paramet_m, ONLY: iip1, jjp1, llmp1
25 guez 83 USE q_sat_m, ONLY: q_sat
26 guez 88 use read_reanalyse_m, only: read_reanalyse
27 guez 109 use tau2alpha_m, only: tau2alpha
28 guez 108 use writefield_m, only: writefield
29 guez 3
30 guez 83 INTEGER, INTENT(IN):: itau
31 guez 102 REAL, intent(inout):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
32     REAL, intent(inout):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant
33    
34 guez 108 REAL, intent(inout):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
35     ! température potentielle
36    
37     REAL, intent(inout):: q(:, :, :) ! (iim + 1, jjm + 1, llm)
38 guez 88 REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
39 guez 3
40 guez 83 ! Local:
41    
42 guez 108 ! variables dynamiques pour les réanalyses
43 guez 102
44     REAL, save:: ucovrea1(iim + 1, jjm + 1, llm), vcovrea1(iim + 1, jjm, llm)
45     ! vents covariants reanalyses
46    
47 guez 90 REAL, save:: tetarea1(iim + 1, jjm + 1, llm) ! temp pot reales
48     REAL, save:: qrea1(iim + 1, jjm + 1, llm) ! temp pot reales
49 guez 102
50     REAL, save:: ucovrea2(iim + 1, jjm + 1, llm), vcovrea2(iim + 1, jjm, llm)
51     ! vents covariants reanalyses
52    
53 guez 90 REAL, save:: tetarea2(iim + 1, jjm + 1, llm) ! temp pot reales
54     REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales
55 guez 3
56 guez 116 ! alpha détermine la part des injections de données à chaque étape
57 guez 112 ! alpha=0 signifie pas d'injection
58     ! alpha=1 signifie injection totale
59 guez 90 REAL, save:: alpha_q(iim + 1, jjm + 1)
60 guez 103 REAL, save:: alpha_t(iim + 1, jjm + 1)
61 guez 102 REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)
62    
63 guez 115 INTEGER l
64 guez 102 REAL tau
65 guez 3
66 guez 44 ! TEST SUR QSAT
67 guez 90 REAL p(iim + 1, jjm + 1, llmp1)
68     real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)
69     REAL qsat(iim + 1, jjm + 1, llm)
70 guez 3
71 guez 115 REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)
72    
73 guez 29 !-----------------------------------------------------------------------
74 guez 3
75 guez 172 IF (itau == 0) THEN
76 guez 102 IF (online) THEN
77 guez 115 IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
78     ! grille regulière
79     if (guide_u) alpha_u = factt / tau_max_u
80     if (guide_v) alpha_v = factt / tau_max_v
81     if (guide_t) alpha_t = factt / tau_max_t
82     if (guide_q) alpha_q = factt / tau_max_q
83     else
84     call init_tau2alpha(dxdys, dxdyu, dxdyv)
85 guez 3
86 guez 115 if (guide_u) then
87     CALL tau2alpha(dxdyu, rlatu, tau_min_u, tau_max_u, alpha_u)
88     CALL writefield("alpha_u", alpha_u)
89     end if
90 guez 3
91 guez 115 if (guide_v) then
92     CALL tau2alpha(dxdyv, rlatv, tau_min_v, tau_max_v, alpha_v)
93     CALL writefield("alpha_v", alpha_v)
94     end if
95 guez 3
96 guez 115 if (guide_t) then
97     CALL tau2alpha(dxdys, rlatu, tau_min_t, tau_max_t, alpha_t)
98     CALL writefield("alpha_t", alpha_t)
99     end if
100    
101     if (guide_q) then
102     CALL tau2alpha(dxdys, rlatu, tau_min_q, tau_max_q, alpha_q)
103     CALL writefield("alpha_q", alpha_q)
104     end if
105     end IF
106 guez 102 ELSE
107 guez 107 ! Cas où on force exactement par les variables analysées
108 guez 115 if (guide_u) alpha_u = 1.
109     if (guide_v) alpha_v = 1.
110     if (guide_t) alpha_t = 1.
111 guez 112 if (guide_q) alpha_q = 1.
112 guez 102 END IF
113 guez 3
114 guez 172 ! Lecture du premier état des réanalyses :
115     CALL read_reanalyse(ps, ucovrea2, vcovrea2, tetarea2, qrea2)
116     qrea2 = max(qrea2, 0.1)
117 guez 3
118 guez 172 if (ini_anal) then
119     IF (guide_u) ucov = ucovrea2
120     IF (guide_v) vcov = vcovrea2
121     IF (guide_t) teta = tetarea2
122 guez 115
123 guez 172 IF (guide_q) then
124     ! Calcul de l'humidité saturante :
125     forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps
126     CALL exner_hyb(ps, p, pks, pk)
127     q = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa)) &
128     * qrea2 * 0.01
129     end IF
130 guez 112 end if
131 guez 172 END IF
132 guez 3
133 guez 172 ! Importation des vents, pression et temp\'erature r\'eels :
134 guez 115
135 guez 102 ! Nudging fields are given 4 times per day:
136     IF (mod(itau, day_step / 4) == 0) THEN
137     vcovrea1 = vcovrea2
138     ucovrea1 = ucovrea2
139     tetarea1 = tetarea2
140     qrea1 = qrea2
141 guez 3
142 guez 172 CALL read_reanalyse(ps, ucovrea2, vcovrea2, tetarea2, qrea2)
143 guez 102 qrea2 = max(qrea2, 0.1)
144 guez 112
145     if (guide_u) then
146     CALL writefield("ucov", ucov)
147     CALL writefield("ucovrea2", ucovrea2)
148     end if
149    
150     if (guide_t) then
151     CALL writefield("teta", teta)
152     CALL writefield("tetarea2", tetarea2)
153     end if
154    
155     if (guide_q) then
156     CALL writefield("qrea2", qrea2)
157     CALL writefield("q", q)
158     end if
159 guez 102 END IF
160 guez 3
161 guez 102 ! Guidage
162 guez 3
163 guez 102 tau = mod(real(itau) / real(day_step / 4), 1.)
164 guez 3
165 guez 102 ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses
166 guez 3
167 guez 172 IF (guide_u) forall (l = 1: llm) ucov(:, :, l) = (1. - alpha_u) &
168     * ucov(:, :, l) + alpha_u * ((1. - tau) * ucovrea1(:, :, l) + tau &
169     * ucovrea2(:, :, l))
170 guez 3
171 guez 172 IF (guide_v) forall (l = 1: llm) vcov(:, :, l) = (1. - alpha_v) &
172     * vcov(:, :, l) + alpha_v * ((1. - tau) * vcovrea1(:, :, l) + tau &
173     * vcovrea2(:, :, l))
174 guez 3
175 guez 172 IF (guide_t) forall (l = 1: llm) teta(:, :, l) = (1. - alpha_t) &
176     * teta(:, :, l) + alpha_t * ((1. - tau) * tetarea1(:, :, l) + tau &
177     * tetarea2(:, :, l))
178    
179 guez 102 IF (guide_q) THEN
180     ! Calcul de l'humidité saturante :
181     forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps
182     CALL exner_hyb(ps, p, pks, pk)
183     qsat = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa))
184 guez 3
185 guez 102 ! humidité relative en % -> humidité spécifique
186 guez 172 forall (l = 1: llm) q(:, :, l) = (1. - alpha_q) * q(:, :, l) &
187     + alpha_q * (qsat(:, :, l) * ((1. - tau) * qrea1(:, :, l) &
188     + tau * qrea2(:, :, l)) * 0.01)
189 guez 102 END IF
190 guez 3
191 guez 29 END SUBROUTINE guide
192 guez 20
193     END MODULE guide_m
  ViewVC Help
Powered by ViewVC 1.1.21