Context Navigation

fpmetbinary_mod.F90 @ 9cdf8bd

FPv9.3.1FPv9.3.2fp9.3.1-20161214-nc4grib2nc4_repair

Last change on this file since 9cdf8bd was 9cdf8bd, checked in by Don Morton <Don.Morton@…>, 8 years ago

Incorporated checking of allocated dimensions in preprocessed files
versus the FLEXPART which reads them. See

https://www.flexpart.eu/ticket/161

Property mode set to 100644

File size: 25.2 KB

Line
1	MODULE fpmetbinary_mod
2
3	!*****************************************************************************
4	! *
5	! Contains data and routines for dumping and loading processed met *
6	! fields. *
7	! Authors Don Morton (Don.Morton@borealscicomp.com) *
8	! Delia Arnold (deliona.arnold@gmail.com) *
9	! *
10	! 15 Sep 2015 *
11	! *
12	! Currently, the only data being dumped and loaded has data structures *
13	! defined in com_mod.f90. In the future, perhaps it will be necessary *
14	! to use data structures from other parts of the FLEXPART code system. *
15	! *
16	! *
17	! Most of the data structures from com_mod.f90 that are dumped and *
18	! loaded have a final dimension of size two, so that they may hold data *
19	! from two met files. When we dump the contents into a .fp file, we *
20	! need to specify which of the two to dump. Likewise, when we load *
21	! from a .fp file, we need to specify which of the two possible indices *
22	! to load into. *
23	! *
24	! Note that these routines need more robustness. For example, what *
25	! what happens if the filename can't be read or written. Or, what *
26	! happens if a read or write fails in any way. Right now, it's crash *
27	! city. *
28	! *
29	!*****************************************************************************
30
31	USE com_mod
32	USE conv_mod
33	USE par_mod, ONLY : nxmax, nymax, nzmax, nuvzmax, nwzmax
34
35	IMPLICIT NONE
36
37	! Users may want to change these IO Unit values if they conflict with other parts
38	! of code
39	INTEGER, PARAMETER :: IOUNIT_DUMP = 33, IOUNIT_LOAD = 34, &
40	IOUNIT_TEXTOUT = 35
41	PRIVATE IOUNIT_DUMP, IOUNIT_LOAD, IOUNIT_TEXTOUT, fpio
42
43
44	CONTAINS
45
46	!*****************************************************************************
47	! *
48	! Subroutines fpmetbinary_dump() and fpmetbinary_load() provide the *
49	! public interface to *
50	! this module functionality. I created the PRIVATE fpio() because I *
51	! wanted all interactions with variables to be in one place. The read *
52	! and write operations need to be done in exactly the same sequence, so *
53	! I felt like keeping them in the same routine would at least allow for *
54	! coders to more easily compare the two sequences than if they were *
55	! separate. *
56	! *
57	! As mentioned above, the dumps and loads will, for most variables, *
58	! need to refer to one of two index values for the last dimension of *
59	! the array. *
60	! *
61	!*****************************************************************************
62
63
64	SUBROUTINE fpmetbinary_dump(filename, cm_index)
65	CHARACTER(LEN=*), INTENT(IN) :: filename ! Full path for file
66	INTEGER, INTENT(IN) :: cm_index ! Index of last dimension in
67	! most com_mod variables.
68	! Should be 1 or 2
69
70	INTEGER millisecs_start, millisecs_stop, count_rate, count_max
71
72	CALL SYSTEM_CLOCK(millisecs_start, count_rate, count_max)
73	OPEN(IOUNIT_DUMP, file=filename, action='WRITE', status='REPLACE', form="unformatted", access="stream")
74	CALL fpio(IOUNIT_DUMP, 'DUMP', cm_index)
75	CLOSE(IOUNIT_DUMP)
76	CALL SYSTEM_CLOCK(millisecs_stop, count_rate, count_max)
77
78	!PRINT *, 'Dump walltime secs: ', (millisecs_stop-millisecs_start)/1000.0
79	END SUBROUTINE fpmetbinary_dump
80
81	SUBROUTINE fpmetbinary_load(filename, cm_index)
82	CHARACTER(LEN=*), INTENT(IN) :: filename ! Full path for file
83	INTEGER, INTENT(IN) :: cm_index ! Index of last dimension in
84	! most com_mod variables.
85	! Should be 1 or 2
86
87	INTEGER millisecs_start, millisecs_stop, count_rate, count_max
88
89	CALL SYSTEM_CLOCK(millisecs_start, count_rate, count_max)
90	OPEN(IOUNIT_LOAD, file=filename, action='READ', status='OLD', form="unformatted", access="stream")
91	CALL fpio(IOUNIT_LOAD, 'LOAD', cm_index)
92	CLOSE(IOUNIT_LOAD)
93	CALL SYSTEM_CLOCK(millisecs_stop, count_rate, count_max)
94	!PRINT *, 'Load walltime secs: ', (millisecs_stop-millisecs_start)/1000.0
95	END SUBROUTINE fpmetbinary_load
96
97	SUBROUTINE fpmetbinary_zero(cm_index)
98	INTEGER, INTENT(IN) :: cm_index ! Index of last dimension in
99	! most com_mod variables.
100	! Should be 1 or 2
101
102
103	! Zeroes out, in local datastructures, the values dumped/loaded
104	! This was written primarily as a testing mechanism.
105	! The lines here correspond to READ and WRITE in the dump/load routines
106
107	! Scalar values
108	nx=0.0; ny=0.0; nxmin1=0.0; nymin1=0.0; nxfield=0.0
109	nuvz=0.0; nwz=0.0; nz=0.0; nmixz=0.0; nlev_ec=0.0
110	dx=0.0; dy=0.0; xlon0=0.0; ylat0=0.0; dxconst=0.0; dyconst=0.0
111
112	! Fixed fields, static in time
113	oro=0.0; excessoro=0.0; lsm=0.0; xlanduse=0.0; height=0.0
114
115	! 3d fields
116	uu(:,:,:,cm_index) = 0.0
117	vv(:,:,:,cm_index) = 0.0
118	uupol(:,:,:,cm_index) = 0.0
119	vvpol(:,:,:,cm_index) = 0.0
120	ww(:,:,:,cm_index) = 0.0
121	tt(:,:,:,cm_index) = 0.0
122	qv(:,:,:,cm_index) = 0.0
123	pv(:,:,:,cm_index) = 0.0
124	rho(:,:,:,cm_index) = 0.0
125	drhodz(:,:,:,cm_index) = 0.0
126	tth(:,:,:,cm_index) = 0.0
127	qvh(:,:,:,cm_index) = 0.0
128	pplev(:,:,:,cm_index) = 0.0
129	clouds(:,:,:,cm_index) = 0.0
130	cloudsh(:,:,cm_index) = 0.0
131
132	! 2d fields
133	ps(:,:,:,cm_index) = 0.0
134	sd(:,:,:,cm_index) = 0.0
135	msl(:,:,:,cm_index) = 0.0
136	tcc(:,:,:,cm_index) = 0.0
137	u10(:,:,:,cm_index) = 0.0
138	v10(:,:,:,cm_index) = 0.0
139	tt2(:,:,:,cm_index) = 0.0
140	td2(:,:,:,cm_index) = 0.0
141	lsprec(:,:,:,cm_index) = 0.0
142	convprec(:,:,:,cm_index) = 0.0
143	sshf(:,:,:,cm_index) = 0.0
144	ssr(:,:,:,cm_index) = 0.0
145	surfstr(:,:,:,cm_index) = 0.0
146	ustar(:,:,:,cm_index) = 0.0
147	wstar(:,:,:,cm_index) = 0.0
148	hmix(:,:,:,cm_index) = 0.0
149	tropopause(:,:,:,cm_index) = 0.0
150	oli(:,:,:,cm_index) = 0.0
151	diffk(:,:,:,cm_index) = 0.0
152	vdep(:,:,:,cm_index) = 0.0
153
154	! 1d fields
155	z0(:) = 0.0
156	akm(:) = 0.0
157	bkm(:) = 0.0
158	akz(:) = 0.0
159	bkz(:) = 0.0
160	aknew(:) = 0.0
161	bknew(:) = 0.0
162
163	! Nested, scalar values (for each nest)
164	nxn(:) = 0.0
165	nyn(:) = 0.0
166	dxn(:) = 0.0
167	dyn(:) = 0.0
168	xlon0n(:) = 0.0
169	ylat0n(:) = 0.0
170
171	! Nested fields, static in time
172	oron=0.0; excessoron=0.0; lsmn=0.0; xlandusen=0.0
173
174	! 3d nested fields
175	uun(:,:,:,cm_index,:) = 0.0
176	wwn(:,:,:,cm_index,:) = 0.0
177	ttn(:,:,:,cm_index,:) = 0.0
178	qvn(:,:,:,cm_index,:) = 0.0
179	pvn(:,:,:,cm_index,:) = 0.0
180	cloudsn(:,:,:,cm_index,:) = 0.0
181	cloudsnh(:,:,cm_index,:) = 0.0
182	rhon(:,:,:,cm_index,:) = 0.0
183	drhodzn(:,:,:,cm_index,:) = 0.0
184	tthn(:,:,:,cm_index,:) = 0.0
185	qvhn(:,:,:,cm_index,:) = 0.0
186
187	! 2d nested fields
188	psn(:,:,:,cm_index,:) = 0.0
189	sdn(:,:,:,cm_index,:) = 0.0
190	msln(:,:,:,cm_index,:) = 0.0
191	tccn(:,:,:,cm_index,:) = 0.0
192	u10n(:,:,:,cm_index,:) = 0.0
193	v10n(:,:,:,cm_index,:) = 0.0
194	tt2n(:,:,:,cm_index,:) = 0.0
195	td2n(:,:,:,cm_index,:) = 0.0
196	lsprecn(:,:,:,cm_index,:) = 0.0
197	convprecn(:,:,:,cm_index,:) = 0.0
198	sshfn(:,:,:,cm_index,:) = 0.0
199	ssrn(:,:,:,cm_index,:) = 0.0
200	surfstrn(:,:,:,cm_index,:) = 0.0
201	ustarn(:,:,:,cm_index,:) = 0.0
202	wstarn(:,:,:,cm_index,:) = 0.0
203	hmixn(:,:,:,cm_index,:) = 0.0
204	tropopausen(:,:,:,cm_index,:) = 0.0
205	olin(:,:,:,cm_index,:) = 0.0
206	diffkn(:,:,:,cm_index,:) = 0.0
207	vdepn(:,:,:,cm_index,:) = 0.0
208
209	! Auxiliary variables for nests
210	xresoln(:) = 0.0
211	yresoln(:) = 0.0
212	xln(:) = 0.0
213	yln(:) = 0.0
214	xrn(:) = 0.0
215	yrn(:) = 0.0
216
217	! Variables for polar stereographic projection
218	xglobal=.FALSE.; sglobal=.FALSE.; nglobal=.FALSE.
219	switchnorthg=0.0; switchsouthg=0.0
220	southpolemap(:) = 0.0
221	northpolemap(:) = 0.0
222
223	! Variables declared in conv_mod (convection)
224	pconv(:) = 0.0
225	phconv(:) = 0.0
226	dpr(:) = 0.0
227	pconv_hpa(:) = 0.0
228	phconv_hpa(:) = 0.0
229	ft(:) = 0.0
230	fq(:) = 0.0
231	fmass(:,:) = 0.0
232	sub(:) = 0.0
233	fmassfrac(:,:) = 0.0
234	cbaseflux(:,:) = 0.0
235	cbasefluxn(:,:,:) = 0.0
236	tconv(:) = 0.0
237	qconv(:) = 0.0
238	qsconv(:) = 0.0
239	psconv=0.0; tt2conv=0.0; td2conv=0.0
240	nconvlev=0.0; nconvtop=0.0
241
242	END SUBROUTINE fpmetbinary_zero
243
244	SUBROUTINE fpio(iounit, op, cm_index)
245	IMPLICIT NONE
246	INTEGER, INTENT(IN) :: iounit
247	CHARACTER(LEN=4), INTENT(IN) :: op ! Operation - DUMP or LOAD
248	INTEGER, INTENT(IN) :: cm_index ! Index of last dimension in
249	! most com_mod variables.
250	! Should be 1 or 2
251
252	! These are temporary variables, used in the LOAD option, for
253	! comparing against the current values in FLEXPART of nxmax, nymax, ...
254	INTEGER :: temp_nxmax, temp_nymax, temp_nzmax, &
255	& temp_nuvzmax, temp_nwzmax
256
257	CHARACTER(LEN=128) :: errmesg
258
259	if (op == 'DUMP') THEN
260
261	! Write the compiled max dimensions from par_mod - these are
262	! not meant to be reassigned during a LOAD, but used as "header"
263	! information to provide the structure of arrays
264	WRITE (iounit) nxmax, nymax, nzmax, nuvzmax, nwzmax
265
266	! Scalar values
267	WRITE(iounit) nx, ny, nxmin1, nymin1, nxfield
268	WRITE(iounit) nuvz, nwz, nz, nmixz, nlev_ec
269	WRITE(iounit) dx, dy, xlon0, ylat0, dxconst, dyconst
270
271	! Fixed fields, static in time
272	WRITE(iounit) oro, excessoro, lsm, xlanduse, height
273
274	! 3d fields
275	WRITE(iounit) uu(:,:,:,cm_index)
276	WRITE(iounit) vv(:,:,:,cm_index)
277	WRITE(iounit) uupol(:,:,:,cm_index)
278	WRITE(iounit) vvpol(:,:,:,cm_index)
279	WRITE(iounit) ww(:,:,:,cm_index)
280	WRITE(iounit) tt(:,:,:,cm_index)
281	WRITE(iounit) qv(:,:,:,cm_index)
282	WRITE(iounit) pv(:,:,:,cm_index)
283	WRITE(iounit) rho(:,:,:,cm_index)
284	WRITE(iounit) drhodz(:,:,:,cm_index)
285	WRITE(iounit) tth(:,:,:,cm_index)
286	WRITE(iounit) qvh(:,:,:,cm_index)
287	WRITE(iounit) pplev(:,:,:,cm_index)
288	WRITE(iounit) clouds(:,:,:,cm_index)
289	WRITE(iounit) cloudsh(:,:,cm_index)
290
291	! 2d fields
292	WRITE(iounit) ps(:,:,:,cm_index)
293	WRITE(iounit) sd(:,:,:,cm_index)
294	WRITE(iounit) msl(:,:,:,cm_index)
295	WRITE(iounit) tcc(:,:,:,cm_index)
296	WRITE(iounit) u10(:,:,:,cm_index)
297	WRITE(iounit) v10(:,:,:,cm_index)
298	WRITE(iounit) tt2(:,:,:,cm_index)
299	WRITE(iounit) td2(:,:,:,cm_index)
300	WRITE(iounit) lsprec(:,:,:,cm_index)
301	WRITE(iounit) convprec(:,:,:,cm_index)
302	WRITE(iounit) sshf(:,:,:,cm_index)
303	WRITE(iounit) ssr(:,:,:,cm_index)
304	WRITE(iounit) surfstr(:,:,:,cm_index)
305	WRITE(iounit) ustar(:,:,:,cm_index)
306	WRITE(iounit) wstar(:,:,:,cm_index)
307	WRITE(iounit) hmix(:,:,:,cm_index)
308	WRITE(iounit) tropopause(:,:,:,cm_index)
309	WRITE(iounit) oli(:,:,:,cm_index)
310	WRITE(iounit) diffk(:,:,:,cm_index)
311	WRITE(iounit) vdep(:,:,:,cm_index)
312
313	! 1d fields
314	WRITE(iounit) z0(:)
315	WRITE(iounit) akm(:)
316	WRITE(iounit) bkm(:)
317	WRITE(iounit) akz(:)
318	WRITE(iounit) bkz(:)
319	WRITE(iounit) aknew(:)
320	WRITE(iounit) bknew(:)
321
322	! Nested, scalar values (for each nest)
323	WRITE(iounit) nxn(:)
324	WRITE(iounit) nyn(:)
325	WRITE(iounit) dxn(:)
326	WRITE(iounit) dyn(:)
327	WRITE(iounit) xlon0n(:)
328	WRITE(iounit) ylat0n(:)
329
330	! Nested fields, static over time
331	WRITE(iounit) oron, excessoron, lsmn, xlandusen
332
333	! 3d nested fields
334	WRITE(iounit) uun(:,:,:,cm_index,:)
335	WRITE(iounit) vvn(:,:,:,cm_index,:)
336	WRITE(iounit) wwn(:,:,:,cm_index,:)
337	WRITE(iounit) ttn(:,:,:,cm_index,:)
338	WRITE(iounit) qvn(:,:,:,cm_index,:)
339	WRITE(iounit) pvn(:,:,:,cm_index,:)
340	WRITE(iounit) cloudsn(:,:,:,cm_index,:)
341	WRITE(iounit) cloudsnh(:,:,cm_index,:)
342	WRITE(iounit) rhon(:,:,:,cm_index,:)
343	WRITE(iounit) drhodzn(:,:,:,cm_index,:)
344	WRITE(iounit) tthn(:,:,:,cm_index,:)
345	WRITE(iounit) qvhn(:,:,:,cm_index,:)
346
347	! 2d nested fields
348	WRITE(iounit) psn(:,:,:,cm_index,:)
349	WRITE(iounit) sdn(:,:,:,cm_index,:)
350	WRITE(iounit) msln(:,:,:,cm_index,:)
351	WRITE(iounit) tccn(:,:,:,cm_index,:)
352	WRITE(iounit) u10n(:,:,:,cm_index,:)
353	WRITE(iounit) v10n(:,:,:,cm_index,:)
354	WRITE(iounit) tt2n(:,:,:,cm_index,:)
355	WRITE(iounit) td2n(:,:,:,cm_index,:)
356	WRITE(iounit) lsprecn(:,:,:,cm_index,:)
357	WRITE(iounit) convprecn(:,:,:,cm_index,:)
358	WRITE(iounit) sshfn(:,:,:,cm_index,:)
359	WRITE(iounit) ssrn(:,:,:,cm_index,:)
360	WRITE(iounit) surfstrn(:,:,:,cm_index,:)
361	WRITE(iounit) ustarn(:,:,:,cm_index,:)
362	WRITE(iounit) wstarn(:,:,:,cm_index,:)
363	WRITE(iounit) hmixn(:,:,:,cm_index,:)
364	WRITE(iounit) tropopausen(:,:,:,cm_index,:)
365	WRITE(iounit) olin(:,:,:,cm_index,:)
366	WRITE(iounit) diffkn(:,:,:,cm_index,:)
367	WRITE(iounit) vdepn(:,:,:,cm_index,:)
368
369	! Auxiliary variables for nests
370	WRITE(iounit) xresoln(:)
371	WRITE(iounit) yresoln(:)
372	WRITE(iounit) xln(:)
373	WRITE(iounit) yln(:)
374	WRITE(iounit) xrn(:)
375	WRITE(iounit) yrn(:)
376
377	! Variables for polar stereographic projection
378	WRITE(iounit) xglobal, sglobal, nglobal
379	WRITE(iounit) switchnorthg, switchsouthg
380	WRITE(iounit) southpolemap(:)
381	WRITE(iounit) northpolemap(:)
382
383	! Variables declared in conv_mod (convection)
384	WRITE(iounit) pconv(:)
385	WRITE(iounit) phconv(:)
386	WRITE(iounit) dpr(:)
387	WRITE(iounit) pconv_hpa(:)
388	WRITE(iounit) phconv_hpa(:)
389	WRITE(iounit) ft(:)
390	WRITE(iounit) fq(:)
391	WRITE(iounit) fmass(:,:)
392	WRITE(iounit) sub(:)
393	WRITE(iounit) fmassfrac(:,:)
394	WRITE(iounit) cbaseflux(:,:)
395	WRITE(iounit) cbasefluxn(:,:,:)
396	WRITE(iounit) tconv(:)
397	WRITE(iounit) qconv(:)
398	WRITE(iounit) qsconv(:)
399	WRITE(iounit) psconv, tt2conv, td2conv
400	WRITE(iounit) nconvlev, nconvtop
401
402	ELSE IF (op == 'LOAD') THEN
403
404	! Read the compiled max dimensions that were dumped from par_mod
405	! when creating the fp file, so that we can compare against
406	! current FLEXPART dimensions - they need to be the same, or else
407	! we abort.
408	READ (iounit) temp_nxmax, temp_nymax, temp_nzmax, &
409	& temp_nuvzmax, temp_nwzmax
410
411
412	IF ( (temp_nxmax == nxmax) .AND. (temp_nymax == nymax) .AND. &
413	& (temp_nzmax == nzmax) .AND. &
414	& (temp_nuvzmax == nuvzmax) .AND. &
415	& (temp_nwzmax == nwzmax) ) THEN
416	CONTINUE
417	ELSE
418	PRINT *, 'Incompatible dimensions between fp file and current FLEXPART!'
419	PRINT *, ''
420	PRINT *, ' FP file Compiled FP'
421	PRINT *, 'nxmax: ', temp_nxmax, ' ', nxmax
422	PRINT *, 'nymax: ', temp_nymax, ' ', nymax
423	PRINT *, 'nzmax: ', temp_nzmax, ' ', nzmax
424	PRINT *, 'nuvzmax: ', temp_nuvzmax, ' ', nuvzmax
425	PRINT *, 'nwzmax: ', temp_nwzmax, ' ', nwzmax
426	PRINT *, ''
427	STOP
428	END IF
429
430
431	! Scalar values
432	READ(iounit) nx, ny, nxmin1, nymin1, nxfield
433	READ(iounit) nuvz, nwz, nz, nmixz, nlev_ec
434	READ(iounit) dx, dy, xlon0, ylat0, dxconst, dyconst
435
436	! Fixed fields, static in time
437	READ(iounit) oro, excessoro, lsm, xlanduse, height
438
439	! 3d fields
440	READ(iounit) uu(:,:,:,cm_index)
441	READ(iounit) vv(:,:,:,cm_index)
442	READ(iounit) uupol(:,:,:,cm_index)
443	READ(iounit) vvpol(:,:,:,cm_index)
444	READ(iounit) ww(:,:,:,cm_index)
445	READ(iounit) tt(:,:,:,cm_index)
446	READ(iounit) qv(:,:,:,cm_index)
447	READ(iounit) pv(:,:,:,cm_index)
448	READ(iounit) rho(:,:,:,cm_index)
449	READ(iounit) drhodz(:,:,:,cm_index)
450	READ(iounit) tth(:,:,:,cm_index)
451	READ(iounit) qvh(:,:,:,cm_index)
452	READ(iounit) pplev(:,:,:,cm_index)
453	READ(iounit) clouds(:,:,:,cm_index)
454	READ(iounit) cloudsh(:,:,cm_index)
455
456	! 2d fields
457	READ(iounit) ps(:,:,:,cm_index)
458	READ(iounit) sd(:,:,:,cm_index)
459	READ(iounit) msl(:,:,:,cm_index)
460	READ(iounit) tcc(:,:,:,cm_index)
461	READ(iounit) u10(:,:,:,cm_index)
462	READ(iounit) v10(:,:,:,cm_index)
463	READ(iounit) tt2(:,:,:,cm_index)
464	READ(iounit) td2(:,:,:,cm_index)
465	READ(iounit) lsprec(:,:,:,cm_index)
466	READ(iounit) convprec(:,:,:,cm_index)
467	READ(iounit) sshf(:,:,:,cm_index)
468	READ(iounit) ssr(:,:,:,cm_index)
469	READ(iounit) surfstr(:,:,:,cm_index)
470	READ(iounit) ustar(:,:,:,cm_index)
471	READ(iounit) wstar(:,:,:,cm_index)
472	READ(iounit) hmix(:,:,:,cm_index)
473	READ(iounit) tropopause(:,:,:,cm_index)
474	READ(iounit) oli(:,:,:,cm_index)
475	READ(iounit) diffk(:,:,:,cm_index)
476	READ(iounit) vdep(:,:,:,cm_index)
477
478	! 1d fields
479	READ(iounit) z0(:)
480	READ(iounit) akm(:)
481	READ(iounit) bkm(:)
482	READ(iounit) akz(:)
483	READ(iounit) bkz(:)
484	READ(iounit) aknew(:)
485	READ(iounit) bknew(:)
486
487
488	! Nested, scalar values (for each nest)
489	READ(iounit) nxn(:)
490	READ(iounit) nyn(:)
491	READ(iounit) dxn(:)
492	READ(iounit) dyn(:)
493	READ(iounit) xlon0n(:)
494	READ(iounit) ylat0n(:)
495
496
497	! Nested fields, static over time
498	READ(iounit) oron, excessoron, lsmn, xlandusen
499
500	! 3d nested fields
501	READ(iounit) uun(:,:,:,cm_index,:)
502	READ(iounit) vvn(:,:,:,cm_index,:)
503	READ(iounit) wwn(:,:,:,cm_index,:)
504	READ(iounit) ttn(:,:,:,cm_index,:)
505	READ(iounit) qvn(:,:,:,cm_index,:)
506	READ(iounit) pvn(:,:,:,cm_index,:)
507	READ(iounit) cloudsn(:,:,:,cm_index,:)
508	READ(iounit) cloudsnh(:,:,cm_index,:)
509	READ(iounit) rhon(:,:,:,cm_index,:)
510	READ(iounit) drhodzn(:,:,:,cm_index,:)
511	READ(iounit) tthn(:,:,:,cm_index,:)
512	READ(iounit) qvhn(:,:,:,cm_index,:)
513
514	! 2d nested fields
515	READ(iounit) psn(:,:,:,cm_index,:)
516	READ(iounit) sdn(:,:,:,cm_index,:)
517	READ(iounit) msln(:,:,:,cm_index,:)
518	READ(iounit) tccn(:,:,:,cm_index,:)
519	READ(iounit) u10n(:,:,:,cm_index,:)
520	READ(iounit) v10n(:,:,:,cm_index,:)
521	READ(iounit) tt2n(:,:,:,cm_index,:)
522	READ(iounit) td2n(:,:,:,cm_index,:)
523	READ(iounit) lsprecn(:,:,:,cm_index,:)
524	READ(iounit) convprecn(:,:,:,cm_index,:)
525	READ(iounit) sshfn(:,:,:,cm_index,:)
526	READ(iounit) ssrn(:,:,:,cm_index,:)
527	READ(iounit) surfstrn(:,:,:,cm_index,:)
528	READ(iounit) ustarn(:,:,:,cm_index,:)
529	READ(iounit) wstarn(:,:,:,cm_index,:)
530	READ(iounit) hmixn(:,:,:,cm_index,:)
531	READ(iounit) tropopausen(:,:,:,cm_index,:)
532	READ(iounit) olin(:,:,:,cm_index,:)
533	READ(iounit) diffkn(:,:,:,cm_index,:)
534	READ(iounit) vdepn(:,:,:,cm_index,:)
535
536	! Auxiliary variables for nests
537	READ(iounit) xresoln(:)
538	READ(iounit) yresoln(:)
539	READ(iounit) xln(:)
540	READ(iounit) yln(:)
541	READ(iounit) xrn(:)
542	READ(iounit) yrn(:)
543
544	! Variables for polar stereographic projection
545	READ(iounit) xglobal, sglobal, nglobal
546	READ(iounit) switchnorthg, switchsouthg
547	READ(iounit) southpolemap(:)
548	READ(iounit) northpolemap(:)
549
550	! Variables declared in conv_mod (convection)
551	READ(iounit) pconv(:)
552	READ(iounit) phconv(:)
553	READ(iounit) dpr(:)
554	READ(iounit) pconv_hpa(:)
555	READ(iounit) phconv_hpa(:)
556	READ(iounit) ft(:)
557	READ(iounit) fq(:)
558	READ(iounit) fmass(:,:)
559	READ(iounit) sub(:)
560	READ(iounit) fmassfrac(:,:)
561	READ(iounit) cbaseflux(:,:)
562	READ(iounit) cbasefluxn(:,:,:)
563	READ(iounit) tconv(:)
564	READ(iounit) qconv(:)
565	READ(iounit) qsconv(:)
566	READ(iounit) psconv, tt2conv, td2conv
567	READ(iounit) nconvlev, nconvtop
568
569	ELSE
570	STOP 'fpio(): Illegal operation'
571
572	ENDIF
573	END SUBROUTINE fpio
574
575	SUBROUTINE fpmetbinary_filetext(filename, cm_index)
576
577	! This is a utility subroutine meant to be used for testing purposes.
578	! It facilitates the text output of variables read in from the
579	! specified .fp file. This routine will easily cause the program
580	! to crash due memory allocation issues, particularly when you are
581	! trying to text print 3d arrays in a single formatted statetment.
582
583	CHARACTER(LEN=*), INTENT(IN) :: filename
584	INTEGER, INTENT(IN) :: cm_index ! Index of last dimension in
585	! most com_mod variables.
586	! Should be 1 or 2
587
588	!OPEN(IOUNIT_TEXTOUT, file=filename, action='WRITE', status='REPLACE', &
589	! form="formatted", access="stream")
590	OPEN(IOUNIT_TEXTOUT, file=filename, action='WRITE', &
591	form="formatted", access="APPEND")
592
593	WRITE(IOUNIT_TEXTOUT, *) 'oro: ', oro
594	WRITE(IOUNIT_TEXTOUT, *) 'excessoro: ', excessoro
595	WRITE(IOUNIT_TEXTOUT, *) 'lsm: ', lsm
596	WRITE(IOUNIT_TEXTOUT, *) 'xlanduse: ', xlanduse
597	WRITE(IOUNIT_TEXTOUT, *) 'height: ', height
598
599	WRITE(IOUNIT_TEXTOUT, *) 'uu: ', uu(:,:,:,cm_index)
600	WRITE(IOUNIT_TEXTOUT, *) 'vv: ', vv(:,:,:,cm_index)
601	WRITE(IOUNIT_TEXTOUT, *) 'uupol: ', uupol(:,:,:,cm_index)
602	WRITE(IOUNIT_TEXTOUT, *) 'vvpol: ', vvpol(:,:,:,cm_index)
603	WRITE(IOUNIT_TEXTOUT, *) 'ww: ', ww(:,:,:,cm_index)
604	WRITE(IOUNIT_TEXTOUT, *) 'tt: ', tt(:,:,:,cm_index)
605	WRITE(IOUNIT_TEXTOUT, *) 'qv: ', qv(:,:,:,cm_index)
606	WRITE(IOUNIT_TEXTOUT, *) 'pv: ', pv(:,:,:,cm_index)
607	WRITE(IOUNIT_TEXTOUT, *) 'rho: ', rho(:,:,:,cm_index)
608	WRITE(IOUNIT_TEXTOUT, *) 'drhodz: ', drhodz(:,:,:,cm_index)
609	WRITE(IOUNIT_TEXTOUT, *) 'tth: ', tth(:,:,:,cm_index)
610	WRITE(IOUNIT_TEXTOUT, *) 'qvh: ', qvh(:,:,:,cm_index)
611	WRITE(IOUNIT_TEXTOUT, *) 'pplev: ', pplev(:,:,:,cm_index)
612	WRITE(IOUNIT_TEXTOUT, *) 'clouds: ', clouds(:,:,:,cm_index)
613	WRITE(IOUNIT_TEXTOUT, *) 'cloudsh: ', cloudsh(:,:,cm_index)
614
615
616
617
618	CLOSE(IOUNIT_TEXTOUT)
619	END SUBROUTINE fpmetbinary_filetext
620
621
622	END MODULE fpmetbinary_mod

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

Download in other formats:

Original Format