module_quilt_outbuf_ops.F
References to this file elsewhere.
1 MODULE 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
22 CONTAINS
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
296 END 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