Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

iniwrite.F

Last change on this file was 2573, checked in by emillour, 3 years ago
Mars GCM: Fixes for the picky gfortran10 compiler which identifies using a scalar instead of a one-element array as an error. MW+EM
File size: 11.8 KB

Line
1	SUBROUTINE iniwrite(nid,idayref,phis,area,nbplon,nbplat)
2
3	use comsoil_h, only: mlayer, nsoilmx
4	USE comcstfi_h, only: g, mugaz, omeg, rad, rcp, pi
5	USE vertical_layers_mod, ONLY: ap,bp,aps,bps,pseudoalt
6	! USE logic_mod, ONLY: fxyhypb,ysinus
7	! USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy
8	USE time_phylmdz_mod, ONLY: hour_ini, daysec, dtphys
9	! USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
10	USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
11	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
12	use phyetat0_mod, only: tab_cntrl_mod
13	IMPLICIT NONE
14
15	c=======================================================================
16	c
17	c Auteur: L. Fairhead , P. Le Van, Y. Wanherdrick, F. Forget
18	c -------
19	c
20	c Objet:
21	c ------
22	c
23	c 'Initialize' the diagfi.nc file: write down dimensions as well
24	c as time-independent fields (e.g: geopotential, mesh area, ...)
25	c
26	c=======================================================================
27	c-----------------------------------------------------------------------
28	c Declarations:
29	c -------------
30
31	include "netcdf.inc"
32
33	c Arguments:
34	c ----------
35
36	integer,intent(in) :: nid ! NetCDF file ID
37	INTEGER*4,intent(in) :: idayref ! date (initial date for this run)
38	real,intent(in) :: phis(nbplon,nbp_lat) ! surface geopotential
39	real,intent(in) :: area(nbplon,nbp_lat) ! mesh area (m2)
40	integer,intent(in) :: nbplon,nbplat ! sizes of area and phis arrays
41
42	c Local:
43	c ------
44	! INTEGER length,l
45	! parameter (length = 100)
46	! REAL tab_cntrl(length) ! run parameters are stored in this array
47	INTEGER ierr
48	REAl,ALLOCATABLE :: lon_reg_ext(:) ! extended longitudes
49
50	integer :: nvarid,idim_index,idim_rlonv
51	integer :: idim_rlatu,idim_llmp1,idim_llm
52	integer :: idim_nsoilmx ! "subsurface_layers" dimension ID #
53	integer, dimension(2) :: id
54	c-----------------------------------------------------------------------
55
56	IF (nbp_lon*nbp_lat==1) THEN
57	! 1D model
58	ALLOCATE(lon_reg_ext(1))
59	ELSE
60	! 3D model
61	ALLOCATE(lon_reg_ext(nbp_lon+1))
62	ENDIF
63
64	! DO l=1,length
65	! tab_cntrl(l)=0.
66	! ENDDO
67	! tab_cntrl(1) = real(nbp_lon)
68	! tab_cntrl(2) = real(nbp_lat-1)
69	! tab_cntrl(3) = real(nbp_lev)
70	! tab_cntrl(4) = real(idayref)
71	! tab_cntrl(5) = rad
72	! tab_cntrl(6) = omeg
73	! tab_cntrl(7) = g
74	! tab_cntrl(8) = mugaz
75	! tab_cntrl(9) = rcp
76	! tab_cntrl(10) = daysec
77	! tab_cntrl(11) = dtphys
78	! tab_cntrl(12) = etot0
79	! tab_cntrl(13) = ptot0
80	! tab_cntrl(14) = ztot0
81	! tab_cntrl(15) = stot0
82	! tab_cntrl(16) = ang0
83
84	! tab_cntrl(27) = hour_ini
85	c
86	c .......... P.Le Van ( ajout le 8/04/96 ) .........
87	c ..... parametres pour le zoom ......
88	! tab_cntrl(17) = clon
89	! tab_cntrl(18) = clat
90	! tab_cntrl(19) = grossismx
91	! tab_cntrl(20) = grossismy
92	c
93	c ..... ajout le 6/05/97 et le 15/10/97 .......
94	c
95	! IF ( fxyhypb ) THEN
96	! tab_cntrl(21) = 1.
97	! tab_cntrl(22) = dzoomx
98	! tab_cntrl(23) = dzoomy
99	! ELSE
100	! tab_cntrl(21) = 0.
101	! tab_cntrl(22) = dzoomx
102	! tab_cntrl(23) = dzoomy
103	! tab_cntrl(24) = 0.
104	! IF( ysinus ) tab_cntrl(24) = 1.
105	! ENDIF
106
107	c .........................................................
108
109	! Define dimensions
110
111	ierr = NF_REDEF (nid)
112
113	ierr = NF_DEF_DIM (nid, "index", SIZE(tab_cntrl_mod), idim_index)
114	! ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
115	ierr = NF_DEF_DIM (nid, "latitude", nbp_lat, idim_rlatu)
116	IF (nbp_lon*nbp_lat==1) THEN
117	ierr = NF_DEF_DIM (nid, "longitude", 1, idim_rlonv)
118	ELSE
119	ierr = NF_DEF_DIM (nid, "longitude", nbp_lon+1, idim_rlonv)
120	ENDIF
121	! ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
122	ierr = NF_DEF_DIM (nid, "interlayer", (nbp_lev+1), idim_llmp1)
123	ierr = NF_DEF_DIM (nid, "altitude", nbp_lev, idim_llm)
124	ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
125	c
126	ierr = NF_ENDDEF(nid)
127
128	c Contol parameters for this run
129	ierr = NF_REDEF (nid)
130	#ifdef NC_DOUBLE
131	ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1,
132	. [idim_index],nvarid)
133	#else
134	ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1,
135	. [idim_index],nvarid)
136	#endif
137	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
138	. "Control parameters")
139	ierr = NF_ENDDEF(nid)
140	#ifdef NC_DOUBLE
141	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl_mod)
142	#else
143	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl_mod)
144	#endif
145
146	c --------------------------
147	c longitudes and latitudes
148	!
149	! ierr = NF_REDEF (nid)
150	!#ifdef NC_DOUBLE
151	! ierr = NF_DEF_VAR (nid, "rlonu", NF_DOUBLE, 1, idim_rlonu,nvarid)
152	!#else
153	! ierr = NF_DEF_VAR (nid, "rlonu", NF_FLOAT, 1, idim_rlonu,nvarid)
154	!#endif
155	! ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
156	! . "Longitudes at u nodes")
157	! ierr = NF_ENDDEF(nid)
158	!#ifdef NC_DOUBLE
159	! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu/pi*180)
160	!#else
161	! ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu/pi*180)
162	!#endif
163	c
164	c --------------------------
165	ierr = NF_REDEF (nid)
166	#ifdef NC_DOUBLE
167	ierr=NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,[idim_rlatu],nvarid)
168	#else
169	ierr=NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,[idim_rlatu],nvarid)
170	#endif
171	ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
172	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
173	. "North latitude")
174	ierr = NF_ENDDEF(nid)
175	#ifdef NC_DOUBLE
176	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lat_reg/pi*180)
177	#else
178	ierr = NF_PUT_VAR_REAL (nid,nvarid,lat_reg/pi*180)
179	#endif
180	c
181	c --------------------------
182
183	lon_reg_ext(1:nbp_lon)=lon_reg(1:nbp_lon)
184	IF (nbp_lon*nbp_lat/=1) THEN
185	! In 3D, add extra redundant point (180 degrees,
186	! since lon_reg starts at -180)
187	lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
188	ENDIF
189
190	ierr = NF_REDEF (nid)
191	#ifdef NC_DOUBLE
192	ierr =NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,[idim_rlonv],nvarid)
193	#else
194	ierr = NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,[idim_rlonv],nvarid)
195	#endif
196	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
197	. "East longitude")
198	ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
199	ierr = NF_ENDDEF(nid)
200	#ifdef NC_DOUBLE
201	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lon_reg_ext/pi*180)
202	#else
203	ierr = NF_PUT_VAR_REAL (nid,nvarid,lon_reg_ext/pi*180)
204	#endif
205	c
206	c --------------------------
207	ierr = NF_REDEF (nid)
208	#ifdef NC_DOUBLE
209	ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
210	. [idim_llm],nvarid)
211	#else
212	ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
213	. [idim_llm],nvarid)
214	#endif
215	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
216	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
217	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
218
219	ierr = NF_ENDDEF(nid)
220	#ifdef NC_DOUBLE
221	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
222	#else
223	ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
224	#endif
225	c
226	c --------------------------
227	! ierr = NF_REDEF (nid)
228	!#ifdef NC_DOUBLE
229	! ierr = NF_DEF_VAR (nid, "rlatv",NF_DOUBLE,1,[idim_rlatv],nvarid)
230	!#else
231	! ierr = NF_DEF_VAR (nid, "rlatv",NF_FLOAT,1,[idim_rlatv],nvarid)
232	!#endif
233	! ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
234	! . "Latitudes at v nodes")
235	! ierr = NF_ENDDEF(nid)
236	!#ifdef NC_DOUBLE
237	! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv/pi*180)
238	!#else
239	! ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv/pi*180)
240	!#endif
241	c
242	c --------------------------
243	c Vertical levels
244	call def_var(nid,"aps","hybrid pressure at midlayers ","Pa",
245	. 1,idim_llm,nvarid,ierr)
246	#ifdef NC_DOUBLE
247	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
248	#else
249	ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
250	#endif
251
252	call def_var(nid,"bps","hybrid sigma at midlayers"," ",
253	. 1,idim_llm,nvarid,ierr)
254	#ifdef NC_DOUBLE
255	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
256	#else
257	ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
258	#endif
259
260	call def_var(nid,"ap","hybrid pressure at interlayers","Pa",
261	. 1,idim_llmp1,nvarid,ierr)
262	#ifdef NC_DOUBLE
263	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
264	#else
265	ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
266	#endif
267
268	call def_var(nid,"bp","hybrid sigma at interlayers"," ",
269	. 1,idim_llmp1,nvarid,ierr)
270	#ifdef NC_DOUBLE
271	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
272	#else
273	ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
274	#endif
275
276	!-------------------------------
277	! (soil) depth variable mlayer() (known from comsoil_h)
278	!-------------------------------
279	ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
280	! define variable
281	#ifdef NC_DOUBLE
282	ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,[idim_nsoilmx],nvarid)
283	#else
284	ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,[idim_nsoilmx],nvarid)
285	#endif
286	ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
287	. "Soil mid-layer depth")
288	ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
289	ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
290	ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
291	! write variable
292	#ifdef NC_DOUBLE
293	ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
294	#else
295	ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
296	#endif
297
298	c
299	c --------------------------
300	c Mesh area and conversion coefficients cov. <-> contra. <--> natural
301
302	! id(1)=idim_rlonu
303	! id(2)=idim_rlatu
304	c
305	! ierr = NF_REDEF (nid)
306	!#ifdef NC_DOUBLE
307	! ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
308	!#else
309	! ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
310	!#endif
311	! ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
312	! . "Conversion coefficients cov <--> natural")
313	! ierr = NF_ENDDEF(nid)
314	!#ifdef NC_DOUBLE
315	! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
316	!#else
317	! ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
318	!#endif
319	c
320	! id(1)=idim_rlonv
321	! id(2)=idim_rlatv
322	c
323	c --------------------------
324	! ierr = NF_REDEF (nid)
325	!#ifdef NC_DOUBLE
326	! ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
327	!#else
328	! ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
329	!#endif
330	! ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
331	! . "Conversion coefficients cov <--> natural")
332	! ierr = NF_ENDDEF(nid)
333	!#ifdef NC_DOUBLE
334	! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
335	!#else
336	! ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
337	!#endif
338	c
339	id(1)=idim_rlonv
340	id(2)=idim_rlatu
341	c
342	c --------------------------
343	ierr = NF_REDEF (nid)
344	#ifdef NC_DOUBLE
345	ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
346	#else
347	ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
348	#endif
349	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
350	. "Mesh area")
351	ierr = NF_ENDDEF(nid)
352	#ifdef NC_DOUBLE
353	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
354	#else
355	ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
356	#endif
357	c
358	c Surface geopotential
359	id(1)=idim_rlonv
360	id(2)=idim_rlatu
361	c
362	ierr = NF_REDEF (nid)
363	#ifdef NC_DOUBLE
364	ierr = NF_DEF_VAR (nid, "phisinit", NF_DOUBLE, 2, id,nvarid)
365	#else
366	ierr = NF_DEF_VAR (nid, "phisinit", NF_FLOAT, 2, id,nvarid)
367	#endif
368	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
369	. "Geopotential at the surface")
370	ierr = NF_ENDDEF(nid)
371	#ifdef NC_DOUBLE
372	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
373	#else
374	ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
375	#endif
376	c
377
378	write(,)'iniwrite: nbp_lon,nbp_lat,nbp_lev,idayref',
379	& nbp_lon,nbp_lat,nbp_lev,idayref
380	write(,)'iniwrite: rad,omeg,g,mugaz,rcp',
381	& rad,omeg,g,mugaz,rcp
382	write(,)'iniwrite: daysec,dtphys',daysec,dtphys
383
384	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format