source: trunk/WRF.COMMON/WRFV2/frame/module_quilt_outbuf_ops.F @ 3553

Last change on this file since 3553 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 25.3 KB
Line 
1MODULE module_quilt_outbuf_ops
2!<DESCRIPTION>
3!<PRE>
4! This module contains routines and data structures used by the I/O quilt
5! servers to assemble fields ("quilting") and write them to disk. 
6!</PRE>
7!</DESCRIPTION>
8  INTEGER, PARAMETER :: tabsize = 1000
9  INTEGER            :: num_entries
10
11  TYPE outrec
12    CHARACTER*80                       :: VarName, DateStr, MemoryOrder, Stagger, DimNames(3)
13    INTEGER                            :: ndim
14    INTEGER, DIMENSION(3)              :: DomainStart, DomainEnd
15    INTEGER                            :: FieldType
16    REAL,    POINTER, DIMENSION(:,:,:) :: rptr
17    INTEGER, POINTER, DIMENSION(:,:,:) :: iptr
18  END TYPE outrec
19
20  TYPE(outrec), DIMENSION(tabsize) :: outbuf_table
21
22CONTAINS
23
24  SUBROUTINE init_outbuf
25!<DESCRIPTION>
26!<PRE>
27! This routine re-initializes module data structures. 
28!</PRE>
29!</DESCRIPTION>
30    IMPLICIT NONE
31    INTEGER i
32    DO i = 1, tabsize
33      outbuf_table(i)%VarName = ""
34      outbuf_table(i)%DateStr = ""
35      outbuf_table(i)%MemoryOrder = ""
36      outbuf_table(i)%Stagger = ""
37      outbuf_table(i)%DimNames(1) = ""
38      outbuf_table(i)%DimNames(2) = ""
39      outbuf_table(i)%DimNames(3) = ""
40      outbuf_table(i)%ndim = 0
41      NULLIFY( outbuf_table(i)%rptr )
42      NULLIFY( outbuf_table(i)%iptr )
43    ENDDO
44    num_entries = 0
45  END SUBROUTINE init_outbuf
46
47
48  SUBROUTINE write_outbuf ( DataHandle , io_form_arg )
49!<DESCRIPTION>
50!<PRE>
51! This routine writes all of the records stored in outbuf_table to the
52! file referenced by DataHandle using format specified by io_form_arg. 
53! This routine calls the package-specific I/O routines to accomplish
54! the write. 
55! It then re-initializes module data structures. 
56!</PRE>
57!</DESCRIPTION>
58    USE module_state_description
59    IMPLICIT NONE
60#include "wrf_io_flags.h"
61    INTEGER , INTENT(IN)  :: DataHandle, io_form_arg
62    INTEGER               :: ii,ds1,de1,ds2,de2,ds3,de3
63    INTEGER               :: Comm, IOComm, DomainDesc ! dummy
64    INTEGER               :: Status
65    CHARACTER*80          :: mess
66    Comm = 0 ; IOComm = 0 ; DomainDesc = 0
67    DO ii = 1, num_entries
68      WRITE(mess,*)'writing ', &
69                    TRIM(outbuf_table(ii)%DateStr)," ",                                   &
70                    TRIM(outbuf_table(ii)%VarName)," ",                                   &
71                    TRIM(outbuf_table(ii)%MemoryOrder)
72      ds1 = outbuf_table(ii)%DomainStart(1) ; de1 = outbuf_table(ii)%DomainEnd(1)
73      ds2 = outbuf_table(ii)%DomainStart(2) ; de2 = outbuf_table(ii)%DomainEnd(2)
74      ds3 = outbuf_table(ii)%DomainStart(3) ; de3 = outbuf_table(ii)%DomainEnd(3)
75
76      SELECT CASE ( io_form_arg )
77
78#ifdef NETCDF
79        CASE ( IO_NETCDF   )
80
81          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
82
83          CALL ext_ncd_write_field ( DataHandle ,                                     &
84                                 TRIM(outbuf_table(ii)%DateStr),                      &
85                                 TRIM(outbuf_table(ii)%VarName),                      &
86                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
87                                 outbuf_table(ii)%FieldType,                          &  !*
88                                 Comm, IOComm, DomainDesc ,                           &
89                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
90                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
91                                 outbuf_table(ii)%DimNames ,                          &  !*
92                                 outbuf_table(ii)%DomainStart,                        &
93                                 outbuf_table(ii)%DomainEnd,                          &
94                                 outbuf_table(ii)%DomainStart,                        &
95                                 outbuf_table(ii)%DomainEnd,                          &
96                                 outbuf_table(ii)%DomainStart,                        &
97                                 outbuf_table(ii)%DomainEnd,                          &
98                                 Status )
99
100          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
101          CALL ext_ncd_write_field ( DataHandle ,                                     &
102                                 TRIM(outbuf_table(ii)%DateStr),                      &
103                                 TRIM(outbuf_table(ii)%VarName),                      &
104                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
105                                 outbuf_table(ii)%FieldType,                          &  !*
106                                 Comm, IOComm, DomainDesc ,                           &
107                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
108                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
109                                 outbuf_table(ii)%DimNames ,                          &  !*
110                                 outbuf_table(ii)%DomainStart,                        &
111                                 outbuf_table(ii)%DomainEnd,                          &
112                                 outbuf_table(ii)%DomainStart,                        &
113                                 outbuf_table(ii)%DomainEnd,                          &
114                                 outbuf_table(ii)%DomainStart,                        &
115                                 outbuf_table(ii)%DomainEnd,                          &
116                                 Status )
117          ENDIF
118#endif
119#ifdef YYY
120      CASE ( IO_YYY   )
121
122          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
123
124          CALL ext_yyy_write_field ( DataHandle ,                                     &
125                                 TRIM(outbuf_table(ii)%DateStr),                      &
126                                 TRIM(outbuf_table(ii)%VarName),                      &
127                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
128                                 outbuf_table(ii)%FieldType,                          &  !*
129                                 Comm, IOComm, DomainDesc ,                           &
130                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
131                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
132                                 outbuf_table(ii)%DimNames ,                          &  !*
133                                 outbuf_table(ii)%DomainStart,                        &
134                                 outbuf_table(ii)%DomainEnd,                          &
135                                 outbuf_table(ii)%DomainStart,                        &
136                                 outbuf_table(ii)%DomainEnd,                          &
137                                 outbuf_table(ii)%DomainStart,                        &
138                                 outbuf_table(ii)%DomainEnd,                          &
139                                 Status )
140
141          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
142          CALL ext_yyy_write_field ( DataHandle ,                                     &
143                                 TRIM(outbuf_table(ii)%DateStr),                      &
144                                 TRIM(outbuf_table(ii)%VarName),                      &
145                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
146                                 outbuf_table(ii)%FieldType,                          &  !*
147                                 Comm, IOComm, DomainDesc ,                           &
148                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
149                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
150                                 outbuf_table(ii)%DimNames ,                          &  !*
151                                 outbuf_table(ii)%DomainStart,                        &
152                                 outbuf_table(ii)%DomainEnd,                          &
153                                 outbuf_table(ii)%DomainStart,                        &
154                                 outbuf_table(ii)%DomainEnd,                          &
155                                 outbuf_table(ii)%DomainStart,                        &
156                                 outbuf_table(ii)%DomainEnd,                          &
157                                 Status )
158          ENDIF
159#endif
160#ifdef GRIB1
161      CASE ( IO_GRIB1   )
162
163          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
164
165          CALL ext_gr1_write_field ( DataHandle ,                                   &
166                                 TRIM(outbuf_table(ii)%DateStr),                      &
167                                 TRIM(outbuf_table(ii)%VarName),                      &
168                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
169                                 outbuf_table(ii)%FieldType,                          &  !*
170                                 Comm, IOComm, DomainDesc ,                           &
171                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
172                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
173                                 outbuf_table(ii)%DimNames ,                          &  !*
174                                 outbuf_table(ii)%DomainStart,                        &
175                                 outbuf_table(ii)%DomainEnd,                          &
176                                 outbuf_table(ii)%DomainStart,                        &
177                                 outbuf_table(ii)%DomainEnd,                          &
178                                 outbuf_table(ii)%DomainStart,                        &
179                                 outbuf_table(ii)%DomainEnd,                          &
180                                 Status )
181
182          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
183          CALL ext_gr1_write_field ( DataHandle ,                                   &
184                                 TRIM(outbuf_table(ii)%DateStr),                      &
185                                 TRIM(outbuf_table(ii)%VarName),                      &
186                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
187                                 outbuf_table(ii)%FieldType,                          &  !*
188                                 Comm, IOComm, DomainDesc ,                           &
189                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
190                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
191                                 outbuf_table(ii)%DimNames ,                          &  !*
192                                 outbuf_table(ii)%DomainStart,                        &
193                                 outbuf_table(ii)%DomainEnd,                          &
194                                 outbuf_table(ii)%DomainStart,                        &
195                                 outbuf_table(ii)%DomainEnd,                          &
196                                 outbuf_table(ii)%DomainStart,                        &
197                                 outbuf_table(ii)%DomainEnd,                          &
198                                 Status )
199          ENDIF
200#endif
201#ifdef GRIB2
202      CASE ( IO_GRIB2   )
203
204          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
205
206          CALL ext_gr2_write_field ( DataHandle ,                                   &
207                                 TRIM(outbuf_table(ii)%DateStr),                      &
208                                 TRIM(outbuf_table(ii)%VarName),                      &
209                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
210                                 outbuf_table(ii)%FieldType,                          &  !*
211                                 Comm, IOComm, DomainDesc ,                           &
212                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
213                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
214                                 outbuf_table(ii)%DimNames ,                          &  !*
215                                 outbuf_table(ii)%DomainStart,                        &
216                                 outbuf_table(ii)%DomainEnd,                          &
217                                 outbuf_table(ii)%DomainStart,                        &
218                                 outbuf_table(ii)%DomainEnd,                          &
219                                 outbuf_table(ii)%DomainStart,                        &
220                                 outbuf_table(ii)%DomainEnd,                          &
221                                 Status )
222
223          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
224          CALL ext_gr2_write_field ( DataHandle ,                                   &
225                                 TRIM(outbuf_table(ii)%DateStr),                      &
226                                 TRIM(outbuf_table(ii)%VarName),                      &
227                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
228                                 outbuf_table(ii)%FieldType,                          &  !*
229                                 Comm, IOComm, DomainDesc ,                           &
230                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
231                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
232                                 outbuf_table(ii)%DimNames ,                          &  !*
233                                 outbuf_table(ii)%DomainStart,                        &
234                                 outbuf_table(ii)%DomainEnd,                          &
235                                 outbuf_table(ii)%DomainStart,                        &
236                                 outbuf_table(ii)%DomainEnd,                          &
237                                 outbuf_table(ii)%DomainStart,                        &
238                                 outbuf_table(ii)%DomainEnd,                          &
239                                 Status )
240          ENDIF
241#endif
242#ifdef INTIO
243        CASE ( IO_INTIO  )
244          IF ( outbuf_table(ii)%FieldType .EQ. WRF_FLOAT ) THEN
245
246          CALL ext_int_write_field ( DataHandle ,                                     &
247                                 TRIM(outbuf_table(ii)%DateStr),                      &
248                                 TRIM(outbuf_table(ii)%VarName),                      &
249                                 outbuf_table(ii)%rptr(ds1:de1,ds2:de2,ds3:de3),      &
250                                 outbuf_table(ii)%FieldType,                          &  !*
251                                 Comm, IOComm, DomainDesc ,                           &
252                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
253                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
254                                 outbuf_table(ii)%DimNames ,                          &  !*
255                                 outbuf_table(ii)%DomainStart,                        &
256                                 outbuf_table(ii)%DomainEnd,                          &
257                                 outbuf_table(ii)%DomainStart,                        &
258                                 outbuf_table(ii)%DomainEnd,                          &
259                                 outbuf_table(ii)%DomainStart,                        &
260                                 outbuf_table(ii)%DomainEnd,                          &
261                                 Status )
262
263          ELSE IF ( outbuf_table(ii)%FieldType .EQ. WRF_INTEGER ) THEN
264
265          CALL ext_int_write_field ( DataHandle ,                                     &
266                                 TRIM(outbuf_table(ii)%DateStr),                      &
267                                 TRIM(outbuf_table(ii)%VarName),                      &
268                                 outbuf_table(ii)%iptr(ds1:de1,ds2:de2,ds3:de3),      &
269                                 outbuf_table(ii)%FieldType,                          &  !*
270                                 Comm, IOComm, DomainDesc ,                           &
271                                 TRIM(outbuf_table(ii)%MemoryOrder),                  &
272                                 TRIM(outbuf_table(ii)%Stagger),                      &  !*
273                                 outbuf_table(ii)%DimNames ,                          &  !*
274                                 outbuf_table(ii)%DomainStart,                        &
275                                 outbuf_table(ii)%DomainEnd,                          &
276                                 outbuf_table(ii)%DomainStart,                        &
277                                 outbuf_table(ii)%DomainEnd,                          &
278                                 outbuf_table(ii)%DomainStart,                        &
279                                 outbuf_table(ii)%DomainEnd,                          &
280                                 Status )
281
282          ENDIF
283#endif
284        CASE DEFAULT
285      END SELECT
286
287
288      IF ( ASSOCIATED( outbuf_table(ii)%rptr) ) DEALLOCATE(outbuf_table(ii)%rptr)
289      IF ( ASSOCIATED( outbuf_table(ii)%iptr) ) DEALLOCATE(outbuf_table(ii)%iptr)
290      NULLIFY( outbuf_table(ii)%rptr )
291      NULLIFY( outbuf_table(ii)%iptr )
292    ENDDO
293    CALL init_outbuf
294  END SUBROUTINE write_outbuf
295
296END MODULE module_quilt_outbuf_ops
297
298! don't let other programs see the definition of this; type mismatches
299! on inbuf will result;  may want to make a module program at some point
300  SUBROUTINE store_patch_in_outbuf( inbuf_r, inbuf_i, DateStr, VarName , FieldType, MemoryOrder, Stagger, DimNames, &
301                                    DomainStart , DomainEnd , &
302                                    MemoryStart , MemoryEnd , &
303                                    PatchStart , PatchEnd )
304!<DESCRIPTION>
305!<PRE>
306! This routine does the "output quilting". 
307!
308! It stores a patch in the appropriate location in a domain-sized array
309! within an element of the outbuf_table data structure.  DateStr, VarName, and
310! MemoryOrder are used to uniquely identify which element of outbuf_table is
311! associated with this array.  If no element is associated, then this routine
312! first assigns an unused element and allocates space within that element for
313! the globally-sized array.  This routine also stores DateStr, VarName,
314! FieldType, MemoryOrder, Stagger, DimNames, DomainStart, and DomainEnd within
315! the same element of outbuf. 
316!</PRE>
317!</DESCRIPTION>
318    USE module_quilt_outbuf_ops
319    IMPLICIT NONE
320#include "wrf_io_flags.h"
321    INTEGER ,                INTENT(IN) :: FieldType
322    REAL    , DIMENSION(*) , INTENT(IN) :: inbuf_r
323    INTEGER , DIMENSION(*) , INTENT(IN) :: inbuf_i
324    INTEGER , DIMENSION(3) , INTENT(IN) :: DomainStart , DomainEnd , MemoryStart , MemoryEnd , PatchStart , PatchEnd
325    CHARACTER*(*)    , INTENT(IN) :: DateStr , VarName, MemoryOrder , Stagger, DimNames(3)
326! Local
327    CHARACTER*120 mess
328    INTEGER               :: l,m,n,ii,jj
329    LOGICAL               :: found
330
331    ! Find the VarName if it's in the buffer already
332    ii = 1
333    found = .false.
334    DO WHILE ( .NOT. found .AND. ii .LE. num_entries )
335      !TBH:  need to test other attributes too! 
336      IF ( TRIM(VarName) .EQ. TRIM(outbuf_table(ii)%VarName) ) THEN
337        IF ( TRIM(DateStr) .EQ. TRIM(outbuf_table(ii)%DateStr) ) THEN
338          IF ( TRIM(MemoryOrder) .EQ. TRIM(outbuf_table(ii)%MemoryOrder) ) THEN
339            found = .true.
340          ELSE
341            CALL wrf_error_fatal("store_patch_in_outbuf: memory order disagreement")
342          ENDIF
343        ELSE
344          CALL wrf_error_fatal("store_patch_in_outbuf: multiple dates in buffer")
345        ENDIF
346      ELSE
347        ii = ii + 1
348      ENDIF
349    ENDDO
350    IF ( .NOT. found ) THEN
351      num_entries = num_entries + 1
352      IF      ( FieldType .EQ. WRF_FLOAT ) THEN
353        ALLOCATE( outbuf_table(num_entries)%rptr(DomainStart(1):DomainEnd(1), &
354                                                 DomainStart(2):DomainEnd(2),DomainStart(3):DomainEnd(3)) )
355      ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
356        ALLOCATE( outbuf_table(num_entries)%iptr(DomainStart(1):DomainEnd(1), &
357                                                 DomainStart(2):DomainEnd(2),DomainStart(3):DomainEnd(3)) )
358      ELSE
359        write(mess,*)"store_patch_in_outbuf: unsupported type ", FieldType
360        CALL wrf_error_fatal(mess)
361      ENDIF
362      outbuf_table(num_entries)%VarName = TRIM(VarName)
363      outbuf_table(num_entries)%DateStr = TRIM(DateStr)
364      outbuf_table(num_entries)%MemoryOrder = TRIM(MemoryOrder)
365      outbuf_table(num_entries)%Stagger = TRIM(Stagger)
366      outbuf_table(num_entries)%DimNames(1) = TRIM(DimNames(1))
367      outbuf_table(num_entries)%DimNames(2) = TRIM(DimNames(2))
368      outbuf_table(num_entries)%DimNames(3) = TRIM(DimNames(3))
369      outbuf_table(num_entries)%DomainStart = DomainStart
370      outbuf_table(num_entries)%DomainEnd = DomainEnd
371      outbuf_table(num_entries)%FieldType = FieldType
372      ii = num_entries
373    ENDIF
374    jj = 1
375    IF (  FieldType .EQ. WRF_FLOAT ) THEN
376      DO n = PatchStart(3),PatchEnd(3)
377        DO m = PatchStart(2),PatchEnd(2)
378          DO l = PatchStart(1),PatchEnd(1)
379            outbuf_table(ii)%rptr(l,m,n) = inbuf_r(jj)
380            jj = jj + 1
381          ENDDO
382        ENDDO
383      ENDDO
384    ENDIF
385    IF (  FieldType .EQ. WRF_INTEGER ) THEN
386      DO n = PatchStart(3),PatchEnd(3)
387        DO m = PatchStart(2),PatchEnd(2)
388          DO l = PatchStart(1),PatchEnd(1)
389            outbuf_table(ii)%iptr(l,m,n) = inbuf_i(jj)
390            jj = jj + 1
391          ENDDO
392        ENDDO
393      ENDDO
394    ENDIF
395
396    RETURN
397
398  END SUBROUTINE store_patch_in_outbuf
399
400!call add_to_bufsize_for_field( VarName, hdrbufsize+chunksize )
401
402  SUBROUTINE add_to_bufsize_for_field( VarName, Nbytes )
403!<DESCRIPTION>
404!<PRE>
405! This routine is a wrapper for C routine add_to_bufsize_for_field_c() that
406! is used to accumulate buffer sizes.  Buffer size Nbytes is added to the
407! curent buffer size for the buffer named VarName.  Any buffer space
408! associated with VarName is freed.  If a buffer named VarName does not exist,
409! a new one is assigned and its size is set to Nbytes. 
410!</PRE>
411!</DESCRIPTION>
412    USE module_quilt_outbuf_ops
413    IMPLICIT NONE
414    CHARACTER*(*)    , INTENT(IN) :: VarName
415    INTEGER          , INTENT(IN) :: Nbytes
416! Local
417    CHARACTER*120 mess
418    INTEGER               :: i, ierr
419    INTEGER               :: VarNameAsInts( 256 )
420    VarNameAsInts( 1 ) = len(trim(VarName))
421    DO i = 2, len(trim(VarName)) + 1
422      VarNameAsInts( i ) = ICHAR( VarName(i-1:i-1) )
423    ENDDO
424    CALL add_to_bufsize_for_field_c ( VarNameAsInts, Nbytes )
425    RETURN
426  END SUBROUTINE add_to_bufsize_for_field
427 
428  SUBROUTINE store_piece_of_field( inbuf, VarName, Nbytes )
429!<DESCRIPTION>
430!<PRE>
431! This routine is a wrapper for C routine store_piece_of_field_c() that
432! is used to store pieces of a field in an internal buffer.  Nbytes bytes of
433! buffer inbuf are appended to the end of the internal buffer named VarName. 
434! An error occurs if either an internal buffer named VarName does not exist or
435! if there are fewer than Nbytes bytes left in the internal buffer. 
436!</PRE>
437!</DESCRIPTION>
438    USE module_quilt_outbuf_ops
439    IMPLICIT NONE
440    INTEGER ,                INTENT(IN) :: Nbytes
441    INTEGER , DIMENSION(*) , INTENT(IN) :: inbuf
442    CHARACTER*(*)    , INTENT(IN) :: VarName
443! Local
444    CHARACTER*120 mess
445    INTEGER               :: i, ierr
446    INTEGER               :: VarNameAsInts( 256 )
447
448    VarNameAsInts( 1 ) = len(trim(VarName))
449    DO i = 2, len(trim(VarName)) + 1
450      VarNameAsInts( i ) = ICHAR( VarName(i-1:i-1) )
451    ENDDO
452    CALL store_piece_of_field_c ( inbuf, VarNameAsInts, Nbytes, ierr )
453    IF ( ierr .NE. 0 ) CALL wrf_error_fatal ( "store_piece_of_field" )
454    RETURN
455  END SUBROUTINE store_piece_of_field
456
457  SUBROUTINE retrieve_pieces_of_field( outbuf, VarName, obufsz, Nbytes_tot, lret )
458!<DESCRIPTION>
459!<PRE>
460! This routine is a wrapper for C routine retrieve_pieces_of_field_c() that
461! is used to extract the entire contents (i.e. all previously stored pieces of
462! fields) of the next internal buffer.  The name associated with this internal
463! buffer is returned in VarName.  The number of bytes read is returned in
464! Nbytes_tot.  Bytes are stored in outbuf whose size (in bytes) is obufsz. 
465! If there are more than obufsz bytes left in the next internal buffer, then
466! only obufsz bytes are returned and the rest are discarded (probably an error
467! in the making!).  The internal buffer is then freed.  Flag lret is set to
468! .TRUE. iff there are more fields left to extract. 
469!</PRE>
470!</DESCRIPTION>
471    USE module_quilt_outbuf_ops
472    IMPLICIT NONE
473    INTEGER ,                INTENT(IN) :: obufsz
474    INTEGER ,                INTENT(OUT) :: Nbytes_tot
475    INTEGER , DIMENSION(*) , INTENT(OUT) :: outbuf
476    CHARACTER*(*)    , INTENT(OUT) :: VarName
477    LOGICAL                       :: lret   ! true if more, false if not
478! Local
479    CHARACTER*120 mess
480    INTEGER               :: i, iret
481    INTEGER               :: VarNameAsInts( 256 )
482
483    CALL retrieve_pieces_of_field_c ( outbuf, VarNameAsInts, obufsz, Nbytes_tot, iret )
484    IF ( iret .NE.  0 ) THEN
485       lret = .FALSE.
486    ELSE
487       lret = .TRUE.
488       VarName = ' '
489       DO i = 2, VarNameAsInts(1) + 1
490         VarName(i-1:i-1) = CHAR(VarNameAsInts( i ))
491       ENDDO
492    ENDIF
493    RETURN
494  END SUBROUTINE retrieve_pieces_of_field
495
Note: See TracBrowser for help on using the repository browser.