io_int.F90
References to this file elsewhere.
1 ! (old comment from when this file was a template)
2 ! This is a template for adding a package-dependent implemetnation of
3 ! the I/O API. You can use the name xxx since that is already set up
4 ! as a placeholder in module_io.F, md_calls.m4, and the Registry, or
5 ! you can change the name here and in those other places. For additional
6 ! information on adding a package to WRF, see the latest version of the
7 ! WRF Design and Implementation Document 1.1 (Draft). June 21, 2001
8 !
9 ! Uses header manipulation routines in module_io_quilt.F
10 !
11
12 MODULE module_ext_internal
13
14 USE module_internal_header_util
15
16 INTEGER, PARAMETER :: int_num_handles = 99
17 LOGICAL, DIMENSION(int_num_handles) :: okay_for_io, int_handle_in_use, okay_to_commit
18 INTEGER, DIMENSION(int_num_handles) :: int_num_bytes_to_write
19 ! first_operation is set to .TRUE. when a new handle is allocated
20 ! or when open-for-write or open-for-read are committed. It is set
21 ! to .FALSE. when the first field is read or written.
22 LOGICAL, DIMENSION(int_num_handles) :: first_operation
23 ! TBH: file_status is checked by routines that call the WRF IOAPI. It is not
24 ! TBH: yet cleanly integrated with okay_for_io, int_handle_in_use,
25 ! TBH: okay_to_commit. Fix this later...
26 INTEGER, DIMENSION(int_num_handles) :: file_status
27 ! TBH: This flag goes along with file_status and is set as early as possible.
28 LOGICAL, DIMENSION(int_num_handles) :: file_read_only
29 CHARACTER*128, DIMENSION(int_num_handles) :: CurrentDateInFile
30 REAL, POINTER :: int_local_output_buffer(:)
31 INTEGER :: int_local_output_cursor
32
33 INTEGER, PARAMETER :: onebyte = 1
34 INTEGER comm_io_servers, iserver, hdrbufsize, obufsize
35 INTEGER itypesize, rtypesize, typesize
36 INTEGER, DIMENSION(512) :: hdrbuf
37 INTEGER, DIMENSION(int_num_handles) :: handle
38 INTEGER, DIMENSION(512, int_num_handles) :: open_file_descriptors
39
40 CHARACTER*132 last_next_var( int_num_handles )
41
42 CONTAINS
43
44 LOGICAL FUNCTION int_valid_handle( handle )
45 IMPLICIT NONE
46 INTEGER, INTENT(IN) :: handle
47 int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles )
48 END FUNCTION int_valid_handle
49
50 SUBROUTINE int_get_fresh_handle( retval )
51 #include "wrf_io_flags.h"
52 INTEGER i, retval
53 retval = -1
54 ! dont use first 8 handles
55 DO i = 8, int_num_handles
56 IF ( .NOT. int_handle_in_use(i) ) THEN
57 retval = i
58 GOTO 33
59 ENDIF
60 ENDDO
61 33 CONTINUE
62 IF ( retval < 0 ) THEN
63 CALL wrf_error_fatal("io_int.F90: int_get_fresh_handle() can not get new handle")
64 ENDIF
65 int_handle_in_use(i) = .TRUE.
66 first_operation(i) = .TRUE.
67 file_status(i) = WRF_FILE_NOT_OPENED
68 NULLIFY ( int_local_output_buffer )
69 END SUBROUTINE int_get_fresh_handle
70
71 SUBROUTINE release_handle( i )
72 #include "wrf_io_flags.h"
73 INTEGER, INTENT(IN) :: i
74 IF ( i .LT. 8 .OR. i .GT. int_num_handles ) RETURN
75 IF ( .NOT. int_handle_in_use(i) ) RETURN
76 int_handle_in_use(i) = .FALSE.
77 RETURN
78 END SUBROUTINE release_handle
79
80
81
82 !--- ioinit
83 SUBROUTINE init_module_ext_internal
84 IMPLICIT NONE
85 INTEGER i
86 CALL wrf_sizeof_integer( itypesize )
87 CALL wrf_sizeof_real ( rtypesize )
88 DO i = 1, int_num_handles
89 last_next_var( i ) = ' '
90 ENDDO
91 END SUBROUTINE init_module_ext_internal
92
93 ! Returns .TRUE. iff it is OK to write time-independent domain metadata to the
94 ! file referenced by DataHandle. If DataHandle is invalid, .FALSE. is
95 ! returned.
96 LOGICAL FUNCTION int_ok_to_put_dom_ti( DataHandle )
97 #include "wrf_io_flags.h"
98 INTEGER, INTENT(IN) :: DataHandle
99 CHARACTER*256 :: fname
100 INTEGER :: filestate
101 INTEGER :: Status
102 LOGICAL :: dryrun, first_output, retval
103 call ext_int_inquire_filename( DataHandle, fname, filestate, Status )
104 IF ( Status /= 0 ) THEN
105 retval = .FALSE.
106 ELSE
107 dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
108 first_output = int_is_first_operation( DataHandle )
109 ! Note that we want to REPLICATE time-independent domain metadata in the
110 ! output files so the metadata is available during reads. Fortran
111 ! unformatted I/O must be sequential because we don't have fixed record
112 ! lengths.
113 ! retval = .NOT. dryrun .AND. first_output
114 retval = .NOT. dryrun
115 ENDIF
116 int_ok_to_put_dom_ti = retval
117 RETURN
118 END FUNCTION int_ok_to_put_dom_ti
119
120 ! Returns .TRUE. iff it is OK to read time-independent domain metadata from the
121 ! file referenced by DataHandle. If DataHandle is invalid, .FALSE. is
122 ! returned.
123 LOGICAL FUNCTION int_ok_to_get_dom_ti( DataHandle )
124 #include "wrf_io_flags.h"
125 INTEGER, INTENT(IN) :: DataHandle
126 CHARACTER*256 :: fname
127 INTEGER :: filestate
128 INTEGER :: Status
129 LOGICAL :: dryrun, retval
130 call ext_int_inquire_filename( DataHandle, fname, filestate, Status )
131 IF ( Status /= 0 ) THEN
132 retval = .FALSE.
133 ELSE
134 dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
135 retval = .NOT. dryrun
136 ENDIF
137 int_ok_to_get_dom_ti = retval
138 RETURN
139 END FUNCTION int_ok_to_get_dom_ti
140
141 ! Returns .TRUE. iff nothing has been read from or written to the file
142 ! referenced by DataHandle. If DataHandle is invalid, .FALSE. is returned.
143 LOGICAL FUNCTION int_is_first_operation( DataHandle )
144 INTEGER, INTENT(IN) :: DataHandle
145 LOGICAL :: retval
146 retval = .FALSE.
147 IF ( int_valid_handle ( DataHandle ) ) THEN
148 IF ( int_handle_in_use( DataHandle ) ) THEN
149 retval = first_operation( DataHandle )
150 ENDIF
151 ENDIF
152 int_is_first_operation = retval
153 RETURN
154 END FUNCTION int_is_first_operation
155
156 END MODULE module_ext_internal
157
158 SUBROUTINE ext_int_ioinit( SysDepInfo, Status )
159 USE module_ext_internal
160 IMPLICIT NONE
161 CHARACTER*(*), INTENT(IN) :: SysDepInfo
162 INTEGER Status
163 CALL init_module_ext_internal
164 END SUBROUTINE ext_int_ioinit
165
166 !--- open_for_write
167 SUBROUTINE ext_int_open_for_write( FileName , Comm_compute, Comm_io, SysDepInfo, &
168 DataHandle , Status )
169 USE module_ext_internal
170 IMPLICIT NONE
171 INCLUDE 'intio_tags.h'
172 CHARACTER*(*) :: FileName
173 INTEGER , INTENT(IN) :: Comm_compute , Comm_io
174 CHARACTER*(*) :: SysDepInfo
175 INTEGER , INTENT(OUT) :: DataHandle
176 INTEGER , INTENT(OUT) :: Status
177
178 CALL ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
179 DataHandle , Status )
180 IF ( Status .NE. 0 ) RETURN
181 CALL ext_int_open_for_write_commit( DataHandle , Status )
182 RETURN
183 END SUBROUTINE ext_int_open_for_write
184
185 !--- open_for_write_begin
186 SUBROUTINE ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
187 DataHandle , Status )
188 USE module_ext_internal
189 IMPLICIT NONE
190 INCLUDE 'intio_tags.h'
191 #include "wrf_io_flags.h"
192 CHARACTER*(*) :: FileName
193 INTEGER , INTENT(IN) :: Comm_compute , Comm_io
194 CHARACTER*(*) :: SysDepInfo
195 INTEGER , INTENT(OUT) :: DataHandle
196 INTEGER , INTENT(OUT) :: Status
197 INTEGER i, tasks_in_group, ierr, comm_io_group
198 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
199 REAL dummy
200 INTEGER io_form
201 CHARACTER*256 :: fname
202
203 CALL int_get_fresh_handle(i)
204 okay_for_io(i) = .false.
205 DataHandle = i
206
207 io_form = 100 ! dummy value
208 fname = TRIM(FileName)
209 CALL int_gen_ofwb_header( open_file_descriptors(1,i), hdrbufsize, itypesize, &
210 fname,SysDepInfo,io_form,DataHandle )
211
212 OPEN ( unit=DataHandle, file=TRIM(FileName), form='unformatted', iostat=Status )
213
214 file_status(DataHandle) = WRF_FILE_OPENED_NOT_COMMITTED
215 file_read_only(DataHandle) = .FALSE.
216
217 Status = 0
218 RETURN
219 END SUBROUTINE ext_int_open_for_write_begin
220
221 !--- open_for_write_commit
222 SUBROUTINE ext_int_open_for_write_commit( DataHandle , Status )
223 USE module_ext_internal
224 IMPLICIT NONE
225 INCLUDE 'intio_tags.h'
226 #include "wrf_io_flags.h"
227 INTEGER , INTENT(IN ) :: DataHandle
228 INTEGER , INTENT(OUT) :: Status
229 REAL dummy
230
231 IF ( int_valid_handle ( DataHandle ) ) THEN
232 IF ( int_handle_in_use( DataHandle ) ) THEN
233 okay_for_io( DataHandle ) = .true.
234 ENDIF
235 ENDIF
236
237 first_operation( DataHandle ) = .TRUE.
238 file_status(DataHandle) = WRF_FILE_OPENED_FOR_WRITE
239
240 Status = 0
241
242 RETURN
243 END SUBROUTINE ext_int_open_for_write_commit
244
245 !--- open_for_read
246 SUBROUTINE ext_int_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
247 DataHandle , Status )
248 USE module_ext_internal
249 IMPLICIT NONE
250 #include "wrf_io_flags.h"
251 CHARACTER*(*) :: FileName
252 INTEGER , INTENT(IN) :: Comm_compute , Comm_io
253 CHARACTER*(*) :: SysDepInfo
254 INTEGER , INTENT(OUT) :: DataHandle
255 INTEGER , INTENT(OUT) :: Status
256 INTEGER i
257 CHARACTER*256 :: fname
258
259 CALL int_get_fresh_handle(i)
260 DataHandle = i
261 CurrentDateInFile(i) = ""
262 fname = TRIM(FileName)
263
264 CALL int_gen_ofr_header( open_file_descriptors(1,i), hdrbufsize, itypesize, &
265 fname,SysDepInfo,DataHandle )
266
267 OPEN ( unit=DataHandle, status="old", file=TRIM(FileName), form='unformatted', iostat=Status )
268 okay_for_io(DataHandle) = .true.
269 file_status(DataHandle) = WRF_FILE_OPENED_FOR_READ
270 file_read_only(DataHandle) = .TRUE.
271
272 RETURN
273 END SUBROUTINE ext_int_open_for_read
274
275 !--- inquire_opened
276 SUBROUTINE ext_int_inquire_opened ( DataHandle, FileName , FileStatus, Status )
277 USE module_ext_internal
278 IMPLICIT NONE
279 #include "wrf_io_flags.h"
280 INTEGER , INTENT(IN) :: DataHandle
281 CHARACTER*(*) :: FileName
282 INTEGER , INTENT(OUT) :: FileStatus
283 INTEGER , INTENT(OUT) :: Status
284 CHARACTER*256 :: fname
285
286 Status = 0
287
288 CALL ext_int_inquire_filename ( DataHandle, fname, FileStatus, Status )
289 IF ( fname /= TRIM(FileName) ) THEN
290 FileStatus = WRF_FILE_NOT_OPENED
291 ENDIF
292
293 Status = 0
294
295 RETURN
296 END SUBROUTINE ext_int_inquire_opened
297
298 !--- inquire_filename
299 SUBROUTINE ext_int_inquire_filename ( DataHandle, FileName , FileStatus, Status )
300 USE module_ext_internal
301 IMPLICIT NONE
302 #include "wrf_io_flags.h"
303 INTEGER , INTENT(IN) :: DataHandle
304 CHARACTER*(*) :: FileName
305 INTEGER , INTENT(OUT) :: FileStatus
306 INTEGER , INTENT(OUT) :: Status
307 CHARACTER *4096 SysDepInfo
308 INTEGER locDataHandle
309 CHARACTER*256 :: fname
310 INTEGER io_form
311 Status = 0
312 SysDepInfo = ""
313 FileStatus = WRF_FILE_NOT_OPENED
314 FileName = ""
315 IF ( int_valid_handle( DataHandle ) ) THEN
316 IF ( int_handle_in_use( DataHandle ) ) THEN
317 ! Note that the formats for these headers differ.
318 IF ( file_read_only(DataHandle) ) THEN
319 CALL int_get_ofr_header( open_file_descriptors(1,DataHandle), hdrbufsize, itypesize, &
320 fname,SysDepInfo,locDataHandle )
321 ELSE
322 CALL int_get_ofwb_header( open_file_descriptors(1,DataHandle), hdrbufsize, itypesize, &
323 fname,SysDepInfo,io_form,locDataHandle )
324 ENDIF
325 FileName = TRIM(fname)
326 FileStatus = file_status(DataHandle)
327 ENDIF
328 ENDIF
329 Status = 0
330 END SUBROUTINE ext_int_inquire_filename
331
332 !--- sync
333 SUBROUTINE ext_int_iosync ( DataHandle, Status )
334 USE module_ext_internal
335 IMPLICIT NONE
336 INTEGER , INTENT(IN) :: DataHandle
337 INTEGER , INTENT(OUT) :: Status
338
339 Status = 0
340 RETURN
341 END SUBROUTINE ext_int_iosync
342
343 !--- close
344 SUBROUTINE ext_int_ioclose ( DataHandle, Status )
345 USE module_ext_internal
346 IMPLICIT NONE
347 INTEGER DataHandle, Status
348
349 IF ( int_valid_handle (DataHandle) ) THEN
350 IF ( int_handle_in_use( DataHandle ) ) THEN
351 CLOSE ( DataHandle )
352 ENDIF
353 CALL release_handle(DataHandle)
354 ENDIF
355
356 Status = 0
357
358 RETURN
359 END SUBROUTINE ext_int_ioclose
360
361 !--- ioexit
362 SUBROUTINE ext_int_ioexit( Status )
363
364 USE module_ext_internal
365 IMPLICIT NONE
366 INCLUDE 'intio_tags.h'
367 INTEGER , INTENT(OUT) :: Status
368 INTEGER :: DataHandle
369 INTEGER i,ierr
370 REAL dummy
371
372 RETURN
373 END SUBROUTINE ext_int_ioexit
374
375 !--- get_next_time
376 SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status )
377 USE module_ext_internal
378 IMPLICIT NONE
379 INCLUDE 'intio_tags.h'
380 INTEGER , INTENT(IN) :: DataHandle
381 CHARACTER*(*) :: DateStr
382 INTEGER , INTENT(OUT) :: Status
383 INTEGER code
384 CHARACTER*132 locElement, dummyvar
385 INTEGER istat
386
387 !local
388 INTEGER :: locDataHandle
389 CHARACTER*132 :: locDateStr
390 CHARACTER*132 :: locData
391 CHARACTER*132 :: locVarName
392 integer :: locFieldType
393 integer :: locComm
394 integer :: locIOComm
395 integer :: locDomainDesc
396 character*132 :: locMemoryOrder
397 character*132 :: locStagger
398 character*132 , dimension (3) :: locDimNames
399 integer ,dimension(3) :: locDomainStart, locDomainEnd
400 integer ,dimension(3) :: locMemoryStart, locMemoryEnd
401 integer ,dimension(3) :: locPatchStart, locPatchEnd
402 integer loccode
403
404 character*132 mess
405 integer ii,jj,kk,myrank
406 INTEGER inttypesize, realtypesize
407 REAL, DIMENSION(1) :: Field ! dummy
408
409 IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
410 CALL wrf_error_fatal("io_int.F90: ext_int_get_next_time: invalid data handle" )
411 ENDIF
412 IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
413 CALL wrf_error_fatal("io_int.F90: ext_int_get_next_time: DataHandle not opened" )
414 ENDIF
415 inttypesize = itypesize
416 realtypesize = rtypesize
417 DO WHILE ( .TRUE. )
418 READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows
419 IF ( istat .EQ. 0 ) THEN
420 code = hdrbuf(2)
421 IF ( code .EQ. int_field ) THEN
422 CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, &
423 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, &
424 locDomainDesc , locMemoryOrder , locStagger , locDimNames , &
425 locDomainStart , locDomainEnd , &
426 locMemoryStart , locMemoryEnd , &
427 locPatchStart , locPatchEnd )
428 IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN ! control break, return this date
429 DateStr = TRIM(locDateStr)
430 CurrentDateInFile(DataHandle) = TRIM(DateStr)
431 BACKSPACE ( unit=DataHandle )
432 Status = 0
433 GOTO 7717
434 ELSE
435 READ( unit=DataHandle, iostat=istat )
436 ENDIF
437 ELSE IF ( code .EQ. int_dom_td_char ) THEN
438 CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
439 locDataHandle, locDateStr, locElement, locData, loccode )
440 IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN ! control break, return this date
441 DateStr = TRIM(locDateStr)
442 CurrentDateInFile(DataHandle) = TRIM(DateStr)
443 BACKSPACE ( unit=DataHandle )
444 Status = 0
445 GOTO 7717
446 ELSE
447 READ( unit=DataHandle, iostat=istat )
448 ENDIF
449 ENDIF
450 ELSE
451 Status = 1
452 GOTO 7717
453 ENDIF
454 ENDDO
455 7717 CONTINUE
456
457 RETURN
458 END SUBROUTINE ext_int_get_next_time
459
460 !--- set_time
461 SUBROUTINE ext_int_set_time ( DataHandle, DateStr, Status )
462 USE module_ext_internal
463 IMPLICIT NONE
464 INCLUDE 'intio_tags.h'
465 INTEGER , INTENT(IN) :: DataHandle
466 CHARACTER*(*) :: DateStr
467 INTEGER , INTENT(OUT) :: Status
468
469 CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
470 DataHandle, "TIMESTAMP", "", TRIM(DateStr), int_set_time )
471 WRITE( unit=DataHandle ) hdrbuf
472 Status = 0
473 RETURN
474 END SUBROUTINE ext_int_set_time
475
476 !--- get_var_info
477 SUBROUTINE ext_int_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
478 DomainStart , DomainEnd , WrfType, Status )
479 USE module_ext_internal
480 IMPLICIT NONE
481 INCLUDE 'intio_tags.h'
482 integer ,intent(in) :: DataHandle
483 character*(*) ,intent(in) :: VarName
484 integer ,intent(out) :: NDim
485 character*(*) ,intent(out) :: MemoryOrder
486 character*(*) ,intent(out) :: Stagger
487 integer ,dimension(*) ,intent(out) :: DomainStart, DomainEnd
488 integer ,intent(out) :: WrfType
489 integer ,intent(out) :: Status
490
491 !local
492 INTEGER :: locDataHandle
493 CHARACTER*132 :: locDateStr
494 CHARACTER*132 :: locVarName
495 integer :: locFieldType
496 integer :: locComm
497 integer :: locIOComm
498 integer :: locDomainDesc
499 character*132 :: locMemoryOrder
500 character*132 :: locStagger
501 character*132 , dimension (3) :: locDimNames
502 integer ,dimension(3) :: locDomainStart, locDomainEnd
503 integer ,dimension(3) :: locMemoryStart, locMemoryEnd
504 integer ,dimension(3) :: locPatchStart, locPatchEnd
505
506 character*132 mess
507 integer ii,jj,kk,myrank
508 INTEGER inttypesize, realtypesize, istat, code
509 REAL, DIMENSION(1) :: Field ! dummy
510
511 IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
512 CALL wrf_error_fatal("io_int.F90: ext_int_get_var_info: invalid data handle" )
513 ENDIF
514 IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
515 CALL wrf_error_fatal("io_int.F90: ext_int_get_var_info: DataHandle not opened" )
516 ENDIF
517 inttypesize = itypesize
518 realtypesize = rtypesize
519 DO WHILE ( .TRUE. )
520 READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows
521 IF ( istat .EQ. 0 ) THEN
522 code = hdrbuf(2)
523 IF ( code .EQ. int_field ) THEN
524 CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, &
525 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, &
526 locDomainDesc , MemoryOrder , locStagger , locDimNames , &
527 locDomainStart , locDomainEnd , &
528 locMemoryStart , locMemoryEnd , &
529 locPatchStart , locPatchEnd )
530
531 IF ( LEN(TRIM(MemoryOrder)) .EQ. 3 ) THEN
532 NDim = 3
533 ELSE IF ( LEN(TRIM(MemoryOrder)) .EQ. 2 ) THEN
534 NDim = 2
535 ELSE IF ( TRIM(MemoryOrder) .EQ. '0' ) THEN
536 NDim = 0
537 ELSE
538 NDim = 1
539 ENDIF
540 Stagger = locStagger
541 DomainStart(1:3) = locDomainStart(1:3)
542 DomainEnd(1:3) = locDomainEnd(1:3)
543 WrfType = locFieldType
544 BACKSPACE ( unit=DataHandle )
545 Status = 0
546 GOTO 7717
547 ENDIF
548 ELSE
549 Status = 1
550 GOTO 7717
551 ENDIF
552 ENDDO
553 7717 CONTINUE
554
555 RETURN
556 END SUBROUTINE ext_int_get_var_info
557
558 !--- get_next_var
559 SUBROUTINE ext_int_get_next_var ( DataHandle, VarName, Status )
560 USE module_ext_internal
561 IMPLICIT NONE
562 include 'intio_tags.h'
563 include 'wrf_status_codes.h'
564 INTEGER , INTENT(IN) :: DataHandle
565 CHARACTER*(*) :: VarName
566 INTEGER , INTENT(OUT) :: Status
567
568 !local
569 INTEGER :: locDataHandle
570 CHARACTER*132 :: locDateStr
571 CHARACTER*132 :: locVarName
572 integer :: locFieldType
573 integer :: locComm
574 integer :: locIOComm
575 integer :: locDomainDesc
576 character*132 :: locMemoryOrder
577 character*132 :: locStagger
578 character*132 , dimension (3) :: locDimNames
579 integer ,dimension(3) :: locDomainStart, locDomainEnd
580 integer ,dimension(3) :: locMemoryStart, locMemoryEnd
581 integer ,dimension(3) :: locPatchStart, locPatchEnd
582
583 character*128 locElement, strData, dumstr
584 integer loccode, loccount
585 integer idata(128)
586 real rdata(128)
587
588 character*132 mess
589 integer ii,jj,kk,myrank
590 INTEGER inttypesize, realtypesize, istat, code
591 REAL, DIMENSION(1) :: Field ! dummy
592
593 IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
594 CALL wrf_error_fatal("io_int.F90: ext_int_get_next_var: invalid data handle" )
595 ENDIF
596 IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
597 CALL wrf_error_fatal("io_int.F90: ext_int_get_next_var: DataHandle not opened" )
598 ENDIF
599 inttypesize = itypesize
600 realtypesize = rtypesize
601 DO WHILE ( .TRUE. )
602 7727 CONTINUE
603 READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows
604 IF ( istat .EQ. 0 ) THEN
605 code = hdrbuf(2)
606 #if 1
607 IF ( code .EQ. int_dom_ti_char ) THEN
608 CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
609 locDataHandle, locElement, dumstr, strData, loccode )
610 ENDIF
611 IF ( code .EQ. int_dom_ti_integer ) THEN
612 CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
613 locDataHandle, locElement, iData, loccount, code )
614 ENDIF
615 IF ( code .EQ. int_dom_ti_real ) THEN
616 CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
617 locDataHandle, locElement, rData, loccount, code )
618 ENDIF
619 #endif
620 IF ( code .EQ. int_field ) THEN
621 CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, &
622 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, &
623 locDomainDesc , locMemoryOrder , locStagger , locDimNames , &
624 locDomainStart , locDomainEnd , &
625 locMemoryStart , locMemoryEnd , &
626 locPatchStart , locPatchEnd )
627
628 IF (TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle))) THEN
629 Status = WRF_WARN_VAR_EOF !-6 ! signal past last var in time frame
630 BACKSPACE ( unit=DataHandle )
631 last_next_var( DataHandle ) = ""
632 GOTO 7717
633 ELSE
634 VarName = TRIM(locVarName)
635 IF ( last_next_var( DataHandle ) .NE. VarName ) THEN
636 BACKSPACE ( unit=DataHandle )
637 last_next_var( DataHandle ) = VarName
638 ELSE
639 READ( unit=DataHandle, iostat=istat )
640 GOTO 7727
641 ENDIF
642 Status = 0
643 GOTO 7717
644 ENDIF
645 ELSE
646 GOTO 7727
647 ENDIF
648 ELSE
649 Status = 1
650 GOTO 7717
651 ENDIF
652 ENDDO
653 7717 CONTINUE
654 RETURN
655 END SUBROUTINE ext_int_get_next_var
656
657 !--- get_dom_ti_real
658 SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element, Data, Count, Outcount, Status )
659 USE module_ext_internal
660 IMPLICIT NONE
661 INCLUDE 'intio_tags.h'
662 INTEGER , INTENT(IN) :: DataHandle
663 CHARACTER*(*) :: Element
664 REAL , INTENT(OUT) :: Data(*)
665 INTEGER , INTENT(IN) :: Count
666 INTEGER , INTENT(OUT) :: Outcount
667 INTEGER , INTENT(OUT) :: Status
668 INTEGER loccount, code, istat, locDataHandle
669 CHARACTER*132 :: locElement, mess
670 LOGICAL keepgoing
671
672 Status = 0
673 IF ( int_valid_handle( DataHandle ) ) THEN
674 IF ( int_handle_in_use( DataHandle ) ) THEN
675 ! Do nothing unless it is time to read time-independent domain metadata.
676 IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
677 keepgoing = .true.
678 DO WHILE ( keepgoing )
679 READ( unit=DataHandle , iostat = istat ) hdrbuf
680 IF ( istat .EQ. 0 ) THEN
681 code = hdrbuf(2)
682 IF ( code .EQ. int_dom_ti_real ) THEN
683 CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
684 locDataHandle, locElement, Data, loccount, code )
685 IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
686 IF ( loccount .GT. Count ) THEN
687 CALL wrf_error_fatal( 'io_int.F90: ext_int_get_dom_ti_real: loccount .GT. Count' )
688 ENDIF
689 keepgoing = .false. ; Status = 0
690 ENDIF
691 ELSE IF ( .NOT. ( code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_logical .OR. &
692 code .EQ. int_dom_ti_char .OR. code .EQ. int_dom_ti_double .OR. &
693 code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_logical .OR. &
694 code .EQ. int_dom_td_char .OR. code .EQ. int_dom_td_double .OR. &
695 code .EQ. int_dom_td_real ) ) THEN
696 BACKSPACE ( unit=DataHandle )
697 keepgoing = .false. ; Status = 2
698 ENDIF
699 ELSE
700 keepgoing = .false. ; Status = 1
701 ENDIF
702 ENDDO
703 ENDIF
704 ENDIF
705 ENDIF
706 RETURN
707 END SUBROUTINE ext_int_get_dom_ti_real
708
709 !--- put_dom_ti_real
710 SUBROUTINE ext_int_put_dom_ti_real ( DataHandle,Element, Data, Count, Status )
711 USE module_ext_internal
712 IMPLICIT NONE
713 INCLUDE 'intio_tags.h'
714 INTEGER , INTENT(IN) :: DataHandle
715 CHARACTER*(*) :: Element
716 REAL , INTENT(IN) :: Data(*)
717 INTEGER , INTENT(IN) :: Count
718 INTEGER , INTENT(OUT) :: Status
719 REAL dummy
720 !
721
722 IF ( int_valid_handle( DataHandle ) ) THEN
723 IF ( int_handle_in_use( DataHandle ) ) THEN
724 ! Do nothing unless it is time to write time-independent domain metadata.
725 IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
726 CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
727 DataHandle, Element, Data, Count, int_dom_ti_real )
728 WRITE( unit=DataHandle ) hdrbuf
729 ENDIF
730 ENDIF
731 ENDIF
732 Status = 0
733 RETURN
734 END SUBROUTINE ext_int_put_dom_ti_real
735
736 !--- get_dom_ti_double
737 SUBROUTINE ext_int_get_dom_ti_double ( DataHandle,Element, Data, Count, Outcount, Status )
738 USE module_ext_internal
739 IMPLICIT NONE
740 INTEGER , INTENT(IN) :: DataHandle
741 CHARACTER*(*) :: Element
742 real*8 , INTENT(OUT) :: Data(*)
743 INTEGER , INTENT(IN) :: Count
744 INTEGER , INTENT(OUT) :: OutCount
745 INTEGER , INTENT(OUT) :: Status
746 ! Do nothing unless it is time to read time-independent domain metadata.
747 IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
748 CALL wrf_error_fatal('ext_int_get_dom_ti_double not supported yet')
749 ENDIF
750 RETURN
751 END SUBROUTINE ext_int_get_dom_ti_double
752
753 !--- put_dom_ti_double
754 SUBROUTINE ext_int_put_dom_ti_double ( DataHandle,Element, Data, Count, Status )
755 USE module_ext_internal
756 IMPLICIT NONE
757 INTEGER , INTENT(IN) :: DataHandle
758 CHARACTER*(*) :: Element
759 real*8 , INTENT(IN) :: Data(*)
760 INTEGER , INTENT(IN) :: Count
761 INTEGER , INTENT(OUT) :: Status
762 ! Do nothing unless it is time to write time-independent domain metadata.
763 IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
764 CALL wrf_error_fatal('ext_int_put_dom_ti_double not supported yet')
765 ENDIF
766 RETURN
767 END SUBROUTINE ext_int_put_dom_ti_double
768
769 !--- get_dom_ti_integer
770 SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element, Data, Count, Outcount, Status )
771 USE module_ext_internal
772 IMPLICIT NONE
773 INCLUDE 'intio_tags.h'
774 INTEGER , INTENT(IN) :: DataHandle
775 CHARACTER*(*) :: Element
776 integer , INTENT(OUT) :: Data(*)
777 INTEGER , INTENT(IN) :: Count
778 INTEGER , INTENT(OUT) :: OutCount
779 INTEGER , INTENT(OUT) :: Status
780 INTEGER loccount, code, istat, locDataHandle
781 CHARACTER*132 locElement, mess
782 LOGICAL keepgoing
783
784 Status = 0
785 IF ( int_valid_handle( DataHandle ) ) THEN
786 IF ( int_handle_in_use( DataHandle ) ) THEN
787 ! Do nothing unless it is time to read time-independent domain metadata.
788 IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
789 keepgoing = .true.
790 DO WHILE ( keepgoing )
791 READ( unit=DataHandle , iostat = istat ) hdrbuf
792 IF ( istat .EQ. 0 ) THEN
793 code = hdrbuf(2)
794 IF ( code .EQ. int_dom_ti_integer ) THEN
795 CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
796 locDataHandle, locElement, Data, loccount, code )
797 IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
798 IF ( loccount .GT. Count ) THEN
799 CALL wrf_error_fatal( 'io_int.F90: ext_int_get_dom_ti_integer: loccount .GT. Count' )
800 ENDIF
801 keepgoing = .false. ; Status = 0
802 ENDIF
803
804 ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real .OR. code .EQ. int_dom_ti_logical .OR. &
805 code .EQ. int_dom_ti_char .OR. code .EQ. int_dom_ti_double .OR. &
806 code .EQ. int_dom_td_real .OR. code .EQ. int_dom_td_logical .OR. &
807 code .EQ. int_dom_td_char .OR. code .EQ. int_dom_td_double .OR. &
808 code .EQ. int_dom_td_integer ) ) THEN
809 BACKSPACE ( unit=DataHandle )
810 keepgoing = .false. ; Status = 1
811 ENDIF
812 ELSE
813 keepgoing = .false. ; Status = 1
814 ENDIF
815 ENDDO
816 ENDIF
817 ENDIF
818 ENDIF
819 RETURN
820 END SUBROUTINE ext_int_get_dom_ti_integer
821
822 !--- put_dom_ti_integer
823 SUBROUTINE ext_int_put_dom_ti_integer ( DataHandle,Element, Data, Count, Status )
824 USE module_ext_internal
825 IMPLICIT NONE
826 INCLUDE 'intio_tags.h'
827 INTEGER , INTENT(IN) :: DataHandle
828 CHARACTER*(*) :: Element
829 INTEGER , INTENT(IN) :: Data(*)
830 INTEGER , INTENT(IN) :: Count
831 INTEGER , INTENT(OUT) :: Status
832 REAL dummy
833 !
834 IF ( int_valid_handle ( Datahandle ) ) THEN
835 IF ( int_handle_in_use( DataHandle ) ) THEN
836 ! Do nothing unless it is time to write time-independent domain metadata.
837 IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
838 CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, itypesize, &
839 DataHandle, Element, Data, Count, int_dom_ti_integer )
840 WRITE( unit=DataHandle ) hdrbuf
841 ENDIF
842 ENDIF
843 ENDIF
844 Status = 0
845 RETURN
846 END SUBROUTINE ext_int_put_dom_ti_integer
847
848 !--- get_dom_ti_logical
849 SUBROUTINE ext_int_get_dom_ti_logical ( DataHandle,Element, Data, Count, Outcount, Status )
850 USE module_ext_internal
851 IMPLICIT NONE
852 INTEGER , INTENT(IN) :: DataHandle
853 CHARACTER*(*) :: Element
854 logical , INTENT(OUT) :: Data(*)
855 INTEGER , INTENT(IN) :: Count
856 INTEGER , INTENT(OUT) :: OutCount
857 INTEGER , INTENT(OUT) :: Status
858 ! Do nothing unless it is time to read time-independent domain metadata.
859 IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
860 CALL wrf_message('ext_int_get_dom_ti_logical not supported yet')
861 ENDIF
862 RETURN
863 END SUBROUTINE ext_int_get_dom_ti_logical
864
865 !--- put_dom_ti_logical
866 SUBROUTINE ext_int_put_dom_ti_logical ( DataHandle,Element, Data, Count, Status )
867 USE module_ext_internal
868 IMPLICIT NONE
869 INTEGER , INTENT(IN) :: DataHandle
870 CHARACTER*(*) :: Element
871 logical , INTENT(IN) :: Data(*)
872 INTEGER , INTENT(IN) :: Count
873 INTEGER , INTENT(OUT) :: Status
874 ! Do nothing unless it is time to write time-independent domain metadata.
875 IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
876 CALL wrf_message('ext_int_put_dom_ti_logical not supported yet')
877 ENDIF
878 RETURN
879 END SUBROUTINE ext_int_put_dom_ti_logical
880
881 !--- get_dom_ti_char
882 SUBROUTINE ext_int_get_dom_ti_char ( DataHandle,Element, Data, Status )
883 USE module_ext_internal
884 IMPLICIT NONE
885 INCLUDE 'intio_tags.h'
886 INTEGER , INTENT(IN) :: DataHandle
887 CHARACTER*(*) :: Element
888 CHARACTER*(*) :: Data
889 INTEGER , INTENT(OUT) :: Status
890 INTEGER istat, code, i
891 CHARACTER*79 dumstr, locElement
892 INTEGER locDataHandle
893 LOGICAL keepgoing
894
895 Status = 0
896 IF ( int_valid_handle( DataHandle ) ) THEN
897 IF ( int_handle_in_use( DataHandle ) ) THEN
898 ! Do nothing unless it is time to read time-independent domain metadata.
899 IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
900 keepgoing = .true.
901 DO WHILE ( keepgoing )
902 READ( unit=DataHandle , iostat = istat ) hdrbuf
903
904 IF ( istat .EQ. 0 ) THEN
905 code = hdrbuf(2)
906 IF ( code .EQ. int_dom_ti_char ) THEN
907 CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
908 locDataHandle, locElement, dumstr, Data, code )
909 IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
910 keepgoing = .false. ; Status = 0
911 ENDIF
912 ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real .OR. code .EQ. int_dom_ti_logical .OR. &
913 code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_double .OR. &
914 code .EQ. int_dom_td_real .OR. code .EQ. int_dom_td_logical .OR. &
915 code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_double .OR. &
916 code .EQ. int_dom_td_char ) ) THEN
917 BACKSPACE ( unit=DataHandle )
918 keepgoing = .false. ; Status = 1
919 ENDIF
920 ELSE
921 keepgoing = .false. ; Status = 1
922 ENDIF
923 ENDDO
924 ENDIF
925 ENDIF
926 ENDIF
927 RETURN
928 END SUBROUTINE ext_int_get_dom_ti_char
929
930 !--- put_dom_ti_char
931 SUBROUTINE ext_int_put_dom_ti_char ( DataHandle, Element, Data, Status )
932 USE module_ext_internal
933 IMPLICIT NONE
934 INCLUDE 'intio_tags.h'
935 INTEGER , INTENT(IN) :: DataHandle
936 CHARACTER*(*) :: Element
937 CHARACTER*(*) :: Data
938 INTEGER , INTENT(OUT) :: Status
939 INTEGER i
940 REAL dummy
941 INTEGER :: Count
942
943 IF ( int_valid_handle ( Datahandle ) ) THEN
944 IF ( int_handle_in_use( DataHandle ) ) THEN
945 ! Do nothing unless it is time to write time-independent domain metadata.
946 IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
947 CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
948 DataHandle, Element, "", Data, int_dom_ti_char )
949 WRITE( unit=DataHandle ) hdrbuf
950 ENDIF
951 ENDIF
952 ENDIF
953 Status = 0
954 RETURN
955 END SUBROUTINE ext_int_put_dom_ti_char
956
957 !--- get_dom_td_real
958 SUBROUTINE ext_int_get_dom_td_real ( DataHandle,Element, DateStr, Data, Count, Outcount, Status )
959 IMPLICIT NONE
960 INTEGER , INTENT(IN) :: DataHandle
961 CHARACTER*(*) :: Element
962 CHARACTER*(*) :: DateStr
963 real , INTENT(OUT) :: Data(*)
964 INTEGER , INTENT(IN) :: Count
965 INTEGER , INTENT(OUT) :: OutCount
966 INTEGER , INTENT(OUT) :: Status
967 RETURN
968 END SUBROUTINE ext_int_get_dom_td_real
969
970 !--- put_dom_td_real
971 SUBROUTINE ext_int_put_dom_td_real ( DataHandle,Element, DateStr, Data, Count, Status )
972 IMPLICIT NONE
973 INTEGER , INTENT(IN) :: DataHandle
974 CHARACTER*(*) :: Element
975 CHARACTER*(*) :: DateStr
976 real , INTENT(IN) :: Data(*)
977 INTEGER , INTENT(IN) :: Count
978 INTEGER , INTENT(OUT) :: Status
979 RETURN
980 END SUBROUTINE ext_int_put_dom_td_real
981
982 !--- get_dom_td_double
983 SUBROUTINE ext_int_get_dom_td_double ( DataHandle,Element, DateStr, Data, Count, Outcount, Status )
984 IMPLICIT NONE
985 INTEGER , INTENT(IN) :: DataHandle
986 CHARACTER*(*) :: Element
987 CHARACTER*(*) :: DateStr
988 real*8 , INTENT(OUT) :: Data(*)
989 INTEGER , INTENT(IN) :: Count
990 INTEGER , INTENT(OUT) :: OutCount
991 INTEGER , INTENT(OUT) :: Status
992 CALL wrf_error_fatal('ext_int_get_dom_td_double not supported yet')
993 RETURN
994 END SUBROUTINE ext_int_get_dom_td_double
995
996 !--- put_dom_td_double
997 SUBROUTINE ext_int_put_dom_td_double ( DataHandle,Element, DateStr, Data, Count, Status )
998 IMPLICIT NONE
999 INTEGER , INTENT(IN) :: DataHandle
1000 CHARACTER*(*) :: Element
1001 CHARACTER*(*) :: DateStr
1002 real*8 , INTENT(IN) :: Data(*)
1003 INTEGER , INTENT(IN) :: Count
1004 INTEGER , INTENT(OUT) :: Status
1005 CALL wrf_error_fatal('ext_int_get_dom_td_double not supported yet')
1006 RETURN
1007 END SUBROUTINE ext_int_put_dom_td_double
1008
1009 !--- get_dom_td_integer
1010 SUBROUTINE ext_int_get_dom_td_integer ( DataHandle,Element, DateStr, Data, Count, Outcount, Status )
1011 IMPLICIT NONE
1012 INTEGER , INTENT(IN) :: DataHandle
1013 CHARACTER*(*) :: Element
1014 CHARACTER*(*) :: DateStr
1015 integer , INTENT(OUT) :: Data(*)
1016 INTEGER , INTENT(IN) :: Count
1017 INTEGER , INTENT(OUT) :: OutCount
1018 INTEGER , INTENT(OUT) :: Status
1019 RETURN
1020 END SUBROUTINE ext_int_get_dom_td_integer
1021
1022 !--- put_dom_td_integer
1023 SUBROUTINE ext_int_put_dom_td_integer ( DataHandle,Element, DateStr, Data, Count, Status )
1024 IMPLICIT NONE
1025 INTEGER , INTENT(IN) :: DataHandle
1026 CHARACTER*(*) :: Element
1027 CHARACTER*(*) :: DateStr
1028 integer , INTENT(IN) :: Data(*)
1029 INTEGER , INTENT(IN) :: Count
1030 INTEGER , INTENT(OUT) :: Status
1031 RETURN
1032 END SUBROUTINE ext_int_put_dom_td_integer
1033
1034 !--- get_dom_td_logical
1035 SUBROUTINE ext_int_get_dom_td_logical ( DataHandle,Element, DateStr, Data, Count, Outcount, Status )
1036 IMPLICIT NONE
1037 INTEGER , INTENT(IN) :: DataHandle
1038 CHARACTER*(*) :: Element
1039 CHARACTER*(*) :: DateStr
1040 logical , INTENT(OUT) :: Data(*)
1041 INTEGER , INTENT(IN) :: Count
1042 INTEGER , INTENT(OUT) :: OutCount
1043 INTEGER , INTENT(OUT) :: Status
1044 RETURN
1045 END SUBROUTINE ext_int_get_dom_td_logical
1046
1047 !--- put_dom_td_logical
1048 SUBROUTINE ext_int_put_dom_td_logical ( DataHandle,Element, DateStr, Data, Count, Status )
1049 IMPLICIT NONE
1050 INTEGER , INTENT(IN) :: DataHandle
1051 CHARACTER*(*) :: Element
1052 CHARACTER*(*) :: DateStr
1053 logical , INTENT(IN) :: Data(*)
1054 INTEGER , INTENT(IN) :: Count
1055 INTEGER , INTENT(OUT) :: Status
1056 RETURN
1057 END SUBROUTINE ext_int_put_dom_td_logical
1058
1059 !--- get_dom_td_char
1060 SUBROUTINE ext_int_get_dom_td_char ( DataHandle,Element, DateStr, Data, Status )
1061 USE module_ext_internal
1062 IMPLICIT NONE
1063 INCLUDE 'intio_tags.h'
1064 INTEGER , INTENT(IN) :: DataHandle
1065 CHARACTER*(*) :: Element
1066 CHARACTER*(*) :: Data, DateStr
1067 INTEGER , INTENT(OUT) :: Status
1068 INTEGER istat, code, i
1069 CHARACTER*79 dumstr, locElement, locDatestr
1070 INTEGER locDataHandle
1071 LOGICAL keepgoing
1072
1073 IF ( int_valid_handle( DataHandle ) ) THEN
1074 IF ( int_handle_in_use( DataHandle ) ) THEN
1075 keepgoing = .true.
1076 DO WHILE ( keepgoing )
1077 READ( unit=DataHandle , iostat = istat ) hdrbuf
1078
1079 IF ( istat .EQ. 0 ) THEN
1080 code = hdrbuf(2)
1081 IF ( code .EQ. int_dom_td_char ) THEN
1082 CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
1083 locDataHandle, locDateStr, locElement, Data, code )
1084 IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
1085 keepgoing = .false. ; Status = 0
1086 ENDIF
1087 ELSE
1088 BACKSPACE ( unit=DataHandle )
1089 keepgoing = .false. ; Status = 1
1090 ENDIF
1091 ELSE
1092 keepgoing = .false. ; Status = 1
1093 ENDIF
1094 ENDDO
1095 ENDIF
1096 ENDIF
1097 RETURN
1098 END SUBROUTINE ext_int_get_dom_td_char
1099
1100 !--- put_dom_td_char
1101 SUBROUTINE ext_int_put_dom_td_char ( DataHandle,Element, DateStr, Data, Status )
1102 USE module_ext_internal
1103 IMPLICIT NONE
1104 INCLUDE 'intio_tags.h'
1105 INTEGER , INTENT(IN) :: DataHandle
1106 CHARACTER*(*) :: Element
1107 CHARACTER*(*) :: Data, DateStr
1108 INTEGER , INTENT(OUT) :: Status
1109 INTEGER i
1110 REAL dummy
1111 INTEGER :: Count
1112 IF ( int_valid_handle ( Datahandle ) ) THEN
1113 IF ( int_handle_in_use( DataHandle ) ) THEN
1114 CALL int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, &
1115 DataHandle, DateStr, Element, Data, int_dom_td_char )
1116 WRITE( unit=DataHandle ) hdrbuf
1117 ENDIF
1118 ENDIF
1119 Status = 0
1120 RETURN
1121 END SUBROUTINE ext_int_put_dom_td_char
1122
1123 !--- get_var_ti_real
1124 SUBROUTINE ext_int_get_var_ti_real ( DataHandle,Element, Varname, Data, Count, Outcount, Status )
1125 IMPLICIT NONE
1126 INTEGER , INTENT(IN) :: DataHandle
1127 CHARACTER*(*) :: Element
1128 CHARACTER*(*) :: VarName
1129 real , INTENT(OUT) :: Data(*)
1130 INTEGER , INTENT(IN) :: Count
1131 INTEGER , INTENT(OUT) :: OutCount
1132 INTEGER , INTENT(OUT) :: Status
1133 RETURN
1134 END SUBROUTINE ext_int_get_var_ti_real
1135
1136 !--- put_var_ti_real
1137 SUBROUTINE ext_int_put_var_ti_real ( DataHandle,Element, Varname, Data, Count, Status )
1138 IMPLICIT NONE
1139 INTEGER , INTENT(IN) :: DataHandle
1140 CHARACTER*(*) :: Element
1141 CHARACTER*(*) :: VarName
1142 real , INTENT(IN) :: Data(*)
1143 INTEGER , INTENT(IN) :: Count
1144 INTEGER , INTENT(OUT) :: Status
1145 RETURN
1146 END SUBROUTINE ext_int_put_var_ti_real
1147
1148 !--- get_var_ti_double
1149 SUBROUTINE ext_int_get_var_ti_double ( DataHandle,Element, Varname, Data, Count, Outcount, Status )
1150 IMPLICIT NONE
1151 INTEGER , INTENT(IN) :: DataHandle
1152 CHARACTER*(*) :: Element
1153 CHARACTER*(*) :: VarName
1154 real*8 , INTENT(OUT) :: Data(*)
1155 INTEGER , INTENT(IN) :: Count
1156 INTEGER , INTENT(OUT) :: OutCount
1157 INTEGER , INTENT(OUT) :: Status
1158 CALL wrf_error_fatal('ext_int_get_var_ti_double not supported yet')
1159 RETURN
1160 END SUBROUTINE ext_int_get_var_ti_double
1161
1162 !--- put_var_ti_double
1163 SUBROUTINE ext_int_put_var_ti_double ( DataHandle,Element, Varname, Data, Count, Status )
1164 IMPLICIT NONE
1165 INTEGER , INTENT(IN) :: DataHandle
1166 CHARACTER*(*) :: Element
1167 CHARACTER*(*) :: VarName
1168 real*8 , INTENT(IN) :: Data(*)
1169 INTEGER , INTENT(IN) :: Count
1170 INTEGER , INTENT(OUT) :: Status
1171 CALL wrf_error_fatal('ext_int_put_var_ti_double not supported yet')
1172 RETURN
1173 END SUBROUTINE ext_int_put_var_ti_double
1174
1175 !--- get_var_ti_integer
1176 SUBROUTINE ext_int_get_var_ti_integer ( DataHandle,Element, Varname, Data, Count, Outcount, Status )
1177 IMPLICIT NONE
1178 INTEGER , INTENT(IN) :: DataHandle
1179 CHARACTER*(*) :: Element
1180 CHARACTER*(*) :: VarName
1181 integer , INTENT(OUT) :: Data(*)
1182 INTEGER , INTENT(IN) :: Count
1183 INTEGER , INTENT(OUT) :: OutCount
1184 INTEGER , INTENT(OUT) :: Status
1185 RETURN
1186 END SUBROUTINE ext_int_get_var_ti_integer
1187
1188 !--- put_var_ti_integer
1189 SUBROUTINE ext_int_put_var_ti_integer ( DataHandle,Element, Varname, Data, Count, Status )
1190 IMPLICIT NONE
1191 INTEGER , INTENT(IN) :: DataHandle
1192 CHARACTER*(*) :: Element
1193 CHARACTER*(*) :: VarName
1194 integer , INTENT(IN) :: Data(*)
1195 INTEGER , INTENT(IN) :: Count
1196 INTEGER , INTENT(OUT) :: Status
1197 RETURN
1198 END SUBROUTINE ext_int_put_var_ti_integer
1199
1200 !--- get_var_ti_logical
1201 SUBROUTINE ext_int_get_var_ti_logical ( DataHandle,Element, Varname, Data, Count, Outcount, Status )
1202 IMPLICIT NONE
1203 INTEGER , INTENT(IN) :: DataHandle
1204 CHARACTER*(*) :: Element
1205 CHARACTER*(*) :: VarName
1206 logical , INTENT(OUT) :: Data(*)
1207 INTEGER , INTENT(IN) :: Count
1208 INTEGER , INTENT(OUT) :: OutCount
1209 INTEGER , INTENT(OUT) :: Status
1210 RETURN
1211 END SUBROUTINE ext_int_get_var_ti_logical
1212
1213 !--- put_var_ti_logical
1214 SUBROUTINE ext_int_put_var_ti_logical ( DataHandle,Element, Varname, Data, Count, Status )
1215 IMPLICIT NONE
1216 INTEGER , INTENT(IN) :: DataHandle
1217 CHARACTER*(*) :: Element
1218 CHARACTER*(*) :: VarName
1219 logical , INTENT(IN) :: Data(*)
1220 INTEGER , INTENT(IN) :: Count
1221 INTEGER , INTENT(OUT) :: Status
1222 RETURN
1223 END SUBROUTINE ext_int_put_var_ti_logical
1224
1225 !--- get_var_ti_char
1226 SUBROUTINE ext_int_get_var_ti_char ( DataHandle,Element, Varname, Data, Status )
1227 USE module_ext_internal
1228 IMPLICIT NONE
1229 INCLUDE 'intio_tags.h'
1230 INTEGER , INTENT(IN) :: DataHandle
1231 CHARACTER*(*) :: Element
1232 CHARACTER*(*) :: VarName
1233 CHARACTER*(*) :: Data
1234 INTEGER , INTENT(OUT) :: Status
1235 INTEGER locDataHandle, code
1236 CHARACTER*132 locElement, locVarName
1237 IF ( int_valid_handle (DataHandle) ) THEN
1238 IF ( int_handle_in_use( DataHandle ) ) THEN
1239 READ( unit=DataHandle ) hdrbuf
1240 IF ( hdrbuf(2) .EQ. int_var_ti_char ) THEN
1241 CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
1242 locDataHandle, locElement, locVarName, Data, code )
1243 IF ( .NOT. ( code .EQ. int_var_ti_real .OR. code .EQ. int_var_ti_logical .OR. &
1244 code .EQ. int_var_ti_char .OR. code .EQ. int_var_ti_double ) ) THEN
1245 BACKSPACE ( unit=DataHandle )
1246 Status = 1
1247 return
1248 ENDIF
1249 ELSE
1250 BACKSPACE ( unit=DataHandle )
1251 Status = 1
1252 return
1253 ENDIF
1254 ELSE
1255 Status = 1
1256 return
1257 ENDIF
1258 ELSE
1259 Status = 1
1260 return
1261 ENDIF
1262 Status = 0
1263 RETURN
1264 END SUBROUTINE ext_int_get_var_ti_char
1265
1266 !--- put_var_ti_char
1267 SUBROUTINE ext_int_put_var_ti_char ( DataHandle,Element, Varname, Data, Status )
1268 USE module_ext_internal
1269 IMPLICIT NONE
1270 INCLUDE 'intio_tags.h'
1271 INTEGER , INTENT(IN) :: DataHandle
1272 CHARACTER*(*) :: Element
1273 CHARACTER*(*) :: VarName
1274 CHARACTER*(*) :: Data
1275 INTEGER , INTENT(OUT) :: Status
1276 REAL dummy
1277 INTEGER :: Count
1278 IF ( int_valid_handle (DataHandle) ) THEN
1279 IF ( int_handle_in_use( DataHandle ) ) THEN
1280 CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
1281 DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), int_var_ti_char )
1282 WRITE( unit=DataHandle ) hdrbuf
1283 ENDIF
1284 ENDIF
1285 Status = 0
1286 RETURN
1287 END SUBROUTINE ext_int_put_var_ti_char
1288
1289 !--- get_var_td_real
1290 SUBROUTINE ext_int_get_var_td_real ( DataHandle,Element, DateStr,Varname, Data, Count, Outcount, Status )
1291 IMPLICIT NONE
1292 INTEGER , INTENT(IN) :: DataHandle
1293 CHARACTER*(*) :: Element
1294 CHARACTER*(*) :: DateStr
1295 CHARACTER*(*) :: VarName
1296 real , INTENT(OUT) :: Data(*)
1297 INTEGER , INTENT(IN) :: Count
1298 INTEGER , INTENT(OUT) :: OutCount
1299 INTEGER , INTENT(OUT) :: Status
1300 RETURN
1301 END SUBROUTINE ext_int_get_var_td_real
1302
1303 !--- put_var_td_real
1304 SUBROUTINE ext_int_put_var_td_real ( DataHandle,Element, DateStr,Varname, Data, Count, Status )
1305 IMPLICIT NONE
1306 INTEGER , INTENT(IN) :: DataHandle
1307 CHARACTER*(*) :: Element
1308 CHARACTER*(*) :: DateStr
1309 CHARACTER*(*) :: VarName
1310 real , INTENT(IN) :: Data(*)
1311 INTEGER , INTENT(IN) :: Count
1312 INTEGER , INTENT(OUT) :: Status
1313 RETURN
1314 END SUBROUTINE ext_int_put_var_td_real
1315
1316 !--- get_var_td_double
1317 SUBROUTINE ext_int_get_var_td_double ( DataHandle,Element, DateStr,Varname, Data, Count, Outcount, Status )
1318 IMPLICIT NONE
1319 INTEGER , INTENT(IN) :: DataHandle
1320 CHARACTER*(*) :: Element
1321 CHARACTER*(*) :: DateStr
1322 CHARACTER*(*) :: VarName
1323 real*8 , INTENT(OUT) :: Data(*)
1324 INTEGER , INTENT(IN) :: Count
1325 INTEGER , INTENT(OUT) :: OutCount
1326 INTEGER , INTENT(OUT) :: Status
1327 CALL wrf_error_fatal('ext_int_get_var_td_double not supported yet')
1328 RETURN
1329 END SUBROUTINE ext_int_get_var_td_double
1330
1331 !--- put_var_td_double
1332 SUBROUTINE ext_int_put_var_td_double ( DataHandle,Element, DateStr,Varname, Data, Count, Status )
1333 IMPLICIT NONE
1334 INTEGER , INTENT(IN) :: DataHandle
1335 CHARACTER*(*) :: Element
1336 CHARACTER*(*) :: DateStr
1337 CHARACTER*(*) :: VarName
1338 real*8 , INTENT(IN) :: Data(*)
1339 INTEGER , INTENT(IN) :: Count
1340 INTEGER , INTENT(OUT) :: Status
1341 CALL wrf_error_fatal('ext_int_put_var_td_double not supported yet')
1342 RETURN
1343 END SUBROUTINE ext_int_put_var_td_double
1344
1345 !--- get_var_td_integer
1346 SUBROUTINE ext_int_get_var_td_integer ( DataHandle,Element, DateStr,Varname, Data, Count, Outcount, Status )
1347 IMPLICIT NONE
1348 INTEGER , INTENT(IN) :: DataHandle
1349 CHARACTER*(*) :: Element
1350 CHARACTER*(*) :: DateStr
1351 CHARACTER*(*) :: VarName
1352 integer , INTENT(OUT) :: Data(*)
1353 INTEGER , INTENT(IN) :: Count
1354 INTEGER , INTENT(OUT) :: OutCount
1355 INTEGER , INTENT(OUT) :: Status
1356 RETURN
1357 END SUBROUTINE ext_int_get_var_td_integer
1358
1359 !--- put_var_td_integer
1360 SUBROUTINE ext_int_put_var_td_integer ( DataHandle,Element, DateStr,Varname, Data, Count, Status )
1361 IMPLICIT NONE
1362 INTEGER , INTENT(IN) :: DataHandle
1363 CHARACTER*(*) :: Element
1364 CHARACTER*(*) :: DateStr
1365 CHARACTER*(*) :: VarName
1366 integer , INTENT(IN) :: Data(*)
1367 INTEGER , INTENT(IN) :: Count
1368 INTEGER , INTENT(OUT) :: Status
1369 RETURN
1370 END SUBROUTINE ext_int_put_var_td_integer
1371
1372 !--- get_var_td_logical
1373 SUBROUTINE ext_int_get_var_td_logical ( DataHandle,Element, DateStr,Varname, Data, Count, Outcount, Status )
1374 IMPLICIT NONE
1375 INTEGER , INTENT(IN) :: DataHandle
1376 CHARACTER*(*) :: Element
1377 CHARACTER*(*) :: DateStr
1378 CHARACTER*(*) :: VarName
1379 logical , INTENT(OUT) :: Data(*)
1380 INTEGER , INTENT(IN) :: Count
1381 INTEGER , INTENT(OUT) :: OutCount
1382 INTEGER , INTENT(OUT) :: Status
1383 RETURN
1384 END SUBROUTINE ext_int_get_var_td_logical
1385
1386 !--- put_var_td_logical
1387 SUBROUTINE ext_int_put_var_td_logical ( DataHandle,Element, DateStr,Varname, Data, Count, Status )
1388 IMPLICIT NONE
1389 INTEGER , INTENT(IN) :: DataHandle
1390 CHARACTER*(*) :: Element
1391 CHARACTER*(*) :: DateStr
1392 CHARACTER*(*) :: VarName
1393 logical , INTENT(IN) :: Data(*)
1394 INTEGER , INTENT(IN) :: Count
1395 INTEGER , INTENT(OUT) :: Status
1396 RETURN
1397 END SUBROUTINE ext_int_put_var_td_logical
1398
1399 !--- get_var_td_char
1400 SUBROUTINE ext_int_get_var_td_char ( DataHandle,Element, DateStr,Varname, Data, Status )
1401 IMPLICIT NONE
1402 INTEGER , INTENT(IN) :: DataHandle
1403 CHARACTER*(*) :: Element
1404 CHARACTER*(*) :: DateStr
1405 CHARACTER*(*) :: VarName
1406 CHARACTER*(*) :: Data
1407 INTEGER , INTENT(OUT) :: Status
1408 RETURN
1409 END SUBROUTINE ext_int_get_var_td_char
1410
1411 !--- put_var_td_char
1412 SUBROUTINE ext_int_put_var_td_char ( DataHandle,Element, DateStr,Varname, Data, Status )
1413 IMPLICIT NONE
1414 INTEGER , INTENT(IN) :: DataHandle
1415 CHARACTER*(*) :: Element
1416 CHARACTER*(*) :: DateStr
1417 CHARACTER*(*) :: VarName
1418 CHARACTER*(*) :: Data
1419 INTEGER , INTENT(OUT) :: Status
1420 RETURN
1421 END SUBROUTINE ext_int_put_var_td_char
1422
1423 !--- read_field
1424 SUBROUTINE ext_int_read_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
1425 DomainDesc , MemoryOrder , Stagger , DimNames , &
1426 DomainStart , DomainEnd , &
1427 MemoryStart , MemoryEnd , &
1428 PatchStart , PatchEnd , &
1429 Status )
1430 USE module_ext_internal
1431 IMPLICIT NONE
1432 #include "wrf_io_flags.h"
1433 include 'intio_tags.h'
1434 INTEGER , INTENT(IN) :: DataHandle
1435 CHARACTER*(*) :: DateStr
1436 CHARACTER*(*) :: VarName
1437 integer ,intent(inout) :: FieldType
1438 integer ,intent(inout) :: Comm
1439 integer ,intent(inout) :: IOComm
1440 integer ,intent(inout) :: DomainDesc
1441 character*(*) ,intent(inout) :: MemoryOrder
1442 character*(*) ,intent(inout) :: Stagger
1443 character*(*) , dimension (*) ,intent(inout) :: DimNames
1444 integer ,dimension(*) ,intent(inout) :: DomainStart, DomainEnd
1445 integer ,dimension(*) ,intent(inout) :: MemoryStart, MemoryEnd
1446 integer ,dimension(*) ,intent(inout) :: PatchStart, PatchEnd
1447 integer ,intent(out) :: Status
1448
1449 !local
1450 INTEGER :: locDataHandle
1451 CHARACTER*132 :: locDateStr
1452 CHARACTER*132 :: locVarName
1453 integer :: locFieldType
1454 integer :: locComm
1455 integer :: locIOComm
1456 integer :: locDomainDesc
1457 character*132 :: locMemoryOrder
1458 character*132 :: locStagger
1459 character*132 , dimension (3) :: locDimNames
1460 integer ,dimension(3) :: locDomainStart, locDomainEnd
1461 integer ,dimension(3) :: locMemoryStart, locMemoryEnd
1462 integer ,dimension(3) :: locPatchStart, locPatchEnd
1463
1464 character*132 mess
1465
1466 integer ii,jj,kk,myrank
1467
1468
1469 REAL, DIMENSION(*) :: Field
1470
1471 INTEGER inttypesize, realtypesize, istat, code
1472
1473 IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1474 CALL wrf_error_fatal("io_int.F90: ext_int_read_field: invalid data handle" )
1475 ENDIF
1476 IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1477 CALL wrf_error_fatal("io_int.F90: ext_int_read_field: DataHandle not opened" )
1478 ENDIF
1479
1480 inttypesize = itypesize
1481 realtypesize = rtypesize
1482
1483 DO WHILE ( .TRUE. )
1484 READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows
1485 IF ( istat .EQ. 0 ) THEN
1486 code = hdrbuf(2)
1487 IF ( code .EQ. int_field ) THEN
1488 CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, &
1489 locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, &
1490 locDomainDesc , locMemoryOrder , locStagger , locDimNames , &
1491 locDomainStart , locDomainEnd , &
1492 locMemoryStart , locMemoryEnd , &
1493 locPatchStart , locPatchEnd )
1494 IF ( TRIM(locVarName) .EQ. TRIM(VarName) ) THEN
1495 IF ( FieldType .EQ. WRF_REAL ) THEN
1496 CALL rfieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1497 ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
1498 CALL ifieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1499 ELSE
1500 CALL wrf_message('io_int.F90: ext_int_read_field: types other than WRF_REAL not supported yet')
1501 READ( unit=DataHandle )
1502 ENDIF
1503 ELSE
1504 WRITE(mess,*)'ext_int_read_field: ',TRIM(locVarName),' NE ',TRIM(VarName)
1505 CALL wrf_message(mess)
1506 READ( unit=DataHandle )
1507 ENDIF
1508 Status = 0
1509 GOTO 7717
1510 ENDIF
1511 ELSE
1512 Status = 1
1513 GOTO 7717
1514 ENDIF
1515 ENDDO
1516
1517 7717 CONTINUE
1518
1519 first_operation( DataHandle ) = .FALSE.
1520 RETURN
1521
1522 END SUBROUTINE ext_int_read_field
1523
1524 !--- write_field
1525 SUBROUTINE ext_int_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
1526 DomainDesc , MemoryOrder , Stagger , DimNames , &
1527 DomainStart , DomainEnd , &
1528 MemoryStart , MemoryEnd , &
1529 PatchStart , PatchEnd , &
1530 Status )
1531 USE module_ext_internal
1532 IMPLICIT NONE
1533 #include "wrf_io_flags.h"
1534 INTEGER , INTENT(IN) :: DataHandle
1535 CHARACTER*(*) :: DateStr
1536 CHARACTER*(*) :: VarName
1537 integer ,intent(in) :: FieldType
1538 integer ,intent(inout) :: Comm
1539 integer ,intent(inout) :: IOComm
1540 integer ,intent(in) :: DomainDesc
1541 character*(*) ,intent(in) :: MemoryOrder
1542 character*(*) ,intent(in) :: Stagger
1543 character*(*) , dimension (*) ,intent(in) :: DimNames
1544 integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd
1545 integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd
1546 integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd
1547 integer ,intent(out) :: Status
1548
1549 integer ii,jj,kk,myrank
1550
1551 ! REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1552 ! MemoryStart(2):MemoryEnd(2), &
1553 ! MemoryStart(3):MemoryEnd(3) ) :: Field
1554
1555 REAL, DIMENSION(*) :: Field
1556
1557 INTEGER inttypesize, realtypesize
1558
1559 IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1560 CALL wrf_error_fatal("io_int.F90: ext_int_write_field: invalid data handle" )
1561 ENDIF
1562 IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1563 CALL wrf_error_fatal("io_int.F90: ext_int_write_field: DataHandle not opened" )
1564 ENDIF
1565
1566 inttypesize = itypesize
1567 realtypesize = rtypesize
1568 IF ( FieldType .EQ. WRF_REAL .OR. FieldType .EQ. WRF_DOUBLE) THEN
1569 typesize = rtypesize
1570 ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
1571 CALL wrf_error_fatal( 'io_int.F90: ext_int_write_field, WRF_DOUBLE not yet supported')
1572 ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
1573 typesize = itypesize
1574 ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
1575 CALL wrf_error_fatal( 'io_int.F90: ext_int_write_field, WRF_LOGICAL not yet supported')
1576 ENDIF
1577
1578 IF ( okay_for_io( DataHandle ) ) THEN
1579
1580 CALL int_gen_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, &
1581 DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
1582 DomainDesc , MemoryOrder , Stagger , DimNames , &
1583 DomainStart , DomainEnd , &
1584 MemoryStart , MemoryEnd , &
1585 PatchStart , PatchEnd )
1586 WRITE( unit=DataHandle ) hdrbuf
1587 IF ( FieldType .EQ. WRF_REAL ) THEN
1588 CALL rfieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1589 ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
1590 CALL ifieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1591 ENDIF
1592 ENDIF
1593 first_operation( DataHandle ) = .FALSE.
1594 Status = 0
1595 RETURN
1596 END SUBROUTINE ext_int_write_field
1597
1598 SUBROUTINE rfieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1599 INTEGER , INTENT(IN) :: DataHandle
1600 INTEGER ,DIMENSION(*) ,INTENT(IN) :: MemoryStart, MemoryEnd
1601 INTEGER ,DIMENSION(*) ,INTENT(IN) :: PatchStart, PatchEnd
1602 REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1603 MemoryStart(2):MemoryEnd(2), &
1604 MemoryStart(3):MemoryEnd(3) ) :: Field
1605 WRITE( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1606 RETURN
1607 END SUBROUTINE rfieldwrite
1608
1609 SUBROUTINE ifieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1610 INTEGER , INTENT(IN) :: DataHandle
1611 INTEGER ,DIMENSION(*) ,INTENT(IN) :: MemoryStart, MemoryEnd
1612 INTEGER ,DIMENSION(*) ,INTENT(IN) :: PatchStart, PatchEnd
1613 INTEGER, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1614 MemoryStart(2):MemoryEnd(2), &
1615 MemoryStart(3):MemoryEnd(3) ) :: Field
1616 WRITE( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1617 RETURN
1618 END SUBROUTINE ifieldwrite
1619
1620 SUBROUTINE rfieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1621 INTEGER , INTENT(IN) :: DataHandle
1622 INTEGER ,DIMENSION(*) ,INTENT(IN) :: MemoryStart, MemoryEnd
1623 INTEGER ,DIMENSION(*) ,INTENT(IN) :: PatchStart, PatchEnd
1624 REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1625 MemoryStart(2):MemoryEnd(2), &
1626 MemoryStart(3):MemoryEnd(3) ) :: Field
1627 READ( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1628 RETURN
1629 END SUBROUTINE rfieldread
1630
1631 SUBROUTINE ifieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1632 INTEGER , INTENT(IN) :: DataHandle
1633 INTEGER ,DIMENSION(*) ,INTENT(IN) :: MemoryStart, MemoryEnd
1634 INTEGER ,DIMENSION(*) ,INTENT(IN) :: PatchStart, PatchEnd
1635 INTEGER, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1636 MemoryStart(2):MemoryEnd(2), &
1637 MemoryStart(3):MemoryEnd(3) ) :: Field
1638 READ( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1639 RETURN
1640 END SUBROUTINE ifieldread
1641