Context Navigation

fpmetbinary_mod.F90.SAVE @ a9c0209

fp9.3.1-20161214-nc4

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

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

Download in other formats:

Original Format