/[lmdze]/trunk/Sources/dyn3d/dynetat0.f
ViewVC logotype

Contents of /trunk/Sources/dyn3d/dynetat0.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
File size: 7149 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 dynetat0_m
2
3 use dimens_m, only: iim, jjm
4
5 IMPLICIT NONE
6
7 private iim, jjm
8
9 INTEGER day_ini
10 ! day number at the beginning of the run, based at value 1 on
11 ! January 1st of annee_ref
12
13 integer:: day_ref = 1 ! jour de l'ann\'ee de l'\'etat initial
14 ! (= 350 si 20 d\'ecembre par exemple)
15
16 integer:: annee_ref = 1998 ! Annee de l'etat initial (avec 4 chiffres)
17
18 REAL clon ! longitude of the center of the zoom, in rad
19 real clat ! latitude of the center of the zoom, in rad
20
21 real grossismx, grossismy
22 ! facteurs de grossissement du zoom, selon la longitude et la latitude
23 ! = 2 si 2 fois, = 3 si 3 fois, etc.
24
25 real dzoomx, dzoomy
26 ! extensions en longitude et latitude de la zone du zoom (fractions
27 ! de la zone totale)
28
29 real taux, tauy
30 ! raideur de la transition de l'int\'erieur \`a l'ext\'erieur du zoom
31
32 real rlatu(jjm + 1)
33 ! latitudes of points of the "scalar" and "u" grid, in rad
34
35 real rlatv(jjm)
36 ! latitudes of points of the "v" grid, in rad, in decreasing order
37
38 real rlonu(iim + 1) ! longitudes of points of the "u" grid, in rad
39
40 real rlonv(iim + 1)
41 ! longitudes of points of the "scalar" and "v" grid, in rad
42
43 real xprimu(iim + 1), xprimv(iim + 1)
44 ! 2 pi / iim * (derivative of the longitudinal zoom function)(rlon[uv])
45
46 REAL xprimm025(iim + 1), xprimp025(iim + 1)
47 REAL rlatu1(jjm), rlatu2(jjm), yprimu1(jjm), yprimu2(jjm)
48
49 save
50
51 contains
52
53 SUBROUTINE dynetat0(vcov, ucov, teta, q, masse, ps, phis)
54
55 ! From dynetat0.F, version 1.2, 2004/06/22 11:45:30
56 ! Authors: P. Le Van, L. Fairhead
57 ! This procedure reads the initial state of the atmosphere.
58
59 use comconst, only: dtvr
60 use conf_gcm_m, only: raz_date
61 use dimens_m, only: iim, jjm, llm, nqmx
62 use disvert_m, only: pa
63 use ener, only: etot0, ang0, ptot0, stot0, ztot0
64 use iniadvtrac_m, only: tname
65 use netcdf, only: NF90_NOWRITE, NF90_NOERR
66 use netcdf95, only: NF95_GET_VAR, nf95_open, nf95_inq_varid, NF95_CLOSE, &
67 NF95_Gw_VAR
68 use nr_util, only: assert
69 use temps, only: itau_dyn
70 use unit_nml_m, only: unit_nml
71
72 REAL, intent(out):: vcov(: , :, :) ! (iim + 1, jjm, llm)
73 REAL, intent(out):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
74 REAL, intent(out):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
75 REAL, intent(out):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
76 REAL, intent(out):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
77 REAL, intent(out):: ps(:, :) ! (iim + 1, jjm + 1) in Pa
78 REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
79
80 ! Local variables:
81 INTEGER iq
82 REAL, pointer:: tab_cntrl(:) ! tableau des param\`etres du run
83 INTEGER ierr, ncid, varid
84
85 namelist /dynetat0_nml/ day_ref, annee_ref
86
87 !-----------------------------------------------------------------------
88
89 print *, "Call sequence information: dynetat0"
90
91 call assert((/size(ucov, 1), size(vcov, 1), size(masse, 1), size(ps, 1), &
92 size(phis, 1), size(q, 1), size(teta, 1)/) == iim + 1, "dynetat0 iim")
93 call assert((/size(ucov, 2), size(vcov, 2) + 1, size(masse, 2), &
94 size(ps, 2), size(phis, 2), size(q, 2), size(teta, 2)/) == jjm + 1, &
95 "dynetat0 jjm")
96 call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(q, 3), &
97 size(masse, 3)/) == llm, "dynetat0 llm")
98 call assert(size(q, 4) == nqmx, "dynetat0 q nqmx")
99
100 ! Fichier \'etat initial :
101 call nf95_open("start.nc", NF90_NOWRITE, ncid)
102
103 call nf95_inq_varid(ncid, "controle", varid)
104 call NF95_Gw_VAR(ncid, varid, tab_cntrl)
105
106 call assert(int(tab_cntrl(1)) == iim, "dynetat0 tab_cntrl iim")
107 call assert(int(tab_cntrl(2)) == jjm, "dynetat0 tab_cntrl jjm")
108 call assert(int(tab_cntrl(3)) == llm, "dynetat0 tab_cntrl llm")
109
110 IF (dtvr /= tab_cntrl(12)) THEN
111 print *, 'Warning: the time steps from day_step and "start.nc" ' // &
112 'are different.'
113 print *, 'dtvr from day_step: ', dtvr
114 print *, 'dtvr from "start.nc": ', tab_cntrl(12)
115 print *, 'Using the value from day_step.'
116 ENDIF
117
118 etot0 = tab_cntrl(13)
119 ptot0 = tab_cntrl(14)
120 ztot0 = tab_cntrl(15)
121 stot0 = tab_cntrl(16)
122 ang0 = tab_cntrl(17)
123 pa = tab_cntrl(18)
124
125 clon = tab_cntrl(20)
126 clat = tab_cntrl(21)
127 grossismx = tab_cntrl(22)
128 grossismy = tab_cntrl(23)
129 dzoomx = tab_cntrl(25)
130 dzoomy = tab_cntrl(26)
131 taux = tab_cntrl(28)
132 tauy = tab_cntrl(29)
133
134 print *, "Enter namelist 'dynetat0_nml'."
135 read(unit=*, nml=dynetat0_nml)
136 write(unit_nml, nml=dynetat0_nml)
137
138 if (raz_date) then
139 print *, 'Resetting the date, using the namelist.'
140 day_ini = day_ref
141 itau_dyn = 0
142 else
143 day_ref = tab_cntrl(4)
144 annee_ref = tab_cntrl(5)
145 itau_dyn = tab_cntrl(31)
146 day_ini = tab_cntrl(30)
147 end if
148
149 print *, "day_ini = ", day_ini
150
151 deallocate(tab_cntrl) ! pointer
152
153 call NF95_INQ_VARID (ncid, "rlonu", varid)
154 call NF95_GET_VAR(ncid, varid, rlonu)
155
156 call NF95_INQ_VARID (ncid, "rlatu", varid)
157 call NF95_GET_VAR(ncid, varid, rlatu)
158
159 call NF95_INQ_VARID (ncid, "rlonv", varid)
160 call NF95_GET_VAR(ncid, varid, rlonv)
161
162 call NF95_INQ_VARID (ncid, "rlatv", varid)
163 call NF95_GET_VAR(ncid, varid, rlatv)
164
165 CALL nf95_inq_varid(ncid, 'xprimu', varid)
166 CALL nf95_get_var(ncid, varid, xprimu)
167
168 CALL nf95_inq_varid(ncid, 'xprimv', varid)
169 CALL nf95_get_var(ncid, varid, xprimv)
170
171 CALL nf95_inq_varid(ncid, 'xprimm025', varid)
172 CALL nf95_get_var(ncid, varid, xprimm025)
173
174 CALL nf95_inq_varid(ncid, 'xprimp025', varid)
175 CALL nf95_get_var(ncid, varid, xprimp025)
176
177 call NF95_INQ_VARID (ncid, "rlatu1", varid)
178 call NF95_GET_VAR(ncid, varid, rlatu1)
179
180 call NF95_INQ_VARID (ncid, "rlatu2", varid)
181 call NF95_GET_VAR(ncid, varid, rlatu2)
182
183 CALL nf95_inq_varid(ncid, 'yprimu1', varid)
184 CALL nf95_get_var(ncid, varid, yprimu1)
185
186 CALL nf95_inq_varid(ncid, 'yprimu2', varid)
187 CALL nf95_get_var(ncid, varid, yprimu2)
188
189 call NF95_INQ_VARID (ncid, "phisinit", varid)
190 call NF95_GET_VAR(ncid, varid, phis)
191
192 call NF95_INQ_VARID (ncid, "ucov", varid)
193 call NF95_GET_VAR(ncid, varid, ucov)
194
195 call NF95_INQ_VARID (ncid, "vcov", varid)
196 call NF95_GET_VAR(ncid, varid, vcov)
197
198 call NF95_INQ_VARID (ncid, "teta", varid)
199 call NF95_GET_VAR(ncid, varid, teta)
200
201 DO iq = 1, nqmx
202 call NF95_INQ_VARID(ncid, tname(iq), varid, ierr)
203 IF (ierr == NF90_NOERR) THEN
204 call NF95_GET_VAR(ncid, varid, q(:, :, :, iq))
205 ELSE
206 PRINT *, 'dynetat0: "' // tname(iq) // '" not found, ' // &
207 "setting it to zero..."
208 q(:, :, :, iq) = 0.
209 ENDIF
210 ENDDO
211
212 call NF95_INQ_VARID (ncid, "masse", varid)
213 call NF95_GET_VAR(ncid, varid, masse)
214
215 call NF95_INQ_VARID (ncid, "ps", varid)
216 call NF95_GET_VAR(ncid, varid, ps)
217 ! Check that there is a single value at each pole:
218 call assert(ps(1, 1) == ps(2:, 1), "dynetat0 ps north pole")
219 call assert(ps(1, jjm + 1) == ps(2:, jjm + 1), "dynetat0 ps south pole")
220
221 call NF95_CLOSE(ncid)
222
223 END SUBROUTINE dynetat0
224
225 end module dynetat0_m

  ViewVC Help
Powered by ViewVC 1.1.21