OpenCMISS-Iron Internal API Documentation
binary_file_f.f90
Go to the documentation of this file.
1 
44 
45 
46 !#### Module: BINARY_FILE
47 !### Description:
48 !### This module handles the reading and writing of binary files.
49 !### Uses: KINDS,CONSTANTS,MACHINE_CONSTANTS,BASE_ROUTINES,F90C,ISO_VARYING_STRING
50 !### Routine: INQUIRE_OPEN_BINARY_FILE
51 !### Routine: INQUIRE_EOF_BINARY_FILE
52 !### Routine: CLOSE_BINARY_FILE
53 !### Routine: CLOSE_CMISS_BINARY_FILE
54 !### Routine: OPEN_BINARY_FILE
55 !### Routine: OPEN_CMISS_BINARY_FILE
56 !### Routine: READ_BINARY_FILE
57 !### Routine: READ_BINARY_TAG_HEADER
58 !### Routine: RESET_BINARY_NUMBER_TAGS
59 !### Routine: SET_BINARY_FILE
60 !### Routine: SKIP_CM_BINARY_HEADER
61 !### Routine: SKIP_BINARY_FILE
62 !### Routine: SKIP_BINARY_TAGS
63 !### Routine: WRITE_BINARY_FILE
64 !### Routine: WRITE_BINARY_TAG_HEADER
65 
66 !#### Comment: BINARY FILE FORMAT
67 !### Description:
68 !### <HTML>
69 !### The binary file format used for CMISS is as follows:
70 !### Each cmiss binary file has the following header format:
71 !### There are three sections in the header, namely:
72 !### <UL>
73 !### <LI>An identity header section.
74 !### <LI>A machine header section.
75 !### <LI>A file header section.
76 !### </UL>
77 !### The format of the identity header section is:
78 !### <UL>
79 !### <LI>1 identity byte (currently set to the value 0x07).
80 !### <LI>1 byte to indicate the revision of the binary file format
81 !### (currently set to the value 0x02).
82 !### </UL>
83 !### The format of the machine header section is:
84 !### <UL>
85 !### <LI> If the the revision of the binary file format is 0x00
86 !### <UL>
87 !### <LI>2 dummy bytes (to be skipped).
88 !### </UL>
89 !### <LI> If the revision of the binary file format is 0x01
90 !### <UL>
91 !### <LI>1 byte to indicate the number (in standard base two) of
92 !### following bytes in the machine header section. This is
93 !### 11 for this revision and the bytes are:
94 !### <LI>1 byte to indicate the machine type which created the
95 !### file (0x01 - DEC Alpha, 0x02 - SGI, 0x03 - IBM,
96 !### 0x04 - Cray).
97 !### <LI>1 byte to indicate the operating system type of the machine
98 !### which created the file (redundant - for future development).
99 !### <LI>1 byte to indicate the endian ordering of the numbers in
100 !### in the file (0x01 - big endian, 0x02 - little endian).
101 !### Currently all numbers are converted to big endian format.
102 !### <LI>1 byte to indicate the format of standard single precision
103 !### numbers (0x01 - IEEE single standard).
104 !### <LI>1 byte to indicate the format of standard double precision
105 !### numbers (0x01 - IEEE double standard).
106 !### <LI>1 byte to indicate the number of bytes a character type
107 !### takes up in the file.
108 !### <LI>1 byte to indicate the number of bytes a integer type
109 !### takes up in the file.
110 !### <LI>1 byte to indicate the number of bytes a short integer type
111 !### takes up in the file.
112 !### <LI>1 byte to indicate the number of bytes a single precision
113 !### type takes up in the file.
114 !### <LI>1 byte to indicate the number of bytes a double precision
115 !### type takes up in the file.
116 !### <LI>1 byte to indicate the number of bytes a logical
117 !### type takes up in the file.
118 !### </UL>
119 !### <LI> If the revision of the binary file format is 0x02
120 !### <UL>
121 !### </UL>
122 !### <LI>1 byte to indicate the number (in standard base two) of
123 !### following bytes in the machine header section. This is
124 !### 16 for this revision and the bytes are:
125 !### <LI>1 byte to indicate the machine type which created the
126 !### file (0x01 - DEC Alpha, 0x02 - SGI, 0x03 - IBM,
127 !### 0x04 - Cray).
128 !### <LI>1 byte to indicate the operating system type of the machine
129 !### which created the file (redundant - for future development).
130 !### <LI>1 byte to indicate the endian ordering of the numbers in
131 !### in the file (0x01 - big endian, 0x02 - little endian).
132 !### <LI>1 byte to indicate the format of characters (0x01 -
133 !### Ascii, 0x02 - Unicode).
134 !### <LI>1 byte to indicate the format of integers (0x01 -
135 !### twos complement, 0x02 - Signed magnitude).
136 !### <LI>1 byte to indicate the format of standard single precision
137 !### numbers (0x01 - IEEE single standard).
138 !### <LI>1 byte to indicate the format of standard double precision
139 !### numbers (0x01 - IEEE double standard).
140 !### <LI>1 byte to indicate the number of bytes a character type
141 !### takes up in the file.
142 !### <LI>1 byte to indicate the number of bytes an integer type
143 !### takes up in the file.
144 !### <LI>1 byte to indicate the number of bytes a short integer type
145 !### takes up in the file.
146 !### <LI>1 byte to indicate the number of bytes a long integer type
147 !### takes up in the file.
148 !### <LI>1 byte to indicate the number of bytes a single precision
149 !### type takes up in the file.
150 !### <LI>1 byte to indicate the number of bytes a double precision
151 !### type takes up in the file.
152 !### <LI>1 byte to indicate the number of bytes a logical
153 !### type takes up in the file.
154 !### <LI>1 byte to indicate the number of bytes a single precision
155 !### complex type takes up in the file.
156 !### <LI>1 byte to indicate the number of bytes a double precision
157 !### complex type takes up in the file.
158 !### </UL>
159 !### </UL>
160 !### If the binary file format is below 0x02 then the format of the
161 !### file header section is:
162 !### <UL>
163 !### <LI>Integer to specify the file type. Current binary
164 !### file types are: 1 - Binary matrix file, 2 - Binary time
165 !### series file, 3 - Binary signal file.
166 !### <LI>Single precision number to specify the version of the file.
167 !### <LI>Integer to specify the number of bytes in the heading.
168 !### <LI>The heading (as a string of character bytes).
169 !### <LI>Integer to specify how many 'tags' of data are in the file.
170 !### </UL>
171 !### The rest of the data in the file is made up of `tags' which
172 !### contain the actual data. For each tag of data the format is:
173 !### <UL>
174 !### <LI>Integer to specify the type of tag.
175 !### <LI>Integer to specify the number of bytes in the tag
176 !### heading.
177 !### <LI>The tag heading (as a string of character bytes).
178 !### <LI>Integer to specify the number of bytes in the tag
179 !### (excluding the tag header information).
180 !### <LI>The tag data.
181 !### </UL>
182 !### If the binary file format is 0x02 then the format of the file
183 !### header section is:
184 !### <UL>
185 !### <LI>Integer to specify the file type. Current binary
186 !### file types are: 1 - Binary matrix file, 2 - Binary time
187 !### series file, 3 - Binary signal file, 4 - Binary node file ??,
188 !### 5 - Binary element file ??
189 !### <LI>Three integers to specify the version of the file in the
190 !### form xxx.xxx.xxx
191 !### <LI>Integer to specify the number of bytes in the heading.
192 !### <LI>The heading (as a string of character bytes).
193 !### <LI>Integer to specify how many tags are in the next level of
194 !### the binary file.
195 !### </UL>
196 !### The rest of the data in the file is made up of a hierachy of
197 !### `tags' which contain the actual data. For each tag of data the
198 !### format is:
199 !### <UL>
200 !### <LI>Integer to specify the type of tag.
201 !### <LI>Integer to specify the number of bytes in the tag
202 !### heading.
203 !### <LI>The tag heading (as a string of character bytes).
204 !### <LI>An integer to specify the number of tags below this tag.
205 !### If this number is > 0 the tag is known as a node tag.
206 !### If this number is = 0 the tag is known as a leaf tag.
207 !### <LI>If the tag is a leaf tag
208 !### <UL>
209 !### <LI>Integer to specify the number of bytes in the tag
210 !### (excluding the tag header information). NOTE: This restricts
211 !### the amount of information within a tag to under 2 GB. Future
212 !### revisions of the binary file format will change this quantity
213 !### to a long integer (i.e. 64-bits). This will have to wait, however,
214 !### until intel based machines can handle 64-bit integers.
215 !### <LI>The tag data.
216 !### </UL>
217 !### </UL>
218 !### Note: that if any of the byte numbers are unknown they will have
219 !### the value of 0xFF.
220 !### </HTML>
221 
223 MODULE binary_file
224 
225  USE kinds
226  USE constants
227  USE machine_constants
228  USE base_routines
229  USE f90c
230  USE iso_varying_string
231 
232 #include "macros.h"
233 
234  IMPLICIT NONE
235 
236  !PRIVATE
237 
238  !Module parameters
239 
240  INTEGER(INTG), PARAMETER :: max_num_binary_files=99
241 
242  !Skip file parameters
243  INTEGER(INTG), PARAMETER :: file_beginning=0
244  INTEGER(INTG), PARAMETER :: file_current=1
245  INTEGER(INTG), PARAMETER :: file_end=2
246 
247  !File endian parameters
248  INTEGER(INTG), PARAMETER :: file_same_endian=0
249  INTEGER(INTG), PARAMETER :: file_change_endian=1
250 
251  !Binary file parameters
252  INTEGER(INTG), PARAMETER :: binary_file_readable=1
253  INTEGER(INTG), PARAMETER :: binary_file_writable=2
254 
255  !CMISS Binary file parameters
256  INTEGER(INTG), PARAMETER :: cmiss_binary_identity=7
257  INTEGER(INTG), PARAMETER :: cmiss_binary_matrix_file=1
258  INTEGER(INTG), PARAMETER :: cmiss_binary_history_file=2
259  INTEGER(INTG), PARAMETER :: cmiss_binary_signal_file=3
260  INTEGER(INTG), PARAMETER :: cmiss_binary_identity_header=1
261  INTEGER(INTG), PARAMETER :: cmiss_binary_machine_header=2
262  INTEGER(INTG), PARAMETER :: cmiss_binary_file_header=3
263 
264  !Module types
265 
266  TYPE binary_file_info_type
267  PRIVATE
268  INTEGER(INTG) :: file_number
269  INTEGER(INTG) :: binary_file_revision
270  INTEGER(INTG) :: machine_type
271  INTEGER(INTG) :: os_type
272  INTEGER(INTG) :: endian_type
273  INTEGER(INTG) :: char_format
274  INTEGER(INTG) :: int_format
275  INTEGER(INTG) :: sp_format
276  INTEGER(INTG) :: dp_format
277  INTEGER(INTG) :: character_size
278  INTEGER(INTG) :: integer_size
279  INTEGER(INTG) :: sinteger_size
280  INTEGER(INTG) :: linteger_size
281  INTEGER(INTG) :: sp_real_size
282  INTEGER(INTG) :: dp_real_size
283  INTEGER(INTG) :: logical_size
284  INTEGER(INTG) :: spc_real_size
285  INTEGER(INTG) :: dpc_real_size
286  CHARACTER(LEN=MAXSTRLEN) :: file_name
287  INTEGER(INTG) :: access_type
288  END TYPE binary_file_info_type
289 
290  TYPE binary_file_type
291  TYPE(binary_file_info_type), POINTER :: file_information
292  END TYPE binary_file_type
293 
294  TYPE binary_tag_type
295  INTEGER(INTG) :: index
296  INTEGER(INTG) :: num_subtags
297  INTEGER(INTG) :: num_bytes
298  INTEGER(INTG) :: num_header_bytes
299  CHARACTER(LEN=MAXSTRLEN) :: header
300  END TYPE binary_tag_type
301 
302  !Module variables
303 
304  LOGICAL, SAVE :: binary_file_used(max_num_binary_files)=.false.
305 
306  !Interfaces
307 
308  INTERFACE
309 
310  SUBROUTINE binaryclosefile(FILE_NUMBER,ERR,CERROR)
311 !DEC$ ATTRIBUTES C :: binaryclosefile
312  USE constants
313  INTEGER(INTG), INTENT(IN) :: FILE_NUMBER
314  INTEGER(INTG), INTENT(OUT) :: ERR,CERROR(*)
315  END SUBROUTINE binaryclosefile
316 
317  SUBROUTINE binaryopenfile(FILE_NUMBER,CFNAME,CACCESSCODE,ERR,CERROR)
318 !DEC$ ATTRIBUTES C :: binaryopenfile
319  USE constants
320  INTEGER(INTG), INTENT(IN) :: FILE_NUMBER,CFNAME(*),CACCESSCODE(*)
321  INTEGER(INTG), INTENT(OUT) :: ERR,CERROR(*)
322  END SUBROUTINE binaryopenfile
323 
324 !!DEC$ ATTRIBUTES C :: binaryreadfile
325 
326  SUBROUTINE binarysetfile(FILE_NUMBER,SET_CODE,ERR,CERROR)
327  USE constants
328 !DEC$ ATTRIBUTES C :: binarysetfile
329  INTEGER(INTG), INTENT(IN) :: FILE_NUMBER,SET_CODE
330  INTEGER(INTG), INTENT(OUT) :: ERR,CERROR(*)
331  END SUBROUTINE binarysetfile
332 
333  SUBROUTINE binaryskipfile(FILE_NUMBER,NUMBER_BYTES,ERR,CERROR)
334 !DEC$ ATTRIBUTES C :: binaryskipfile
335  USE constants
336  INTEGER(INTG), INTENT(IN) :: FILE_NUMBER,NUMBER_BYTES
337  INTEGER(INTG), INTENT(OUT) :: ERR,CERROR(*)
338  END SUBROUTINE binaryskipfile
339 
340 !! SUBROUTINE BINARYWRITEFILE
341 !!!DEC$ ATTRIBUTES C :: binarywritefile
342 !! END SUBROUTINE BINARYWRITEFILE
343 
344  SUBROUTINE isbinaryfileopen(FILE_NUMBER,RETURNCODE,ERR,CERROR)
345 !DEC$ ATTRIBUTES C :: isbinaryfileopen
346  USE constants
347  INTEGER(INTG), INTENT(IN) :: FILE_NUMBER
348  INTEGER(INTG), INTENT(OUT) :: RETURNCODE, ERR, CERROR(*)
349  END SUBROUTINE isbinaryfileopen
350 
351  SUBROUTINE isendbinaryfile(FILE_NUMBER,RETURN_CODE,ERR,CERROR)
352 !DEC$ ATTRIBUTES C :: isbinaryfileopen
353  USE constants
354  INTEGER(INTG), INTENT(IN) :: FILE_NUMBER
355  INTEGER(INTG), INTENT(OUT) :: RETURN_CODE,ERR,CERROR(*)
356  END SUBROUTINE isendbinaryfile
357 
358  END INTERFACE
359 
360  INTERFACE read_binary_file
361  MODULE PROCEDURE read_binary_file_intg
362  MODULE PROCEDURE read_binary_file_intg1
363  MODULE PROCEDURE read_binary_file_sintg
364  MODULE PROCEDURE read_binary_file_sintg1
365  MODULE PROCEDURE read_binary_file_lintg
366  MODULE PROCEDURE read_binary_file_lintg1
367  MODULE PROCEDURE read_binary_file_sp
368  MODULE PROCEDURE read_binary_file_sp1
369  MODULE PROCEDURE read_binary_file_dp
370  MODULE PROCEDURE read_binary_file_dp1
371  MODULE PROCEDURE read_binary_file_character
372  MODULE PROCEDURE read_binary_file_logical
373  MODULE PROCEDURE read_binary_file_logical1
374  MODULE PROCEDURE read_binary_file_spc
375  MODULE PROCEDURE read_binary_file_spc1
376  MODULE PROCEDURE read_binary_file_dpc
377  MODULE PROCEDURE read_binary_file_dpc1
378  END INTERFACE !READ_BINARY_FILE
379 
380  INTERFACE write_binary_file
381  MODULE PROCEDURE write_binary_file_intg
382  MODULE PROCEDURE write_binary_file_intg1
383  MODULE PROCEDURE write_binary_file_sintg
384  MODULE PROCEDURE write_binary_file_sintg1
385  MODULE PROCEDURE write_binary_file_lintg
386  MODULE PROCEDURE write_binary_file_lintg1
387  MODULE PROCEDURE write_binary_file_sp
388  MODULE PROCEDURE write_binary_file_sp1
389  MODULE PROCEDURE write_binary_file_dp
390  MODULE PROCEDURE write_binary_file_dp1
391  MODULE PROCEDURE write_binary_file_character
392  MODULE PROCEDURE write_binary_file_logical
393  MODULE PROCEDURE write_binary_file_logical1
394  MODULE PROCEDURE write_binary_file_spc
395  MODULE PROCEDURE write_binary_file_spc1
396  MODULE PROCEDURE write_binary_file_dpc
397  MODULE PROCEDURE write_binary_file_dpc1
398  END INTERFACE !WRITE_BINARY_FILE
399 
400  PUBLIC file_beginning,file_current,file_end,cmiss_binary_matrix_file,&
401  & cmiss_binary_history_file,cmiss_binary_signal_file,binary_file_type
402  PUBLIC read_binary_file,write_binary_file
403 
404 CONTAINS
405 
406  !
407  !============================================================================
408  !
409 
410  FUNCTION inquire_open_binary_file(FILEID)
411 
412  !#### Function: INQUIRE_OPEN_BINARY_FILE
413  !### Type: LOGICAL
414  !### Desctiption:
415  !### INQUIRE_OPEN_BINARY_FILE returns .TRUE. if the binary file
416  !### specified by FILEID is OPEN, .FALSE. if not.
417 
418  !Arguments
419  TYPE(binary_file_type), INTENT(IN) :: FILEID
420  !Function Variable
421  LOGICAL :: INQUIRE_OPEN_BINARY_FILE
422  !Local Variables
423 
424  inquire_open_binary_file=ASSOCIATED(fileid%FILE_INFORMATION)
425 
426  RETURN
427  END FUNCTION inquire_open_binary_file
428 
429  !
430  !============================================================================
431  !
432 
433  FUNCTION inquire_eof_binary_file(FILEID, ERR, ERROR)
434 
435  !#### Function: INQUIRE_EOF_BINARY_FILE
436  !### Type: LOGICAL
437  !### Description:
438  !### INQUIRE_EOF_BINARY_FILE returns .TRUE. If the binary file
439  !### specified by FILEID is at eof, .FALSE. if not.
440 
441  !Arguments
442  TYPE(binary_file_type), INTENT(IN) :: FILEID
443  INTEGER(INTG), INTENT(OUT) :: ERR
444  TYPE(varying_string), INTENT(OUT) :: ERROR
445  !Function Variable
446  LOGICAL :: INQUIRE_EOF_BINARY_FILE
447  !Local Variables
448  INTEGER(INTG) :: CERROR(100),RETURNCODE
449  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
450 
451  enters("INQUIRE_EOF_BINARY_FILE",err,error,*999)
452 
453  inquire_eof_binary_file=.false.
454  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
455  CALL isendbinaryfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
456  & returncode,err,cerror)
457  IF(err/=0) THEN
458  CALL c2fstring(cerror,dummy_error,err,error,*999)
459  CALL flagerror(dummy_error,err,error,*999)
460  ENDIF
461  inquire_eof_binary_file=(returncode==1)
462  ELSE
463  CALL flagerror("Invalid FILEID",err,error,*999)
464  ENDIF
465 
466  exits("INQUIRE_EOF_BINARY_FILE")
467  RETURN
468 999 errorsexits("INQUIRE_EOF_BINARY_FILE",err,error)
469  RETURN
470  END FUNCTION
471 
472  !
473  !============================================================================
474  !
475 
476  SUBROUTINE close_binary_file(FILEID,ERR,ERROR,*)
477 
478  !#### Subroutine: CLOSE_BINARY_FILE
479  !### Description:
480  !### CLOSE_BINARY_FILE closes the binary file specified by
481  !### FILEID and deallocates the binary file information.
482 
483  !Argument Variables
484  TYPE(binary_file_type), INTENT(OUT) :: FILEID
485  INTEGER(INTG), INTENT(OUT) :: ERR
486  TYPE(varying_string), INTENT(OUT) :: ERROR
487  !Local Variables
488  INTEGER(INTG) :: CERROR(100)
489  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
490 
491  enters("CLOSE_BINARY_FILE",err,error,*999)
492 
493  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
494  CALL binaryclosefile(fileid%FILE_INFORMATION%FILE_NUMBER, err,&
495  & cerror)
496  IF(err/=0) THEN
497  CALL c2fstring(cerror,dummy_error,err,error,*999)
498  CALL flagerror(dummy_error,err,error,*999)
499  ENDIF
500  !Could be a problem with the file not being closed properly.
501  !DEALLOCATE the file information for now and assume that the
502  !file has already been closed.
503  binary_file_used(fileid%FILE_INFORMATION%FILE_NUMBER)=.false.
504  DEALLOCATE(fileid%FILE_INFORMATION)
505  ELSE
506  CALL flagerror("Invalid FILEID",err,error,*999)
507  ENDIF
508 
509  exits("CLOSE_BINARY_FILE")
510  RETURN
511 999 errorsexits("CLOSE_BINARY_FILE",err,error)
512  RETURN 1
513  END SUBROUTINE close_binary_file
514 
515  !
516  !============================================================================
517  !
518 
519  SUBROUTINE close_cmiss_binary_file(FILEID,ERR,ERROR,*)
520 
521  !#### Subroutine: CLOSE_CMISS_BINARY_FILE
522  !### Description:
523  !### CLOSE_CMISS_BINARY_FILE closes the CMISS binary file specified by
524  !### FILEID.
525 
526  !Argument Variables
527  TYPE(binary_file_type), INTENT(INOUT) :: FILEID
528  INTEGER(INTG), INTENT(OUT) :: ERR
529  TYPE(varying_string), INTENT(OUT) :: ERROR
530  !Local Variables
531  INTEGER(INTG) :: CERROR(100)
532 
533  enters("CLOSE_CMISS_BINARY_FILE",err,error,*999)
534 
535  CALL close_binary_file(fileid,err,error,*999)
536 
537  exits("CLOSE_CMISS_BINARY_FILE")
538  RETURN
539 999 errorsexits("CLOSE_CMISS_BINARY_FILE",err,error)
540  RETURN 1
541  END SUBROUTINE close_cmiss_binary_file
542 
543  !
544  !============================================================================
545  !
546 
547  SUBROUTINE open_binary_file(FILEID,COMMAND,FILENAME,ERR,ERROR,*)
548 
549  !#### Subroutine: OPEN_BINARY_FILE
550  !### Description:
551  !### OPEN_BINARY_FILE opens the binary file specified by
552  !### FILEID with the given FILENAME. The file will be opened
553  !### for reading if COMMAND is "READ" and writting if COMMAND
554  !### is "WRITE".
555 
556  !Argument Variables
557  TYPE(binary_file_type), INTENT(OUT) :: FILEID
558  CHARACTER(LEN=*), INTENT(IN) :: COMMAND, FILENAME
559  INTEGER(INTG), INTENT(OUT) :: ERR
560  TYPE(varying_string), INTENT(OUT) :: ERROR
561  !Local Variables
562  INTEGER(INTG) :: CACCESSCODE(2), CERROR(100), CFNAME(100),&
563  & FILENUMBER,FILENUM
564  CHARACTER(LEN=6) :: FACCESSCODE
565  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
566 
567  enters("OPEN_BINARY_FILE",err,error,*999)
568 
569  filenumber=0
570  DO filenum=1,max_num_binary_files
571  IF(.NOT.binary_file_used(filenum)) THEN
572  filenumber=filenum
573  EXIT
574  ENDIF
575  ENDDO
576  IF(filenumber/=0) THEN
577  ALLOCATE(fileid%FILE_INFORMATION,stat=err)
578  IF(err==0) THEN
579  binary_file_used(fileid%FILE_INFORMATION%FILE_NUMBER)=.true.
580  fileid%FILE_INFORMATION%FILE_NUMBER=filenumber
581  fileid%FILE_INFORMATION%FILE_NAME=filename
582  fileid%FILE_INFORMATION%ENDIAN_TYPE=machine_endian
583  CALL f2cstring(cfname,filename,err,error,*999)
584  IF(command(1:4)=="READ") THEN
585  faccesscode="rb+"
586  fileid%FILE_INFORMATION%ACCESS_TYPE=binary_file_readable
587  ELSE IF(command(1:5)=="WRITE") THEN
588  faccesscode="wb+"
589  fileid%FILE_INFORMATION%ACCESS_TYPE=binary_file_writable
590  ELSE
591  CALL flagerror("Invalid command",err,error,*999)
592  ENDIF
593  CALL f2cstring(caccesscode,faccesscode,err,error,*999)
594  CALL binaryopenfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
595  & cfname,caccesscode,err,cerror)
596  IF(err/=0) THEN
597  CALL c2fstring(cerror,dummy_error,err,error,*999)
598  CALL flagerror(dummy_error,err,error,*999)
599  ENDIF
600  ELSE
601  CALL flagerror("Could not allocate binary file information",&
602  & err,error,*999)
603  ENDIF
604  ELSE
605  CALL flagerror("No free binary files available",err,error,*999)
606  ENDIF
607 
608  exits("OPEN_BINARY_FILE")
609  RETURN
610 999 IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
611  binary_file_used(fileid%FILE_INFORMATION%FILE_NUMBER)=.false.
612  DEALLOCATE(fileid%FILE_INFORMATION)
613  ENDIF
614  errorsexits("OPEN_BINARY_FILE",err,error)
615  RETURN 1
616  END SUBROUTINE open_binary_file
617 
618  !
619  !============================================================================
620  !
621 
622  SUBROUTINE open_cmiss_binary_file(FILEID,FILE_TYPE,NUMBER_TAGS,&
623  & version,fileversion,command,extension,filename,err,error,*)
624 
625  !#### Subroutine: OPEN_CMISS_BINARY_FILE
626  !### Description:
627  !### OPEN_CMISS_BINARY_FILE opens a CMISS binary file called
628  !### file.bin*** (where *** is the extension) specified by
629  !### FILEID, allocates the file information and reads/writes
630  !### (specified by command) file type, version number, heading
631  !### and number of tags.
632 
633  !Argument Variables
634  TYPE(binary_file_type), INTENT(OUT) :: FILEID
635  INTEGER(INTG), INTENT(IN) :: FILE_TYPE
636  INTEGER(INTG), INTENT(INOUT) :: NUMBER_TAGS
637  INTEGER(INTG), INTENT(IN) :: VERSION(3)
638  INTEGER(INTG), INTENT(OUT) :: FILEVERSION(3)
639  CHARACTER(LEN=*), INTENT(IN) :: COMMAND, EXTENSION, FILENAME
640  INTEGER(INTG), INTENT(OUT) :: ERR
641  TYPE(varying_string), INTENT(OUT) :: ERROR
642  !Local Variables
643  INTEGER(INTG) :: FILE_NUM, FILE_NUMBER, FILETYPE, HEADINGSIZE,&
644  & NUMMACHHEADERBYTES
645  REAL(SP) :: FVERSION
646  CHARACTER(LEN=17) :: CHARDATA
647  CHARACTER(LEN=MAXSTRLEN) :: ERROR_STRING,FULL_FILENAME,HEADING,&
648  & WARNING_STRING
649 
650  enters("OPEN_CMISS_BINARY_FILE",err,error,*999)
651 
652  full_filename=filename(1:len_trim(filename))//".bin"&
653  & //extension(1:len_trim(extension))
654  CALL open_binary_file(fileid, command,full_filename,err,error,*999)
655  IF(command(1:4)=="READ") THEN
656  !Read identity header section
657  CALL read_binary_file(fileid,2,chardata,err,error,*999)
658  IF(chardata(1:1)/=char(cmiss_binary_identity)) &
659  & CALL flagerror("Not a CMISS binary file",err,error,*999)
660  fileid%FILE_INFORMATION%BINARY_FILE_REVISION=ichar(chardata(2:2))
661  !Read machine header section
662  SELECT CASE(fileid%FILE_INFORMATION%BINARY_FILE_REVISION)
663  CASE(0)
664  !Identity format 0 - has 2 extra dummy bytes. Skip them.
665  CALL flag_warning("Old binary file identity format&
666  & found. Please update file.",err,error,*999)
667  CALL skip_binary_file(fileid,2*character_size,err,&
668  & error,*999)
669  CASE(1)
670  !Identity format 1 - has machine header section.
671  CALL flag_warning("Old binary file identity format&
672  & found. Please update file.",err,error,*999)
673  CALL read_binary_file(fileid,1,chardata,err,error,*999)
674  nummachheaderbytes=ichar(chardata(1:1))
675  CALL read_binary_file(fileid,nummachheaderbytes,chardata,&
676  & err,error,*999)
677  IF(nummachheaderbytes==11) THEN
678  fileid%FILE_INFORMATION%MACHINE_TYPE=ichar(chardata(1:1))
679  fileid%FILE_INFORMATION%OS_TYPE=ichar(chardata(2:2))
680  fileid%FILE_INFORMATION%ENDIAN_TYPE=ichar(chardata(3:3))
681  fileid%FILE_INFORMATION%SP_FORMAT=ichar(chardata(4:4))
682  fileid%FILE_INFORMATION%DP_FORMAT=ichar(chardata(5:5))
683  fileid%FILE_INFORMATION%CHARACTER_SIZE=ichar(chardata(6:6))
684  fileid%FILE_INFORMATION%INTEGER_SIZE=ichar(chardata(7:7))
685  fileid%FILE_INFORMATION%SINTEGER_SIZE=ichar(chardata(8:8))
686  fileid%FILE_INFORMATION%SP_REAL_SIZE=ichar(chardata(9:9))
687  fileid%FILE_INFORMATION%DP_REAL_SIZE=ichar(chardata(10:10))
688  fileid%FILE_INFORMATION%LOGICAL_SIZE=ichar(chardata(11:11))
689  ELSE
690  CALL flagerror("Invalid number of machine header bytes",&
691  & err,error,*999)
692  ENDIF
693  CASE(2)
694  !Identity format 2 - has extended machine header section and subtags.
695  CALL read_binary_file(fileid,1,chardata,err,error,*999)
696  nummachheaderbytes=ichar(chardata(1:1))
697  CALL read_binary_file(fileid,nummachheaderbytes,chardata,&
698  & err,error,*999)
699  IF(nummachheaderbytes==16) THEN
700  fileid%FILE_INFORMATION%MACHINE_TYPE=ichar(chardata(1:1))
701  fileid%FILE_INFORMATION%OS_TYPE=ichar(chardata(2:2))
702  fileid%FILE_INFORMATION%ENDIAN_TYPE=ichar(chardata(3:3))
703  fileid%FILE_INFORMATION%CHAR_FORMAT=ichar(chardata(4:4))
704  fileid%FILE_INFORMATION%INT_FORMAT=ichar(chardata(5:5))
705  fileid%FILE_INFORMATION%SP_FORMAT=ichar(chardata(6:6))
706  fileid%FILE_INFORMATION%DP_FORMAT=ichar(chardata(7:7))
707  fileid%FILE_INFORMATION%CHARACTER_SIZE=ichar(chardata(8:8))
708  fileid%FILE_INFORMATION%INTEGER_SIZE=ichar(chardata(9:9))
709  fileid%FILE_INFORMATION%SINTEGER_SIZE=ichar(chardata(10:10))
710  fileid%FILE_INFORMATION%LINTEGER_SIZE=ichar(chardata(11:11))
711  fileid%FILE_INFORMATION%SP_REAL_SIZE=ichar(chardata(12:12))
712  fileid%FILE_INFORMATION%DP_REAL_SIZE=ichar(chardata(13:13))
713  fileid%FILE_INFORMATION%LOGICAL_SIZE=ichar(chardata(14:14))
714  fileid%FILE_INFORMATION%SPC_REAL_SIZE=ichar(chardata(15:15))
715  fileid%FILE_INFORMATION%DPC_REAL_SIZE=ichar(chardata(16:16))
716  ELSE
717  CALL flagerror("Invalid number of machine header bytes",&
718  & err,error,*999)
719  ENDIF
720  CASE DEFAULT
721  CALL flagerror("Unknown binary file header identity format",&
722  & err,error,*999)
723  END SELECT
724  !Read file header section
725  !Read file type, version and header
726  CALL read_binary_file(fileid,1,filetype,err,error,*999)
727  IF(filetype/=file_type) THEN
728  WRITE(error_string,'("File has a different file type:",/,&
729  & " File type is ",I3,/," Expected file type is ",I3)')&
730  & filetype,file_type
731  CALL flagerror(warning_string,err,error,*999)
732  ENDIF
733  SELECT CASE(fileid%FILE_INFORMATION%BINARY_FILE_REVISION)
734  CASE(0,1)
735  CALL read_binary_file(fileid,1,fversion,err,error,*999)
736  fileversion(1)=int(fversion,intg)
737  fileversion(2)=0
738  fileversion(3)=0
739  IF(fileversion(1)/=version(1)) THEN
740  WRITE(warning_string,'("File has a different version number:",/,&
741  & " File version is ",I2,".",I2,".",I2,/,&
742  & " Expected file version is ",I2,".",I2,".",I2)') &
743  & fileversion(1),fileversion(2),fileversion(3),&
744  & version(1),version(2),version(3)
745  CALL flag_warning(warning_string,err,error,*999)
746  ENDIF
747  CASE(2)
748  CALL read_binary_file(fileid,3,fileversion,err,error,*999)
749  IF(fileversion(1)/=version(1).OR.&
750  & fileversion(2)/=version(2).OR.&
751  & fileversion(3)/=version(3)) THEN
752  WRITE(warning_string,'("File has a different version number:",/,&
753  & " File version is ",I2,".",I2,".",I2,/,&
754  & " Expected file version is ",I2,".",I2,".",I2)') &
755  & fileversion(1),fileversion(2),fileversion(3),&
756  & version(1),version(2),version(3)
757  CALL flag_warning(warning_string,err,error,*999)
758  ENDIF
759  CASE DEFAULT
760  CALL flagerror("Invalid binary file identity format",err,error,*999)
761  END SELECT
762  CALL read_binary_file(fileid,1,headingsize,err,error,*999)
763  IF(headingsize==0) THEN
764  WRITE(op_string,'("File heading: ")')
765  ELSE
766  CALL read_binary_file(fileid,headingsize,heading,err,error,*999)
767  WRITE(op_string,'("File heading: ",A)') heading(1:headingsize)
768  ENDIF
769  CALL write_string(general_output_type,err,error,*999)
770  CALL read_binary_file(fileid,1,number_tags,err,error,*999)
771  ELSE IF(command(1:5)=="WRITE") THEN
772  !Write identity header section
773  chardata(1:1)=char(cmiss_binary_identity)
774  chardata(2:2)=char(2)
775  CALL write_binary_file(fileid,2,chardata,err,error,*999)
776  !Write the machine header section
777  chardata(1:1)=char(16)
778  chardata(2:2)=char(machine_type)
779  chardata(3:3)=char(machine_os)
780  chardata(4:4)=char(machine_endian)
781  chardata(5:5)=char(machine_char_format)
782  chardata(6:6)=char(machine_int_format)
783  chardata(7:7)=char(machine_sp_format)
784  chardata(8:8)=char(machine_dp_format)
785  chardata(9:9)=char(character_size)
786  chardata(10:10)=char(integer_size)
787  chardata(11:11)=char(short_integer_size)
788  chardata(12:12)=char(long_integer_size)
789  chardata(13:13)=char(single_real_size)
790  chardata(14:14)=char(double_real_size)
791  chardata(15:15)=char(logical_size)
792  chardata(16:16)=char(single_complex_size)
793  chardata(17:17)=char(double_complex_size)
794  fileid%FILE_INFORMATION%MACHINE_TYPE=machine_type
795  fileid%FILE_INFORMATION%OS_TYPE=machine_os
796  fileid%FILE_INFORMATION%ENDIAN_TYPE=machine_endian
797  fileid%FILE_INFORMATION%CHAR_FORMAT=machine_char_format
798  fileid%FILE_INFORMATION%INT_FORMAT=machine_int_format
799  fileid%FILE_INFORMATION%SP_FORMAT=machine_sp_format
800  fileid%FILE_INFORMATION%DP_FORMAT=machine_dp_format
801  fileid%FILE_INFORMATION%CHARACTER_SIZE=character_size
802  fileid%FILE_INFORMATION%INTEGER_SIZE=integer_size
803  fileid%FILE_INFORMATION%SINTEGER_SIZE=short_integer_size
804  fileid%FILE_INFORMATION%LINTEGER_SIZE=long_integer_size
805  fileid%FILE_INFORMATION%SP_REAL_SIZE=single_real_size
806  fileid%FILE_INFORMATION%DP_REAL_SIZE=double_real_size
807  fileid%FILE_INFORMATION%LOGICAL_SIZE=logical_size
808  CALL write_binary_file(fileid,12,chardata,err,error,*999)
809  !Write the file header section
810  !Write file type, version and header
811  CALL write_binary_file(fileid,1,file_type,err,error,*999)
812  CALL write_binary_file(fileid,1,version,err,error,*999)
813  heading=" "
814  headingsize=len_trim(heading)
815  CALL write_binary_file(fileid,1,headingsize,err,error,*999)
816  CALL write_binary_file(fileid,headingsize,heading,err,error,*999)
817  !Write number of tags
818  CALL write_binary_file(fileid,1,number_tags,err,error,*999)
819  ENDIF
820 
821  exits("OPEN_CMISS_BINARY_FILE")
822  RETURN
823 999 errorsexits("OPEN_CMISS_BINARY_FILE",err,error)
824  RETURN 1
825  END SUBROUTINE open_cmiss_binary_file
826 
827  !
828  !============================================================================
829  !
830 
831  !#### Generic-Subroutine: READ_BINARY_FILE
832  !### Description:
833  !### READ_BINARY_FILE reads NUM_DATA elements from the binary
834  !### file specified by FILEID into DATA.
835  !### Child-Subroutines: READ_BINARY_FILE_INTG,READ_BINARY_FILE_INTG1,
836  !### READ_BINARY_FILE_SINTG,READ_BINARY_FILE_SINTG1,
837  !### READ_BINARY_FILE_LINTG,READ_BINARY_FILE_LINTG1,
838  !### READ_BINARY_FILE_SP,READ_BINARY_FILE_SP1,
839  !### READ_BINARY_FILE_DP,READ_BINARY_FILE_DP1,
840  !### READ_BINARY_FILE_CHARACTER,READ_BINARY_FILE_LOGICAL,
841  !### READ_BINARY_FILE_LOGICAL1,READ_BINARY_FILE_SPC,
842  !### READ_BINARY_FILE_SPC1,READ_BINARY_FILE_DPC,
843  !### READ_BINARY_FILE_DPC1
844 
845  !
846  !============================================================================
847  !
848 
849  SUBROUTINE read_binary_file_intg(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
850 
851  !#### Subroutine: READ_BINARY_FILE_INTG
852  !### Description:
853  !### READ_BINARY_FILE_INTG reads NUM_DATA integer values from
854  !### the binary file specified by FILEID into DATA.
855  !### Parent-subroutine: READ_BINARY_FILE
856 
857  !Argument variables
858  TYPE(binary_file_type), INTENT(IN) :: FILEID
859  INTEGER(INTG), INTENT(IN) :: NUM_DATA
860  INTEGER(INTG), INTENT(OUT) :: DATA(*)
861  INTEGER(INTG), INTENT(OUT) :: ERR
862  TYPE(varying_string), INTENT(OUT) :: ERROR
863  !Local variables
864  INTEGER(INTG) :: CERROR(100),ENDIAN
865  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
866 
867  enters("READ_BINARY_FILE_INTG",err,error,*999)
868 
869  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
870  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
871  ENDIAN=file_change_endian
872  ELSE
873  ENDIAN=file_same_endian
874  ENDIF
875  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
876  ENDIAN,NUM_DATA,INTEGER_TYPE,DATA,ERR,CERROR)
877  IF(err/=0) THEN
878  CALL c2fstring(cerror,dummy_error,err,error,*999)
879  CALL flagerror(dummy_error,err,error,*999)
880  ENDIF
881  ELSE
882  CALL flagerror("Invalid FILEID",err,error,*999)
883  ENDIF
884 
885  exits("READ_BINARY_FILE_INTG")
886  RETURN
887 999 errorsexits("READ_BINARY_FILE_INTG",err,error)
888  RETURN 1
889  END SUBROUTINE read_binary_file_intg
890 
891  !
892  !============================================================================
893  !
894 
895  SUBROUTINE read_binary_file_intg1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
896 
897  !#### Subroutine: READ_BINARY_FILE_INTG1
898  !### Description:
899  !### READ_BINARY_FILE_INTG1 reads 1 integer value from
900  !### the binary file specified by FILEID into DATA.
901  !### Parent-subroutine: READ_BINARY_FILE
902 
903  !Argument variables
904  TYPE(binary_file_type), INTENT(IN) :: FILEID
905  INTEGER(INTG), INTENT(IN) :: NUM_DATA
906  INTEGER(INTG), INTENT(OUT) :: DATA
907  INTEGER(INTG), INTENT(OUT) :: ERR
908  TYPE(varying_string), INTENT(OUT) :: ERROR
909  !Local variables
910  INTEGER(INTG) :: CERROR(100),ENDIAN
911  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
912 
913  enters("READ_BINARY_FILE_INTG1",err,error,*999)
914 
915  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
916  IF(num_data/=1) THEN
917  CALL flagerror("Number of data items not equal to one",err,error,*999)
918  ELSE
919  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
920  ENDIAN=file_change_endian
921  ELSE
922  ENDIAN=file_same_endian
923  ENDIF
924  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
925  & endian,1,integer_type,DATA,err,cerror)
926  IF(err/=0) THEN
927  CALL c2fstring(cerror,dummy_error,err,error,*999)
928  CALL flagerror(dummy_error,err,error,*999)
929  ENDIF
930  ENDIF
931  ELSE
932  CALL flagerror("Invalid FILEID",err,error,*999)
933  ENDIF
934 
935  exits("READ_BINARY_FILE_INTG1")
936  RETURN
937 999 errorsexits("READ_BINARY_FILE_INTG1",err,error)
938  RETURN 1
939  END SUBROUTINE read_binary_file_intg1
940 
941  !
942  !============================================================================
943  !
944 
945  SUBROUTINE read_binary_file_sintg(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
946 
947  !#### Subroutine: READ_BINARY_FILE_SINTG
948  !### Description:
949  !### READ_BINARY_FILE_SINTG reads NUM_DATA short integer values
950  !### from the binary file specified by FILEID into DATA.
951  !### Parent-subroutine: READ_BINARY_FILE
952 
953  !Argument variables
954  TYPE(binary_file_type), INTENT(IN) :: FILEID
955  INTEGER(INTG), INTENT(IN) :: NUM_DATA
956  INTEGER(SINTG), INTENT(OUT) :: DATA(*)
957  INTEGER(INTG), INTENT(OUT) :: ERR
958  TYPE(varying_string), INTENT(OUT) :: ERROR
959  !Local variables
960  INTEGER(INTG) :: CERROR(100),ENDIAN
961  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
962 
963  enters("READ_BINARY_FILE_SINTG",err,error,*999)
964 
965  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
966  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
967  ENDIAN=file_change_endian
968  ELSE
969  ENDIAN=file_same_endian
970  ENDIF
971  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
972  & endian,num_data,short_integer_type,DATA,err,cerror)
973  IF(err/=0) THEN
974  CALL c2fstring(cerror,dummy_error,err,error,*999)
975  CALL flagerror(dummy_error,err,error,*999)
976  ENDIF
977  ELSE
978  CALL flagerror("Invalid FILEID",err,error,*999)
979  ENDIF
980 
981  exits("READ_BINARY_FILE_SINTG")
982  RETURN
983 999 errorsexits("READ_BINARY_FILE_SINTG",err,error)
984  RETURN 1
985  END SUBROUTINE read_binary_file_sintg
986 
987  !
988  !============================================================================
989  !
990 
991  SUBROUTINE read_binary_file_sintg1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
992 
993  !#### Subroutine: READ_BINARY_FILE_SINTG1
994  !### Description:
995  !### READ_BINARY_FILE_SINTG1 reads 1 short integer value
996  !### from the binary file specified by FILEID into DATA.
997  !### Parent-subroutine: READ_BINARY_FILE
998 
999  !Argument variables
1000  TYPE(binary_file_type), INTENT(IN) :: FILEID
1001  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1002  INTEGER(SINTG), INTENT(OUT) :: DATA
1003  INTEGER(INTG), INTENT(OUT) :: ERR
1004  TYPE(varying_string), INTENT(OUT) :: ERROR
1005  !Local variables
1006  INTEGER(INTG) :: CERROR(100),ENDIAN
1007  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1008 
1009  enters("READ_BINARY_FILE_SINTG1",err,error,*999)
1010 
1011  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1012  IF(num_data/=1) THEN
1013  CALL flagerror("Number of data items not equal to one",err,error,*999)
1014  ELSE
1015  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1016  ENDIAN=file_change_endian
1017  ELSE
1018  ENDIAN=file_same_endian
1019  ENDIF
1020  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1021  & endian,1,short_integer_type,DATA,err,cerror)
1022  IF(err/=0) THEN
1023  CALL c2fstring(cerror,dummy_error,err,error,*999)
1024  CALL flagerror(dummy_error,err,error,*999)
1025  ENDIF
1026  ENDIF
1027  ELSE
1028  CALL flagerror("Invalid FILEID",err,error,*999)
1029  ENDIF
1030 
1031  exits("READ_BINARY_FILE_SINTG1")
1032  RETURN
1033 999 errorsexits("READ_BINARY_FILE_SINTG1",err,error)
1034  RETURN 1
1035  END SUBROUTINE read_binary_file_sintg1
1036 
1037  !
1038  !============================================================================
1039  !
1040 
1041  SUBROUTINE read_binary_file_lintg(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1042 
1043  !#### Subroutine: READ_BINARY_FILE_LINTG
1044  !### Description:
1045  !### READ_BINARY_FILE_LINTG reads NUM_DATA long integer values
1046  !### from the binary file specified by FILEID into DATA.
1047  !### Parent-subroutine: READ_BINARY_FILE
1048 
1049  !Argument variables
1050  TYPE(binary_file_type), INTENT(IN) :: FILEID
1051  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1052  INTEGER(LINTG), INTENT(OUT) :: DATA(*)
1053  INTEGER(INTG), INTENT(OUT) :: ERR
1054  TYPE(varying_string), INTENT(OUT) :: ERROR
1055  !Local variables
1056  INTEGER(INTG) :: CERROR(100),ENDIAN
1057  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1058 
1059  enters("READ_BINARY_FILE_LINTG",err,error,*999)
1060 
1061  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1062  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1063  ENDIAN=file_change_endian
1064  ELSE
1065  ENDIAN=file_same_endian
1066  ENDIF
1067  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1068  & endian,num_data,long_integer_type,DATA,err,cerror)
1069  IF(err/=0) THEN
1070  CALL c2fstring(cerror,dummy_error,err,error,*999)
1071  CALL flagerror(dummy_error,err,error,*999)
1072  ENDIF
1073  ELSE
1074  CALL flagerror("Invalid FILEID",err,error,*999)
1075  ENDIF
1076 
1077  exits("READ_BINARY_FILE_LINTG")
1078  RETURN
1079 999 errorsexits("READ_BINARY_FILE_LINTG",err,error)
1080  RETURN 1
1081  END SUBROUTINE read_binary_file_lintg
1082 
1083  !
1084  !============================================================================
1085  !
1086 
1087  SUBROUTINE read_binary_file_lintg1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1088 
1089  !#### Subroutine: READ_BINARY_FILE_LINTG1
1090  !### Description:
1091  !### READ_BINARY_FILE_LINTG1 reads 1 long integer value
1092  !### from the binary file specified by FILEID into DATA.
1093  !### Parent-subroutine: READ_BINARY_FILE
1094 
1095  !Argument variables
1096  TYPE(binary_file_type), INTENT(IN) :: FILEID
1097  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1098  INTEGER(LINTG), INTENT(OUT) :: DATA
1099  INTEGER(INTG), INTENT(OUT) :: ERR
1100  TYPE(varying_string), INTENT(OUT) :: ERROR
1101  !Local variables
1102  INTEGER(INTG) :: CERROR(100),ENDIAN
1103  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1104 
1105  enters("READ_BINARY_FILE_LINTG1",err,error,*999)
1106 
1107  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1108  IF(num_data/=1) THEN
1109  CALL flagerror("Number of data items not equal to one",err,error,*999)
1110  ELSE
1111  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1112  ENDIAN=file_change_endian
1113  ELSE
1114  ENDIAN=file_same_endian
1115  ENDIF
1116  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1117  & endian,1,long_integer_type,DATA,err,cerror)
1118  IF(err/=0) THEN
1119  CALL c2fstring(cerror,dummy_error,err,error,*999)
1120  CALL flagerror(dummy_error,err,error,*999)
1121  ENDIF
1122  ENDIF
1123  ELSE
1124  CALL flagerror("Invalid FILEID",err,error,*999)
1125  ENDIF
1126 
1127  exits("READ_BINARY_FILE_LINTG1")
1128  RETURN
1129 999 errorsexits("READ_BINARY_FILE_LINTG1",err,error)
1130  RETURN 1
1131  END SUBROUTINE read_binary_file_lintg1
1132 
1133  !
1134  !============================================================================
1135  !
1136 
1137  SUBROUTINE read_binary_file_sp(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1138 
1139  !#### Subroutine: READ_BINARY_FILE_SP
1140  !### Description:
1141  !### READ_BINARY_FILE_SP reads NUM_DATA single precision real
1142  !### values from the binary file specified by FILEID into DATA.
1143  !### Parent-subroutine: READ_BINARY_FILE
1144 
1145  !Argument variables
1146  TYPE(binary_file_type), INTENT(IN) :: FILEID
1147  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1148  REAL(SP), INTENT(OUT) :: DATA(*)
1149  TYPE(varying_string), INTENT(OUT) :: ERROR
1150  INTEGER(INTG), INTENT(OUT) :: ERR
1151  !Local variables
1152  INTEGER(INTG) :: CERROR(100),ENDIAN
1153  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1154 
1155  enters("READ_BINARY_FILE_SP",err,error,*999)
1156 
1157  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1158  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1159  ENDIAN=file_change_endian
1160  ELSE
1161  ENDIAN=file_same_endian
1162  ENDIF
1163  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1164  & endian,num_data,single_real_type,DATA,err,cerror)
1165  IF(err/=0) THEN
1166  CALL c2fstring(cerror,dummy_error,err,error,*999)
1167  CALL flagerror(dummy_error,err,error,*999)
1168  ENDIF
1169  ELSE
1170  CALL flagerror("Invalid FILEID",err,error,*999)
1171  ENDIF
1172 
1173  exits("READ_BINARY_FILE_SP")
1174  RETURN
1175 999 errorsexits("READ_BINARY_FILE_SP",err,error)
1176  RETURN 1
1177  END SUBROUTINE read_binary_file_sp
1178 
1179  !
1180  !============================================================================
1181  !
1182 
1183  SUBROUTINE read_binary_file_sp1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1184 
1185  !#### Subroutine: READ_BINARY_FILE_SP1
1186  !### Description:
1187  !### READ_BINARY_FILE_SP1 reads 1 single precision real
1188  !### value from the binary file specified by FILEID into DATA.
1189  !### Parent-subroutine: READ_BINARY_FILE
1190 
1191  !Argument variables
1192  TYPE(binary_file_type), INTENT(IN) :: FILEID
1193  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1194  REAL(SP), INTENT(OUT) :: DATA
1195  TYPE(varying_string), INTENT(OUT) :: ERROR
1196  INTEGER(INTG), INTENT(OUT) :: ERR
1197  !Local variables
1198  INTEGER(INTG) :: CERROR(100),ENDIAN
1199  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1200 
1201  enters("READ_BINARY_FILE_SP1",err,error,*999)
1202 
1203  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1204  IF(num_data/=1) THEN
1205  CALL flagerror("Number of data items not equal to one",err,error,*999)
1206  ELSE
1207  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1208  ENDIAN=file_change_endian
1209  ELSE
1210  ENDIAN=file_same_endian
1211  ENDIF
1212  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1213  & endian,1,single_real_type,DATA,err,cerror)
1214  IF(err/=0) THEN
1215  CALL c2fstring(cerror,dummy_error,err,error,*999)
1216  CALL flagerror(dummy_error,err,error,*999)
1217  ENDIF
1218  ENDIF
1219  ELSE
1220  CALL flagerror("Invalid FILEID",err,error,*999)
1221  ENDIF
1222 
1223  exits("READ_BINARY_FILE_SP1")
1224  RETURN
1225 999 errorsexits("READ_BINARY_FILE_SP1",err,error)
1226  RETURN 1
1227  END SUBROUTINE read_binary_file_sp1
1228 
1229  !
1230  !============================================================================
1231  !
1232 
1233  SUBROUTINE read_binary_file_dp(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1234 
1235  !#### Subroutine: READ_BINARY_FILE_DP
1236  !### Description:
1237  !### READ_BINARY_FILE_DP reads NUM_DATA double precision real
1238  !### values from the binary file specified by FILEID into DATA.
1239  !### Parent-subroutine: READ_BINARY_FILE
1240 
1241  !Argument variables
1242  TYPE(binary_file_type), INTENT(IN) :: FILEID
1243  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1244  REAL(DP), INTENT(OUT) :: DATA(*)
1245  INTEGER(INTG), INTENT(OUT) :: ERR
1246  TYPE(varying_string), INTENT(OUT) :: ERROR
1247  !Local variables
1248  INTEGER(INTG) :: CERROR(100),ENDIAN
1249  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1250 
1251  enters("READ_BINARY_FILE_DP",err,error,*999)
1252 
1253  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1254  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1255  ENDIAN=file_change_endian
1256  ELSE
1257  ENDIAN=file_same_endian
1258  ENDIF
1259  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1260  & endian,num_data,double_real_type,DATA,err,cerror)
1261  IF(err/=0) THEN
1262  CALL c2fstring(cerror,dummy_error,err,error,*999)
1263  CALL flagerror(dummy_error,err,error,*999)
1264  ENDIF
1265  ELSE
1266  CALL flagerror("Invalid FILEID",err,error,*999)
1267  ENDIF
1268 
1269  exits("READ_BINARY_FILE_DP")
1270  RETURN
1271 999 errorsexits("READ_BINARY_FILE_DP",err,error)
1272  RETURN 1
1273  END SUBROUTINE read_binary_file_dp
1274 
1275  !
1276  !============================================================================
1277  !
1278 
1279  SUBROUTINE read_binary_file_dp1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1280 
1281  !#### Subroutine: READ_BINARY_FILE_DP1
1282  !### Description:
1283  !### READ_BINARY_FILE_DP1 reads 1 double precision real
1284  !### value from the binary file specified by FILEID into DATA.
1285  !### Parent-subroutine: READ_BINARY_FILE
1286 
1287  !Argument variables
1288  TYPE(binary_file_type), INTENT(IN) :: FILEID
1289  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1290  REAL(DP), INTENT(OUT) :: DATA
1291  INTEGER(INTG), INTENT(OUT) :: ERR
1292  TYPE(varying_string), INTENT(OUT) :: ERROR
1293  !Local variables
1294  INTEGER(INTG) :: CERROR(100),ENDIAN
1295  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1296 
1297  enters("READ_BINARY_FILE_DP1",err,error,*999)
1298 
1299  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1300  IF(num_data/=1) THEN
1301  CALL flagerror("Number of data items not equal to one",err,error,*999)
1302  ELSE
1303  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1304  ENDIAN=file_change_endian
1305  ELSE
1306  ENDIAN=file_same_endian
1307  ENDIF
1308  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1309  & endian,1,double_real_type,DATA,err,cerror)
1310  IF(err/=0) THEN
1311  CALL c2fstring(cerror,dummy_error,err,error,*999)
1312  CALL flagerror(dummy_error,err,error,*999)
1313  ENDIF
1314  ENDIF
1315  ELSE
1316  CALL flagerror("Invalid FILEID",err,error,*999)
1317  ENDIF
1318 
1319  exits("READ_BINARY_FILE_DP1")
1320  RETURN
1321 999 errorsexits("READ_BINARY_FILE_DP1",err,error)
1322  RETURN 1
1323  END SUBROUTINE read_binary_file_dp1
1324 
1325  !
1326  !============================================================================
1327  !
1328 
1329  SUBROUTINE read_binary_file_character(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1330 
1331  !#### Subroutine: READ_BINARY_FILE_CHARACTER
1332  !### Description:
1333  !### READ_BINARY_FILE_CHARACTER reads NUM_DATA character
1334  !### values from the binary file specified by FILEID into DATA.
1335  !### Parent-subroutine: READ_BINARY_FILE
1336 
1337  !Argument variables
1338  TYPE(binary_file_type), INTENT(IN) :: FILEID
1339  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1340  CHARACTER(LEN=*), INTENT(OUT) :: DATA
1341  INTEGER(INTG), INTENT(OUT) :: ERR
1342  TYPE(varying_string), INTENT(OUT) :: ERROR
1343  !Local variables
1344  INTEGER(INTG) :: CERROR(100),CSTRING(250),LENGTH
1345  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1346 
1347  enters("READ_BINARY_FILE_CHARACTER",err,error,*999)
1348 
1349  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1350  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER, &
1351  & file_same_endian,num_data,character_type,cstring,err,&
1352  & cerror)
1353  IF(err/=0) THEN
1354  CALL c2fstring(cerror,dummy_error,err,error,*999)
1355  CALL flagerror(dummy_error,err,error,*999)
1356  ELSE
1357  length=cstringlength(cstring)
1358  IF(length==0.AND.num_data==1) THEN
1359  !Zero length string and data read i.e. read a single byte
1360  !of value zero.
1361  DATA(1:1)=char(0)
1362  ELSE
1363  CALL c2fstring(cstring,DATA,err,error,*999)
1364  ENDIF
1365  ENDIF
1366  ELSE
1367  CALL flagerror("Invalid FILEID",err,error,*999)
1368  ENDIF
1369 
1370  exits("READ_BINARY_FILE_CHARACTER")
1371  RETURN
1372 999 errorsexits("READ_BINARY_FILE_CHARACTER",err,error)
1373  RETURN 1
1374  END SUBROUTINE read_binary_file_character
1375 
1376  !
1377  !============================================================================
1378  !
1379 
1380  SUBROUTINE read_binary_file_logical(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1381 
1382  !#### Subroutine: READ_BINARY_FILE_LOGICAL
1383  !### Description:
1384  !### READ_BINARY_FILE_LOGICAL reads NUM_DATA logical
1385  !### values from the binary file specified by FILEID into DATA.
1386  !### Parent-subroutine: READ_BINARY_FILE
1387 
1388  !Argument variables
1389  TYPE(binary_file_type), INTENT(IN) :: FILEID
1390  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1391  LOGICAL, INTENT(OUT) :: DATA(*)
1392  INTEGER(INTG), INTENT(OUT) :: ERR
1393  TYPE(varying_string), INTENT(OUT) :: ERROR
1394  !Local variables
1395  INTEGER(INTG) :: CERROR(100),ENDIAN
1396  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1397 
1398  enters("READ_BINARY_FILE_LOGICAL",err,error,*999)
1399 
1400  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1401  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1402  ENDIAN=file_change_endian
1403  ELSE
1404  ENDIAN=file_same_endian
1405  ENDIF
1406  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1407  & endian,num_data,logical_type,DATA,err,cerror)
1408  IF(err/=0) THEN
1409  CALL c2fstring(cerror,dummy_error,err,error,*999)
1410  CALL flagerror(dummy_error,err,error,*999)
1411  ENDIF
1412  ELSE
1413  CALL flagerror("Invalid FILEID",err,error,*999)
1414  ENDIF
1415 
1416  exits("READ_BINARY_FILE_LOGICAL")
1417  RETURN
1418 999 errorsexits("READ_BINARY_FILE_LOGICAL",err,error)
1419  RETURN 1
1420  END SUBROUTINE read_binary_file_logical
1421 
1422  !
1423  !============================================================================
1424  !
1425 
1426  SUBROUTINE read_binary_file_logical1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1427 
1428  !#### Subroutine: READ_BINARY_FILE_LOGICAL1
1429  !### Description:
1430  !### READ_BINARY_FILE_LOGICAL1 reads 1 logical value from the
1431  !### binary file specified by FILEID into DATA.
1432  !### Parent-subroutine: READ_BINARY_FILE
1433 
1434  !Argument variables
1435  TYPE(binary_file_type), INTENT(IN) :: FILEID
1436  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1437  LOGICAL, INTENT(OUT) :: DATA
1438  INTEGER(INTG), INTENT(OUT) :: ERR
1439  TYPE(varying_string), INTENT(OUT) :: ERROR
1440  !Local variables
1441  INTEGER(INTG) :: CERROR(100),ENDIAN
1442  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1443 
1444  enters("READ_BINARY_FILE_LOGICAL1",err,error,*999)
1445 
1446  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1447  IF(num_data/=1) THEN
1448  CALL flagerror("Number of data items not equal to one",err,error,*999)
1449  ELSE
1450  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1451  ENDIAN=file_change_endian
1452  ELSE
1453  ENDIAN=file_same_endian
1454  ENDIF
1455  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1456  & endian,1,logical_type,DATA,err,cerror)
1457  IF(err/=0) THEN
1458  CALL c2fstring(cerror,dummy_error,err,error,*999)
1459  CALL flagerror(dummy_error,err,error,*999)
1460  ENDIF
1461  ENDIF
1462  ELSE
1463  CALL flagerror("Invalid FILEID",err,error,*999)
1464  ENDIF
1465 
1466  exits("READ_BINARY_FILE_LOGICAL1")
1467  RETURN
1468 999 errorsexits("READ_BINARY_FILE_LOGICAL1",err,error)
1469  RETURN 1
1470  END SUBROUTINE read_binary_file_logical1
1471 
1472  !
1473  !============================================================================
1474  !
1475 
1476  SUBROUTINE read_binary_file_spc(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1477 
1478  !#### Subroutine: READ_BINARY_FILE_SPC
1479  !### Description:
1480  !### READ_BINARY_FILE_SPC reads NUM_DATA single precision
1481  !### complex values from the binary file specified by FILEID
1482  !### into DATA.
1483  !### Parent-subroutine: READ_BINARY_FILE
1484 
1485  !Argument variables
1486  TYPE(binary_file_type), INTENT(IN) :: FILEID
1487  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1488  COMPLEX(SPC), INTENT(OUT) :: DATA(*)
1489  INTEGER(INTG), INTENT(OUT) :: ERR
1490  TYPE(varying_string), INTENT(OUT) :: ERROR
1491  !Local variables
1492  INTEGER(INTG) :: CERROR(100),ENDIAN
1493  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1494 
1495  enters("READ_BINARY_FILE_SPC",err,error,*999)
1496 
1497  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1498  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1499  ENDIAN=file_change_endian
1500  ELSE
1501  ENDIAN=file_same_endian
1502  ENDIF
1503  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1504  & endian,num_data,single_complex_type,DATA,err,cerror)
1505  IF(err/=0) THEN
1506  CALL c2fstring(cerror,dummy_error,err,error,*999)
1507  CALL flagerror(dummy_error,err,error,*999)
1508  ENDIF
1509  ELSE
1510  CALL flagerror("Invalid FILEID",err,error,*999)
1511  ENDIF
1512 
1513  exits("READ_BINARY_FILE_SPC")
1514  RETURN
1515 999 errorsexits("READ_BINARY_FILE_SPC",err,error)
1516  RETURN 1
1517  END SUBROUTINE read_binary_file_spc
1518 
1519  !
1520  !============================================================================
1521  !
1522 
1523  SUBROUTINE read_binary_file_spc1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1524 
1525  !#### Subroutine: READ_BINARY_FILE_SPC1
1526  !### Description:
1527  !### READ_BINARY_FILE_SPC1 reads 1 single precision
1528  !### complex value from the binary file specified by FILEID
1529  !### into DATA.
1530  !### Parent-subroutine: READ_BINARY_FILE
1531 
1532  !Argument variables
1533  TYPE(binary_file_type), INTENT(IN) :: FILEID
1534  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1535  COMPLEX(SPC), INTENT(OUT) :: DATA
1536  INTEGER(INTG), INTENT(OUT) :: ERR
1537  TYPE(varying_string), INTENT(OUT) :: ERROR
1538  !Local variables
1539  INTEGER(INTG) :: CERROR(100),ENDIAN
1540  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1541 
1542  enters("READ_BINARY_FILE_SPC1",err,error,*999)
1543 
1544  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1545  IF(num_data/=1) THEN
1546  CALL flagerror("Number of data items not equal to one",err,error,*999)
1547  ELSE
1548  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1549  ENDIAN=file_change_endian
1550  ELSE
1551  ENDIAN=file_same_endian
1552  ENDIF
1553  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1554  & endian,1,single_complex_type,DATA,err,cerror)
1555  IF(err/=0) THEN
1556  CALL c2fstring(cerror,dummy_error,err,error,*999)
1557  CALL flagerror(dummy_error,err,error,*999)
1558  ENDIF
1559  ENDIF
1560  ELSE
1561  CALL flagerror("Invalid FILEID",err,error,*999)
1562  ENDIF
1563 
1564  exits("READ_BINARY_FILE_SPC1")
1565  RETURN
1566 999 errorsexits("READ_BINARY_FILE_SPC1",err,error)
1567  RETURN 1
1568  END SUBROUTINE read_binary_file_spc1
1569 
1570  !
1571  !============================================================================
1572  !
1573 
1574  SUBROUTINE read_binary_file_dpc(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1575 
1576  !#### Subroutine: READ_BINARY_FILE_DPC
1577  !### Description:
1578  !### READ_BINARY_FILE_DPC reads NUM_DATA double precision
1579  !### complex values from the binary file specified by FILEID
1580  !### into DATA.
1581  !### Parent-subroutine: READ_BINARY_FILE
1582 
1583  !Argument variables
1584  TYPE(binary_file_type), INTENT(IN) :: FILEID
1585  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1586  COMPLEX(DPC), INTENT(OUT) :: DATA(*)
1587  INTEGER(INTG), INTENT(OUT) :: ERR
1588  TYPE(varying_string), INTENT(OUT) :: ERROR
1589  !Local variables
1590  INTEGER(INTG) :: CERROR(100),ENDIAN
1591  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1592 
1593  enters("READ_BINARY_FILE_DPC",err,error,*999)
1594 
1595  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1596  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1597  ENDIAN=file_change_endian
1598  ELSE
1599  ENDIAN=file_same_endian
1600  ENDIF
1601  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1602  & endian,num_data,double_complex_type,DATA,err,cerror)
1603  IF(err/=0) THEN
1604  CALL c2fstring(cerror,dummy_error,err,error,*999)
1605  CALL flagerror(dummy_error,err,error,*999)
1606  ENDIF
1607  ELSE
1608  CALL flagerror("Invalid FILEID",err,error,*999)
1609  ENDIF
1610 
1611  exits("READ_BINARY_FILE_DPC")
1612  RETURN
1613 999 errorsexits("READ_BINARY_FILE_DPC",err,error)
1614  RETURN 1
1615  END SUBROUTINE read_binary_file_dpc
1616 
1617  !
1618  !============================================================================
1619  !
1620 
1621  SUBROUTINE read_binary_file_dpc1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1622 
1623  !#### Subroutine: READ_BINARY_FILE_DPC1
1624  !### Description:
1625  !### READ_BINARY_FILE_DPC1 reads 1 double precision
1626  !### complex value from the binary file specified by FILEID
1627  !### into DATA.
1628  !### Parent-subroutine: READ_BINARY_FILE
1629 
1630  !Argument variables
1631  TYPE(binary_file_type), INTENT(IN) :: FILEID
1632  INTEGER(INTG), INTENT(IN) :: NUM_DATA
1633  COMPLEX(DPC), INTENT(OUT) :: DATA
1634  INTEGER(INTG), INTENT(OUT) :: ERR
1635  TYPE(varying_string), INTENT(OUT) :: ERROR
1636  !Local variables
1637  INTEGER(INTG) :: CERROR(100),ENDIAN
1638  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1639 
1640  enters("READ_BINARY_FILE_DPC1",err,error,*999)
1641 
1642  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1643  IF(num_data/=1) THEN
1644  CALL flagerror("Number of data items not equal to one",err,error,*999)
1645  ELSE
1646  IF(fileid%FILE_INFORMATION%ENDIAN_TYPE/=machine_endian) THEN
1647  ENDIAN=file_change_endian
1648  ELSE
1649  ENDIAN=file_same_endian
1650  ENDIF
1651  CALL binaryreadfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1652  & endian,1,double_complex_type,DATA,err,cerror)
1653  IF(err/=0) THEN
1654  CALL c2fstring(cerror,dummy_error,err,error,*999)
1655  CALL flagerror(dummy_error,err,error,*999)
1656  ENDIF
1657  ENDIF
1658  ELSE
1659  CALL flagerror("Invalid FILEID",err,error,*999)
1660  ENDIF
1661 
1662  exits("READ_BINARY_FILE_DPC1")
1663  RETURN
1664 999 errorsexits("READ_BINARY_FILE_DPC1",err,error)
1665  RETURN 1
1666  END SUBROUTINE read_binary_file_dpc1
1667 
1668  !
1669  !============================================================================
1670  !
1671 
1672  SUBROUTINE read_binary_tag_header(FILEID,TAG,ERR,ERROR,*)
1673 
1674  !#### Subroutine: READ_BINARY_TAG_HEADER
1675  !### Description:
1676  !### READ_BINARY_TAG_HEADER reads a binary tag header from the
1677  !### binary file specified by FILEID.
1678 
1679  !Argument variables
1680  TYPE(binary_file_type), INTENT(IN) :: FILEID
1681  TYPE(binary_tag_type), INTENT(OUT) :: TAG
1682  INTEGER(INTG), INTENT(OUT) :: ERR
1683  TYPE(varying_string), INTENT(OUT) :: ERROR
1684  !Local variables
1685  INTEGER(INTG) :: INTDATA(2)
1686 
1687  enters("READ_BINARY_TAG_HEADER",err,error,*999)
1688 
1689  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1690  CALL read_binary_file(fileid,2,intdata,err,error,*999)
1691  tag%INDEX=intdata(1)
1692  tag%NUM_HEADER_BYTES=intdata(2)
1693  IF(tag%NUM_HEADER_BYTES>maxstrlen) THEN
1694  CALL flagerror("Tag header length greater than maximum &
1695  &string length",err,error,*999)
1696  ENDIF
1697  CALL read_binary_file(fileid,tag%NUM_HEADER_BYTES,tag%HEADER,err,&
1698  & error,*999)
1699  SELECT CASE(fileid%FILE_INFORMATION%BINARY_FILE_REVISION)
1700  CASE(0,1)
1701  tag%NUM_SUBTAGS=0
1702  CASE(2)
1703  CALL read_binary_file(fileid,1,tag%NUM_SUBTAGS,err,error,*999)
1704  CASE DEFAULT
1705  CALL flagerror("Invalid binary file header identity format",&
1706  & err,error,*999)
1707  END SELECT
1708  IF(tag%NUM_SUBTAGS==0) THEN
1709  CALL read_binary_file(fileid,1,tag%NUM_BYTES,err,error,*999)
1710  ELSE
1711  tag%NUM_BYTES=0
1712  ENDIF
1713  IF(tag%NUM_BYTES<0) CALL flagerror("Invalid number of tag bytes",&
1714  & err,error,*999)
1715  ELSE
1716  CALL flagerror("Invalid FILEID",err,error,*999)
1717  ENDIF
1718 
1719  exits("READ_BINARY_TAG_HEADER")
1720  RETURN
1721 999 errorsexits("READ_BINARY_TAG_HEADER",err,error)
1722  RETURN 1
1723  END SUBROUTINE read_binary_tag_header
1724 
1725  !
1726  !============================================================================
1727  !
1728 
1729  SUBROUTINE reset_binary_number_tags(FILEID,NUMBER_TAGS,ERR,ERROR,*)
1730 
1731  !#### Subroutine: RESET_BINARY_NUMBER_TAGS
1732  !### Description:
1733  !### RESET_BINARY_NUMBER_TAGS resets the number of tags in the
1734  !### binary file specified by FILEID to that specified by
1735  !### NUMBER_TAGS
1736 
1737 !!TODO: THIS PROBABLY NEEDS TO BE REWRITTEN TO ALLOW IT TO RESET THE NUMBER
1738 !! OF TAGS AT A SPECIFIED LEVEL IN THE TAG HIERACHY
1739 
1740  !Argument variables
1741  TYPE(binary_file_type), INTENT(IN) :: FILEID
1742  INTEGER(INTG), INTENT(IN) :: NUMBER_TAGS
1743  INTEGER(INTG), INTENT(OUT) :: ERR
1744  TYPE(varying_string), INTENT(OUT) :: ERROR
1745  !Local Variables
1746  INTEGER(INTG) :: NUMBER_HEADER_BYTES,NUMBER_SKIP_BYTES
1747 
1748  enters("RESET_BINARY_NUMBER_TAGS",err,error,*999)
1749 
1750  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1751  !Rewind the file to the beginning
1752  CALL set_binary_file(fileid,file_beginning,err,error,*999)
1753  !Skip the identity and machine header sections
1754  CALL skip_cm_binary_header(fileid,cmiss_binary_machine_header,&
1755  & err,error,*999)
1756  !Skip the file type and version
1757  number_skip_bytes=integer_size+single_real_size
1758  CALL skip_binary_file(fileid,number_skip_bytes,err,error,*999)
1759  !Skip the file header
1760  CALL read_binary_file(fileid,1,number_header_bytes,err,error,*999)
1761  CALL skip_binary_file(fileid,number_header_bytes,err,error,*999)
1762  !Set the file position
1763  CALL set_binary_file(fileid,file_current,err,error,*999)
1764  !Write the new number of tags
1765  CALL write_binary_file(fileid,1,number_tags,err,error,*999)
1766  !Go to the end of the file
1767  CALL set_binary_file(fileid,file_end,err,error,*999)
1768  ELSE
1769  CALL flagerror("Invalid FILEID",err,error,*999)
1770  ENDIF
1771 
1772  exits("RESET_BINARY_NUMBER_TAGS")
1773  RETURN
1774 999 errorsexits("RESET_BINARY_NUMBER_TAGS",err,error)
1775  RETURN 1
1776  END SUBROUTINE reset_binary_number_tags
1777 
1778  !
1779  !============================================================================
1780  !
1781 
1782  SUBROUTINE set_binary_file(FILEID,SET_CODE,ERR,ERROR,*)
1783 
1784  !#### Subroutine: SET_BINARY_FILE
1785  !### Description:
1786  !### SET_BINARY_FILE sets the position of the binary file
1787  !### specified bye FILEID to that specified by SET_CODE.
1788  !### Current SET_CODES are FILE_BEGINNING for the beginning of
1789  !### a file, FILE_CURRENT for the current file position and
1790  !### FILE_END for the end of a file.
1791 
1792  !Argument Variables
1793  TYPE(binary_file_type), INTENT(IN) :: FILEID
1794  INTEGER(INTG), INTENT(IN) :: SET_CODE
1795  INTEGER(INTG), INTENT(OUT) :: ERR
1796  TYPE(varying_string), INTENT(OUT) :: ERROR
1797  !Local Variables
1798  INTEGER(INTG) :: CERROR(100)
1799  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1800 
1801  enters("SET_BINARY_FILE",err,error,*999)
1802 
1803  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1804  CALL binarysetfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1805  & set_code,err,cerror)
1806  IF(err/=0) THEN
1807  CALL c2fstring(cerror,dummy_error,err,error,*999)
1808  CALL flagerror(dummy_error,err,error,*999)
1809  ENDIF
1810  ELSE
1811  CALL flagerror("Invalid FILEID",err,error,*999)
1812  ENDIF
1813 
1814  exits("SET_BINARY_FILE")
1815  RETURN
1816 999 errorsexits("SET_BINARY_FILE",err,error)
1817  RETURN 1
1818  END SUBROUTINE set_binary_file
1819 
1820  !
1821  !============================================================================
1822  !
1823 
1824  SUBROUTINE skip_cm_binary_header(FILEID,SKIP,ERR,ERROR,*)
1825 
1826  !#### Subroutine: SKIP_CM_BINARY_HEADER
1827  !### Description:
1828  !### SKIP_CM_BINARY_HEADER skips CMISS binary header
1829  !### information in a binary file specified by FILEID. The
1830  !### ammount of information skipping is controlled by SKIP.
1831  !### Current values of SKIP are CMISS_BINARY_IDENTITY_HEADER
1832  !### to skip the identity header, CMISS_BINARY_MACHINE_HEADER
1833  !### to skip the machine header and CMISS_BINARY_FILE_HEADER
1834  !### to skip the file header.
1835 
1836  !Argument Variables
1837  TYPE(binary_file_type), INTENT(IN) :: FILEID
1838  INTEGER(INTG), INTENT(IN) :: SKIP
1839  INTEGER(INTG), INTENT(OUT) :: ERR
1840  TYPE(varying_string), INTENT(OUT) :: ERROR
1841  !Local Variables
1842  INTEGER(INTG) :: BINARY_FILE_REVISION,INTDATA(1),NUMBER_SKIP_BYTES
1843  CHARACTER(LEN=11) :: CHARDATA
1844 
1845  enters("SKIP_CM_BINARY_HEADER",err,error,*999)
1846 
1847  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1848  IF(skip/=cmiss_binary_identity_header.OR.&
1849  & skip/=cmiss_binary_machine_header.OR.&
1850  skip/=cmiss_binary_file_header) &
1851  & CALL flagerror("Invalid SKIP code",err,error,*999)
1852  IF(skip>=cmiss_binary_identity_header) THEN
1853  !Skip the identity header section
1854  CALL read_binary_file(fileid,2,chardata,err,error,*999)
1855  IF(chardata(1:1)/=char(cmiss_binary_identity)) &
1856  & CALL flagerror("Not a CMISS binary file",err,error,*999)
1857  ENDIF
1858  IF(skip>=cmiss_binary_machine_header) THEN
1859  !Skip the machine header section
1860  binary_file_revision=ichar(chardata(2:2))
1861  SELECT CASE(binary_file_revision)
1862  CASE(0)
1863  number_skip_bytes=3
1864  CASE(1,2)
1865  CALL read_binary_file(fileid,1,chardata,err,error,*999)
1866  number_skip_bytes=ichar(chardata(1:1))
1867  CASE DEFAULT
1868  CALL flagerror("Unknown binary file header identity format",&
1869  & err,error,*999)
1870  END SELECT
1871  CALL skip_binary_file(fileid,number_skip_bytes,err,error,*999)
1872  ENDIF
1873  IF(skip>=cmiss_binary_file_header) THEN
1874  !Skip the file header section
1875  number_skip_bytes=integer_size+single_real_size
1876  CALL skip_binary_file(fileid,number_skip_bytes, err,error,*999)
1877  CALL read_binary_file(fileid,1,intdata,err,error,*999)
1878  number_skip_bytes=intdata(1)*character_size+integer_size
1879  CALL skip_binary_file(fileid,number_skip_bytes,err,error,*999)
1880  ENDIF
1881  ELSE
1882  CALL flagerror("Invalid FILEID",err,error,*999)
1883  ENDIF
1884 
1885  exits("SKIP_CM_BINARY_HEADER")
1886  RETURN
1887 999 errorsexits("SKIP_CM_BINARY_HEADER",err,error)
1888  RETURN 1
1889  END SUBROUTINE skip_cm_binary_header
1890 
1891  !
1892  !============================================================================
1893  !
1894 
1895  SUBROUTINE skip_binary_file(FILEID,NUMBER_BYTES,ERR,ERROR,*)
1896 
1897  !#### Subroutine: SKIP_BINARY_FILE
1898  !### Description:
1899  !### SKIP_BINARY_FILE skips NUMBER_BYTES in a binary file
1900  !### specified bye FILEID.
1901 
1902  !Argument Variables
1903  TYPE(binary_file_type), INTENT(IN) :: FILEID
1904  INTEGER(INTG), INTENT(IN) :: NUMBER_BYTES
1905  INTEGER(INTG), INTENT(OUT) :: ERR
1906  TYPE(varying_string), INTENT(OUT) :: ERROR
1907  !Local variables
1908  INTEGER(INTG) :: CERROR(100)
1909  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1910 
1911  enters("SKIP_BINARY_FILE",err,error,*999)
1912 
1913  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1914  IF(number_bytes<=0) &
1915  & CALL flagerror("NUMBER_BYTES to skip is <= 0",err,error,*999)
1916  CALL binaryskipfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1917  & number_bytes,err,cerror)
1918  IF(err/=0) THEN
1919  CALL c2fstring(cerror,dummy_error,err,error,*999)
1920  CALL flagerror(dummy_error,err,error,*999)
1921  ENDIF
1922  ELSE
1923  CALL flagerror("Invalid FILEID",err,error,*999)
1924  ENDIF
1925 
1926  exits("SKIP_BINARY_FILE")
1927  RETURN
1928 999 errorsexits("SKIP_BINARY_FILE",err,error)
1929  RETURN 1
1930  END SUBROUTINE skip_binary_file
1931 
1932  !
1933  !============================================================================
1934  !
1935 
1936  RECURSIVE SUBROUTINE skip_binary_tags(FILEID,TAG,ERR,ERROR,*)
1937 
1938  !#### Subroutine: SKIP_BINARY_TAG
1939  !### Description:
1940  !### SKIP_BINARY_TAG (recursively) skips a binary tag that has
1941  !### already been read by READ_BINARY_TAG.
1942 
1943  !Argument Variables
1944  TYPE(binary_file_type), INTENT(IN) :: FILEID
1945  TYPE(binary_tag_type), INTENT(IN) :: TAG
1946  INTEGER(INTG), INTENT(OUT) :: ERR
1947  TYPE(varying_string), INTENT(OUT) :: ERROR
1948  !Local variables
1949  INTEGER(INTG) :: CERROR(100),i
1950  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
1951  TYPE(binary_tag_type) :: SUBTAG
1952 
1953  enters("SKIP_BINARY_TAGS",err,error,*999)
1954 
1955  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
1956  IF(tag%NUM_SUBTAGS>0) THEN
1957  DO i=1,tag%NUM_SUBTAGS
1958  CALL read_binary_tag_header(fileid,subtag,err,error,*999)
1959  CALL skip_binary_tags(fileid,subtag,err,error,*999)
1960  ENDDO !i
1961  ELSE
1962  CALL binaryskipfile(fileid%FILE_INFORMATION%FILE_NUMBER,&
1963  & tag%NUM_BYTES,err,cerror)
1964  ENDIF
1965  ELSE
1966  CALL flagerror("Invalid FILEID",err,error,*999)
1967  ENDIF
1968 
1969  exits("SKIP_BINARY_TAGS")
1970  RETURN
1971 999 errorsexits("SKIP_BINARY_TAGS",err,error)
1972  RETURN 1
1973  END SUBROUTINE skip_binary_tags
1974 
1975  !
1976  !============================================================================
1977  !
1978 
1979  !#### Generic-Subroutine: WRITE_BINARY_FILE
1980  !### Description:
1981  !### WRITE_BINARY_FILE writes NUM_DATA elements from the binary
1982  !### file specified by FILEID from DATA.
1983  !### Child-Subroutines: WRITE_BINARY_FILE_INTG,
1984  !### WRITE_BINARY_FILE_INTG1,WRITE_BINARY_FILE_SINTG,
1985  !### WRITE_BINARY_FILE_SNT1,WRITE_BINARY_FILE_LINTG,
1986  !### WRITE_BINARY_FILE_LINTG1,WRITE_BINARY_FILE_SP,
1987  !### WRITE_BINARY_FILE_SP1,WRITE_BINARY_FILE_DP,
1988  !### WRITE_BINARY_FILE_DP1,WRITE_BINARY_FILE_CHARACTER,
1989  !### WRITE_BINARY_FILE_LOGICAL,WRITE_BINARY_FILE_LOGICAL1,
1990  !### WRITE_BINARY_FILE_SPC,WRITE_BINARY_FILE_SPC1,
1991  !### WRITE_BINARY_FILE_DPC,WRITE_BINARY_FILE_DPC1
1992 
1993  !
1994  !============================================================================
1995  !
1996 
1997  SUBROUTINE write_binary_file_intg(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
1998 
1999  !#### Subroutine: WRITE_BINARY_FILE_INTG
2000  !### Description:
2001  !### WRITE_BINARY_FILE_INTG writes NUM_DATA integer values to
2002  !### the binary file specified by FILEID from DATA.
2003  !### Parent-subroutine: WRITE_BINARY_FILE
2004 
2005  !Argument variables
2006  TYPE(binary_file_type), INTENT(IN) :: FILEID
2007  INTEGER(INTG), INTENT(IN) :: NUM_DATA, DATA(*)
2008  INTEGER(INTG), INTENT(OUT) :: ERR
2009  TYPE(varying_string), INTENT(OUT) :: ERROR
2010  !Local variables
2011  INTEGER(INTG) :: CERROR(100)
2012  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2013 
2014  enters("WRITE_BINARY_FILE_INTG",err,error,*999)
2015 
2016  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2017  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2018  & file_same_endian,num_data,integer_type,DATA,err,cerror)
2019  IF(err/=0) THEN
2020  CALL c2fstring(cerror,dummy_error,err,error,*999)
2021  CALL flagerror(dummy_error,err,error,*999)
2022  ENDIF
2023  ELSE
2024  CALL flagerror("Invalid FILEID",err,error,*999)
2025  ENDIF
2026 
2027  exits("WRITE_BINARY_FILE_INTG")
2028  RETURN
2029 999 errorsexits("WRITE_BINARY_FILE_INTG",err,error)
2030  RETURN 1
2031  END SUBROUTINE write_binary_file_intg
2032 
2033  !
2034  !============================================================================
2035  !
2036 
2037  SUBROUTINE write_binary_file_intg1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2038 
2039  !#### Subroutine: WRITE_BINARY_FILE_INTG1
2040  !### Description:
2041  !### WRITE_BINARY_FILE_INTG1 writes 1 integer value to
2042  !### the binary file specified by FILEID from DATA.
2043  !### Parent-subroutine: WRITE_BINARY_FILE
2044 
2045  !Argument variables
2046  TYPE(binary_file_type), INTENT(IN) :: FILEID
2047  INTEGER(INTG), INTENT(IN) :: NUM_DATA, DATA
2048  INTEGER(INTG), INTENT(OUT) :: ERR
2049  TYPE(varying_string), INTENT(OUT) :: ERROR
2050  !Local variables
2051  INTEGER(INTG) :: CERROR(100)
2052  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2053 
2054  enters("WRITE_BINARY_FILE_INTG1",err,error,*999)
2055 
2056  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2057  IF(num_data/=1) THEN
2058  CALL flagerror("Number of data items not equal to one",err,error,*999)
2059  ELSE
2060  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2061  & file_same_endian,1,integer_type,DATA,err,cerror)
2062  IF(err/=0) THEN
2063  CALL c2fstring(cerror,dummy_error,err,error,*999)
2064  CALL flagerror(dummy_error,err,error,*999)
2065  ENDIF
2066  ENDIF
2067  ELSE
2068  CALL flagerror("Invalid FILEID",err,error,*999)
2069  ENDIF
2070 
2071  exits("WRITE_BINARY_FILE_INTG1")
2072  RETURN
2073 999 errorsexits("WRITE_BINARY_FILE_INTG1",err,error)
2074  RETURN 1
2075  END SUBROUTINE write_binary_file_intg1
2076 
2077  !
2078  !============================================================================
2079  !
2080 
2081  SUBROUTINE write_binary_file_sintg(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2082 
2083  !#### Subroutine: WRITE_BINARY_FILE_SINTG
2084  !### Description:
2085  !### WRITE_BINARY_FILE_SINTG writes NUM_DATA short integer
2086  !### values to the binary file specified by FILEID from DATA.
2087  !### Parent-subroutine: WRITE_BINARY_FILE
2088 
2089  !Argument variables
2090  TYPE(binary_file_type), INTENT(IN) :: FILEID
2091  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2092  INTEGER(SINTG), INTENT(IN) :: DATA(*)
2093  INTEGER(INTG), INTENT(OUT) :: ERR
2094  TYPE(varying_string), INTENT(OUT) :: ERROR
2095  !Local variables
2096  INTEGER(INTG) :: CERROR(100)
2097  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2098 
2099  enters("WRITE_BINARY_FILE_SINTG",err,error,*999)
2100 
2101  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2102  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2103  & file_same_endian,num_data,short_integer_type,DATA,err,&
2104  & cerror)
2105  IF(err/=0) THEN
2106  CALL c2fstring(cerror,dummy_error,err,error,*999)
2107  CALL flagerror(dummy_error,err,error,*999)
2108  ENDIF
2109  ELSE
2110  CALL flagerror("Invalid FILEID",err,error,*999)
2111  ENDIF
2112 
2113  exits("WRITE_BINARY_FILE_SINTG")
2114  RETURN
2115 999 errorsexits("WRITE_BINARY_FILE_SINTG",err,error)
2116  RETURN 1
2117  END SUBROUTINE write_binary_file_sintg
2118 
2119  !
2120  !============================================================================
2121  !
2122 
2123  SUBROUTINE write_binary_file_sintg1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2124 
2125  !#### Subroutine: WRITE_BINARY_FILE_SINTG1
2126  !### Description:
2127  !### WRITE_BINARY_FILE_SINTG1 writes 1 short integer value to
2128  !### the binary file specified by FILEID from DATA.
2129  !### Parent-subroutine: WRITE_BINARY_FILE
2130 
2131  !Argument variables
2132  TYPE(binary_file_type), INTENT(IN) :: FILEID
2133  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2134  INTEGER(SINTG), INTENT(IN) :: DATA
2135  INTEGER(INTG), INTENT(OUT) :: ERR
2136  TYPE(varying_string), INTENT(OUT) :: ERROR
2137  !Local variables
2138  INTEGER(INTG) :: CERROR(100)
2139  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2140 
2141  enters("WRITE_BINARY_FILE_SINTG1",err,error,*999)
2142 
2143  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2144  IF(num_data/=1) THEN
2145  CALL flagerror("Number of data items not equal to one",err,error,*999)
2146  ELSE
2147  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2148  & file_same_endian,1,short_integer_type,DATA,err,cerror)
2149  IF(err/=0) THEN
2150  CALL c2fstring(cerror,dummy_error,err,error,*999)
2151  CALL flagerror(dummy_error,err,error,*999)
2152  ENDIF
2153  ENDIF
2154  ELSE
2155  CALL flagerror("Invalid FILEID",err,error,*999)
2156  ENDIF
2157 
2158  exits("WRITE_BINARY_FILE_SINTG1")
2159  RETURN
2160 999 errorsexits("WRITE_BINARY_FILE_SINTG1",err,error)
2161  RETURN 1
2162  END SUBROUTINE write_binary_file_sintg1
2163 
2164  !
2165  !============================================================================
2166  !
2167 
2168  SUBROUTINE write_binary_file_lintg(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2169 
2170  !#### Subroutine: WRITE_BINARY_FILE_LINTG
2171  !### Description:
2172  !### WRITE_BINARY_FILE_LINTG writes NUM_DATA long integer
2173  !### values to the binary file specified by FILEID from DATA.
2174  !### Parent-subroutine: WRITE_BINARY_FILE
2175 
2176  !Argument variables
2177  TYPE(binary_file_type), INTENT(IN) :: FILEID
2178  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2179  INTEGER(LINTG), INTENT(IN) :: DATA(*)
2180  INTEGER(INTG), INTENT(OUT) :: ERR
2181  TYPE(varying_string), INTENT(OUT) :: ERROR
2182  !Local variables
2183  INTEGER(INTG) :: CERROR(100)
2184  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2185 
2186  enters("WRITE_BINARY_FILE_LINTG",err,error,*999)
2187 
2188  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2189  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2190  & file_same_endian,num_data,long_integer_type,DATA,err,&
2191  & cerror)
2192  IF(err/=0) THEN
2193  CALL c2fstring(cerror,dummy_error,err,error,*999)
2194  CALL flagerror(dummy_error,err,error,*999)
2195  ENDIF
2196  ELSE
2197  CALL flagerror("Invalid FILEID",err,error,*999)
2198  ENDIF
2199 
2200  exits("WRITE_BINARY_FILE_LINTG")
2201  RETURN
2202 999 errorsexits("WRITE_BINARY_FILE_LINTG",err,error)
2203  RETURN 1
2204  END SUBROUTINE write_binary_file_lintg
2205 
2206  !
2207  !============================================================================
2208  !
2209 
2210  SUBROUTINE write_binary_file_lintg1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2211 
2212  !#### Subroutine: WRITE_BINARY_FILE_LINTG1
2213  !### Description:
2214  !### WRITE_BINARY_FILE_LINTG1 writes 1 long integer value to
2215  !### the binary file specified by FILEID from DATA.
2216  !### Parent-subroutine: WRITE_BINARY_FILE
2217 
2218  !Argument variables
2219  TYPE(binary_file_type), INTENT(IN) :: FILEID
2220  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2221  INTEGER(LINTG), INTENT(IN) :: DATA
2222  INTEGER(INTG), INTENT(OUT) :: ERR
2223  TYPE(varying_string), INTENT(OUT) :: ERROR
2224  !Local variables
2225  INTEGER(INTG) :: CERROR(100)
2226  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2227 
2228  enters("WRITE_BINARY_FILE_LINTG1",err,error,*999)
2229 
2230  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2231  IF(num_data/=1) THEN
2232  CALL flagerror("Number of data items not equal to one",err,error,*999)
2233  ELSE
2234  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2235  & file_same_endian,1,long_integer_type,DATA,err,cerror)
2236  IF(err/=0) THEN
2237  CALL c2fstring(cerror,dummy_error,err,error,*999)
2238  CALL flagerror(dummy_error,err,error,*999)
2239  ENDIF
2240  ENDIF
2241  ELSE
2242  CALL flagerror("Invalid FILEID",err,error,*999)
2243  ENDIF
2244 
2245  exits("WRITE_BINARY_FILE_LINTG1")
2246  RETURN
2247 999 errorsexits("WRITE_BINARY_FILE_LINTG1",err,error)
2248  RETURN 1
2249  END SUBROUTINE write_binary_file_lintg1
2250 
2251  !
2252  !============================================================================
2253  !
2254 
2255  SUBROUTINE write_binary_file_sp(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2256 
2257  !#### Subroutine: WRITE_BINARY_FILE_SP
2258  !### Description:
2259  !### WRITE_BINARY_FILE_SP writes NUM_DATA single precision
2260  !### real values to the binary file specified by FILEID from
2261  !### DATA.
2262  !### Parent-subroutine: WRITE_BINARY_FILE
2263 
2264  !Argument variables
2265  TYPE(binary_file_type), INTENT(IN) :: FILEID
2266  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2267  REAL(SP), INTENT(IN) :: DATA(*)
2268  INTEGER(INTG), INTENT(OUT) :: ERR
2269  TYPE(varying_string), INTENT(OUT) :: ERROR
2270  !Local variables
2271  INTEGER(INTG) :: CERROR(100)
2272  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2273 
2274  enters("WRITE_BINARY_FILE_SP",err,error,*999)
2275 
2276  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2277  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2278  & file_same_endian,num_data,single_real_type,DATA,err,&
2279  & cerror)
2280  IF(err/=0) THEN
2281  CALL c2fstring(cerror,dummy_error,err,error,*999)
2282  CALL flagerror(dummy_error,err,error,*999)
2283  ENDIF
2284  ELSE
2285  CALL flagerror("Invalid FILEID",err,error,*999)
2286  ENDIF
2287 
2288  exits("WRITE_BINARY_FILE_SP")
2289  RETURN
2290 999 errorsexits("WRITE_BINARY_FILE_SP",err,error)
2291  RETURN 1
2292  END SUBROUTINE write_binary_file_sp
2293 
2294  !
2295  !============================================================================
2296  !
2297 
2298  SUBROUTINE write_binary_file_sp1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2299 
2300  !#### Subroutine: WRITE_BINARY_FILE_SP1
2301  !### Description:
2302  !### WRITE_BINARY_FILE_SP1 writes 1 single precision real
2303  !### value to the binary file specified by FILEID from DATA.
2304  !### Parent-subroutine: WRITE_BINARY_FILE
2305 
2306  !Argument variables
2307  TYPE(binary_file_type), INTENT(IN) :: FILEID
2308  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2309  REAL(SP), INTENT(IN) :: DATA
2310  INTEGER(INTG), INTENT(OUT) :: ERR
2311  TYPE(varying_string), INTENT(OUT) :: ERROR
2312  !Local variables
2313  INTEGER(INTG) :: CERROR(100)
2314  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2315 
2316  enters("WRITE_BINARY_FILE_SP1",err,error,*999)
2317 
2318  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2319  IF(num_data/=1) THEN
2320  CALL flagerror("Number of data items not equal to one",err,error,*999)
2321  ELSE
2322  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2323  & file_same_endian,1,single_real_type,DATA,err,cerror)
2324  IF(err/=0) THEN
2325  CALL c2fstring(cerror,dummy_error,err,error,*999)
2326  CALL flagerror(dummy_error,err,error,*999)
2327  ENDIF
2328  ENDIF
2329  ELSE
2330  CALL flagerror("Invalid FILEID",err,error,*999)
2331  ENDIF
2332 
2333  exits("WRITE_BINARY_FILE_SP1")
2334  RETURN
2335 999 errorsexits("WRITE_BINARY_FILE_SP1",err,error)
2336  RETURN 1
2337  END SUBROUTINE write_binary_file_sp1
2338 
2339  !
2340  !============================================================================
2341  !
2342 
2343  SUBROUTINE write_binary_file_dp(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2344 
2345  !#### Subroutine: WRITE_BINARY_FILE_DP
2346  !### Description:
2347  !### WRITE_BINARY_FILE_DP writes NUM_DATA double precision
2348  !### real values to the binary file specified by FILEID from
2349  !### DATA.
2350  !### Parent-subroutine: WRITE_BINARY_FILE
2351 
2352  !Argument variables
2353  TYPE(binary_file_type), INTENT(IN) :: FILEID
2354  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2355  REAL(DP), INTENT(IN) :: DATA(*)
2356  INTEGER(INTG), INTENT(OUT) :: ERR
2357  TYPE(varying_string), INTENT(OUT) :: ERROR
2358  !Local variables
2359  INTEGER(INTG) :: CERROR(100)
2360  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2361 
2362  enters("WRITE_BINARY_FILE_DP",err,error,*999)
2363 
2364  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2365  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2366  & file_same_endian, num_data, double_real_type, DATA, err,&
2367  & cerror)
2368  IF(err/=0) THEN
2369  CALL c2fstring(cerror,dummy_error,err,error,*999)
2370  CALL flagerror(dummy_error,err,error,*999)
2371  ENDIF
2372  ELSE
2373  CALL flagerror("Invalid FILEID",err,error,*999)
2374  ENDIF
2375 
2376  exits("WRITE_BINARY_FILE_DP")
2377  RETURN
2378 999 errorsexits("WRITE_BINARY_FILE_DP",err,error)
2379  RETURN 1
2380  END SUBROUTINE write_binary_file_dp
2381 
2382  !
2383  !============================================================================
2384  !
2385 
2386  SUBROUTINE write_binary_file_dp1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2387 
2388  !#### Subroutine: WRITE_BINARY_FILE_DP1
2389  !### Description:
2390  !### WRITE_BINARY_FILE_DP1 writes 1 double precision real
2391  !### value to the binary file specified by FILEID from DATA.
2392  !### Parent-subroutine: WRITE_BINARY_FILE
2393 
2394  !Argument variables
2395  TYPE(binary_file_type), INTENT(IN) :: FILEID
2396  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2397  REAL(DP), INTENT(IN) :: DATA
2398  INTEGER(INTG), INTENT(OUT) :: ERR
2399  TYPE(varying_string), INTENT(OUT) :: ERROR
2400  !Local variables
2401  INTEGER(INTG) :: CERROR(100)
2402  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2403 
2404  enters("WRITE_BINARY_FILE_DP1",err,error,*999)
2405 
2406  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2407  IF(num_data/=1) THEN
2408  CALL flagerror("Number of data items not equal to one",err,error,*999)
2409  ELSE
2410  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2411  & file_same_endian,1,double_real_type,DATA,err,cerror)
2412  IF(err/=0) THEN
2413  CALL c2fstring(cerror,dummy_error,err,error,*999)
2414  CALL flagerror(dummy_error,err,error,*999)
2415  ENDIF
2416  ENDIF
2417  ELSE
2418  CALL flagerror("Invalid FILEID",err,error,*999)
2419  ENDIF
2420 
2421  exits("WRITE_BINARY_FILE_DP1")
2422  RETURN
2423 999 errorsexits("WRITE_BINARY_FILE_DP1",err,error)
2424  RETURN 1
2425  END SUBROUTINE write_binary_file_dp1
2426 
2427  !
2428  !============================================================================
2429  !
2430 
2431  SUBROUTINE write_binary_file_character(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2432 
2433  !#### Subroutine: WRITE_BINARY_FILE_CHARACTER
2434  !### Description:
2435  !### WRITE_BINARY_FILE_CHARACTER writes NUM_DATA character
2436  !### values to the binary file specified by FILEID from DATA.
2437  !### Parent-subroutine: WRITE_BINARY_FILE
2438 
2439  !Argument variables
2440  TYPE(binary_file_type), INTENT(IN) :: FILEID
2441  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2442  CHARACTER(LEN=*), INTENT(IN) :: DATA
2443  INTEGER(INTG), INTENT(OUT) :: ERR
2444  TYPE(varying_string), INTENT(OUT) :: ERROR
2445  !Local variables
2446  INTEGER(INTG) :: CERROR(100),CSTRING(250)
2447  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2448 
2449  enters("WRITE_BINARY_FILE_CHARACTER",err,error,*999)
2450 
2451  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2452  CALL f2cstring(cstring,DATA,err,error,*999)
2453  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2454  & file_same_endian,num_data,character_type,cstring,err,&
2455  & cerror)
2456  IF(err/=0) THEN
2457  CALL c2fstring(cerror,dummy_error,err,error,*999)
2458  CALL flagerror(dummy_error,err,error,*999)
2459  ENDIF
2460  ELSE
2461  CALL flagerror("Invalid FILEID",err,error,*999)
2462  ENDIF
2463 
2464  exits("WRITE_BINARY_FILE_CHARACTER")
2465  RETURN
2466 999 errorsexits("WRITE_BINARY_FILE_CHARACTER",err,error)
2467  RETURN 1
2468  END SUBROUTINE write_binary_file_character
2469 
2470  !
2471  !============================================================================
2472  !
2473 
2474  SUBROUTINE write_binary_file_logical(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2475 
2476  !#### Subroutine: WRITE_BINARY_FILE_LOGICAL
2477  !### Description:
2478  !### WRITE_BINARY_FILE_LOGICAL writes NUM_DATA logical values
2479  !### to the binary file specified by FILEID from DATA.
2480  !### Parent-subroutine: WRITE_BINARY_FILE
2481 
2482  !Argument variables
2483  TYPE(binary_file_type), INTENT(IN) :: FILEID
2484  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2485  LOGICAL, INTENT(IN) :: DATA(*)
2486  INTEGER(INTG), INTENT(OUT) :: ERR
2487  TYPE(varying_string), INTENT(OUT) :: ERROR
2488  !Local variables
2489  INTEGER(INTG) :: CERROR(100)
2490  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2491 
2492  enters("WRITE_BINARY_FILE_LOGICAL",err,error,*999)
2493 
2494  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2495  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2496  & file_same_endian,num_data,logical_type,DATA,err,cerror)
2497  IF(err/=0) THEN
2498  CALL c2fstring(cerror,dummy_error,err,error,*999)
2499  CALL flagerror(dummy_error,err,error,*999)
2500  ENDIF
2501  ELSE
2502  CALL flagerror("Invalid FILEID",err,error,*999)
2503  ENDIF
2504 
2505  exits("WRITE_BINARY_FILE_LOGICAL")
2506  RETURN
2507 999 errorsexits("WRITE_BINARY_FILE_LOGICAL",err,error)
2508  RETURN 1
2509  END SUBROUTINE write_binary_file_logical
2510 
2511  !
2512  !============================================================================
2513  !
2514 
2515  SUBROUTINE write_binary_file_logical1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2516 
2517  !#### Subroutine: WRITE_BINARY_FILE_LOGICAL1
2518  !### Description:
2519  !### WRITE_BINARY_FILE_LOGICAL1 writes 1 logical value to
2520  !### the binary file specified by FILEID from DATA.
2521  !### Parent-subroutine: WRITE_BINARY_FILE
2522 
2523  !Argument variables
2524  TYPE(binary_file_type), INTENT(IN) :: FILEID
2525  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2526  LOGICAL, INTENT(IN) :: DATA
2527  INTEGER(INTG), INTENT(OUT) :: ERR
2528  TYPE(varying_string), INTENT(OUT) :: ERROR
2529  !Local variables
2530  INTEGER(INTG) :: CERROR(100)
2531  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2532 
2533  enters("WRITE_BINARY_FILE_LOGICAL1",err,error,*999)
2534 
2535  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2536  IF(num_data/=1) THEN
2537  CALL flagerror("Number of data items not equal to one",err,error,*999)
2538  ELSE
2539  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2540  & file_same_endian,1,logical_type,DATA,err,cerror)
2541  IF(err/=0) THEN
2542  CALL c2fstring(cerror,dummy_error,err,error,*999)
2543  CALL flagerror(dummy_error,err,error,*999)
2544  ENDIF
2545  ENDIF
2546  ELSE
2547  CALL flagerror("Invalid FILEID",err,error,*999)
2548  ENDIF
2549 
2550  exits("WRITE_BINARY_FILE_LOGICAL1")
2551  RETURN
2552 999 errorsexits("WRITE_BINARY_FILE_LOGICAL1",err,error)
2553  RETURN 1
2554  END SUBROUTINE write_binary_file_logical1
2555 
2556  !
2557  !============================================================================
2558  !
2559 
2560  SUBROUTINE write_binary_file_spc(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2561 
2562  !#### Subroutine: WRITE_BINARY_FILE_SPC
2563  !### Description:
2564  !### WRITE_BINARY_FILE_SPC writes NUM_DATA single precision
2565  !### complex values to the binary file specified by FILEID
2566  !### from DATA.
2567  !### Parent-subroutine: WRITE_BINARY_FILE
2568 
2569  !Argument variables
2570  TYPE(binary_file_type), INTENT(IN) :: FILEID
2571  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2572  COMPLEX(SPC), INTENT(IN) :: DATA(*)
2573  INTEGER(INTG), INTENT(OUT) :: ERR
2574  TYPE(varying_string), INTENT(OUT) :: ERROR
2575  !Local variables
2576  INTEGER(INTG) :: CERROR(100)
2577  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2578 
2579  enters("WRITE_BINARY_FILE_SPC",err,error,*999)
2580 
2581  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2582  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2583  & file_same_endian,num_data,single_complex_type,DATA,err,&
2584  & cerror)
2585  IF(err/=0) THEN
2586  CALL c2fstring(cerror,dummy_error,err,error,*999)
2587  CALL flagerror(dummy_error,err,error,*999)
2588  ENDIF
2589  ELSE
2590  CALL flagerror("Invalid FILEID",err,error,*999)
2591  ENDIF
2592 
2593  exits("WRITE_BINARY_FILE_SPC")
2594  RETURN
2595 999 errorsexits("WRITE_BINARY_FILE_SPC",err,error)
2596  RETURN 1
2597  END SUBROUTINE write_binary_file_spc
2598 
2599  !
2600  !============================================================================
2601  !
2602 
2603  SUBROUTINE write_binary_file_spc1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2604 
2605  !#### Subroutine: WRITE_BINARY_FILE_SPC1
2606  !### Description:
2607  !### WRITE_BINARY_FILE_SPC1 writes 1 single precision complex
2608  !### value to the binary file specified by FILEID from DATA.
2609  !### Parent-subroutine: WRITE_BINARY_FILE
2610 
2611  !Argument variables
2612  TYPE(binary_file_type), INTENT(IN) :: FILEID
2613  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2614  COMPLEX(SPC), INTENT(IN) :: DATA
2615  INTEGER(INTG), INTENT(OUT) :: ERR
2616  TYPE(varying_string), INTENT(OUT) :: ERROR
2617  !Local variables
2618  INTEGER(INTG) :: CERROR(100)
2619  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2620 
2621  enters("WRITE_BINARY_FILE_SPC1",err,error,*999)
2622 
2623  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2624  IF(num_data/=1) THEN
2625  CALL flagerror("Number of data items not equal to one",err,error,*999)
2626  ELSE
2627  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2628  & file_same_endian, 1, single_complex_type, DATA, err,&
2629  & cerror)
2630  IF(err/=0) THEN
2631  CALL c2fstring(cerror,dummy_error,err,error,*999)
2632  CALL flagerror(dummy_error,err,error,*999)
2633  ENDIF
2634  ENDIF
2635  ELSE
2636  CALL flagerror("Invalid FILEID",err,error,*999)
2637  ENDIF
2638 
2639  exits("WRITE_BINARY_FILE_SPC1")
2640  RETURN
2641 999 errorsexits("WRITE_BINARY_FILE_SPC1",err,error)
2642  RETURN 1
2643  END SUBROUTINE write_binary_file_spc1
2644 
2645  !
2646  !============================================================================
2647  !
2648 
2649  SUBROUTINE write_binary_file_dpc(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2650 
2651  !#### Subroutine: WRITE_BINARY_FILE_DPC
2652  !### Description:
2653  !### WRITE_BINARY_FILE_DPC writes NUM_DATA double precision
2654  !### complex values to the binary file specified by FILEID
2655  !### from DATA.
2656  !### Parent-subroutine: WRITE_BINARY_FILE
2657 
2658  !Argument variables
2659  TYPE(binary_file_type), INTENT(IN) :: FILEID
2660  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2661  COMPLEX(DPC), INTENT(IN) :: DATA(*)
2662  INTEGER(INTG), INTENT(OUT) :: ERR
2663  TYPE(varying_string), INTENT(OUT) :: ERROR
2664  !Local variables
2665  INTEGER(INTG) :: CERROR(100)
2666  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2667 
2668  enters("WRITE_BINARY_FILE_DPC",err,error,*999)
2669 
2670  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2671  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2672  & file_same_endian,num_data,double_complex_type,DATA,err,&
2673  & cerror)
2674  IF(err/=0) THEN
2675  CALL c2fstring(cerror,dummy_error,err,error,*999)
2676  CALL flagerror(dummy_error,err,error,*999)
2677  ENDIF
2678  ELSE
2679  CALL flagerror("Invalid FILEID",err,error,*999)
2680  ENDIF
2681 
2682  exits("WRITE_BINARY_FILE_DPC")
2683  RETURN
2684 999 errorsexits("WRITE_BINARY_FILE_DPC",err,error)
2685  RETURN 1
2686  END SUBROUTINE write_binary_file_dpc
2687 
2688  !
2689  !============================================================================
2690  !
2691 
2692  SUBROUTINE write_binary_file_dpc1(FILEID,NUM_DATA,DATA,ERR,ERROR,*)
2693 
2694  !#### Subroutine: WRITE_BINARY_FILE_DPC1
2695  !### Description:
2696  !### WRITE_BINARY_FILE_ writes 1 double precision complex
2697  !### value to the binary file specified by FILEID from DATA.
2698  !### Parent-subroutine: WRITE_BINARY_FILE
2699 
2700  !Argument variables
2701  TYPE(binary_file_type), INTENT(IN) :: FILEID
2702  INTEGER(INTG), INTENT(IN) :: NUM_DATA
2703  COMPLEX(DPC), INTENT(IN) :: DATA
2704  INTEGER(INTG), INTENT(OUT) :: ERR
2705  TYPE(varying_string), INTENT(OUT) :: ERROR
2706  !Local variables
2707  INTEGER(INTG) :: CERROR(100)
2708  CHARACTER(LEN=MAXSTRLEN) :: DUMMY_ERROR
2709 
2710  enters("WRITE_BINARY_FILE_DPC1",err,error,*999)
2711 
2712  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2713  IF(num_data/=1) THEN
2714  CALL flagerror("Number of data item not equal to one",err,error,*999)
2715  ELSE
2716  CALL binarywritefile(fileid%FILE_INFORMATION%FILE_NUMBER,&
2717  & file_same_endian, 1, double_complex_type, DATA, err,&
2718  & cerror)
2719  IF(err/=0) THEN
2720  CALL c2fstring(cerror,dummy_error,err,error,*999)
2721  CALL flagerror(dummy_error,err,error,*999)
2722  ENDIF
2723  ENDIF
2724  ELSE
2725  CALL flagerror("Invalid FILEID",err,error,*999)
2726  ENDIF
2727 
2728  exits("WRITE_BINARY_FILE_DPC1")
2729  RETURN
2730 999 errorsexits("WRITE_BINARY_FILE_DPC1",err,error)
2731  RETURN 1
2732  END SUBROUTINE write_binary_file_dpc1
2733 
2734  !
2735  !============================================================================
2736  !
2737 
2738  SUBROUTINE write_binary_tag_header(FILEID,TAG,ERR,ERROR,*)
2739 
2740  !#### Subroutine: WRITE_BINARY_TAG_HEADER
2741  !### Description:
2742  !### WRITE_BINARY_TAG_HEADER writes a binary tag header from
2743  !### the binary file specified by FILEID.
2744 
2745  !Argument variables
2746  TYPE(binary_file_type), INTENT(IN) :: FILEID
2747  TYPE(binary_tag_type), INTENT(OUT) :: TAG
2748  INTEGER(INTG), INTENT(OUT) :: ERR
2749  TYPE(varying_string), INTENT(OUT) :: ERROR
2750  !Local Variables
2751  INTEGER(INTG) :: INTDATA(2)
2752 
2753  enters("WRITE_BINARY_TAG_HEADER",err,error,*999)
2754 
2755  IF(ASSOCIATED(fileid%FILE_INFORMATION)) THEN
2756  intdata(1)=tag%INDEX
2757  tag%NUM_HEADER_BYTES=len_trim(tag%HEADER)
2758  intdata(2)=tag%NUM_HEADER_BYTES
2759  CALL write_binary_file(fileid,2,intdata,err,error,*999)
2760  CALL write_binary_file(fileid,tag%NUM_HEADER_BYTES,&
2761  & tag%HEADER,err,error,*999)
2762  CALL write_binary_file(fileid,1,tag%NUM_SUBTAGS,err,error,*999)
2763  IF(tag%NUM_SUBTAGS>0) &
2764  & CALL write_binary_file(fileid,1,tag%NUM_BYTES,err,error,*999)
2765  ELSE
2766  CALL flagerror("Invalid FILEID",err,error,*999)
2767  ENDIF
2768 
2769  exits("WRITE_BINARY_TAG_HEADER")
2770  RETURN
2771 999 errorsexits("WRITE_BINARY_TAG_HEADER",err,error)
2772  RETURN 1
2773  END SUBROUTINE write_binary_tag_header
2774 
2775  !
2776  !============================================================================
2777  !
2778 
2779 END MODULE binary_file
machine_constants::machine_char_format
integer(intg), parameter machine_char_format
Definition: machine_constants_aix.f90:58
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
binary_file::read_binary_file_sintg
subroutine read_binary_file_sintg(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:946
binary_file::cmiss_binary_matrix_file
integer(intg), parameter, public cmiss_binary_matrix_file
Definition: binary_file_f.f90:257
binary_file::inquire_eof_binary_file
logical function inquire_eof_binary_file(FILEID, ERR, ERROR)
Definition: binary_file_f.f90:434
binary_file::cmiss_binary_identity_header
integer(intg), parameter cmiss_binary_identity_header
Definition: binary_file_f.f90:260
binary_file::binary_file_used
logical, dimension(max_num_binary_files), save binary_file_used
Definition: binary_file_f.f90:304
binary_file::reset_binary_number_tags
subroutine reset_binary_number_tags(FILEID, NUMBER_TAGS, ERR, ERROR,)
Definition: binary_file_f.f90:1730
binary_file::write_binary_file_dpc1
subroutine write_binary_file_dpc1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2693
binary_file::read_binary_file_dpc
subroutine read_binary_file_dpc(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1575
binary_file::read_binary_file_dp1
subroutine read_binary_file_dp1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1280
machine_constants::integer_size
integer(intg), parameter integer_size
Definition: machine_constants_aix.f90:62
binary_file::read_binary_file_sp1
subroutine read_binary_file_sp1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1184
binary_file::write_binary_file_intg1
subroutine write_binary_file_intg1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2038
binary_file::read_binary_file
Definition: binary_file_f.f90:360
binary_file::write_binary_tag_header
subroutine write_binary_tag_header(FILEID, TAG, ERR, ERROR,)
Definition: binary_file_f.f90:2739
binary_file::skip_binary_tags
recursive subroutine skip_binary_tags(FILEID, TAG, ERR, ERROR,)
Definition: binary_file_f.f90:1937
binary_file::close_binary_file
subroutine close_binary_file(FILEID, ERR, ERROR,)
Definition: binary_file_f.f90:477
binary_file::file_current
integer(intg), parameter, public file_current
Definition: binary_file_f.f90:244
kinds::intg
integer, parameter intg
Standard integer kind.
Definition: kinds.f90:55
binary_file::file_change_endian
integer(intg), parameter file_change_endian
Definition: binary_file_f.f90:249
binary_file::read_binary_file_logical1
subroutine read_binary_file_logical1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1427
binary_file::inquire_open_binary_file
logical function inquire_open_binary_file(FILEID)
Definition: binary_file_f.f90:411
binary_file::cmiss_binary_machine_header
integer(intg), parameter cmiss_binary_machine_header
Definition: binary_file_f.f90:261
machine_constants::machine_os
integer(intg), parameter machine_os
Definition: machine_constants_aix.f90:56
binary_file::write_binary_file_logical1
subroutine write_binary_file_logical1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2516
machine_constants::double_complex_size
integer(intg), parameter double_complex_size
Definition: machine_constants_aix.f90:70
machine_constants::machine_endian
integer(intg), parameter machine_endian
Definition: machine_constants_aix.f90:57
binary_file::binary_file_type
Definition: binary_file_f.f90:290
binary_file::read_binary_file_dpc1
subroutine read_binary_file_dpc1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1622
binary_file::write_binary_file_intg
subroutine write_binary_file_intg(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1998
binary_file::read_binary_file_lintg
subroutine read_binary_file_lintg(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1042
binary_file::write_binary_file_sp
subroutine write_binary_file_sp(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2256
binary_file::write_binary_file_spc1
subroutine write_binary_file_spc1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2604
binary_file::binary_file_readable
integer(intg), parameter binary_file_readable
Definition: binary_file_f.f90:252
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
binary_file::read_binary_file_logical
subroutine read_binary_file_logical(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1381
binary_file::cmiss_binary_history_file
integer(intg), parameter, public cmiss_binary_history_file
Definition: binary_file_f.f90:258
binary_file::read_binary_file_spc
subroutine read_binary_file_spc(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1477
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
constants
This module contains all program wide constants.
Definition: constants.f90:45
binary_file::binary_file_info_type
Definition: binary_file_f.f90:266
binary_file::cmiss_binary_identity
integer(intg), parameter cmiss_binary_identity
Definition: binary_file_f.f90:256
base_routines::flag_warning
Flags a warning to the user.
Definition: base_routines.f90:232
machine_constants::machine_type
integer(intg), parameter machine_type
Definition: machine_constants_aix.f90:55
binary_file::cmiss_binary_signal_file
integer(intg), parameter, public cmiss_binary_signal_file
Definition: binary_file_f.f90:259
binary_file::read_binary_file_sp
subroutine read_binary_file_sp(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1138
binary_file::read_binary_file_dp
subroutine read_binary_file_dp(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1234
binary_file::write_binary_file_lintg
subroutine write_binary_file_lintg(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2169
machine_constants::machine_dp_format
integer(intg), parameter machine_dp_format
Definition: machine_constants_aix.f90:61
binary_file::write_binary_file
Definition: binary_file_f.f90:380
machine_constants::logical_size
integer(intg), parameter logical_size
Definition: machine_constants_aix.f90:68
binary_file::file_beginning
integer(intg), parameter, public file_beginning
Definition: binary_file_f.f90:243
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
machine_constants::machine_int_format
integer(intg), parameter machine_int_format
Definition: machine_constants_aix.f90:59
binary_file::read_binary_file_intg1
subroutine read_binary_file_intg1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:896
binary_file::write_binary_file_sintg
subroutine write_binary_file_sintg(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2082
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
binary_file::binary_file_writable
integer(intg), parameter binary_file_writable
Definition: binary_file_f.f90:253
base_routines::general_output_type
integer(intg), parameter, public general_output_type
General output type.
Definition: base_routines.f90:66
binary_file::read_binary_file_character
subroutine read_binary_file_character(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1330
machine_constants::short_integer_size
integer(intg), parameter short_integer_size
Definition: machine_constants_aix.f90:63
machine_constants::single_complex_size
integer(intg), parameter single_complex_size
Definition: machine_constants_aix.f90:69
binary_file::read_binary_file_intg
subroutine read_binary_file_intg(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:850
binary_file::skip_cm_binary_header
subroutine skip_cm_binary_header(FILEID, SKIP, ERR, ERROR,)
Definition: binary_file_f.f90:1825
machine_constants::double_real_size
integer(intg), parameter double_real_size
Definition: machine_constants_aix.f90:66
binary_file::binary_tag_type
Definition: binary_file_f.f90:294
binary_file::write_binary_file_spc
subroutine write_binary_file_spc(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2561
binary_file::skip_binary_file
subroutine skip_binary_file(FILEID, NUMBER_BYTES, ERR, ERROR,)
Definition: binary_file_f.f90:1896
binary_file::read_binary_file_sintg1
subroutine read_binary_file_sintg1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:992
binary_file::read_binary_file_lintg1
subroutine read_binary_file_lintg1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1088
binary_file::write_binary_file_dp1
subroutine write_binary_file_dp1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2387
binary_file::read_binary_file_spc1
subroutine read_binary_file_spc1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:1524
binary_file
This module handles the reading and writing of binary files.
Definition: binary_file_f.f90:223
binary_file::cmiss_binary_file_header
integer(intg), parameter cmiss_binary_file_header
Definition: binary_file_f.f90:262
machine_constants::machine_sp_format
integer(intg), parameter machine_sp_format
Definition: machine_constants_aix.f90:60
machine_constants::character_size
integer(intg), parameter character_size
Definition: machine_constants_aix.f90:67
iso_varying_string::char
Definition: iso_varying_string.f90:138
binary_file::max_num_binary_files
integer(intg), parameter max_num_binary_files
Definition: binary_file_f.f90:240
binary_file::read_binary_tag_header
subroutine read_binary_tag_header(FILEID, TAG, ERR, ERROR,)
Definition: binary_file_f.f90:1673
machine_constants::long_integer_size
integer(intg), parameter long_integer_size
Definition: machine_constants_aix.f90:64
binary_file::write_binary_file_logical
subroutine write_binary_file_logical(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2475
iso_varying_string::len_trim
Definition: iso_varying_string.f90:166
binary_file::write_binary_file_dp
subroutine write_binary_file_dp(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2344
binary_file::write_binary_file_sintg1
subroutine write_binary_file_sintg1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2124
binary_file::file_end
integer(intg), parameter, public file_end
Definition: binary_file_f.f90:245
iso_varying_string::index
Definition: iso_varying_string.f90:156
binary_file::write_binary_file_dpc
subroutine write_binary_file_dpc(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2650
binary_file::write_binary_file_sp1
subroutine write_binary_file_sp1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2299
binary_file::write_binary_file_character
subroutine write_binary_file_character(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2432
binary_file::set_binary_file
subroutine set_binary_file(FILEID, SET_CODE, ERR, ERROR,)
Definition: binary_file_f.f90:1783
binary_file::open_binary_file
subroutine open_binary_file(FILEID, COMMAND, FILENAME, ERR, ERROR,)
Definition: binary_file_f.f90:548
base_routines::op_string
character(len=maxstrlen), dimension(max_output_lines), save, public op_string
The array of lines to output.
Definition: base_routines.f90:173
machine_constants
This module contains all machine dependent constants for AIX systems.
Definition: machine_constants_aix.f90:45
machine_constants::single_real_size
integer(intg), parameter single_real_size
Definition: machine_constants_aix.f90:65
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
binary_file::close_cmiss_binary_file
subroutine close_cmiss_binary_file(FILEID, ERR, ERROR,)
Definition: binary_file_f.f90:520
binary_file::open_cmiss_binary_file
subroutine open_cmiss_binary_file(FILEID, FILE_TYPE, NUMBER_TAGS, VERSION, FILEVERSION, COMMAND, EXTENSION, FILENAME, ERR, ERROR,)
Definition: binary_file_f.f90:624
binary_file::write_binary_file_lintg1
subroutine write_binary_file_lintg1(FILEID, NUM_DATA, DATA, ERR, ERROR,)
Definition: binary_file_f.f90:2211
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
binary_file::file_same_endian
integer(intg), parameter file_same_endian
Definition: binary_file_f.f90:248
iso_varying_string::ichar
Definition: iso_varying_string.f90:152