source: flexpart.git/flexpart_code/fpmetbinary_mod.F90 @ b9970e3

fp9.3.1-20161214-nc4
Last change on this file since b9970e3 was b9970e3, checked in by Don Morton <Don.Morton@…>, 7 years ago

Incremental addition and testing of NC4 formatting to preprocessed met data

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