Context Navigation

source: ether_ndacc/trunk/dev_ndacc/livraison/src/barray/dataex.f @ 84

Last change on this file since 84 was 84, checked in by cbipsl, 14 years ago
import ether_ndacc
Property svn:executable set to ``*
File size: 182.8 KB

Line
1
2	PROGRAM DATAEX
3	C
4	C Fortran 77 program to read and check format of exchange data files.
5	C This is mainly a format checking program, but it can also be used to
6	C retrieve the contents of an exchange file. This is a memory-
7	C economizer version so for 3-D and 4-D data files (eg. FFI=3010,4010)
8	C the contents of the primary variable data records are written to an
9	C unformatted scratch file which is rewound and can be read in this or
10	C a user-supplied routine.
11	C
12	C MS DOS Fortran users will have to break this code into smaller modules
13	C for compilation.
14	C
15	C Sections of code preceded by a string of plus signs (+++) and
16	C terminated by a string of minus signs (---) indicate locations where
17	C a user of this program must supply the indicated variable definitions.
18	C With the possible exception of the OPEN statements, this code is
19	C standard Fortran 77.
20	C
21	C This code is intended to be used with reference to the document
22	C written by S.Gaines and S.Hipskind entitled "Format Specification
23	C for Data Exchange". Most of the variables used in this code
24	C correspond in name and function to those defined in the referenced
25	C document.
26	C
27	C There are three types of error diagnostics written to unit IOU.
28	C The severity of the error is indicated by the number of asterisks
29	C preceding the diagnostic.
30	C
31	C One asterisk (*) indicates a suggestion for improving the file
32	C format and the associated "error" will not cause this program to
33	C reject the file format.
34	C
35	C Two asterisks (**) indicate a violation of the format standards but
36	C the associated error is not fatal, so this program will continue
37	C after encountering an error of this type.
38	C
39	C Three asterisks (***) indicate a fatal error for this program and
40	C a violation of the format standards (subsequent error diagnostics
41	C may be meaningless). This type of error can indicate that
42	C parameter values defined in the PARAMETER statements must be
43	C redefined.
44	C
45	C NOTE: There is one aspect of the file format that may not be checked
46	C by this routine. That is a ^Z (control-Z, ASCII decimal value
47	C 26) as the only character in a line. Fortran on some operating
48	C systems (VMS for example) interprets such an occurence of ^Z as
49	C an EOF (end-of-file mark) so if one is encountered then this
50	C program thinks its at the end of the data file and will not
51	C read beyond it.
52	C
53	C In that case, an external process (DCL command file, etc.) may
54	C have to be used to check the file for occurrences of ^Z and
55	C write the results of the search to a file defined by the
56	C character string FCTLZ. This program reads that file (unit
57	C IZU), if CHCKNP=.TRUE., and notes the line numbers of lines
58	C containing one or more ^Zs in the output file (IOU).
59	C
60	C If FCTLZ does not exist, then this program does not try
61	C to read unit IZU.
62	C
63	C
64	C BUGS
65	C
66	C Note added 91-10-22: These bugs only apply if PARSIT = .FALSE.
67	C
68	C General:
69	C This code reads numeric data values with "free format" read
70	C statements and assumes that successive numeric values are
71	C delimited by one or more spaces. Most versions of Fortran also
72	C permit a comma to be used as a delimiter and some versions may
73	C allow other characters as delimiters. If these delimiter
74	C characters (other than spaces) appear in a numeric data record,
75	C they will not produce a read error, and may go undetected unless
76	C their presence produces a noticable error in the values of the
77	C independent variables.
78	C
79	C The "free format" Fortran reads may also allow data record format
80	C errors to go undetected if DX for the independent variable mark is
81	C zero (nonuniform increment).
82	C
83	C FFI 1001:
84	C If DX(1)=0 and one or more primary variable values are omitted
85	C from one or more data records, then no format errors will be
86	C detected. This is an unavoidable bug resulting from the fact
87	C that the independent and primary variables are read as one
88	C logical record with no constraints on the number of lines
89	C occupied by the record.
90	C
91	C
92	C History:
93	C 06-07-18 (JDW)
94	C Removed checking for improper mission name
95	C 06-06-28 (JDW)
96	C Increased MAXA to 65.
97	C Increased MAXCA to 25.
98	C 06-06-22 (JDW)
99	C Increased MAXAC from 10 to 15
100	C
101	C 96-02-29 (JDW)
102	C Increased MAXA from 30 to 40.
103	C
104	C 96-02-29 (JDW)
105	C Modified RHEAD to skip over database header if DBHEAD = .TRUE.
106	C Modified DATAEX to set DBHEAD
107	C
108	C 95-03-06 (SEG)
109	C Increased MAXX1 from 1000 to 5000.
110	C
111	C 94-08-03 (SEG)
112	C Modified TMON3 to test each value of X each call.
113	C
114	C 94-01-03 (SEG)
115	C Increased MAXV to 70.
116	C
117	C 92-11-02 (SEG)
118	C Increased MAXX1 from 300 to 1000.
119	C
120	C 92-06-09 (SEG)
121	C Increased MAXV to 50.
122	C
123	C 92-02-11 (SEG)
124	C Modified PARFLT to check for blank space separators between
125	C numeric values.
126	C
127	C 92-01-18 (SEG)
128	C Modified CKNPC subroutine to properly check last line of the
129	C data file. The main concern was to flag the last line if it
130	C is not properly terminated.
131	C
132	C 91-12-17 (SEG)
133	C Modified file header reading routines to use PARHD and TIXN to
134	C read and test numeric values in place of RHINT, RHMISS, RHSCAL.
135	C This change was to ensure that blank lines preceding numeric
136	C values are flagged, and that commas used as field delimiters
137	C will be flagged.
138	C
139	C 91-10-25 (SEG)
140	C Added code in PD2160 to check lengths of character strings.
141	C
142	C 91-10-23 (SEG)
143	C Added PARSIT option to eliminate the bugs outlined above,
144	C and to flag the following conditions:
145	C Non-numeric characters in the data records;
146	C Excess number of values within a data record;
147	C Blank lines within the data records;
148	C Excessive padding of data records with spaces.
149	C Also added code to terminate file checking/reading if NDIAG > 50.
150	C Corrected bugs pointed out by J.Wild in RDATA, PRDATA, RD2310 to
151	C omit testing/printing of X1 if NX(1)=AMISS(1) or NX(1)=0.
152	C
153	C 91-10-09 (SEG)
154	C Modified RHBGIN to ensure that MNAME0 is the first non-blank
155	C character string in MNAME. Included FRSTNB to help with this
156	C task.
157	C
158	C 91-08-13 (SEG)
159	C Modified CKNPC to test last line for nonprintable characters in
160	C the event that an end-of-file designator appears before an
161	C end-of-line.
162	C
163	C 91-08-09 (SEG)
164	C Modified test at the end of this main program to only print a
165	C warning about nonconstant number of lines per independent
166	C variable mark when the format does not allow for a variable
167	C number for NX(1) in the auxiliary variable list.
168	C
169	C 91-07-03 (SEG)
170	C Modified CKNPC to return NLINES, and added code near the end of
171	C this routine to print the number of lines per independent
172	C variable mark.
173	C
174	C 91-06-28 (SEG)
175	C Modified RDATA, TRIVM, and TSTDX to be more lenient with the
176	C definition of constant data intervals (DX(s) not 0). TSTDX
177	C was also changed to be able to test more than one value of DX
178	C per call.
179	C
180	C Modified CH2FLT so that lower case `e' in exponential notation
181	C is not flagged as an error.
182	C
183	C
184	C S.E.Gaines, April 1991.
185	C=========================
186	C
187	C
188	PARAMETER ( MAXA = 70 )
189	PARAMETER ( MAXCA = 25 )
190	PARAMETER ( MAXCOM = 100 )
191	PARAMETER ( MAXCPL = 132 )
192	PARAMETER ( MAXIV = 4 )
193	PARAMETER ( MAXV = 70 )
194	PARAMETER ( MAXX1 =5000 )
195	PARAMETER ( MAXX2 = 200 )
196	PARAMETER ( MAXX3 = 30 )
197	PARAMETER ( MXCFLG = 2 )
198	C
199	LOGICAL CHCKNP, EXISTS, PARSIT, PRNTIT, RETDAT, DBHEAD
200	C
201	CHARACTER*(MAXCPL) ANAME( MAXA )
202	CHARACTER*(MAXCPL) CA( MAXCA )
203	CHARACTER*(MAXCPL) CAMISS( MAXCA )
204	CHARACTER*255 CDUM
205	CHARACTER*1 CFLG( MXCFLG )
206	CHARACTER*6 CRFMT
207	CHARACTER*6 CWFMT
208	CHARACTER*(MAXCPL) CX2
209	CHARACTER*(MAXCPL) FCTLZ
210	CHARACTER*(MAXCPL) FILSPC
211	CHARACTER*(MAXCPL) MNAME
212	CHARACTER*(MAXCPL) MNAME0
213	CHARACTER*(MAXCPL) NCOM( MAXCOM )
214	CHARACTER*(MAXCPL) ONAME
215	CHARACTER*(MAXCPL) ORG
216	CHARACTER*(MAXCPL) SCOM( MAXCOM )
217	CHARACTER*(MAXCPL) SNAME
218	CHARACTER*(MAXCPL) VNAME( MAXV )
219	CHARACTER*(MAXCPL) XNAME( MAXIV )
220	C
221	DIMENSION A( MAXA ), AMISS( MAXA ), ASCAL( MAXA )
222	DIMENSION DX( MAXIV ), DUM( MAXX1 )
223	DIMENSION KFLG( MXCFLG )
224	DIMENSION LENA( MAXCA ), LENX( MAXIV )
225	DIMENSION NX( MAXIV ), NXDEF( MAXIV )
226	DIMENSION V( MAXX1,MAXV ), VMISS( MAXV ), VSCAL( MAXV )
227	DIMENSION X1( MAXX1 ), X2( MAXX2 ), X3( MAXX3 )
228	C
229	C Define logical unit numbers.
230	C IUN = data file.
231	C IIU = input file.
232	C IOU = output file containing diagnostics.
233	C ISU = scratch file for writing and reading 3-D and 4-D data.
234	C IZU = file whose name is defined by FCTLZ and contains the results
235	C of the search for ^Zs.
236	C
237	DATA IUN / 21 /
238	DATA IIU / 5 /
239	DATA IOU / 6 /
240	DATA ISU / 77 /
241	DATA IZU / 88 /
242	C
243	C Define default values for logical variables.
244	C CHCKNP = .TRUE. = check data file for non-printable characters
245	C before reading the data values.
246	C EXISTS = .TRUE. = file FCTLZ exists and there are ^Zs in the
247	C the data file.
248	C PARSIT = .TRUE. = numeric data records are `parsed' and checked for
249	C extra numeric values.
250	C = .FALSE. = numeric data records are read with `free format'
251	C READ statements.
252	C PRNTIT = .TRUE. = print contents of data file.
253	C RETDAT = .TRUE. = 3-D and 4-D primary variable values are written to
254	C the unformatted scratch file in the same order as they were
255	C read from the data file. The scratch file is rewound and
256	C properly positioned for reading the values after calling
257	C subroutine RDATA.
258	C DBHEAD = .TRUE. = the datafile contains a UARS header that must be skipped
259	C over.
260	C
261	C
262	DATA CHCKNP / .TRUE. /
263	DATA EXISTS / .FALSE. /
264	DATA PARSIT / .TRUE. /
265	DATA PRNTIT / .FALSE. /
266	DATA RETDAT / .FALSE. /
267	DATA DBHEAD / .TRUE. /
268	C
269	C
270	C Define format for reading character data.
271	C
272	WRITE( CRFMT,FMT='(2H(A,I3,1H))' ) MAXCPL
273	C
274	C Define ASCII characters to flag and count in routine CKNPC.
275	C
276	NFLG = 1
277	CFLG(1) = CHAR( 9 )
278	C
279	C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
280	C Define/open input, output and scratch files (IIU, IOU, ISU).
281	C
282	C+UNIX
283	C In this case the input and output files are defined on the
284	C command line which executes this program.
285	C
286	c OPEN( IIU, STATUS='OLD' )
287	c OPEN( IOU, STATUS='NEW' )
288	OPEN( ISU, STATUS='SCRATCH',FORM='UNFORMATTED' )
289	C-UNIX
290	C+VMS
291	C In this case the input and output files are defined as
292	C DEXDIR:DATAEX.IN and DEXDIR:DATAEX.OUT, where DEXDIR is the logical
293	C name for the directory containing the files DATAEX.IN and DATAEX.OUT.
294	C
295	C OPEN( IIU, FILE='DEXDIR:DATAEX.IN', STATUS='OLD' )
296	C OPEN( IOU, FILE='DEXDIR:DATAEX.OUT',STATUS='NEW',
297	C * CARRIAGECONTROL='LIST' )
298	C OPEN( ISU, STATUS='SCRATCH',FORM='UNFORMATTED' )
299	C-VMS
300	C
301	C Re-define the program control variables if necessary.
302	C MNAME0 is the standard mission name.
303	C FCTLZ is the name of the file containing the results of the
304	C search for ^Zs by some external process.
305	C
306	C In this case they are read from the input file.
307	C
308	READ( IIU,FMT='(L1)' ) CHCKNP
309	READ( IIU,FMT='(L1)' ) PARSIT
310	READ( IIU,FMT='(L1)' ) RETDAT
311	READ( IIU,FMT='(L1)' ) PRNTIT
312	READ( IIU,FMT='(L1)' ) DBHEAD
313	READ( IIU,FMT=CRFMT ) MNAME0
314	READ( IIU,FMT=CRFMT ) FCTLZ
315	IF( PRNTIT ) RETDAT = .TRUE.
316	C-----------------------------------------------------------------------
317	C
318	C Print values of the program control variables.
319	C
320	WRITE(IOU,*) 'Program control variables:'
321	WRITE(IOU,FMT='(9H CHCKNP=,L1)') CHCKNP
322	WRITE(IOU,FMT='(9H PARSIT=,L1)') PARSIT
323	WRITE(IOU,FMT='(9H PRNTIT=,L1)') PRNTIT
324	WRITE(IOU,FMT='(9H RETDAT=,L1)') RETDAT
325	WRITE(IOU,FMT='(9H DBHEAD=,L1)') DBHEAD
326	C
327	CDUM = ' '//MNAME0
328	CALL LASTNB ( CDUM, LEN(CDUM), LNB )
329	CALL CHFMT ( LNB, CWFMT )
330	WRITE(IOU,*) ' MNAME0:'
331	WRITE(IOU,FMT=CWFMT) CDUM
332	C
333	CDUM = ' CRFMT='//CRFMT
334	CALL LASTNB ( CDUM, LEN(CDUM), LNB )
335	CALL CHFMT ( LNB, CWFMT )
336	WRITE(IOU,FMT=CWFMT) CDUM
337	C
338	WRITE(IOU,*) ' ASCII decimal values of nonprintable characters',
339	* ' to be flagged and counted:'
340	WRITE(IOU,FMT='(20I4)') ( ICHAR(CFLG(I)), I=1,NFLG )
341	C
342	C Open IZU if file FCTLZ exits.
343	C
344	CALL LASTNB ( FCTLZ, LEN(FCTLZ), NCFZ )
345	INQUIRE( FILE=FCTLZ(1:NCFZ),EXIST=EXISTS )
346	IF( EXISTS ) THEN
347	OPEN( IZU,FILE=FCTLZ(1:NCFZ),STATUS='OLD' )
348	ENDIF
349	C
350	C Loop on data files.
351	C
352	NFILES = 0
353	100 CONTINUE
354	NDIAG = 0
355	C
356	C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
357	C Define/open the data file (IUN). FILSPC contains the complete
358	C file specification (path name) of the data file.
359	C
360	C In this case FILSPC is read from the input file.
361	C
362	READ( IIU,FMT=CRFMT,END=300 ) FILSPC
363	PRINT *, FILSPC
364	CALL LASTNB ( FILSPC, LEN(FILSPC), NCFS )
365	WRITE( IOU,* ) ' '
366	WRITE( IOU,* ) 'Reading file '//FILSPC(1:NCFS)
367	C+UNIX
368	OPEN( IUN,FILE=FILSPC(1:NCFS),STATUS='OLD' )
369	C-UNIX
370	C+VMS
371	C OPEN( IUN,FILE=FILSPC(1:NCFS),STATUS='OLD',READONLY )
372	C-VMS
373	C-----------------------------------------------------------------------
374	NFILES = NFILES + 1
375	C
376	C Check for non-printable characters.
377	C
378	NLINES = 0
379	IF( CHCKNP ) THEN
380	IF( EXISTS ) THEN
381	CALL FGCTLZ ( FILSPC, NCFS, CRFMT, CDUM, NDIAG,
382	* IZU, IOU )
383	ENDIF
384	IF (DBHEAD) READ (IUN,*)
385	CALL CKNPC ( CDUM, CFLG, KFLG, NFLG, MAXCPL,
386	* NLINES, NDIAG, IUN, IOU )
387	REWIND IUN
388	ENDIF
389	C
390	C Read file header.
391	C All relevant file header info is returned by subroutine RHEAD.
392	C
393	CALL RHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
394	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
395	* DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
396	* NV, NVPM, VSCAL, VMISS, VNAME,
397	* NAUXV, ASCAL, AMISS, ANAME,
398	* NAUXC, LENA, CAMISS,
399	* NSCOML, SCOM, NNCOML, NCOM,
400	* MAXX1, MAXX2, MAXX3,
401	* MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM,
402	* MNAME0, CRFMT, IUN, IOU, ISUBV, NDIAG, IERR,
403	* DBHEAD )
404	IF( IERR .NE. 0 ) GO TO 290
405	IF( PRNTIT ) THEN
406	CALL PRHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
407	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
408	* DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
409	* NV, NVPM, VSCAL, VMISS, VNAME,
410	* NAUXV, ASCAL, AMISS, ANAME,
411	* NAUXC, LENA, CAMISS,
412	* NSCOML, SCOM, NNCOML, NCOM, CWFMT, IOU )
413	ENDIF
414	C
415	C Loop on reading data records.
416	C One independent variable mark and all associated auxiliary,
417	C independent, and primary variable values are returned with
418	C each call to subroutine RDATA.
419	C For 3-D and 4-D primary variables (eg. FFI=3010 and 4010),
420	C the primary variable values are written to the unformatted
421	C scratch file in the same order as they were read from the
422	C data file, and can be read from the scratch file after
423	C calling subroutine RDATA.
424	C
425	LINE = NLHEAD
426	NCIDR = 0
427	NBIDR = 0
428	NIVM = 0
429	NVALS = 0
430	230 CONTINUE
431	IF( RETDAT .AND. IFFI .GT. 2999 ) REWIND ISU
432	CALL RDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
433	* A, AMISS, CA, CAMISS, LENA, NAUXV, NAUXC,
434	* V, VMISS, MAXX1, NV, NVPM,
435	* CDUM, DUM, LINE, NBIDR, NCIDR, NVALS,
436	* CRFMT, RETDAT, PARSIT,
437	* IUN, IOU, ISU, NIVM,
438	* ISUBV, NDIAG, IERR )
439	IF( IERR .NE. 0 ) GO TO 288
440	IF( RETDAT .AND. IFFI .GT. 2999 ) REWIND ISU
441	IF( PRNTIT ) THEN
442	CALL PRDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
443	* A, AMISS, CA, LENA, NAUXV, NAUXC,
444	* V, MAXX1, NV, NVPM, CWFMT, IOU, ISU,
445	* ISUBV )
446	IF( IFFI .GT. 2999 ) REWIND ISU
447	ENDIF
448	C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
449	C At this point, all data values associated with the current
450	C independent variable mark are available for user-defined
451	C routines. Values of 3-D and 4-D primary variables must be
452	C read from the scratch file (unit ISU).
453	C-----------------------------------------------------------------------
454	C
455	C Terminate reading/checking of the file if there are too
456	C many error diagnostics.
457	C
458	IF( NDIAG .GT. 50 ) THEN
459	WRITE( IOU,* ) ' !!!! TOO MANY ERRORS, I QUIT !!!!'
460	ELSE
461	GO TO 230
462	ENDIF
463	288 CONTINUE
464	IF( NIVM .LT. 1 ) THEN
465	WRITE(IOU,) ' *No complete data records were found'
466	NDIAG = NDIAG + 1
467	ENDIF
468	IF( NCIDR .GT. 5000 ) THEN
469	IPCB = INT( 100.0*FLOAT(NBIDR-NVALS)/FLOAT(NCIDR) )
470	IF( IPCB .GT. 25 ) THEN
471	WRITE( IOU,FMT='(3X,14H*ADMONITION-- ,I2,
472	* 49H% of the data records are extraneous blank spaces)' )
473	* IPCB
474	ENDIF
475	ENDIF
476	WRITE( IOU,* ) ' Number of lines in file header=', NLHEAD
477	WRITE( IOU,* ) ' Number of successfully read independent'
478	WRITE( IOU,* ) ' variable marks and associated data=', NIVM
479	290 CONTINUE
480	IF( NDIAG .GT. 0 ) THEN
481	WRITE( IOU,* ) ' Number of diagnostics=', NDIAG
482	WRITE( IOU,* )
483	* '**** File format is not acceptable ****'
484	WRITE( IOU,* )
485	* '**** Please make corrections and try again ****'
486	ELSE
487	IF( NLINES .GT. 0 ) THEN
488	NLDATA = NLINES - NLHEAD
489	NLPIVM = NLDATA / NIVM
490	FLPIVM = FLOAT( NLDATA ) / FLOAT( NIVM )
491	IF( NIVM*NLPIVM .NE. NLDATA .AND. IFFI .NE. 2110 .AND.
492	* IFFI .NE. 2160 .AND. IFFI .NE. 2310 ) THEN
493	WRITE( IOU,* )
494	* '?????? File format looks ok except that the ??????'
495	WRITE( IOU,* )
496	* '?????? number of lines of data per independent ??????'
497	WRITE( IOU,* )
498	* '?????? variable mark is not a constant ??????'
499	WRITE( IOU,* )
500	* ' Number of lines per independent variable mark=',FLPIVM
501	ELSE
502	WRITE( IOU,* )
503	* ' Number of lines per independent variable mark=',FLPIVM
504	WRITE( IOU,* )
505	* '$$$$$$ Looks good! Thanks for the file $$$$$$'
506	ENDIF
507	ELSE
508	WRITE( IOU,* )
509	* '$$$$$$ Looks good! Thanks for the file $$$$$$'
510	ENDIF
511	ENDIF
512	CLOSE( IUN )
513	GO TO 100
514	300 CONTINUE
515	WRITE( IOU,* ) ' '
516	WRITE( IOU,* ) ' Number of files read=', NFILES
517	C
518	C Delete IZU if it has been opened.
519	C
520	IF( EXISTS ) THEN
521	CLOSE(IZU,STATUS='DELETE')
522	ENDIF
523	END
524	SUBROUTINE CH2FLT ( C, I1, I2, N1, N2, VAL, IFLAG, NDIAG, IOU )
525	C
526	C Given a character string, C, and location limits to search (I1,I2),
527	C this routine looks for and extracts the first floating point number
528	C (VAL) it can find, including sign and decimal point.
529	C VAL starts with a number, + or - or decimal point, and ends with the
530	C first non-numeric character (other than +, -, ., or E).
531	C N1 and N2 are the location limits within which it found VAL.
532	C If IFLAG is returned as zero then no VAL was found.
533	C
534	C Required routines: CH2INT.
535	C
536	C History:
537	C 91-06-27 (SEG) Commented out the code to issue an error diagnostic
538	C if `e' is used in exponential notation.
539	C
540	C
541	CHARACTER() C
542	CHARACTER*8 IFMT
543	C
544	IFLAG = 0
545	NDEC = 0
546	NEXP = 0
547	NSIGN1= 0
548	NSIGN2= 0
549	C
550	C Locate first integer number (NS1, NE1).
551	C
552	CALL CH2INT ( C, I1, I2, NS1, NE1, IVAL1 )
553	IF( IVAL1 .LT. 0 ) GO TO 100
554	N1 = NS1
555	N2 = NE1
556	C
557	C Check for decimal before IVAL1.
558	C
559	IF( NS1 .GT. I1 ) THEN
560	IF( C(NS1-1:NS1-1) .EQ. '.' ) THEN
561	NDEC = NS1 - 1
562	N1 = NS1 - 1
563	ENDIF
564	ENDIF
565	C
566	C Check for sign before IVAL1.
567	C
568	IF( N1 .GT. I1 ) THEN
569	IF( C(N1-1:N1-1) .EQ. '-' .OR. C(N1-1:N1-1) .EQ. '+' ) THEN
570	NSIGN1 = N1 - 1
571	N1 = N1 - 1
572	ENDIF
573	ENDIF
574	C
575	C Check for a fractional number after IVAL1.
576	C
577	IF( NDEC .LT. 1 ) THEN
578	IF( N2 .LT. I2 ) THEN
579	IF( C(N2+1:N2+1) .EQ. '.' ) THEN
580	NDEC = N2 + 1
581	N2 = N2 + 1
582	C
583	C Check for fraction after the decimal point.
584	C
585	IF( N2 .LT. I2 ) THEN
586	IF( C(N2+1:N2+1) .GE. '0' .AND.
587	* C(N2+1:N2+1) .LE. '9' ) THEN
588
589	CALL CH2INT ( C, NDEC+1, I2, NS2, NE2, IVAL2 )
590	IF( IVAL2 .GE. 0 ) N2 = NE2
591	ENDIF
592	ENDIF
593	ENDIF
594	ENDIF
595	ENDIF
596	C
597	C Check for exponent.
598	C
599	IF( N2 .LT. I2 ) THEN
600	IF( C(N2+1:N2+1) .EQ. 'E' .OR. C(N2+1:N2+1) .EQ. 'e' ) THEN
601	C IF( C(N2+1:N2+1) .EQ. 'e' ) THEN
602	C WRITE( IOU,* )
603	C * ' **Non-standard exponential notation. Use E instead of e.'
604	C NDIAG = NDIAG + 1
605	C ENDIF
606	IF( C(N2+2:N2+2) .EQ. '+' .OR. C(N2+2:N2+2) .EQ. '-' ) THEN
607	IF( C(N2+3:N2+3) .GE. '0' .AND.
608	* C(N2+3:N2+3) .LE. '9' ) THEN
609	CALL CH2INT ( C, N2+3, I2, NS3, NE3, IVEXP )
610	NEXP = N2 + 1
611	NSIGN2 = N2 + 2
612	N2 = NE3
613	ELSE
614	NEXP = N2 + 1
615	NSIGN2 = N2 + 2
616	IVEXP = 0
617	N2 = N2 + 2
618	ENDIF
619	ELSE IF( C(N2+2:N2+2) .LT. '0' .OR.
620	* C(N2+2:N2+2) .GT. '9' ) THEN
621	NEXP = N2 + 1
622	IVEXP = 0
623	N2 = N2 + 1
624	ELSE
625	CALL CH2INT ( C, N2+2, I2, NS3, NE3, IVEXP )
626	NEXP = N2 + 1
627	N2 = NE3
628	ENDIF
629	ENDIF
630	ENDIF
631	C
632	C Setup format for decoding the number, and decode it.
633	C
634	NTOT = N2 - N1 + 1
635	IF( NEXP .GT. 0 .AND. NDEC .GT. 0 ) THEN
636	ND = NEXP - NDEC - 1
637	ELSE IF( NEXP .GT. 0 ) THEN
638	ND = 0
639	ELSE IF( NDEC .GT. 0 ) THEN
640	ND = N2 - NDEC
641	ELSE
642	ND = 0
643	ENDIF
644	WRITE(IFMT,FMT='(2H(F,I2,1H.,I2,1H))') NTOT, ND
645	READ (C(N1:N2),FMT=IFMT) VAL
646	IFLAG = 1
647	100 CONTINUE
648	RETURN
649	END
650	SUBROUTINE CH2INT ( C, I1, I2, N1, N2, IVAL )
651	C
652	C Given a character string, C, and location limits to search (I1,I2),
653	C this routine looks for and extracts the first positive integer
654	C number (IVAL) it can find. The integer number starts with the first
655	C numeric character encountered within the search limits, and ends
656	C with the first non-numeric character encountered after a number.
657	C N1 and N2 are the location limits within which it found the integer
658	C number.
659	C IVAL is returned as a negative number if no integer value can be
660	C found. Otherwise it contains the positive integer value.
661	C
662	CHARACTER() C
663	CHARACTER*5 IFMT
664	C
665	IVAL = -1
666	C
667	C Locate position of first numeric character.
668	C
669	DO 20 I=I1,I2
670	IF( C(I:I) .GE. '0' .AND. C(I:I) .LE. '9' ) THEN
671	N1 = I
672	GO TO 22
673	ENDIF
674	20 CONTINUE
675	GO TO 50
676	22 CONTINUE
677	C
678	C Locate first non-numeric character.
679	C
680	IF( N1 .EQ. I2 ) THEN
681	N2 = N1
682	GO TO 32
683	ELSE
684	DO 30 I=N1+1,I2
685	IF( C(I:I) .LT. '0' .OR. C(I:I) .GT. '9' ) THEN
686	N2 = I - 1
687	GO TO 32
688	ENDIF
689	30 CONTINUE
690	N2 = I2
691	ENDIF
692	32 CONTINUE
693	C
694	C Setup format for decoding the number, and decode it.
695	C
696	WRITE(IFMT,FMT='(2H(I,I2,1H))') N2-N1+1
697	READ (C(N1:N2),FMT=IFMT) IVAL
698	50 CONTINUE
699	RETURN
700	END
701	SUBROUTINE CHFMT ( NCHAR, CWFMT )
702	C
703	C Given NCHAR, the number of characters to be written, this
704	C routine defines a character variable CWFMT containing the required
705	C format for writing the character string as a left-justified string
706	C of the proper length.
707	C It is assumed that CWFMT is at least a CHARACTER*6 variable.
708	C
709	CHARACTER() CWFMT
710	C
711	IF( NCHAR .LE. 0 ) THEN
712	CWFMT = '(A1)'
713	ELSE
714	WRITE(CWFMT,FMT='(2H(A,I3,1H))') NCHAR
715	ENDIF
716	RETURN
717	END
718	SUBROUTINE CKMISV ( V, VMISS, NV, X,
719	* VFLG, NVF, IVFLG, NIF, SFLG, NSF,
720	* NDIAG, IOU )
721	C
722	C Subroutine to test NV values of V(N) against their appropriate
723	C missing values.
724	C
725	CHARACTER() IVFLG
726	CHARACTER() SFLG
727	CHARACTER() VFLG
728	C
729	DIMENSION V( * ), VMISS( * )
730	C
731	IF( NV .LT. 1 ) RETURN
732	DO 30 N=1,NV
733	IF( V(N) .GT. VMISS(N) ) THEN
734	WRITE( IOU,* )
735	* ' **Error in CKMISV when called by ',SFLG(1:NSF)
736	WRITE( IOU,* )
737	* ' ',VFLG(1:NVF),' .GT. its missing value for index ',N
738	WRITE( IOU,* ) ' ',VFLG(1:NVF),'= ', V(N)
739	WRITE( IOU,* ) ' at ',IVFLG(1:NIF),'= ', X
740	NDIAG = NDIAG + 1
741	ENDIF
742	30 CONTINUE
743	RETURN
744	END
745	SUBROUTINE CKMSXV ( V, IDIM, VMISS, NV, X, NX,
746	* VFLG, NVF, IVFLG, NIF, SFLG, NSF,
747	* NDIAG, IOU )
748	C
749	C Subroutine to test values of V(I,N) against their appropriate
750	C missing values.
751	C
752	CHARACTER() IVFLG
753	CHARACTER() SFLG
754	CHARACTER() VFLG
755	C
756	DIMENSION V( IDIM,* ), VMISS( * )
757	C
758	IF( NX .LT. 1 ) RETURN
759	DO 50 N=1,NV
760	BIG = -9.9E+20
761	DO 30 I=1,NX
762	BIG = AMAX1( V(I,N), BIG )
763	30 CONTINUE
764	IF( BIG .GT. VMISS(N) ) THEN
765	WRITE( IOU,* )
766	* ' **Error in CKMSXV when called by ',SFLG(1:NSF)
767	WRITE( IOU,* )
768	* ' ',VFLG(1:NVF),' .GT. its missing value for index ',N
769	WRITE( IOU,* ) ' ',VFLG(1:NVF),'= ', BIG
770	WRITE( IOU,* ) ' at ',IVFLG(1:NIF),'= ', X
771	NDIAG = NDIAG + 1
772	ENDIF
773	50 CONTINUE
774	RETURN
775	END
776	SUBROUTINE CKNPC ( CDUM, CFLG, KFLG, NFLG, MAXLEN,
777	* IREC, NDIAG, IUN, IOU )
778	C
779	C Subroutine to check ASCII files for non-printable characters and
780	C long records.
781	C Record lengths greater than MAXLEN are flagged.
782	C Characters with ASCII decimal values .LT. CMIN and .GT. CMAX
783	C are flagged.
784	C The contents of CFLG(I) denote characters outside the limits of
785	C CMIN and CMAX which are counted with the number of finds stored
786	C in KFLG(I). This option is for unwanted characters which are likely
787	C to occur often.
788	C
789	C Required routines: LASTNB.
790	C
791	C History:
792	C 92-01-18 (SEG) Modified to initialize CDUM=' ' before reading
793	C a record, so that last line of file is
794	C properly checked.
795	C 91-08-13 (SEG) Modified to check last record.
796	C 91-07-03 (SEG) Modified to return IREC.
797	C
798	C
799	CHARACTER() CFLG( * )
800	CHARACTER() CDUM
801	CHARACTER*1 CMAX
802	CHARACTER*1 CMIN
803	CHARACTER*6 CRFMT
804	C
805	DIMENSION KFLG( * )
806	C
807	DATA CMAX / '~' /
808	DATA CMIN / ' ' /
809	C
810	IREC = 0
811	DO 18 I=1,NFLG
812	KFLG(I) = 0
813	18 CONTINUE
814	LCD = LEN( CDUM )
815	WRITE( CRFMT,FMT='(2H(A,I3,1H))' ) LCD
816	20 CONTINUE
817	CDUM = ' '
818	READ( IUN,FMT=CRFMT,END=200 ) CDUM
819	CALL LASTNB ( CDUM, LCD, N )
820	IREC = IREC + 1
821	IF( N .GT. MAXLEN ) THEN
822	WRITE( IOU,* )
823	* ' **Line too long--line #, length=', IREC, N
824	NDIAG = NDIAG + 1
825	ENDIF
826	DO 40 I=1,N
827	IF( CDUM(I:I) .LT. CMIN .OR. CDUM(I:I) .GT. CMAX ) THEN
828	IF( NFLG .GT. 0 ) THEN
829	DO 26 J=1,NFLG
830	IF( CDUM(I:I) .EQ. CFLG(J) ) THEN
831	KFLG(J) = KFLG(J) + 1
832	GO TO 40
833	ENDIF
834	26 CONTINUE
835	ENDIF
836	WRITE( IOU,* )
837	* ' **Found non-printable character with ASCII decimal value=',
838	* ICHAR(CDUM(I:I))
839	WRITE( IOU,* ) ' at line number=', IREC
840	NDIAG = NDIAG + 1
841	ENDIF
842	40 CONTINUE
843	GO TO 20
844	200 CONTINUE
845	C
846	C Check last line in the event that end-of-file characters are tacked
847	C on to the end of the line without a proper end-of-line designator.
848	C
849	CALL LASTNB ( CDUM, LCD, N )
850	IF( N .GT. 0 ) THEN
851	IF( N .GT. MAXLEN ) THEN
852	WRITE( IOU,* )
853	* ' **Last line too long--length=', N
854	NDIAG = NDIAG + 1
855	ENDIF
856	DO 240 I=1,N
857	IF( CDUM(I:I) .LT. CMIN .OR. CDUM(I:I) .GT. CMAX ) THEN
858	IF( NFLG .GT. 0 ) THEN
859	DO 226 J=1,NFLG
860	IF( CDUM(I:I) .EQ. CFLG(J) ) THEN
861	KFLG(J) = KFLG(J) + 1
862	GO TO 240
863	ENDIF
864	226 CONTINUE
865	ENDIF
866	WRITE( IOU,* )
867	* ' **Found non-printable character with ASCII decimal value=',
868	* ICHAR(CDUM(I:I))
869	WRITE( IOU,* ) ' in last line of file.'
870	NDIAG = NDIAG + 1
871	ENDIF
872	240 CONTINUE
873	C
874	C Flag last line if N>0. There should only be an EOF.
875	C
876	WRITE(IOU,) ' *Last line improperly terminated'
877	NDIAG = NDIAG + 1
878	ENDIF
879	C
880	C Print summary of flagged characters.
881	C
882	IF( NFLG .GT. 0 ) THEN
883	DO 250 I=1,NFLG
884	IF( KFLG(I) .GT. 0 ) THEN
885	WRITE( IOU,* )
886	* ' **Found non-printable character with ASCII decimal value=',
887	* ICHAR(CFLG(I))
888	WRITE(IOU,*) ' Number of occurrences=', KFLG(I)
889	NDIAG = NDIAG + 1
890	ENDIF
891	250 CONTINUE
892	ENDIF
893	WRITE( IOU,* ) ' Number of lines read by CKNPC= ', IREC
894	RETURN
895	END
896	SUBROUTINE CNTBLA ( C, I1, I2, NBLANK )
897	C
898	C Given a character string, C, and location limits to search (I1,I2),
899	C this routine counts the number of blank spaces within the search
900	C limits.
901	C
902	CHARACTER() C
903	C
904	NBLANK = 0
905	DO 30 I=I1,I2
906	IF( C(I:I) .EQ. ' ' ) NBLANK = NBLANK + 1
907	30 CONTINUE
908	RETURN
909	END
910	SUBROUTINE CNTNN ( C, I1, I2, NNN )
911	C
912	C Given a character string, C, and location limits to search (I1,I2),
913	C this routine counts the number of non-numeric printable characters
914	C within the search limits.
915	C Numeric characters are 0 1 2 3 4 5 6 7 8 9 . + - e E (and space).
916	C
917	CHARACTER() C
918	C
919	NNN = 0
920	DO 30 I=I1,I2
921	IF( C(I:I) .GT. ' ' .AND. C(I:I) .LT. '0' ) THEN
922	IF( C(I:I) .EQ. '+' .OR.
923	* C(I:I) .EQ. '-' .OR. C(I:I) .EQ. '.' ) GO TO 30
924	NNN = NNN + 1
925	ELSE IF( C(I:I) .GT. '9' .AND. C(I:I) .LE. '~' ) THEN
926	IF( C(I:I) .EQ. 'E' .OR. C(I:I) .EQ. 'e' ) GO TO 30
927	NNN = NNN + 1
928	ENDIF
929	30 CONTINUE
930	RETURN
931	END
932	SUBROUTINE FGCTLZ ( FILSPC, NCFS, CRFMT, CDUM, NDIAG, IZU, IOU )
933	C
934	C Subroutine to scan file in unit IZU for occurrences of ^Z and
935	C note them in the output file.
936	C
937	C Required routines: LASTNB.
938	C
939	CHARACTER*10 CD2
940	CHARACTER() CDUM
941	CHARACTER() CRFMT
942	CHARACTER() FILSPC
943	C
944	REWIND IZU
945	20 CONTINUE
946	READ( IZU,FMT=CRFMT,END=200 ) CDUM
947	L = INDEX( CDUM, FILSPC(1:NCFS) )
948	IF( L .NE. 1 ) GOTO 20
949	CALL LASTNB ( CDUM, LEN(CDUM), LNB )
950	WRITE(CD2,FMT='(1H(,I3,3HX,I,I2,1H))') NCFS+1, LNB-NCFS-1
951	READ( CDUM,FMT=CD2 ) LINO
952	WRITE( IOU,* ) ' **Found ^Z in line number ', LINO
953	NDIAG = NDIAG + 1
954	GOTO 20
955	200 CONTINUE
956	RETURN
957	END
958	SUBROUTINE FNDFLT ( C, X, NX, MAXX, NDIAG, IOU )
959	C
960	C Subroutine to find all floating point numbers in a character string.
961	C
962	C Required routines: CH2FLT, LASTNB.
963	C
964	CHARACTER() C
965	C
966	DIMENSION X( * )
967	C
968	NX = 0
969	CALL LASTNB ( C, LEN(C), LNB )
970	I1 = 1
971	DO 100 I=1,MIN0(LNB/2+1,MAXX)
972	CALL CH2FLT ( C, I1, LNB, N1, N2, X(I), IFLAG, NDIAG, IOU )
973	IF( IFLAG .GT. 0 ) THEN
974	NX = NX + 1
975	I1 = N2 + 1
976	ELSE
977	GO TO 110
978	ENDIF
979	100 CONTINUE
980	110 CONTINUE
981	RETURN
982	END
983	SUBROUTINE FRSTNB ( C, N, NB1 )
984	C
985	C Subroutine to determine the location of the last non-blank character
986	C in the string C.
987	C This routine assumes the character string C is blank-filled, which
988	C is not the case for strings read with the VAX Q-format--they are
989	C null-filled.
990	C
991	CHARACTER() C
992	C
993	NB1 = 0
994	DO 20 I=1,N
995	IF( C(I:I) .NE. ' ' ) THEN
996	NB1 = I
997	GO TO 22
998	ENDIF
999	20 CONTINUE
1000	22 CONTINUE
1001	RETURN
1002	END
1003	SUBROUTINE L3CVAL ( X, LX, NVAL, CVAL )
1004	C
1005	C Subroutine to store the last three values of character variable X,
1006	C of length LX, in the array CVAL.
1007	C
1008	CHARACTER() CVAL( * )
1009	CHARACTER() X
1010	C
1011	IF( NVAL .GT. 3 ) THEN
1012	CVAL(1) = CVAL(2)(1:LX)
1013	CVAL(2) = CVAL(3)(1:LX)
1014	CVAL(3) = X(1:LX)
1015	ELSE
1016	CVAL(NVAL) = X(1:LX)
1017	ENDIF
1018	RETURN
1019	END
1020	SUBROUTINE L3RVAL ( X, NVAL, RVAL, X0 )
1021	C
1022	C Subroutine to store the last three values of real variable X
1023	C in the array RVAL.
1024	C
1025	DIMENSION RVAL( * )
1026	C
1027	IF( NVAL .GT. 3 ) THEN
1028	RVAL(1) = RVAL(2)
1029	RVAL(2) = RVAL(3)
1030	RVAL(3) = X
1031	ELSE
1032	RVAL(NVAL) = X
1033	X0 = RVAL(1)
1034	ENDIF
1035	RETURN
1036	END
1037	SUBROUTINE LASTNB ( C, N, LNB )
1038	C
1039	C Subroutine to determine the location of the last non-blank character
1040	C in the string C.
1041	C This routine assumes the character string C is blank-filled, which
1042	C is not the case for strings read with the VAX Q-format--they are
1043	C null-filled.
1044	C
1045	CHARACTER() C
1046	C
1047	LNB = 0
1048	DO 20 I=N,1,-1
1049	IF( C(I:I) .NE. ' ' ) THEN
1050	LNB = I
1051	GO TO 22
1052	ENDIF
1053	20 CONTINUE
1054	22 CONTINUE
1055	RETURN
1056	END
1057	SUBROUTINE PARDAT ( V, NWANT, NFIND, SUBFLG, NSF, VALFLG, NVF,
1058	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1059	* CRFMT, IUN, IOU, NDIAG, IERR )
1060	C
1061	C Subroutine to read numeric values, flag non-numeric characters,
1062	C and flag lines with more data than expected.
1063	C This routine allows for records spanning more than one line.
1064	C
1065	C Required routines: PARFLT.
1066	C
1067	CHARACTER() CDUM
1068	CHARACTER() CRFMT
1069	CHARACTER() SUBFLG
1070	CHARACTER() VALFLG
1071	C
1072	DIMENSION V( * )
1073	C
1074	NREAD = 0
1075	NFIND = 0
1076	I1 = 1
1077	DO 40 K=1,NWANT
1078	READ ( IUN,FMT=CRFMT,IOSTAT=IERR ) CDUM
1079	IF( IERR .LT. 0 ) THEN
1080	IERR = -1
1081	RETURN
1082	ELSE IF( IERR .GT. 0 ) THEN
1083	WRITE( IOU,* ) ' ***PARDAT error reading line ', LINE+1
1084	WRITE(IOU,*) ' while reading ', VALFLG(1:NVF)
1085	WRITE( IOU,* ) ' PARDAT called by ',SUBFLG(1:NSF)
1086	WRITE( IOU,* ) ' IOSTAT=', IERR
1087	IERR = 1
1088	NDIAG = NDIAG + 1
1089	RETURN
1090	ENDIF
1091	LINE = LINE + 1
1092	NREAD = NREAD + 1
1093	CALL PARFLT ( CDUM, V(I1), NVAL, NWANT+5, LN, NCIDR, NBIDR,
1094	* NEXTRA, NDIAG, IOU )
1095	NFIND = NFIND + NVAL
1096	IF( NEXTRA .GT. 0 ) THEN
1097	WRITE(IOU,*)
1098	* ' **PARDAT found extraneous character in line ', LINE
1099	WRITE(IOU,*) ' Number of extraneous chars.= ', NEXTRA
1100	WRITE( IOU,* ) ' PARDAT called by ',SUBFLG(1:NSF)
1101	NDIAG = NDIAG + 1
1102	ENDIF
1103	IF( NFIND .EQ. NWANT ) THEN
1104	GOTO 42
1105	ELSE IF( NFIND .GT. NWANT ) THEN
1106	WRITE(IOU,*)
1107	* ' **PARDAT error--excess values in line ', LINE
1108	WRITE(IOU,*) ' while reading ', VALFLG(1:NVF)
1109	WRITE(IOU,*) ' PARDAT called by ',SUBFLG(1:NSF)
1110	NDIAG = NDIAG + 1
1111	GOTO 42
1112	ELSE IF( NVAL .LT. 1 ) THEN
1113	WRITE(IOU,) ' *PARDAT error--no numbers in line ',LINE
1114	WRITE(IOU,*) ' while reading ', VALFLG(1:NVF)
1115	WRITE(IOU,*) ' PARDAT called by ',SUBFLG(1:NSF)
1116	NDIAG = NDIAG + 1
1117	ENDIF
1118	I1 = NFIND + 1
1119	40 CONTINUE
1120	42 CONTINUE
1121	RETURN
1122	END
1123	SUBROUTINE PARFLT ( C, X, NX, MAXX, LN, NCIDR, NBIDR, NEXTRA,
1124	* NDIAG, IOU )
1125	C
1126	C Subroutine to find MAXX floating point numbers (integers included)
1127	C in a character string C(1:LN), and flag non-numeric characters in
1128	C the string.
1129	C This routine also keeps a running talley of the number of characters
1130	C (NCIDR) and the number of blanks (NBIDR) in C(1:LN).
1131	C
1132	C History:
1133	C 92-02-11 - Modified to check for blank space between numeric
1134	C values.
1135	C 91-12-17 - Modified to stop searching for numbers if NX=MAXX, and
1136	C to return the index of either the last numeric character
1137	C in the string (if NX=MAXX) or the last nonblank
1138	C character in the string (if NX<MAXX).
1139	C
1140	C
1141	C Required routines: CH2FLT, CHFMT, CNTBLA, LASTNB
1142	C
1143	CHARACTER() C
1144	CHARACTER*6 CWFMT
1145	C
1146	DIMENSION X( * )
1147	C
1148	NX = 0
1149	NC = 0
1150	NS = 0
1151	CALL LASTNB ( C, LEN(C), LNB )
1152	NCIDR = NCIDR + LNB
1153	I1 = 1
1154	I = 0
1155	30 CONTINUE
1156	I = I + 1
1157	CALL CH2FLT ( C, I1, LNB, N1, N2, X(I), IFLAG, NDIAG, IOU )
1158	IF( IFLAG .GT. 0 ) THEN
1159	NX = NX + 1
1160	IF( N1 .GT. 1 ) THEN
1161	IF( C(N1-1:N1-1) .NE. ' ' ) NS = NS + 1
1162	ENDIF
1163	I1 = N2 + 1
1164	NC = NC + N2 - N1 + 1
1165	LN = N2
1166	IF( NX .EQ. MAXX ) GOTO 110
1167	ELSE
1168	LN = LNB
1169	GO TO 110
1170	ENDIF
1171	IF( I1 .LT. LNB ) GOTO 30
1172	110 CONTINUE
1173	CALL CNTBLA ( C, 1, LN, NBLANK )
1174	NBIDR = NBIDR + NBLANK
1175	NEXTRA = LN - NC - NBLANK
1176	IF( NS .GT. 0 ) THEN
1177	WRITE(IOU,*)
1178	* ' **PARFLT error--The following line contains values with '
1179	WRITE(IOU,*) ' no space between them:'
1180	CALL CHFMT ( LNB, CWFMT )
1181	WRITE(IOU,FMT=CWFMT) C(1:LNB)
1182	NDIAG = NDIAG + 1
1183	ENDIF
1184	RETURN
1185	END
1186	SUBROUTINE PARHD ( V, NWANT, NFIND, SUBFLG, NSF, VALFLG, NVF,
1187	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1188	* CRFMT, IUN, IOU, NDIAG, IERR )
1189	C
1190	C Subroutine to read numeric values from file header records and
1191	C flag non-numeric characters within the fields where they should
1192	C not be.
1193	C This routine is essentially the same as PARDAT except that it
1194	C forces PARFLT to stop reading after it finds NWANT characters.
1195	C This behavior is to allow for the possibility of comments in the
1196	C file header records.
1197	C This routine allows for records spanning more than one line.
1198	C
1199	C Required routines: PARFLT.
1200	C
1201	CHARACTER() CDUM
1202	CHARACTER() CRFMT
1203	CHARACTER() SUBFLG
1204	CHARACTER() VALFLG
1205	C
1206	DIMENSION V( * )
1207	C
1208	NREAD = 0
1209	NFIND = 0
1210	I1 = 1
1211	DO 40 K=1,NWANT
1212	READ ( IUN,FMT=CRFMT,IOSTAT=IERR ) CDUM
1213	IF( IERR .LT. 0 ) THEN
1214	IERR = -1
1215	RETURN
1216	ELSE IF( IERR .GT. 0 ) THEN
1217	WRITE( IOU,* ) ' ***PARHD error reading line ', LINE+1
1218	WRITE(IOU,*) ' while reading ', VALFLG(1:NVF)
1219	WRITE( IOU,* ) ' PARHD called by ',SUBFLG(1:NSF)
1220	WRITE( IOU,* ) ' IOSTAT=', IERR
1221	IERR = 1
1222	NDIAG = NDIAG + 1
1223	RETURN
1224	ENDIF
1225	LINE = LINE + 1
1226	NREAD = NREAD + 1
1227	CALL PARFLT ( CDUM, V(I1), NVAL, NWANT, LN, NCIDR, NBIDR,
1228	* NEXTRA, NDIAG, IOU )
1229	NFIND = NFIND + NVAL
1230	IF( NEXTRA .GT. 0 ) THEN
1231	WRITE(IOU,*)
1232	* ' **PARHD found extraneous character in line ', LINE
1233	WRITE(IOU,*) ' Number of extraneous chars.= ', NEXTRA
1234	WRITE( IOU,* ) ' PARHD called by ',SUBFLG(1:NSF)
1235	NDIAG = NDIAG + 1
1236	ENDIF
1237	IF( NFIND .EQ. NWANT ) THEN
1238	GOTO 42
1239	ELSE IF( NVAL .LT. 1 ) THEN
1240	WRITE(IOU,) ' *PARHD error--no numbers in line ',LINE
1241	WRITE(IOU,*) ' while reading ', VALFLG(1:NVF)
1242	WRITE(IOU,*) ' PARHD called by ',SUBFLG(1:NSF)
1243	NDIAG = NDIAG + 1
1244	ENDIF
1245	I1 = NFIND + 1
1246	40 CONTINUE
1247	IF( NFIND .LT. NWANT ) THEN
1248	WRITE(IOU,) ' **PARHD could not find all values of ',
1249	* VALFLG(1:NVF)
1250	WRITE(IOU,*) ' Started looking at line ',LINE-NREAD+1
1251	WRITE(IOU,*) ' Number of values to find= ', NWANT
1252	NDIAG = NDIAG + 1
1253	IERR = 2
1254	ENDIF
1255	42 CONTINUE
1256	RETURN
1257	END
1258	SUBROUTINE PD1001 ( X1, V, VMISS, NV, CDUM, DUM,
1259	* LINE, NCIDR, NBIDR, NVALS,
1260	* CRFMT, IUN, IOU, NDIAG, IERR )
1261	C
1262	C Subroutine to read a data record for FFI=1001.
1263	C This routine reads the expected number of values, checks for extra
1264	C values within the record, tests dependent variables against their
1265	C missing values, and counts the number of lines, number of characters,
1266	C and the number of blanks in the data records.
1267	C
1268	C IERR = 0 = successful read.
1269	C = -1 = EOF encountered.
1270	C = +1 = read error.
1271	C
1272	C Required routines: CKMISV, PARDAT.
1273	C
1274	C
1275	CHARACTER() CDUM
1276	CHARACTER() CRFMT
1277	C
1278	DIMENSION DUM( * ), V( * ), VMISS( * )
1279	C
1280	IERR = 0
1281	CALL PARDAT ( DUM, NV+1, NFIND, 'PD1001', 6, 'X1,V(N)', 7,
1282	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1283	* CRFMT, IUN, IOU, NDIAG, IERR )
1284	NVALS = NVALS + NFIND
1285	IF( IERR .LT. 0 ) THEN
1286	GOTO 100
1287	ELSE IF( IERR .GT. 0 ) THEN
1288	RETURN
1289	ELSE
1290	X1 = DUM(1)
1291	DO 30 N=1,NV
1292	V(N) = DUM(N+1)
1293	30 CONTINUE
1294	CALL CKMISV ( V, VMISS, NV, X1,
1295	* 'V(N)', 4, 'X1', 2, 'PD1001', 6, NDIAG, IOU )
1296	ENDIF
1297	RETURN
1298	C
1299	C Flag EOF.
1300	C
1301	100 CONTINUE
1302	IF( NFIND .GT. 0 .AND. NFIND .LT. NV+1 ) THEN
1303	WRITE( IOU,* ) ' ***PD1001 error--premature EOF in line',LINE+1
1304	WRITE( IOU,* ) ' while reading X1,V(N)'
1305	WRITE( IOU,* ) ' Last successfully read value of X1=', X1
1306	WRITE( IOU,* ) ' Number of values expected in record=',NV+1
1307	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1308	NDIAG = NDIAG + 1
1309	ENDIF
1310	RETURN
1311	END
1312	SUBROUTINE PD1010 ( X1, A, AMISS, NAUXV, V, VMISS, NV,
1313	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
1314	* IUN, IOU, NDIAG, IERR )
1315	C
1316	C Subroutine to read a data record group for FFI=1010.
1317	C This routine reads the expected number of values, checks for extra
1318	C values within the record, tests dependent variables against their
1319	C missing values, and counts the number of lines, number of characters,
1320	C and the number of blanks in the data records.
1321	C
1322	C IERR = 0 = successful read.
1323	C = -1 = EOF encountered.
1324	C = +1 = read error.
1325	C
1326	C Required routines: CKMISV, PARDAT.
1327	C
1328	C
1329	CHARACTER() CDUM
1330	CHARACTER() CRFMT
1331	C
1332	DIMENSION A( * ), AMISS( * ), DUM( * ), V( * ), VMISS( * )
1333	C
1334	IERR = 0
1335	C
1336	C Read a group of data records.
1337	C
1338	CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD1010', 6, 'X1,A(I)', 7,
1339	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1340	* CRFMT, IUN, IOU, NDIAG, IERR )
1341	NVALS = NVALS + NFIND
1342	IF( IERR .LT. 0 ) THEN
1343	GOTO 100
1344	ELSE IF( IERR .GT. 0 ) THEN
1345	RETURN
1346	ELSE
1347	X1 = DUM(1)
1348	IF( NAUXV .GT. 0 ) THEN
1349	DO 30 IA=1,NAUXV
1350	A(IA) = DUM(IA+1)
1351	30 CONTINUE
1352	CALL CKMISV ( A, AMISS, NAUXV, X1,
1353	* 'A(I)', 4, 'X1', 2, 'PD1010', 6, NDIAG, IOU )
1354	ENDIF
1355	ENDIF
1356	CALL PARDAT ( DUM, NV, NFIND, 'PD1010', 6, 'V(N)', 4,
1357	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1358	* CRFMT, IUN, IOU, NDIAG, IERR )
1359	NVALS = NVALS + NFIND
1360	IF( IERR .LT. 0 ) THEN
1361	GOTO 102
1362	ELSE IF( IERR .GT. 0 ) THEN
1363	RETURN
1364	ELSE
1365	DO 40 N=1,NV
1366	V(N) = DUM(N)
1367	40 CONTINUE
1368	CALL CKMISV ( V, VMISS, NV, X1,
1369	* 'V(N)', 4, 'X1', 2, 'PD1010', 6, NDIAG, IOU )
1370	ENDIF
1371	RETURN
1372	C
1373	C Flag EOF.
1374	C
1375	100 CONTINUE
1376	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
1377	WRITE( IOU,* ) ' ***PD1010 error--premature EOF in line',LINE+1
1378	WRITE( IOU,* ) ' while reading X1,A(I)'
1379	WRITE( IOU,* ) ' Last successfully read value of X1=', X1
1380	WRITE( IOU,* ) ' Number of values expected in record=',
1381	* NAUXV+1
1382	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1383	NDIAG = NDIAG + 1
1384	ENDIF
1385	RETURN
1386	102 CONTINUE
1387	WRITE( IOU,* ) ' ***PD1010 error--premature EOF in line',LINE+1
1388	WRITE( IOU,* ) ' while reading primary variables'
1389	WRITE( IOU,* ) ' Incomplete primary variable list at X1=',X1
1390	WRITE( IOU,* ) ' Number of values expected in record=', NV
1391	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1392	NDIAG = NDIAG + 1
1393	RETURN
1394	END
1395	SUBROUTINE PD1020 ( X1, DX, A, AMISS, NAUXV,
1396	* V, VMISS, MAXX1, NVPM, NV,
1397	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
1398	* IUN, IOU, NDIAG, IERR )
1399	C
1400	C Subroutine to read a data record group for FFI=1020.
1401	C This routine reads the expected number of values, checks for extra
1402	C values within the record, tests dependent variables against their
1403	C missing values, and counts the number of lines, number of characters,
1404	C and the number of blanks in the data records.
1405	C
1406	C IERR = 0 = successful read.
1407	C = -1 = EOF encountered.
1408	C = +1 = read error.
1409	C
1410	C Required routines: CKMISV, CKMSXV, PARDAT.
1411	C
1412	C
1413	CHARACTER() CDUM
1414	CHARACTER() CRFMT
1415	C
1416	DIMENSION A( * ), AMISS( * ), DUM( * )
1417	DIMENSION V( MAXX1,* ), VMISS( * ), X1( * )
1418	C
1419	IERR = 0
1420	C
1421	C Read a group of data records.
1422	C
1423	CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD1020', 6, 'X1,A(I)', 7,
1424	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1425	* CRFMT, IUN, IOU, NDIAG, IERR )
1426	NVALS = NVALS + NFIND
1427	IF( IERR .LT. 0 ) THEN
1428	GOTO 100
1429	ELSE IF( IERR .GT. 0 ) THEN
1430	RETURN
1431	ELSE
1432	X1(1) = DUM(1)
1433	IF( NAUXV .GT. 0 ) THEN
1434	DO 20 IA=1,NAUXV
1435	A(IA) = DUM(IA+1)
1436	20 CONTINUE
1437	CALL CKMISV ( A, AMISS, NAUXV, X1,
1438	* 'A(I)', 4, 'X1', 2, 'PD1020', 6, NDIAG, IOU )
1439	ENDIF
1440	ENDIF
1441	C
1442	DO 30 N=1,NV
1443	CALL PARDAT ( DUM, NVPM, NFIND, 'PD1020', 6, 'V(I,N)', 6,
1444	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1445	* CRFMT, IUN, IOU, NDIAG, IERR )
1446	NVALS = NVALS + NFIND
1447	IF( IERR .LT. 0 ) THEN
1448	GOTO 102
1449	ELSE IF( IERR .GT. 0 ) THEN
1450	RETURN
1451	ELSE
1452	DO 26 I=1,NVPM
1453	V(I,N) = DUM(I)
1454	26 CONTINUE
1455	ENDIF
1456	30 CONTINUE
1457	CALL CKMSXV ( V, MAXX1, VMISS, NV, X1, NVPM,
1458	* 'V(N)', 4, 'X1', 2, 'PD1020', 6, NDIAG, IOU )
1459	C
1460	C Define X1 values.
1461	C
1462	DO 40 I=2,NVPM
1463	X1(I) = X1(1) + DX * FLOAT( I-1 )
1464	40 CONTINUE
1465	RETURN
1466	C
1467	C Flag EOF.
1468	C
1469	100 CONTINUE
1470	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
1471	WRITE( IOU,* ) ' ***PD1020 error--premature EOF in line',LINE+1
1472	WRITE( IOU,* ) ' while reading X1,A(I)'
1473	WRITE( IOU,* ) ' Last successfully read value of X1=', X1(1)
1474	WRITE( IOU,* ) ' Number of values expected in record=',
1475	* NAUXV+1
1476	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1477	NDIAG = NDIAG + 1
1478	ENDIF
1479	RETURN
1480	102 CONTINUE
1481	WRITE( IOU,* ) ' ***PD1010 error--premature EOF while reading'
1482	WRITE( IOU,* ) ' values of primary variable V(I,N), N=',N
1483	WRITE( IOU,* ) ' at independent variable mark X1(1)=', X1(1)
1484	WRITE( IOU,* ) ' NV, NVPM=', NV, NVPM
1485	WRITE( IOU,* ) ' Number of values expected in record=',NVPM
1486	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1487	NDIAG = NDIAG + 1
1488	RETURN
1489	END
1490	SUBROUTINE PD2010 ( X2, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
1491	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
1492	* IUN, IOU, NDIAG, IERR )
1493	C
1494	C Subroutine to read a data record group for FFI=2010.
1495	C This routine reads the expected number of values, checks for extra
1496	C values within the record, tests dependent variables against their
1497	C missing values, and counts the number of lines, number of characters,
1498	C and the number of blanks in the data records.
1499	C
1500	C IERR = 0 = successful read.
1501	C = -1 = EOF encountered.
1502	C = +1 = read error.
1503	C
1504	C Required routines: CKMISV, CKMSXV, PARDAT.
1505	C
1506	C
1507	CHARACTER() CDUM
1508	CHARACTER() CRFMT
1509	C
1510	DIMENSION A( * ), AMISS( * ), DUM( * )
1511	DIMENSION V( MAXX1,* ), VMISS( * )
1512	C
1513	IERR = 0
1514	C
1515	C Read a group of data records.
1516	C
1517	CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD2010', 6, 'X2,A(I)', 7,
1518	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1519	* CRFMT, IUN, IOU, NDIAG, IERR )
1520	NVALS = NVALS + NFIND
1521	IF( IERR .LT. 0 ) THEN
1522	GOTO 100
1523	ELSE IF( IERR .GT. 0 ) THEN
1524	RETURN
1525	ELSE
1526	X2 = DUM(1)
1527	IF( NAUXV .GT. 0 ) THEN
1528	DO 20 IA=1,NAUXV
1529	A(IA) = DUM(IA+1)
1530	20 CONTINUE
1531	CALL CKMISV ( A, AMISS, NAUXV, X2,
1532	* 'A(I)', 4, 'X2', 2, 'PD2010', 6, NDIAG, IOU )
1533	ENDIF
1534	ENDIF
1535	C
1536	DO 30 N=1,NV
1537	CALL PARDAT ( DUM, NX, NFIND, 'PD2010', 6, 'V(I,N)', 6,
1538	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1539	* CRFMT, IUN, IOU, NDIAG, IERR )
1540	NVALS = NVALS + NFIND
1541	IF( IERR .LT. 0 ) THEN
1542	GOTO 102
1543	ELSE IF( IERR .GT. 0 ) THEN
1544	RETURN
1545	ELSE
1546	DO 26 I=1,NX
1547	V(I,N) = DUM(I)
1548	26 CONTINUE
1549	ENDIF
1550	30 CONTINUE
1551	C
1552	CALL CKMSXV ( V, MAXX1, VMISS, NV, X2, NX,
1553	* 'V(N)', 4, 'X2', 2, 'PD2010', 6, NDIAG, IOU )
1554	RETURN
1555	C
1556	C Flag EOF.
1557	C
1558	100 CONTINUE
1559	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
1560	WRITE( IOU,* ) ' ***PD2010 error--premature EOF in line',LINE+1
1561	WRITE( IOU,* ) ' while reading X2,A(I)'
1562	WRITE( IOU,* ) ' Last successfully read value of X2=', X2
1563	WRITE( IOU,* ) ' Number of values expected in record=',
1564	* NAUXV+1
1565	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1566	NDIAG = NDIAG + 1
1567	ENDIF
1568	RETURN
1569	102 CONTINUE
1570	WRITE( IOU,* ) ' ***PD2010 encountered EOF while reading values'
1571	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
1572	WRITE( IOU,* ) ' at independent variable mark X2=', X2
1573	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
1574	WRITE( IOU,* ) ' Number of values expected in record=', NX
1575	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1576	NDIAG = NDIAG + 1
1577	RETURN
1578	END
1579	SUBROUTINE PD2110 ( X1, X2, A, AMISS, NAUXV, V, VMISS, MAXX1,
1580	* NX, NV, CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
1581	* CRFMT, IUN, IOU, NDIAG, IERR )
1582	C
1583	C Subroutine to read a data record group for FFI=2110.
1584	C This routine reads the expected number of values, checks for extra
1585	C values within the record, tests dependent variables against their
1586	C missing values, and counts the number of lines, number of characters,
1587	C and the number of blanks in the data records.
1588	C
1589	C IERR = 0 = successful read.
1590	C = -1 = EOF encountered.
1591	C = +1 = read error.
1592	C = +2 = error in value of NX
1593	C
1594	C Required routines: CKMISV, CKMSXV, PARDAT.
1595	C
1596	C
1597	CHARACTER() CDUM
1598	CHARACTER() CRFMT
1599	C
1600	DIMENSION A( * ), AMISS( * ), DUM( * )
1601	DIMENSION V( MAXX1,* ), VMISS( * ), X1( * )
1602	C
1603	IERR = 0
1604	C
1605	C Read a group of data records.
1606	C
1607	CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD2110', 6, 'X2,A(I)', 7,
1608	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1609	* CRFMT, IUN, IOU, NDIAG, IERR )
1610	NVALS = NVALS + NFIND
1611	IF( IERR .LT. 0 ) THEN
1612	GOTO 100
1613	ELSE IF( IERR .GT. 0 ) THEN
1614	RETURN
1615	ELSE
1616	X2 = DUM(1)
1617	NX = INT( DUM(2) + 0.5 )
1618	IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
1619	WRITE( IOU,* ) ' ***PD2110 error--NX(1) too large'
1620	WRITE( IOU,* ) ' MAXX1,NX(1)=', MAXX1, NX
1621	IERR = 2
1622	NDIAG = NDIAG + 1
1623	RETURN
1624	ENDIF
1625	DO 20 IA=1,NAUXV
1626	A(IA) = DUM(IA+1)
1627	20 CONTINUE
1628	CALL CKMISV ( A, AMISS, NAUXV, X2,
1629	* 'A(I)', 4, 'X2', 2, 'PD2110', 6, NDIAG, IOU )
1630	ENDIF
1631	C
1632	IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
1633	DO 30 I=1,NX
1634	CALL PARDAT ( DUM, NV+1, NFIND, 'PD2110', 6,
1635	* 'X1(I),V(I,N)', 12,
1636	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1637	* CRFMT, IUN, IOU, NDIAG, IERR )
1638	NVALS = NVALS + NFIND
1639	IF( IERR .LT. 0 ) THEN
1640	GOTO 102
1641	ELSE IF( IERR .GT. 0 ) THEN
1642	RETURN
1643	ELSE
1644	X1(I) = DUM(1)
1645	DO 26 N=1,NV
1646	V(I,N) = DUM(N+1)
1647	26 CONTINUE
1648	ENDIF
1649	30 CONTINUE
1650	CALL CKMSXV ( V, MAXX1, VMISS, NV, X2, NX, 'X1(I),V(I,N)', 12,
1651	* 'X2', 2, 'PD2110', 6, NDIAG, IOU )
1652	ENDIF
1653	RETURN
1654	C
1655	C Flag EOF.
1656	C
1657	100 CONTINUE
1658	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
1659	WRITE( IOU,* ) ' ***PD2110 error--premature EOF in line',LINE+1
1660	WRITE( IOU,* ) ' while reading X2,A(I)'
1661	WRITE( IOU,* ) ' Last successfully read value of X2=', X2
1662	WRITE( IOU,* ) ' Number of values expected in record=',
1663	* NAUXV+1
1664	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1665	NDIAG = NDIAG + 1
1666	ENDIF
1667	RETURN
1668	102 CONTINUE
1669	WRITE( IOU,* ) ' ***PD2110 encountered EOF'
1670	WRITE( IOU,* ) ' while reading record containing X1(I), I= ', I
1671	WRITE( IOU,* ) ' at independent variable mark X2=', X2
1672	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
1673	WRITE( IOU,* ) ' Number of values expected in record=',NV+1
1674	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1675	NDIAG = NDIAG + 1
1676	RETURN
1677	END
1678	SUBROUTINE PD2160 ( X1, CX2, LENX,
1679	* A, AMISS, NAUXV, CA, CAMISS, LENA, NAUXC,
1680	* V, VMISS, MAXX1, NX, NV,
1681	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
1682	* CRFMT, IUN, IOU, NDIAG, IERR )
1683	C
1684	C Subroutine to read a data record group for FFI=2160.
1685	C This routine reads the expected number of values, checks for extra
1686	C values within the record, tests dependent variables against their
1687	C missing values, and counts the number of lines, number of characters,
1688	C and the number of blanks in the data records.
1689	C
1690	C IERR = 0 = successful read.
1691	C = -1 = EOF encountered.
1692	C = +1 = read error.
1693	C = +2 = error in value of NX.
1694	C
1695	C Required routines: LASTNB, PARDAT.
1696	C
1697	C History:
1698	C 91-10-25 (SEG) - Added code to test lengths of CX2 and CA.
1699	C
1700	C
1701	CHARACTER() CA( * )
1702	CHARACTER() CAMISS( * )
1703	CHARACTER() CDUM
1704	CHARACTER() CRFMT
1705	CHARACTER() CX2
1706	C
1707	DIMENSION A( * ), AMISS( * ), V( MAXX1,* ), VMISS( * )
1708	DIMENSION DUM( * ), LENX( * ), LENA( * ), X1( * )
1709	C
1710	IERR = 0
1711	C
1712	C Read a group of data records.
1713	C
1714	READ( IUN,FMT=CRFMT,ERR=200,END=100 ) CX2
1715	CALL LASTNB ( CX2, LEN(CX2), LX2 )
1716	IF( LX2 .GT. LENX(2) ) THEN
1717	WRITE( IOU,* ) ' **PR2160 error--string too long for'
1718	WRITE( IOU,* ) ' independent variable mark X2=', CX2(1:LX2)
1719	WRITE( IOU,* ) ' LENGTH, LENX= ', LX2, LENX(2)
1720	NDIAG = NDIAG + 1
1721	ENDIF
1722	C
1723	CALL PARDAT ( DUM, NAUXV-NAUXC, NFIND, 'PD2160', 6,
1724	* 'Real A(I)', 9,
1725	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1726	* CRFMT, IUN, IOU, NDIAG, IERR )
1727	NVALS = NVALS + NFIND
1728	IF( IERR .LT. 0 ) THEN
1729	GOTO 101
1730	ELSE IF( IERR .GT. 0 ) THEN
1731	RETURN
1732	ELSE
1733	NX = INT( DUM(1)+0.5 )
1734	IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
1735	WRITE( IOU,* ) ' ***PD2160 error--NX(1) too large'
1736	WRITE( IOU,* ) ' MAXX1,NX(1)=', MAXX1, NX
1737	IERR = 2
1738	NDIAG = NDIAG + 1
1739	RETURN
1740	ENDIF
1741	DO 16 IA=1,NAUXV-NAUXC
1742	A(IA) = DUM(IA)
1743	IF( A(IA) .GT. AMISS(IA) ) THEN
1744	WRITE( IOU,* )
1745	* ' **PD2160 error--auxiliary variable .GT. its missing value'
1746	WRITE( IOU,* )
1747	* ' at independent variable mark X2= ',CX2(1:LENX(2))
1748	WRITE( IOU,* )
1749	* ' I, A(I), AMISS(I)= ', IA,A(IA),AMISS(IA)
1750	NDIAG = NDIAG + 1
1751	ENDIF
1752	16 CONTINUE
1753	ENDIF
1754	C
1755	IF( NAUXC .GT. 0 ) THEN
1756	DO 20 IC=1,NAUXC
1757	READ( IUN,FMT=CRFMT,ERR=202,END=102 ) CA(IC)
1758	CALL LASTNB ( CA(IC), LEN(CA(IC)), LCA )
1759	IF( LCA .GT. LENA(IC) ) THEN
1760	WRITE( IOU,* ) ' **PD2160 error--string too long for'
1761	WRITE( IOU,* ) ' auxiliary variable A(I), I=',
1762	* NAUXV-NAUXC+IC
1763	WRITE( IOU,* )
1764	* ' At independent variable mark X2=', CX2(1:LENX(2))
1765	WRITE( IOU,* ) ' LENGTH, LENA(I)= ', LCA, LENA(IC)
1766	WRITE( IOU,* ) ' A(I)=', CA(IC)(1:LCA)
1767	NDIAG = NDIAG + 1
1768	ENDIF
1769	IF( LGT( CA(IC)(1:LENA(IC)), CAMISS(IC)(1:LENA(IC)) )) THEN
1770	WRITE( IOU,* )
1771	* ' **PD2160 error--auxiliary variable .GT. its missing value'
1772	WRITE( IOU,* )
1773	* ' at independent variable mark X2= ',CX2(1:LENX(2))
1774	WRITE( IOU,* ) ' Auxiliary variable index=',
1775	* NAUXV-NAUXC+IC
1776	WRITE( IOU,* ) ' A(I)= ', CA(IC)(1:LENA(IC))
1777	WRITE( IOU,* ) ' AMISS(I)= ', CAMISS(IC)(1:LENA(IC))
1778	NDIAG = NDIAG + 1
1779	ENDIF
1780	20 CONTINUE
1781	ENDIF
1782	C
1783	IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
1784	DO 30 I=1,NX
1785	CALL PARDAT ( DUM, NV+1, NFIND, 'PD2160', 6, 'V(I,N)', 6,
1786	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1787	* CRFMT, IUN, IOU, NDIAG, IERR )
1788	NVALS = NVALS + NFIND
1789	IF( IERR .LT. 0 ) THEN
1790	GOTO 103
1791	ELSE IF( IERR .GT. 0 ) THEN
1792	RETURN
1793	ELSE
1794	X1(I) = DUM(1)
1795	DO 26 N=1,NV
1796	V(I,N) = DUM(N+1)
1797	IF( V(I,N) .GT. VMISS(N) ) THEN
1798	WRITE( IOU,* )
1799	* ' **PD2160 error--primary variable .GT. its missing value'
1800	WRITE( IOU,* )
1801	* ' at independent variable mark X2= ',CX2(1:LENX(2))
1802	WRITE( IOU,* ) ' I, N, V(I,N), VMISS(N)=',
1803	* I, N, V(I,N), VMISS(N)
1804	NDIAG = NDIAG + 1
1805	ENDIF
1806	26 CONTINUE
1807	ENDIF
1808	30 CONTINUE
1809	ENDIF
1810	RETURN
1811	C
1812	C Flag EOF.
1813	C
1814	100 CONTINUE
1815	IERR = -1
1816	RETURN
1817	101 CONTINUE
1818	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV-NAUXC ) THEN
1819	WRITE( IOU,* ) ' ***PD2160 error--premature EOF in line',LINE+1
1820	WRITE( IOU,* ) ' while reading real auxiliary variables'
1821	WRITE( IOU,* ) ' Last successfully read value of X2= ',
1822	* CX2(1:LENX(2))
1823	WRITE( IOU,* ) ' Number of values expected in record=',
1824	* NAUXV-NAUXC
1825	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1826	NDIAG = NDIAG + 1
1827	ENDIF
1828	RETURN
1829	102 CONTINUE
1830	IERR = -1
1831	WRITE( IOU,* ) ' ***PD2160 error--EOF while reading character'
1832	WRITE( IOU,* ) ' auxiliary variable number ', NAUXV-NAUXC+IC
1833	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
1834	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
1835	WRITE( IOU,* ) ' NAUXV, NAUXC=', NAUXV, NAUXC
1836	NDIAG = NDIAG + 1
1837	RETURN
1838	103 CONTINUE
1839	WRITE( IOU,* )
1840	* ' ***PD2160 error--EOF while reading X1(I),V(I,N), I= ', I
1841	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
1842	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
1843	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
1844	WRITE( IOU,* ) ' Number of values expected in record=', NV
1845	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1846	NDIAG = NDIAG + 1
1847	RETURN
1848	C
1849	C Flag read error.
1850	C
1851	200 CONTINUE
1852	IERR = 1
1853	WRITE( IOU,* )
1854	* ' ***PD2160 error reading independent variable X2'
1855	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
1856	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
1857	NDIAG = NDIAG + 1
1858	RETURN
1859	202 CONTINUE
1860	IERR = 1
1861	WRITE( IOU,* ) ' ***PD2160 error reading character'
1862	WRITE( IOU,* ) ' auxiliary variable number ', NAUXV-NAUXC+IC
1863	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
1864	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
1865	WRITE( IOU,* ) ' NAUXV, NAUXC=', NAUXV, NAUXC
1866	NDIAG = NDIAG + 1
1867	RETURN
1868	END
1869	SUBROUTINE PD2310 ( X2, A, AMISS, NAUXV, V, VMISS, X1, MAXX1,
1870	* NX, NV, DX,
1871	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
1872	* IUN, IOU, NDIAG, IERR )
1873	C
1874	C Subroutine to read a data record group for FFI=2310.
1875	C This routine reads the expected number of values, checks for extra
1876	C values within the record, tests dependent variables against their
1877	C missing values, and counts the number of lines, number of characters,
1878	C and the number of blanks in the data records.
1879	C
1880	C IERR = 0 = successful read.
1881	C = -1 = EOF encountered.
1882	C = +1 = read error.
1883	C = +2 = error in value of NX.
1884	C
1885	C Required routines: CKMISV, CKMSXV, PARDAT.
1886	C
1887	CHARACTER() CDUM
1888	CHARACTER() CRFMT
1889	C
1890	DIMENSION A( * ), AMISS( * ), DUM( * )
1891	DIMENSION V( MAXX1,* ), VMISS( * ), X1( * ), DX( * )
1892	C
1893	IERR = 0
1894	C
1895	C Read a group of data records.
1896	C
1897	CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD2310', 6, 'X2,A(I)', 7,
1898	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1899	* CRFMT, IUN, IOU, NDIAG, IERR )
1900	NVALS = NVALS + NFIND
1901	IF( IERR .LT. 0 ) THEN
1902	GOTO 100
1903	ELSE IF( IERR .GT. 0 ) THEN
1904	RETURN
1905	ELSE
1906	X2 = DUM(1)
1907	DO 20 I=1,NAUXV
1908	A(I) = DUM(I+1)
1909	20 CONTINUE
1910	NX = INT( A(1)+0.5 )
1911	DX(1) = A(3)
1912	IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
1913	WRITE( IOU,* ) ' ***PD2310 error--NX(1) too large'
1914	WRITE( IOU,* ) ' MAXX1,NX(1)=', MAXX1, NX
1915	IERR = 2
1916	NDIAG = NDIAG + 1
1917	RETURN
1918	ENDIF
1919	CALL CKMISV ( A, AMISS, NAUXV, X2,
1920	* 'A(I)', 4, 'X2', 2, 'PD2310', 6, NDIAG, IOU )
1921	ENDIF
1922	C
1923	IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
1924	DO 30 N=1,NV
1925	CALL PARDAT ( DUM, NX, NFIND, 'PD2310', 6, 'V(I,N)', 6,
1926	* LINE, NREAD, CDUM, NCIDR, NBIDR,
1927	* CRFMT, IUN, IOU, NDIAG, IERR )
1928	NVALS = NVALS + NFIND
1929	IF( IERR .LT. 0 ) THEN
1930	GOTO 102
1931	ELSE IF( IERR .GT. 0 ) THEN
1932	RETURN
1933	ELSE
1934	DO 26 I=1,NX
1935	V(I,N) = DUM(I)
1936	26 CONTINUE
1937	ENDIF
1938	30 CONTINUE
1939	CALL CKMSXV ( V, MAXX1, VMISS, NV, X2, NX,
1940	* 'V(N)', 4, 'X2', 2, 'PD2310', 6, NDIAG, IOU )
1941	C
1942	C Define X1(I).
1943	C
1944	DO 40 I=1,NX
1945	X1(I) = A(2) + A(3) * FLOAT( I-1 )
1946	40 CONTINUE
1947	ENDIF
1948	RETURN
1949	C
1950	C Flag EOF.
1951	C
1952	100 CONTINUE
1953	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
1954	WRITE( IOU,* ) ' ***PD2310 error--premature EOF in line',LINE+1
1955	WRITE( IOU,* ) ' while reading X2,A(I)'
1956	WRITE( IOU,* ) ' Last successfully read value of X2=', X2
1957	WRITE( IOU,* ) ' Number of values expected in record=',
1958	* NAUXV+1
1959	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1960	NDIAG = NDIAG + 1
1961	ENDIF
1962	RETURN
1963	102 CONTINUE
1964	WRITE( IOU,* ) ' ***PD2310 encountered EOF while reading values'
1965	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
1966	WRITE( IOU,* ) ' at independent variable mark X2=', X2
1967	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
1968	WRITE( IOU,* ) ' Number of values expected in record=', NX
1969	WRITE( IOU,* ) ' Number of values found in record=', NFIND
1970	NDIAG = NDIAG + 1
1971	RETURN
1972	END
1973	SUBROUTINE PD3010 ( X3, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
1974	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
1975	* IUN, IOU, ISU, RETDAT, NDIAG, IERR )
1976	C
1977	C Subroutine to read a data record group for FFI=3010.
1978	C This routine reads the expected number of values, checks for extra
1979	C values within the record, tests dependent variables against their
1980	C missing values, and counts the number of lines, number of characters,
1981	C and the number of blanks in the data records.
1982	C
1983	C IERR = 0 = successful read.
1984	C = -1 = EOF encountered.
1985	C = +1 = read error.
1986	C If RETDAT=.TRUE. then the primary variable values are written to
1987	C the scratch file unit ISU.
1988	C
1989	C Required routines: CKMISV, CKMSXV, PARDAT.
1990	C
1991	C
1992	LOGICAL RETDAT
1993	C
1994	CHARACTER() CDUM
1995	CHARACTER() CRFMT
1996	C
1997	DIMENSION A( * ), AMISS( * ), DUM( * )
1998	DIMENSION V( MAXX1,* ), VMISS( * ), NX( * )
1999	C
2000	IERR = 0
2001	C
2002	C Read a group of data records.
2003	C
2004	CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD3010', 6, 'X3,A(I)', 7,
2005	* LINE, NREAD, CDUM, NCIDR, NBIDR,
2006	* CRFMT, IUN, IOU, NDIAG, IERR )
2007	NVALS = NVALS + NFIND
2008	IF( IERR .LT. 0 ) THEN
2009	GOTO 100
2010	ELSE IF( IERR .GT. 0 ) THEN
2011	RETURN
2012	ELSE
2013	X3 = DUM(1)
2014	IF( NAUXV .GT. 0 ) THEN
2015	DO 20 IA=1,NAUXV
2016	A(IA) = DUM(IA+1)
2017	20 CONTINUE
2018	CALL CKMISV ( A, AMISS, NAUXV, X3,
2019	* 'A(I)', 4, 'X3', 2, 'PD3010', 6, NDIAG, IOU )
2020	ENDIF
2021	ENDIF
2022	C
2023	DO 30 N=1,NV
2024	DO 28 J=1,NX(2)
2025	CALL PARDAT ( DUM, NX, NFIND, 'PD3010', 6, 'V(I,J,N)', 8,
2026	* LINE, NREAD, CDUM, NCIDR, NBIDR,
2027	* CRFMT, IUN, IOU, NDIAG, IERR )
2028	NVALS = NVALS + NFIND
2029	IF( IERR .LT. 0 ) THEN
2030	GOTO 102
2031	ELSE IF( IERR .GT. 0 ) THEN
2032	RETURN
2033	ELSE
2034	DO 26 I=1,NX(1)
2035	V(I,1) = DUM(I)
2036	26 CONTINUE
2037	ENDIF
2038	CALL CKMSXV ( V, MAXX1, VMISS(N), 1, X3, NX,
2039	* 'V(N)', 4, 'X3', 2, 'PD3010', 6, NDIAG, IOU )
2040	IF( RETDAT ) THEN
2041	WRITE( ISU ) ( V(I,1), I=1,NX(1) )
2042	ENDIF
2043	28 CONTINUE
2044	30 CONTINUE
2045	RETURN
2046	C
2047	C Flag EOF.
2048	C
2049	100 CONTINUE
2050	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
2051	WRITE( IOU,* ) ' ***PD3010 error--premature EOF in line',LINE+1
2052	WRITE( IOU,* ) ' while reading X3,A(I)'
2053	WRITE( IOU,* ) ' Last successfully read value of X3=', X3
2054	WRITE( IOU,* ) ' Number of values expected in record=',
2055	* NAUXV+1
2056	WRITE( IOU,* ) ' Number of values found in record=', NFIND
2057	NDIAG = NDIAG + 1
2058	ENDIF
2059	RETURN
2060	102 CONTINUE
2061	WRITE( IOU,* ) ' ***PD3010 encountered EOF while reading values'
2062	WRITE( IOU,* ) ' of primary variable V(I,J,N), J,N=', J, N
2063	WRITE( IOU,* ) ' at independent variable mark X3=', X3
2064	WRITE( IOU,* ) ' NX(1), NX(2), NV=', NX(1), NX(2), NV
2065	WRITE( IOU,* ) ' Number of values expected in record=', NX(1)
2066	WRITE( IOU,* ) ' Number of values found in record=', NFIND
2067	NDIAG = NDIAG + 1
2068	RETURN
2069	END
2070	SUBROUTINE PD4010 ( X4, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
2071	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
2072	* IUN, IOU, ISU, RETDAT, NDIAG, IERR )
2073	C
2074	C Subroutine to read a data record group for FFI=4010.
2075	C This routine reads the expected number of values, checks for extra
2076	C values within the record, tests dependent variables against their
2077	C missing values, and counts the number of lines, number of characters,
2078	C and the number of blanks in the data records.
2079	C
2080	C IERR = 0 = successful read.
2081	C = -1 = EOF encountered.
2082	C = +1 = read error.
2083	C If RETDAT=.TRUE. then the primary variable values are written to
2084	C the scratch file unit ISU.
2085	C
2086	C Required routines: CKMISV, CKMSXV, PARDAT.
2087	C
2088	C
2089	LOGICAL RETDAT
2090	C
2091	CHARACTER() CDUM
2092	CHARACTER() CRFMT
2093	C
2094	DIMENSION A( * ), AMISS( * ), DUM( * )
2095	DIMENSION V( MAXX1,* ), VMISS( * ), NX( * )
2096	C
2097	IERR = 0
2098	C
2099	C Read a group of data records.
2100	C
2101	CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD4010', 6, 'X4,A(I)', 7,
2102	* LINE, NREAD, CDUM, NCIDR, NBIDR,
2103	* CRFMT, IUN, IOU, NDIAG, IERR )
2104	NVALS = NVALS + NFIND
2105	IF( IERR .LT. 0 ) THEN
2106	GOTO 100
2107	ELSE IF( IERR .GT. 0 ) THEN
2108	RETURN
2109	ELSE
2110	X4 = DUM(1)
2111	IF( NAUXV .GT. 0 ) THEN
2112	DO 20 IA=1,NAUXV
2113	A(IA) = DUM(IA+1)
2114	20 CONTINUE
2115	CALL CKMISV ( A, AMISS, NAUXV, X4,
2116	* 'A(I)', 4, 'X4', 2, 'PD4010', 6, NDIAG, IOU )
2117	ENDIF
2118	ENDIF
2119	C
2120	DO 30 N=1,NV
2121	DO 28 K=1,NX(3)
2122	DO 26 J=1,NX(2)
2123	CALL PARDAT ( DUM, NX, NFIND, 'PD4010', 6,
2124	* 'V(I,J,K,N)', 10,
2125	* LINE, NREAD, CDUM, NCIDR, NBIDR,
2126	* CRFMT, IUN, IOU, NDIAG, IERR )
2127	NVALS = NVALS + NFIND
2128	IF( IERR .LT. 0 ) THEN
2129	GOTO 102
2130	ELSE IF( IERR .GT. 0 ) THEN
2131	RETURN
2132	ELSE
2133	DO 24 I=1,NX(1)
2134	V(I,1) = DUM(I)
2135	24 CONTINUE
2136	ENDIF
2137	CALL CKMSXV ( V, MAXX1, VMISS(N), 1, X4, NX,
2138	* 'V(N)', 4, 'X4', 2, 'PD4010', 6, NDIAG, IOU)
2139	IF( RETDAT ) THEN
2140	WRITE( ISU ) ( V(I,1), I=1,NX(1) )
2141	ENDIF
2142	26 CONTINUE
2143	28 CONTINUE
2144	30 CONTINUE
2145	RETURN
2146	C
2147	C Flag EOF.
2148	C
2149	100 CONTINUE
2150	IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
2151	WRITE( IOU,* ) ' ***PD4010 error--premature EOF in line',LINE+1
2152	WRITE( IOU,* ) ' while reading X4,A(I)'
2153	WRITE( IOU,* ) ' Last successfully read value of X4=', X4
2154	WRITE( IOU,* ) ' Number of values expected in record=',
2155	* NAUXV+1
2156	WRITE( IOU,* ) ' Number of values found in record=', NFIND
2157	NDIAG = NDIAG + 1
2158	ENDIF
2159	RETURN
2160	102 CONTINUE
2161	WRITE( IOU,* ) ' ***PD4010 encountered EOF while reading values'
2162	WRITE( IOU,* ) ' of primary variable V(I,J,K,N), J,K,N=', J,K,N
2163	WRITE( IOU,* ) ' at independent variable mark X4=', X4
2164	WRITE( IOU,* ) ' NX(1), NX(2), NX(3), NV=',(NX(M),M=1,3), NV
2165	WRITE( IOU,* ) ' Number of values expected in record=', NX(1)
2166	WRITE( IOU,* ) ' Number of values found in record=', NFIND
2167	NDIAG = NDIAG + 1
2168	RETURN
2169	END
2170	SUBROUTINE PRDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
2171	* A, AMISS, CA, LENA, NAUXV, NAUXC,
2172	* V, MAXX1, NV, NVPM, CWFMT, IOU, ISU,
2173	* ISUBV )
2174	C
2175	C Subroutine to print data records.
2176	C ISUBV is defined in subroutine RHEAD and used in this routine.
2177	C
2178	C Required routines: CHFMT.
2179	C
2180	C History:
2181	C 91-10-23 (SEG) - Omit printing records with X1 if NX(1)=AMISS(1)
2182	C or NX(1)=0, for formats 2110, 2160, 2310.
2183	C
2184	C
2185	CHARACTER() CA( * )
2186	CHARACTER() CWFMT
2187	CHARACTER() CX2
2188	C
2189	DIMENSION A( * ), AMISS( * ), LENA( * ), V( MAXX1,* )
2190	DIMENSION LENX( * ), X1( * ), X2( * ), X3( * )
2191	DIMENSION DX( * ), NX( * )
2192	C
2193	GO TO ( 1001, 1010, 1020,
2194	* 2010, 2110, 2160, 2310,
2195	* 3010, 4010 ) ISUBV
2196	WRITE( IOU,* ) ' ***PRDATA error--improper value for ISUBV=',
2197	* ISUBV
2198	RETURN
2199	1001 CONTINUE
2200	WRITE(IOU,*) X1(1), ( V(N,1), N=1,NV )
2201	RETURN
2202	1010 CONTINUE
2203	WRITE(IOU,*) X1(1), ( A(IA), IA=1,NAUXV )
2204	WRITE(IOU,*) ( V(N,1), N=1,NV )
2205	RETURN
2206	1020 CONTINUE
2207	WRITE(IOU,*) ( X1(I), I=1,NVPM )
2208	WRITE(IOU,*) ( A(IA), IA=1,NAUXV )
2209	DO 30 N=1,NV
2210	WRITE(IOU,*) ( V(I,N), I=1,NVPM )
2211	30 CONTINUE
2212	RETURN
2213	2010 CONTINUE
2214	WRITE(IOU,*) X2(1), ( A(IA), IA=1,NAUXV )
2215	DO 40 N=1,NV
2216	WRITE(IOU,*) ( V(I,N), I=1,NX(1) )
2217	40 CONTINUE
2218	RETURN
2219	2110 CONTINUE
2220	WRITE(IOU,*) X2(1), ( A(IA), IA=1,NAUXV )
2221	WRITE(IOU,*) 'NX(1)=', NX(1)
2222	IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
2223	DO 50 I=1,NX(1)
2224	WRITE(IOU,*) X1(I), ( V(I,N), N=1,NV )
2225	50 CONTINUE
2226	ENDIF
2227	RETURN
2228	2160 CONTINUE
2229	CALL CHFMT ( LENX(2), CWFMT )
2230	WRITE(IOU,FMT=CWFMT) CX2(1:LENX(2))
2231	WRITE(IOU,*) ( A(IA), IA=1,NAUXV-NAUXC )
2232	WRITE(IOU,*) 'NX(1)=', NX(1)
2233	DO 60 IA=1,NAUXC
2234	CALL CHFMT ( LENA(IA), CWFMT )
2235	WRITE(IOU,FMT=CWFMT) CA(IA)(1:LENA(IA))
2236	60 CONTINUE
2237	IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
2238	DO 62 I=1,NX(1)
2239	WRITE(IOU,*) X1(I), ( V(I,N), N=1,NV )
2240	62 CONTINUE
2241	ENDIF
2242	RETURN
2243	2310 CONTINUE
2244	WRITE(IOU,*) X2(1), ( A(IA), IA=1,NAUXV )
2245	WRITE(IOU,*) 'NX(1),X1(1),DX(1)=', NX(1), X1(1), DX(1)
2246	IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
2247	DO 70 N=1,NV
2248	WRITE(IOU,*) ( V(I,N), I=1,NX(1) )
2249	70 CONTINUE
2250	ENDIF
2251	RETURN
2252	3010 CONTINUE
2253	WRITE(IOU,*) X3(1), ( A(IA), IA=1,NAUXV )
2254	DO 80 N=1,NV
2255	DO 78 J=1,NX(2)
2256	READ(ISU) ( V(I,1), I=1,NX(1) )
2257	WRITE(IOU,*) ( V(I,1), I=1,NX(1) )
2258	78 CONTINUE
2259	80 CONTINUE
2260	RETURN
2261	4010 CONTINUE
2262	WRITE(IOU,*) X4, ( A(IA), IA=1,NAUXV )
2263	DO 90 N=1,NV
2264	DO 88 K=1,NX(3)
2265	DO 86 J=1,NX(2)
2266	READ(ISU) ( V(I,1), I=1,NX(1) )
2267	WRITE(IOU,*) ( V(I,1), I=1,NX(1) )
2268	86 CONTINUE
2269	88 CONTINUE
2270	90 CONTINUE
2271	RETURN
2272	END
2273	SUBROUTINE PRHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
2274	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
2275	* DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
2276	* NV, NVPM, VSCAL, VMISS, VNAME,
2277	* NAUXV, ASCAL, AMISS, ANAME,
2278	* NAUXC, LENA, CAMISS,
2279	* NSCOML, SCOM, NNCOML, NCOM, CWFMT, IOU )
2280	C
2281	C Subroutine to print file header info.
2282	C
2283	C Required routines: CHFMT, LASTNB.
2284	C
2285	CHARACTER() ANAME( * )
2286	CHARACTER() CAMISS( * )
2287	CHARACTER() CWFMT
2288	CHARACTER() MNAME
2289	CHARACTER() NCOM( * )
2290	CHARACTER() ONAME
2291	CHARACTER() ORG
2292	CHARACTER() SCOM( * )
2293	CHARACTER() SNAME
2294	CHARACTER() VNAME( * )
2295	CHARACTER() XNAME( * )
2296	C
2297	DIMENSION DX( * ), NX( * ), NXDEF( * )
2298	DIMENSION X1( * ), X2( * ), X3( * )
2299	DIMENSION AMISS( * ), ASCAL( * ), LENA( * )
2300	DIMENSION VMISS( * ), VSCAL( * ), LENX( * )
2301	C
2302	C
2303	C Obtain NIV.
2304	C
2305	NIV = IFFI / 1000
2306	C
2307	WRITE(IOU,*) NLHEAD, IFFI
2308	CALL LASTNB ( ONAME, LEN(ONAME), LL )
2309	CALL CHFMT ( LL, CWFMT )
2310	WRITE(IOU,FMT=CWFMT) ONAME(1:LL)
2311	CALL LASTNB ( ORG, LEN(ORG), LL )
2312	CALL CHFMT ( LL, CWFMT )
2313	WRITE(IOU,FMT=CWFMT) ORG(1:LL)
2314	CALL LASTNB ( SNAME, LEN(SNAME), LL )
2315	CALL CHFMT ( LL, CWFMT )
2316	WRITE(IOU,FMT=CWFMT) SNAME(1:LL)
2317	CALL LASTNB ( MNAME, LEN(MNAME), LL )
2318	CALL CHFMT ( LL, CWFMT )
2319	WRITE(IOU,FMT=CWFMT) MNAME(1:LL)
2320	WRITE(IOU,*) IVOL, NVOL
2321	WRITE(IOU,*) IYR, IMO, IDY
2322	WRITE(IOU,*) IRYR, IRMO, IRDY
2323	IF( IFFI .EQ. 2160 ) THEN
2324	WRITE(IOU,*) DX(1)
2325	WRITE(IOU,*) LENX(2)
2326	ELSE IF( IFFI .EQ. 2310 ) THEN
2327	WRITE(IOU,*) DX(2)
2328	ELSE
2329	WRITE(IOU,*) ( DX(I), I=1,NIV )
2330	ENDIF
2331	IF( IFFI .EQ. 1020 ) THEN
2332	WRITE(IOU,*) NVPM
2333	ELSE IF( IFFI .EQ. 2010 .OR.
2334	* IFFI .EQ. 3010 .OR. IFFI .EQ. 4010 ) THEN
2335	WRITE(IOU,*) ( NX(I), I=1,NIV-1 )
2336	WRITE(IOU,*) ( NXDEF(I), I=1,NIV-1 )
2337	WRITE(IOU,*) ( X1(I), I=1,NX(1) )
2338	IF( IFFI .EQ. 3010 ) THEN
2339	WRITE(IOU,*) ( X2(J), J=1,NX(2) )
2340	ELSE IF( IFFI .EQ. 4010 ) THEN
2341	WRITE(IOU,*) ( X2(J), J=1,NX(2) )
2342	WRITE(IOU,*) ( X3(K), K=1,NX(3) )
2343	ENDIF
2344	ENDIF
2345	DO 20 IS=1,NIV
2346	CALL LASTNB ( XNAME(IS), LEN(XNAME(IS)), LL )
2347	CALL CHFMT ( LL, CWFMT )
2348	WRITE(IOU,FMT=CWFMT) XNAME(IS)(1:LL)
2349	20 CONTINUE
2350	WRITE(IOU,*) NV
2351	WRITE(IOU,*) ( VSCAL(N), N=1,NV )
2352	WRITE(IOU,*) ( VMISS(N), N=1,NV )
2353	DO 30 N=1,NV
2354	CALL LASTNB ( VNAME(N), LEN(VNAME(N)), LL )
2355	CALL CHFMT ( LL, CWFMT )
2356	WRITE(IOU,FMT=CWFMT) VNAME(N)(1:LL)
2357	30 CONTINUE
2358	IF( IFFI .EQ. 2160 ) THEN
2359	WRITE(IOU,*) NAUXV
2360	WRITE(IOU,*) NAUXC
2361	WRITE(IOU,*) ( ASCAL(IA), IA=1,NAUXV-NAUXC )
2362	WRITE(IOU,*) ( AMISS(IA), IA=1,NAUXV-NAUXC )
2363	WRITE(IOU,*) ( LENA(IA), IA=1,NAUXC )
2364	DO 40 IA=1,NAUXC
2365	CALL LASTNB ( CAMISS(IA), LEN(CAMISS(IA)), LL )
2366	CALL CHFMT ( LL, CWFMT )
2367	WRITE(IOU,FMT=CWFMT) CAMISS(IA)(1:LL)
2368	40 CONTINUE
2369	ELSE IF( IFFI .NE. 1001 ) THEN
2370	WRITE(IOU,*) NAUXV
2371	WRITE(IOU,*) ( ASCAL(IA), IA=1,NAUXV )
2372	WRITE(IOU,*) ( AMISS(IA), IA=1,NAUXV )
2373	ENDIF
2374	IF( IFFI .NE. 1001 ) THEN
2375	DO 50 IA=1,NAUXV
2376	CALL LASTNB ( ANAME(IA), LEN(ANAME(IA)), LL )
2377	CALL CHFMT ( LL, CWFMT )
2378	WRITE(IOU,FMT=CWFMT) ANAME(IA)(1:LL)
2379	50 CONTINUE
2380	ENDIF
2381	WRITE(IOU,*) NSCOML
2382	DO 60 K=1,NSCOML
2383	CALL LASTNB ( SCOM(K), LEN(SCOM(K)), LL )
2384	CALL CHFMT ( LL, CWFMT )
2385	WRITE(IOU,FMT=CWFMT) SCOM(K)(1:LL)
2386	60 CONTINUE
2387	WRITE(IOU,*) NNCOML
2388	DO 70 K=1,NNCOML
2389	CALL LASTNB ( NCOM(K), LEN(NCOM(K)), LL )
2390	CALL CHFMT ( LL, CWFMT )
2391	WRITE(IOU,FMT=CWFMT) NCOM(K)(1:LL)
2392	70 CONTINUE
2393	RETURN
2394	END
2395	SUBROUTINE RD1001 ( X1, V, NV, IUN, IOU, NDIAG, IERR )
2396	C
2397	C Subroutine to read a data record for FFI=1001.
2398	C IERR = 0 = successful read.
2399	C = -1 = EOF encountered.
2400	C = +1 = read error.
2401	C
2402	C
2403	DIMENSION V( * )
2404	C
2405	IERR = 0
2406	READ( IUN,*,ERR=200,END=100 ) X1, ( V(N), N=1,NV )
2407	RETURN
2408	100 CONTINUE
2409	IERR = -1
2410	RETURN
2411	200 CONTINUE
2412	IERR = 1
2413	WRITE( IOU,* ) ' ***RD1001 read error'
2414	WRITE( IOU,* ) ' Last successfully read value of X1=', X1
2415	NDIAG = NDIAG + 1
2416	RETURN
2417	END
2418	SUBROUTINE RD1010 ( X1, A, NAUXV, V, NV,
2419	* IUN, IOU, NDIAG, IERR )
2420	C
2421	C Subroutine to read a data record group for FFI=1010.
2422	C IERR = 0 = successful read.
2423	C = -1 = EOF encountered.
2424	C = +1 = read error.
2425	C
2426	C
2427	DIMENSION A( * ), V( * )
2428	C
2429	IERR = 0
2430	C
2431	C Read a group of data records.
2432	C
2433	IF( NAUXV .GT. 0 ) THEN
2434	READ( IUN,*,ERR=200,END=100 ) X1, ( A(IA), IA=1,NAUXV )
2435	ELSE
2436	READ( IUN,*,ERR=201,END=100 ) X1
2437	ENDIF
2438	READ( IUN,*,ERR=202,END=102 ) ( V(N), N=1,NV )
2439	RETURN
2440	C
2441	C Flag EOF.
2442	C
2443	100 CONTINUE
2444	IERR = -1
2445	RETURN
2446	102 CONTINUE
2447	IERR = -1
2448	WRITE( IOU,* )
2449	* ' ***RD1010 encountered EOF while reading primary variables.'
2450	WRITE( IOU,* ) ' Incomplete primary variable list at X1=', X1
2451	WRITE( IOU,* ) ' NV=', NV
2452	NDIAG = NDIAG + 1
2453	RETURN
2454	C
2455	C Flag read error.
2456	C
2457	200 CONTINUE
2458	IERR = 1
2459	WRITE( IOU,* )
2460	* ' ***RD1010 error reading independent and auxilary variables'
2461	WRITE( IOU,* ) ' Last successfully read value of X1=', X1
2462	WRITE( IOU,* ) ' NAUXV=', NAUXV
2463	NDIAG = NDIAG + 1
2464	RETURN
2465	201 CONTINUE
2466	IERR = 1
2467	WRITE( IOU,* )
2468	* ' ***RD1010 error reading independent variable X1'
2469	WRITE( IOU,* ) ' Last successfully read value of X1=', X1
2470	NDIAG = NDIAG + 1
2471	RETURN
2472	202 CONTINUE
2473	IERR = 1
2474	WRITE( IOU,* )
2475	* ' ***RD1010 error reading primary variables at X1=',X1
2476	WRITE( IOU,* ) ' NV=', NV
2477	NDIAG = NDIAG + 1
2478	RETURN
2479	END
2480	SUBROUTINE RD1020 ( X1, DX, A, NAUXV, V, MAXX1, NVPM, NV,
2481	* IUN, IOU, NDIAG, IERR )
2482	C
2483	C Subroutine to read a data record group for FFI=1020.
2484	C IERR = 0 = successful read.
2485	C = -1 = EOF encountered.
2486	C = +1 = read error.
2487	C
2488	C
2489	DIMENSION A( * ), V( MAXX1,* ), X1( * )
2490	C
2491	IERR = 0
2492	C
2493	C Read a group of data records.
2494	C
2495	IF( NAUXV .GT. 0 ) THEN
2496	READ( IUN,*,ERR=201,END=100 ) X1(1), ( A(IA), IA=1,NAUXV )
2497	ELSE
2498	READ( IUN,*,ERR=200,END=100 ) X1(1)
2499	ENDIF
2500	DO 30 N=1,NV
2501	READ( IUN,*,ERR=202,END=102 ) ( V(I,N), I=1,NVPM )
2502	30 CONTINUE
2503	C
2504	C Define X1 values.
2505	C
2506	DO 40 I=2,NVPM
2507	X1(I) = X1(1) + DX * FLOAT( I-1 )
2508	40 CONTINUE
2509	RETURN
2510	C
2511	C Flag EOF.
2512	C
2513	100 CONTINUE
2514	IERR = -1
2515	RETURN
2516	102 CONTINUE
2517	IERR = -1
2518	WRITE( IOU,* ) ' ***RD1020 encountered EOF while reading values'
2519	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
2520	WRITE( IOU,* ) ' at independent variable mark X1(1)=', X1(1)
2521	WRITE( IOU,* ) ' NV, NVPM=', NV, NVPM
2522	NDIAG = NDIAG + 1
2523	RETURN
2524	C
2525	C Flag read error.
2526	C
2527	200 CONTINUE
2528	IERR = 1
2529	WRITE( IOU,* )
2530	* ' ***RD1020 error reading independent variable X1(1)'
2531	WRITE( IOU,* ) ' Last successfully read value of X1(1)=', X1(1)
2532	NDIAG = NDIAG + 1
2533	RETURN
2534	201 CONTINUE
2535	IERR = 1
2536	WRITE( IOU,* )
2537	* ' ***RD1020 error reading independent and auxilary variables'
2538	WRITE( IOU,* ) ' Last successfully read value of X1(1)=', X1(1)
2539	WRITE( IOU,* ) ' NAUXV=', NAUXV
2540	NDIAG = NDIAG + 1
2541	RETURN
2542	202 CONTINUE
2543	IERR = 1
2544	WRITE( IOU,* ) ' ***RD1020 error reading values'
2545	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
2546	WRITE( IOU,* ) ' at independent variable mark X1(1)=', X1(1)
2547	WRITE( IOU,* ) ' NV, NVPM=', NV, NVPM
2548	NDIAG = NDIAG + 1
2549	RETURN
2550	END
2551	SUBROUTINE RD2010 ( X2, A, NAUXV, V, MAXX1, NX, NV,
2552	* IUN, IOU, NDIAG, IERR )
2553	C
2554	C Subroutine to read a data record group for FFI=2010.
2555	C IERR = 0 = successful read.
2556	C = -1 = EOF encountered.
2557	C = +1 = read error.
2558	C
2559	C
2560	DIMENSION A( * ), V( MAXX1,1 )
2561	C
2562	IERR = 0
2563	C
2564	C Read a group of data records.
2565	C
2566	IF( NAUXV .GT. 0 ) THEN
2567	READ( IUN,*,ERR=201,END=100 ) X2, ( A(IA), IA=1,NAUXV )
2568	ELSE
2569	READ( IUN,*,ERR=200,END=100 ) X2
2570	ENDIF
2571	DO 30 N=1,NV
2572	READ( IUN,*,ERR=202,END=102 ) ( V(I,N), I=1,NX )
2573	30 CONTINUE
2574	RETURN
2575	C
2576	C Flag EOF.
2577	C
2578	100 CONTINUE
2579	IERR = -1
2580	RETURN
2581	102 CONTINUE
2582	IERR = -1
2583	WRITE( IOU,* ) ' ***RD2010 encountered EOF while reading values'
2584	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
2585	WRITE( IOU,* ) ' at independent variable mark X2=', X2
2586	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2587	NDIAG = NDIAG + 1
2588	RETURN
2589	C
2590	C Flag read error.
2591	C
2592	200 CONTINUE
2593	IERR = 1
2594	WRITE( IOU,* )
2595	* ' ***RD2010 error reading independent variable X2'
2596	WRITE( IOU,* ) ' Last successfully read value of X2=', X2
2597	NDIAG = NDIAG + 1
2598	RETURN
2599	201 CONTINUE
2600	IERR = 1
2601	WRITE( IOU,* )
2602	* ' ***RD2010 error reading independent and auxilary variables'
2603	WRITE( IOU,* ) ' Last successfully read value of X2=', X2
2604	WRITE( IOU,* ) ' NAUXV=', NAUXV
2605	NDIAG = NDIAG + 1
2606	RETURN
2607	202 CONTINUE
2608	IERR = 1
2609	WRITE( IOU,* ) ' ***RD2010 error reading values'
2610	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
2611	WRITE( IOU,* ) ' at independent variable mark X2=', X2
2612	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2613	NDIAG = NDIAG + 1
2614	RETURN
2615	END
2616	SUBROUTINE RD2110 ( X1, X2, A, AMISS, NAUXV, V, MAXX1, NX, NV,
2617	* IUN, IOU, NDIAG, IERR )
2618	C
2619	C Subroutine to read a data record group for FFI=2110.
2620	C IERR = 0 = successful read.
2621	C = -1 = EOF encountered.
2622	C = +1 = read error.
2623	C = +2 = error in value of NX
2624	C
2625	C
2626	DIMENSION A( * ), AMISS( * ), V( MAXX1,* ), X1( * )
2627	C
2628	IERR = 0
2629	C
2630	C Read a group of data records.
2631	C
2632	IF( NAUXV .GT. 1 ) THEN
2633	READ( IUN,*,ERR=200,END=100 ) X2, NX, ( A(IA), IA=2,NAUXV )
2634	ELSE
2635	READ( IUN,*,ERR=200,END=100 ) X2, NX
2636	ENDIF
2637	A(1) = FLOAT( NX )
2638	IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5)) THEN
2639	WRITE( IOU,* ) ' ***RD2110 error--NX(1) too large'
2640	WRITE( IOU,* ) ' MAXX1,NX(1)=', MAXX1, NX
2641	IERR = 2
2642	NDIAG = NDIAG + 1
2643	RETURN
2644	ENDIF
2645	C
2646	IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
2647	DO 30 I=1,NX
2648	READ( IUN,*,ERR=202,END=102 ) X1(I), ( V(I,N), N=1,NV )
2649	30 CONTINUE
2650	ENDIF
2651	RETURN
2652	C
2653	C Flag EOF.
2654	C
2655	100 CONTINUE
2656	IERR = -1
2657	RETURN
2658	102 CONTINUE
2659	IERR = -1
2660	WRITE( IOU,* ) ' ***RD2110 encountered EOF'
2661	WRITE( IOU,* ) ' while reading record containing X1(I), I= ', I
2662	WRITE( IOU,* ) ' at independent variable mark X2=', X2
2663	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2664	NDIAG = NDIAG + 1
2665	RETURN
2666	C
2667	C Flag read error.
2668	C
2669	200 CONTINUE
2670	IERR = 1
2671	WRITE( IOU,* )
2672	* ' ***RD2110 error reading independent and auxilary variables'
2673	WRITE( IOU,* ) ' Last successfully read value of X2=', X2
2674	WRITE( IOU,* ) ' NAUXV=', NAUXV
2675	NDIAG = NDIAG + 1
2676	RETURN
2677	202 CONTINUE
2678	IERR = 1
2679	WRITE( IOU,* )
2680	* ' ***RD2010 error while reading record containing X1(I), I= ',I
2681	WRITE( IOU,* ) ' at independent variable mark X2=', X2
2682	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2683	NDIAG = NDIAG + 1
2684	RETURN
2685	END
2686	SUBROUTINE RD2160 ( X1, CX2, LENX,
2687	* A, AMISS, CA, NAUXV, NAUXC,
2688	* V, MAXX1, NX, NV,
2689	* CRFMT, IUN, IOU, NDIAG, IERR )
2690	C
2691	C Subroutine to read a data record group for FFI=2160.
2692	C IERR = 0 = successful read.
2693	C = -1 = EOF encountered.
2694	C = +1 = read error.
2695	C = +2 = error in value of NX.
2696	C
2697	C
2698	CHARACTER() CA( * )
2699	CHARACTER() CRFMT
2700	CHARACTER() CX2
2701	C
2702	DIMENSION A( * ), AMISS( * ), V( MAXX1,* )
2703	DIMENSION LENX( * ), X1( * )
2704	C
2705	IERR = 0
2706	C
2707	C Read a group of data records.
2708	C
2709	READ( IUN,FMT=CRFMT,ERR=200,END=100 ) CX2
2710	IF( NAUXV-NAUXC .GT. 1 ) THEN
2711	READ( IUN,*,ERR=201,END=101 ) NX, ( A(IA), IA=2,NAUXV-NAUXC )
2712	ELSE
2713	READ( IUN,*,ERR=201,END=101 ) NX
2714	ENDIF
2715	A(1) = FLOAT( NX )
2716	IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
2717	WRITE( IOU,* ) ' ***RD2160 error--NX(1) too large'
2718	WRITE( IOU,* ) ' MAXX1,NX(1)=', MAXX1, NX
2719	IERR = 2
2720	NDIAG = NDIAG + 1
2721	RETURN
2722	ENDIF
2723	IF( NAUXC .GT. 0 ) THEN
2724	DO 20 IC=1,NAUXC
2725	READ( IUN,FMT=CRFMT,ERR=202,END=102 ) CA(IC)
2726	20 CONTINUE
2727	ENDIF
2728	IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
2729	DO 30 I=1,NX
2730	READ( IUN,*,ERR=203,END=103 ) X1(I), ( V(I,N), N=1,NV )
2731	30 CONTINUE
2732	ENDIF
2733	RETURN
2734	C
2735	C Flag EOF.
2736	C
2737	100 CONTINUE
2738	IERR = -1
2739	RETURN
2740	101 CONTINUE
2741	IERR = -1
2742	WRITE( IOU,* )
2743	* ' ***RD2160 EOF while reading real auxiliary variables.'
2744	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
2745	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
2746	WRITE( IOU,* ) ' NAUXV-NAUXC=', NAUXV-NAUXC
2747	NDIAG = NDIAG + 1
2748	RETURN
2749	102 CONTINUE
2750	IERR = -1
2751	WRITE( IOU,* ) ' ***RD2160 EOF while reading character'
2752	WRITE( IOU,* ) ' auxiliary variable number ', NAUXV-NAUXC+IC
2753	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
2754	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
2755	WRITE( IOU,* ) ' NAUXV, NAUXC=', NAUXV, NAUXC
2756	NDIAG = NDIAG + 1
2757	RETURN
2758	103 CONTINUE
2759	IERR = -1
2760	WRITE( IOU,* )
2761	* ' ***RD2160 EOF while reading record containing X1(I), I= ', I
2762	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
2763	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
2764	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2765	NDIAG = NDIAG + 1
2766	RETURN
2767	C
2768	C Flag read error.
2769	C
2770	200 CONTINUE
2771	IERR = 1
2772	WRITE( IOU,* )
2773	* ' ***RD2160 error reading independent variable X2'
2774	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
2775	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
2776	NDIAG = NDIAG + 1
2777	RETURN
2778	201 CONTINUE
2779	IERR = 1
2780	WRITE( IOU,* )
2781	* ' ***RD2160 error reading real auxilary variables'
2782	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
2783	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
2784	WRITE( IOU,* ) ' NAUXV-NAUXC=', NAUXV-NAUXC
2785	NDIAG = NDIAG + 1
2786	RETURN
2787	202 CONTINUE
2788	IERR = 1
2789	WRITE( IOU,* ) ' ***RD2160 error reading character'
2790	WRITE( IOU,* ) ' auxiliary variable number ', NAUXV-NAUXC+IC
2791	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
2792	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
2793	WRITE( IOU,* ) ' NAUXV, NAUXC=', NAUXV, NAUXC
2794	NDIAG = NDIAG + 1
2795	RETURN
2796	203 CONTINUE
2797	IERR = 1
2798	WRITE( IOU,* )
2799	* ' ***RD2160 error while reading record containing X1(I), I= ', I
2800	WRITE( IOU,* ) ' Last successfully read value of X2 is:'
2801	WRITE( IOU,* ) ' ',CX2(1:LENX(2))
2802	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2803	NDIAG = NDIAG + 1
2804	RETURN
2805	END
2806	SUBROUTINE RD2310 ( X2, A, AMISS, NAUXV, V, X1, MAXX1, NX, NV, DX,
2807	* IUN, IOU, NDIAG, IERR )
2808	C
2809	C Subroutine to read a data record group for FFI=2310.
2810	C IERR = 0 = successful read.
2811	C = -1 = EOF encountered.
2812	C = +1 = read error.
2813	C = +2 = error in value of NX.
2814	C
2815	C History:
2816	C 91-10-23 (SEG) - Omit defining X1(I) if NX=AMISS(1) or NX=0.
2817	C
2818	C
2819	DIMENSION A( * ), AMISS( * ), V( MAXX1,* ), X1( * ), DX( * )
2820	C
2821	IERR = 0
2822	C
2823	C Read a group of data records.
2824	C
2825	READ( IUN,*,ERR=200,END=100 ) X2, NX, ( A(IA), IA=2,NAUXV )
2826	A(1) = FLOAT( NX )
2827	DX(1) = A(3)
2828	IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
2829	WRITE( IOU,* ) ' ***RD2310 error--NX(1) too large'
2830	WRITE( IOU,* ) ' MAXX1,NX(1)=', MAXX1, NX
2831	IERR = 2
2832	NDIAG = NDIAG + 1
2833	RETURN
2834	ENDIF
2835	IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
2836	DO 30 N=1,NV
2837	READ( IUN,*,ERR=202,END=102 ) ( V(I,N), I=1,NX )
2838	30 CONTINUE
2839	C
2840	C Define X1(I).
2841	C
2842	DO 40 I=1,NX
2843	X1(I) = A(2) + A(3) * FLOAT( I-1 )
2844	40 CONTINUE
2845	ENDIF
2846	RETURN
2847	C
2848	C Flag EOF.
2849	C
2850	100 CONTINUE
2851	IERR = -1
2852	RETURN
2853	102 CONTINUE
2854	IERR = -1
2855	WRITE( IOU,* ) ' ***RD2310 encountered EOF while reading values'
2856	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
2857	WRITE( IOU,* ) ' at independent variable mark X2=', X2
2858	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2859	NDIAG = NDIAG + 1
2860	RETURN
2861	C
2862	C Flag read error.
2863	C
2864	200 CONTINUE
2865	IERR = 1
2866	WRITE( IOU,* ) ' ***RD2310 error reading independent variable X2'
2867	WRITE( IOU,* ) ' Last successfully read value of X2=', X2
2868	WRITE( IOU,* ) ' NAUXV=', NAUXV
2869	NDIAG = NDIAG + 1
2870	RETURN
2871	202 CONTINUE
2872	IERR = 1
2873	WRITE( IOU,* ) ' ***RD2310 error while reading values'
2874	WRITE( IOU,* ) ' of primary variable V(I,N), N=', N
2875	WRITE( IOU,* ) ' at independent variable mark X2=', X2
2876	WRITE( IOU,* ) ' NV, NX(1)=', NV, NX
2877	NDIAG = NDIAG + 1
2878	RETURN
2879	END
2880	SUBROUTINE RD3010 ( X3, A, NAUXV, V, MAXX1, NX, NV,
2881	* IUN, IOU, ISU, RETDAT, NDIAG, IERR )
2882	C
2883	C Subroutine to read a data record group for FFI=3010.
2884	C IERR = 0 = successful read.
2885	C = -1 = EOF encountered.
2886	C = +1 = read error.
2887	C If RETDAT=.TRUE. then the primary variable values are written to
2888	C the scratch file unit ISU.
2889	C
2890	LOGICAL RETDAT
2891	C
2892	DIMENSION A( * ), V( MAXX1,* ), NX( * )
2893	C
2894	IERR = 0
2895	C
2896	C Read a group of data records.
2897	C
2898	IF( NAUXV .GT. 0 ) THEN
2899	READ( IUN,*,ERR=201,END=100 ) X3, ( A(IA), IA=1,NAUXV )
2900	ELSE
2901	READ( IUN,*,ERR=200,END=100 ) X3
2902	ENDIF
2903	DO 30 N=1,NV
2904	DO 28 J=1,NX(2)
2905	READ( IUN,*,ERR=202,END=102 ) ( V(I,1), I=1,NX(1) )
2906	IF( RETDAT ) THEN
2907	WRITE( ISU ) ( V(I,1), I=1,NX(1) )
2908	ENDIF
2909	28 CONTINUE
2910	30 CONTINUE
2911	RETURN
2912	C
2913	C Flag EOF.
2914	C
2915	100 CONTINUE
2916	IERR = -1
2917	RETURN
2918	102 CONTINUE
2919	IERR = -1
2920	WRITE( IOU,* ) ' ***RD3010 encountered EOF while reading values'
2921	WRITE( IOU,* ) ' of primary variable V(I,J,N), J,N=', J, N
2922	WRITE( IOU,* ) ' at independent variable mark X3=', X3
2923	WRITE( IOU,* ) ' NX(1), NX(2), NV=', NX(1), NX(2), NV
2924	NDIAG = NDIAG + 1
2925	RETURN
2926	C
2927	C Flag read error.
2928	C
2929	200 CONTINUE
2930	IERR = 1
2931	WRITE( IOU,* )
2932	* ' ***RD3010 error reading independent variable X3'
2933	WRITE( IOU,* ) ' Last successfully read value of X3=', X3
2934	NDIAG = NDIAG + 1
2935	RETURN
2936	201 CONTINUE
2937	IERR = 1
2938	WRITE( IOU,* )
2939	* ' ***RD3010 error reading independent and auxilary variables'
2940	WRITE( IOU,* ) ' Last successfully read value of X3=', X3
2941	WRITE( IOU,* ) ' NAUXV=', NAUXV
2942	NDIAG = NDIAG + 1
2943	RETURN
2944	202 CONTINUE
2945	IERR = 1
2946	WRITE( IOU,* ) ' ***RD3010 error while reading values'
2947	WRITE( IOU,* ) ' of primary variable V(I,J,N), J,N=', J, N
2948	WRITE( IOU,* ) ' at independent variable mark X3=', X3
2949	WRITE( IOU,* ) ' NX(1), NX(2), NV=', NX(1), NX(2), NV
2950	NDIAG = NDIAG + 1
2951	RETURN
2952	END
2953	SUBROUTINE RD4010 ( X4, A, NAUXV, V, MAXX1,
2954	* NX, NV, IUN, IOU, ISU, RETDAT, NDIAG, IERR )
2955	C
2956	C Subroutine to read a data record group for FFI=4010.
2957	C IERR = 0 = successful read.
2958	C = -1 = EOF encountered.
2959	C = +1 = read error.
2960	C If RETDAT=.TRUE. then the primary variable values are written to
2961	C the scratch file unit ISU.
2962	C
2963	LOGICAL RETDAT
2964	C
2965	DIMENSION A( * ), V( MAXX1,* ), NX( * )
2966	C
2967	IERR = 0
2968	C
2969	C Read a group of data records.
2970	C
2971	IF( NAUXV .GT. 0 ) THEN
2972	READ( IUN,*,ERR=201,END=100 ) X4, ( A(IA), IA=1,NAUXV )
2973	ELSE
2974	READ( IUN,*,ERR=200,END=100 ) X4
2975	ENDIF
2976	DO 30 N=1,NV
2977	DO 28 K=1,NX(3)
2978	DO 26 J=1,NX(2)
2979	READ( IUN,*,ERR=202,END=102 ) ( V(I,1), I=1,NX(1) )
2980	IF( RETDAT ) THEN
2981	WRITE( ISU ) ( V(I,1), I=1,NX(1) )
2982	ENDIF
2983	26 CONTINUE
2984	28 CONTINUE
2985	30 CONTINUE
2986	RETURN
2987	C
2988	C Flag EOF.
2989	C
2990	100 CONTINUE
2991	IERR = -1
2992	RETURN
2993	102 CONTINUE
2994	IERR = -1
2995	WRITE( IOU,* ) ' ***RD4010 encountered EOF while reading values'
2996	WRITE( IOU,* ) ' of primary variable V(I,J,K,N), J,K,N=', J,K,N
2997	WRITE( IOU,* ) ' at independent variable mark X4=', X4
2998	WRITE( IOU,* ) ' NX(1), NX(2), NX(3), NV=',(NX(M),M=1,3), NV
2999	NDIAG = NDIAG + 1
3000	RETURN
3001	C
3002	C Flag read error.
3003	C
3004	200 CONTINUE
3005	IERR = 1
3006	WRITE( IOU,* )
3007	* ' ***RD4010 error reading independent variable X4'
3008	WRITE( IOU,* ) ' Last successfully read value of X4=', X4
3009	NDIAG = NDIAG + 1
3010	RETURN
3011	201 CONTINUE
3012	IERR = 1
3013	WRITE( IOU,* )
3014	* ' ***RD4010 error reading independent and auxilary variables'
3015	WRITE( IOU,* ) ' Last successfully read value of X4=', X4
3016	WRITE( IOU,* ) ' NAUXV=', NAUXV
3017	NDIAG = NDIAG + 1
3018	RETURN
3019	202 CONTINUE
3020	IERR = 1
3021	WRITE( IOU,* ) ' ***RD4010 error reading values'
3022	WRITE( IOU,* ) ' of primary variable V(I,J,K,N), J,K,N=', J,K,N
3023	WRITE( IOU,* ) ' at independent variable mark X4=', X4
3024	WRITE( IOU,* ) ' NX(1), NX(2), NX(3), NV=',(NX(M),M=1,3), NV
3025	NDIAG = NDIAG + 1
3026	RETURN
3027	END
3028	SUBROUTINE RDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
3029	* A, AMISS, CA, CAMISS, LENA, NAUXV, NAUXC,
3030	* V, VMISS, MAXX1, NV, NVPM,
3031	* CDUM, DUM, LINE, NBIDR, NCIDR, NVALS,
3032	* CRFMT, RETDAT, PARSIT,
3033	* IUN, IOU, ISU, NIVM,
3034	* ISUBV, NDIAG, IERR )
3035	C
3036	C Subroutine to drive data reading routines and check independent
3037	C variable values.
3038	C ISUBV is defined in subroutine RHEAD and used in this routine
3039	C to determine which routine to call.
3040	C
3041	C Required routines: L3RVAL,
3042	C PD1001, PD1010, PD1020,
3043	C PD2010, PD2110, PD2160, PD2310,
3044	C PD3010, PD4010,
3045	C RD1001, RD1010, RD1020,
3046	C RD2010, RD2110, RD2160, RD2310,
3047	C RD3010, RD4010,
3048	C TCIVM, TSTDX, TMON3, TMONO, TRIVM.
3049	C
3050	C History:
3051	C 91-10-23 (SEG) Added PARSIT code.
3052	C Omit testing of X1 if NX(1)=AMISS(1) or NX(1)=0 for
3053	C formats 2110, 2160.
3054	C 91-06-26 (SEG) Improved DX(1) tests for FFI 1020.
3055	C
3056	PARAMETER ( MXVAL = 3 )
3057	C
3058	LOGICAL PARSIT, RETDAT
3059	C
3060	CHARACTER() CA( * )
3061	CHARACTER() CAMISS( * )
3062	CHARACTER() CDUM
3063	CHARACTER() CRFMT
3064	CHARACTER*255 CVAL( MXVAL )
3065	CHARACTER() CX2
3066	CHARACTER*5 SUBFLG
3067	C
3068	DIMENSION A( * ), AMISS( * ), V( MAXX1,* ), VMISS( * )
3069	DIMENSION LENA( * ), LENX( * ), X1( * ), X2( * ), X3( * )
3070	DIMENSION DX( * ), NX( * )
3071	DIMENSION RVAL( MXVAL ), TVAL( 2 )
3072	DIMENSION DUM( * )
3073	C
3074	DATA NSF / 5 /
3075	DATA SUBFLG / 'RDATA' /
3076	C
3077	GO TO ( 1001, 1010, 1020,
3078	* 2010, 2110, 2160, 2310,
3079	* 3010, 4010 ) ISUBV
3080	WRITE( IOU,* ) ' ***RDATA error--improper value for ISUBV=',
3081	* ISUBV
3082	NDIAG = NDIAG + 1
3083	IERR = 2
3084	RETURN
3085	1001 CONTINUE
3086	IF( PARSIT ) THEN
3087	CALL PD1001 ( X1, V, VMISS, NV, CDUM, DUM,
3088	* LINE, NCIDR, NBIDR, NVALS,
3089	* CRFMT, IUN, IOU, NDIAG, IERR )
3090	ELSE
3091	CALL RD1001 ( X1, V, NV, IUN, IOU, NDIAG, IERR )
3092	ENDIF
3093	CALL TRIVM ( X1, DX, RVAL, 'X1', 2, NIVM, XIV0,
3094	* NDIAG, IOU, IERR )
3095	RETURN
3096	1010 CONTINUE
3097	IF( PARSIT ) THEN
3098	CALL PD1010 ( X1, A, AMISS, NAUXV, V, VMISS, NV,
3099	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
3100	* IUN, IOU, NDIAG, IERR )
3101	ELSE
3102	CALL RD1010 ( X1, A, NAUXV, V(1,1), NV,
3103	* IUN, IOU, NDIAG, IERR )
3104	ENDIF
3105	CALL TRIVM ( X1, DX, RVAL, 'X1', 2, NIVM, XIV0,
3106	* NDIAG, IOU, IERR )
3107	RETURN
3108	1020 CONTINUE
3109	IF( PARSIT ) THEN
3110	CALL PD1020 ( X1, DX, A, AMISS, NAUXV,
3111	* V, VMISS, MAXX1, NVPM, NV,
3112	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
3113	* IUN, IOU, NDIAG, IERR )
3114	ELSE
3115	CALL RD1020 ( X1, DX, A, NAUXV, V, MAXX1, NVPM, NV,
3116	* IUN, IOU, NDIAG, IERR )
3117	ENDIF
3118	IF( IERR .EQ. 0 ) THEN
3119	NIVM = NIVM + 1
3120	CALL L3RVAL ( X1, NIVM, RVAL, XIV0 )
3121	CALL TMON3 ( RVAL, MIN0(NIVM,3), DX, SUBFLG, NSF,
3122	* 'X1', 2, NBAD, IOU )
3123	NDIAG = NDIAG + NBAD
3124	TVAL(1) = XIV0
3125	TVAL(2) = RVAL(MIN0(3,NIVM))
3126	CALL TSTDX ( TVAL, MIN0(NIVM-1,2), (NIVM-1)*NVPM+1, DX,
3127	* SUBFLG, NSF, 'X1', 2, NDIAG, IOU )
3128	ENDIF
3129	RETURN
3130	2010 CONTINUE
3131	IF( PARSIT ) THEN
3132	CALL PD2010 ( X2, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
3133	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
3134	* IUN, IOU, NDIAG, IERR )
3135	ELSE
3136	CALL RD2010 ( X2, A, NAUXV, V, MAXX1, NX, NV,
3137	* IUN, IOU, NDIAG, IERR )
3138	ENDIF
3139	CALL TRIVM ( X2, DX(2), RVAL, 'X2', 2, NIVM, XIV0,
3140	* NDIAG, IOU, IERR )
3141	RETURN
3142	2110 CONTINUE
3143	IF( PARSIT ) THEN
3144	CALL PD2110 ( X1, X2, A, AMISS, NAUXV, V, VMISS, MAXX1,
3145	* NX, NV, CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
3146	* CRFMT, IUN, IOU, NDIAG, IERR )
3147	ELSE
3148	CALL RD2110 ( X1, X2, A, AMISS, NAUXV, V, MAXX1, NX, NV,
3149	* IUN, IOU, NDIAG, IERR )
3150	ENDIF
3151	CALL TRIVM ( X2, DX(2), RVAL, 'X2', 2, NIVM, XIV0,
3152	* NDIAG, IOU, IERR )
3153	IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
3154	CALL TMONO ( X1, NX, DX, SUBFLG, NSF, 'X1', 2, NBAD, IOU )
3155	NDIAG = NDIAG + NBAD
3156	CALL TSTDX ( X1, NX, NX, DX, SUBFLG, NSF, 'X1', 2, NDIAG, IOU )
3157	ENDIF
3158	RETURN
3159	2160 CONTINUE
3160	IF( PARSIT ) THEN
3161	CALL PD2160 ( X1, CX2, LENX,
3162	* A, AMISS, NAUXV, CA, CAMISS, LENA, NAUXC,
3163	* V, VMISS, MAXX1, NX, NV,
3164	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
3165	* CRFMT, IUN, IOU, NDIAG, IERR )
3166	ELSE
3167	CALL RD2160 ( X1, CX2, LENX, A, AMISS, CA, NAUXV, NAUXC,
3168	* V, MAXX1, NX, NV,
3169	* CRFMT, IUN, IOU, NDIAG, IERR )
3170	ENDIF
3171	CALL TCIVM ( CX2, LENX(2), CVAL, 'X2', 2, NIVM,
3172	* NDIAG, IOU, IERR )
3173	IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
3174	CALL TMONO ( X1, NX, DX, SUBFLG, NSF, 'X1', 2, NBAD, IOU )
3175	NDIAG = NDIAG + NBAD
3176	CALL TSTDX ( X1, NX, NX, DX, SUBFLG, NSF, 'X1', 2, NDIAG, IOU )
3177	ENDIF
3178	RETURN
3179	2310 CONTINUE
3180	IF( PARSIT ) THEN
3181	CALL PD2310 ( X2, A, AMISS, NAUXV, V, VMISS, X1, MAXX1,
3182	* NX, NV, DX,
3183	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
3184	* IUN, IOU, NDIAG, IERR )
3185	ELSE
3186	CALL RD2310 ( X2, A, AMISS, NAUXV, V, X1, MAXX1, NX, NV, DX,
3187	* IUN, IOU, NDIAG, IERR )
3188	ENDIF
3189	CALL TRIVM ( X2, DX(2), RVAL, 'X2', 2, NIVM, XIV0,
3190	* NDIAG, IOU, IERR )
3191	RETURN
3192	3010 CONTINUE
3193	IF( PARSIT ) THEN
3194	CALL PD3010 ( X3, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
3195	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
3196	* IUN, IOU, ISU, RETDAT, NDIAG, IERR )
3197	ELSE
3198	CALL RD3010 ( X3, A, NAUXV, V, MAXX1, NX, NV,
3199	* IUN, IOU, ISU, RETDAT, NDIAG, IERR )
3200	ENDIF
3201	CALL TRIVM ( X3, DX(3), RVAL, 'X3', 2, NIVM, XIV0,
3202	* NDIAG, IOU, IERR )
3203	RETURN
3204	4010 CONTINUE
3205	IF( PARSIT ) THEN
3206	CALL PD4010 ( X4, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
3207	* CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
3208	* IUN, IOU, ISU, RETDAT, NDIAG, IERR )
3209	ELSE
3210	CALL RD4010 ( X4, A, NAUXV, V, MAXX1,
3211	* NX, NV, IUN, IOU, ISU, RETDAT, NDIAG, IERR )
3212	ENDIF
3213	CALL TRIVM ( X4, DX(4), RVAL, 'X4', 2, NIVM, XIV0,
3214	* NDIAG, IOU, IERR )
3215	RETURN
3216	END
3217	SUBROUTINE RH1001 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3218	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3219	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
3220	* NSCOML, SCOM, NNCOML, NCOM,
3221	* MAXV, MAXCOM, CDUM,
3222	* CRFMT, IUN, IOU, NDIAG, IERR )
3223	C
3224	C Subroutine to read file header for FFI=1010.
3225	C IERR = 0 = successful read.
3226	C = <0 = EOF encountered.
3227	C = >0 = read error.
3228	C
3229	C History:
3230	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
3231	C and TIXN routines, to `parse' numeric values in the
3232	C file header records.
3233	C
3234	C Required routines: PARHD, RHBGIN, RHSTRN, TIXN.
3235	C
3236	C
3237	CHARACTER() CDUM
3238	CHARACTER() CRFMT
3239	CHARACTER() MNAME
3240	CHARACTER() NCOM( * )
3241	CHARACTER() ONAME
3242	CHARACTER() ORG
3243	CHARACTER() SCOM( * )
3244	CHARACTER() SNAME
3245	CHARACTER*6 SUBFLG
3246	CHARACTER() VNAME( * )
3247	CHARACTER() XNAME
3248	C
3249	DIMENSION VMISS( * ), VSCAL( * )
3250	C
3251	DATA NSF / 6 /
3252	DATA SUBFLG / 'RH1001' /
3253	C
3254	C
3255	IERR = 0
3256	LINE = 0
3257	NCIDR= 0
3258	NBIDR= 0
3259	C
3260	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3261	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3262	* LINE, SUBFLG, NSF, CDUM, CRFMT,
3263	* IUN, IOU, NDIAG, IERR )
3264	IF( IERR .NE. 0 ) RETURN
3265	C
3266	CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
3267	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3268	* CRFMT, IUN, IOU, NDIAG, IERR )
3269	IF( IERR .NE. 0 ) RETURN
3270	C
3271	CALL RHSTRN ( XNAME, 1, SUBFLG, NSF, 'XNAME', 5,
3272	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3273	IF( IERR .NE. 0 ) RETURN
3274	C
3275	CALL PARHD ( RNV, 1, NFIND, SUBFLG, NSF, 'NV', 2,
3276	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3277	* CRFMT, IUN, IOU, NDIAG, IERR )
3278	IF( IERR .NE. 0 ) RETURN
3279	NV = INT( RNV + 0.5 )
3280	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
3281	* IUN, IOU, NDIAG, IERR )
3282	IF( IERR .NE. 0 ) RETURN
3283	C
3284	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
3285	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3286	* CRFMT, IUN, IOU, NDIAG, IERR )
3287	IF( IERR .NE. 0 ) RETURN
3288	DO 40 N=1,NV
3289	IF( VSCAL(N) .EQ. 0.0 ) THEN
3290	WRITE(IOU,) ' *RH1001 error--VSCAL(N)=0, for N=', N
3291	ENDIF
3292	40 CONTINUE
3293	C
3294	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
3295	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3296	* CRFMT, IUN, IOU, NDIAG, IERR )
3297	IF( IERR .NE. 0 ) RETURN
3298	C
3299	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
3300	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3301	IF( IERR .NE. 0 ) RETURN
3302	C
3303	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
3304	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3305	* CRFMT, IUN, IOU, NDIAG, IERR )
3306	IF( IERR .NE. 0 ) RETURN
3307	NSCOML = INT( DUM + 0.5 )
3308	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
3309	* IUN, IOU, NDIAG, IERR )
3310	IF( IERR .NE. 0 ) RETURN
3311	C
3312	IF( NSCOML .GT. 0 ) THEN
3313	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
3314	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3315	IF( IERR .NE. 0 ) RETURN
3316	ENDIF
3317	C
3318	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
3319	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3320	* CRFMT, IUN, IOU, NDIAG, IERR )
3321	IF( IERR .NE. 0 ) RETURN
3322	NNCOML = INT( DUM + 0.5 )
3323	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
3324	* IUN, IOU, NDIAG, IERR )
3325	IF( IERR .NE. 0 ) RETURN
3326	C
3327	IF( NNCOML .GT. 0 ) THEN
3328	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
3329	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3330	IF( IERR .NE. 0 ) RETURN
3331	ENDIF
3332	C
3333	IF( LINE .NE. NLHEAD ) THEN
3334	WRITE(IOU,) ' *RH1001 thinks NLHEAD may be in error'
3335	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
3336	NDIAG = NDIAG + 1
3337	ENDIF
3338	RETURN
3339	END
3340	SUBROUTINE RH1010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3341	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3342	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
3343	* NAUXV, ASCAL, AMISS, ANAME,
3344	* NSCOML, SCOM, NNCOML, NCOM,
3345	* MAXV, MAXA, MAXCOM, CDUM,
3346	* CRFMT, IUN, IOU, NDIAG, IERR )
3347	C
3348	C Subroutine to read file header for FFI=1010.
3349	C IERR = 0 = successful read.
3350	C = <0 = EOF encountered.
3351	C = >0 = read error.
3352	C
3353	C History:
3354	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
3355	C and TIXN routines, to `parse' numeric values in the
3356	C file header records.
3357	C
3358	C Required routines: PARHD, RHBGIN, RHSTRN, TIXN.
3359	C
3360	C
3361	CHARACTER() ANAME( * )
3362	CHARACTER() CDUM
3363	CHARACTER() CRFMT
3364	CHARACTER() MNAME
3365	CHARACTER() NCOM( * )
3366	CHARACTER() ONAME
3367	CHARACTER() ORG
3368	CHARACTER() SCOM( * )
3369	CHARACTER() SNAME
3370	CHARACTER*6 SUBFLG
3371	CHARACTER() VNAME( * )
3372	CHARACTER() XNAME
3373	C
3374	DIMENSION AMISS( * ), ASCAL( * )
3375	DIMENSION VMISS( * ), VSCAL( * )
3376	C
3377	DATA NSF / 6 /
3378	DATA SUBFLG / 'RH1010' /
3379	C
3380	C
3381	IERR = 0
3382	LINE = 0
3383	NCIDR = 0
3384	NBIDR = 0
3385	C
3386	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3387	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3388	* LINE, SUBFLG, NSF, CDUM, CRFMT,
3389	* IUN, IOU, NDIAG, IERR )
3390	IF( IERR .NE. 0 ) RETURN
3391	C
3392	CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
3393	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3394	* CRFMT, IUN, IOU, NDIAG, IERR )
3395	IF( IERR .NE. 0 ) RETURN
3396	C
3397	CALL RHSTRN ( XNAME, 1, SUBFLG, NSF, 'XNAME', 5,
3398	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3399	IF( IERR .NE. 0 ) RETURN
3400	C
3401	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
3402	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3403	* CRFMT, IUN, IOU, NDIAG, IERR )
3404	IF( IERR .NE. 0 ) RETURN
3405	NV = INT( DUM + 0.5 )
3406	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
3407	* IUN, IOU, NDIAG, IERR )
3408	IF( IERR .NE. 0 ) RETURN
3409	C
3410	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
3411	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3412	* CRFMT, IUN, IOU, NDIAG, IERR )
3413	IF( IERR .NE. 0 ) RETURN
3414	DO 40 N=1,NV
3415	IF( VSCAL(N) .EQ. 0.0 ) THEN
3416	WRITE(IOU,) ' *RH1010 error--VSCAL(N)=0, for N=', N
3417	ENDIF
3418	40 CONTINUE
3419	C
3420	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
3421	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3422	* CRFMT, IUN, IOU, NDIAG, IERR )
3423	IF( IERR .NE. 0 ) RETURN
3424	C
3425	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
3426	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3427	IF( IERR .NE. 0 ) RETURN
3428	C
3429	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
3430	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3431	* CRFMT, IUN, IOU, NDIAG, IERR )
3432	IF( IERR .NE. 0 ) RETURN
3433	NAUXV = INT( DUM + 0.5 )
3434	CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
3435	* IUN, IOU, NDIAG, IERR )
3436	IF( IERR .NE. 0 ) RETURN
3437	C
3438	IF( NAUXV .GT. 0 ) THEN
3439	CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
3440	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3441	* CRFMT, IUN, IOU, NDIAG, IERR )
3442	IF( IERR .NE. 0 ) RETURN
3443	DO 50 NA=1,NAUXV
3444	IF( ASCAL(NA) .EQ. 0.0 ) THEN
3445	WRITE(IOU,) ' *RH1010 error--ASCAL(I)=0, for I=', NA
3446	ENDIF
3447	50 CONTINUE
3448	C
3449	CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
3450	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3451	* CRFMT, IUN, IOU, NDIAG, IERR )
3452	IF( IERR .NE. 0 ) RETURN
3453	C
3454	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
3455	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3456	IF( IERR .NE. 0 ) RETURN
3457	ENDIF
3458	C
3459	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
3460	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3461	* CRFMT, IUN, IOU, NDIAG, IERR )
3462	IF( IERR .NE. 0 ) RETURN
3463	NSCOML = INT( DUM + 0.5 )
3464	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
3465	* IUN, IOU, NDIAG, IERR )
3466	IF( IERR .NE. 0 ) RETURN
3467	C
3468	IF( NSCOML .GT. 0 ) THEN
3469	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
3470	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3471	IF( IERR .NE. 0 ) RETURN
3472	ENDIF
3473	C
3474	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
3475	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3476	* CRFMT, IUN, IOU, NDIAG, IERR )
3477	IF( IERR .NE. 0 ) RETURN
3478	NNCOML = INT( DUM + 0.5 )
3479	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
3480	* IUN, IOU, NDIAG, IERR )
3481	IF( IERR .NE. 0 ) RETURN
3482	C
3483	IF( NNCOML .GT. 0 ) THEN
3484	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
3485	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3486	IF( IERR .NE. 0 ) RETURN
3487	ENDIF
3488	C
3489	IF( LINE .NE. NLHEAD ) THEN
3490	WRITE(IOU,) ' *RH1010 thinks NLHEAD may be in error'
3491	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
3492	NDIAG = NDIAG + 1
3493	ENDIF
3494	RETURN
3495	END
3496	SUBROUTINE RH1020 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3497	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3498	* DX, NVPM, XNAME, NV, VSCAL, VMISS, VNAME,
3499	* NAUXV, ASCAL, AMISS, ANAME,
3500	* NSCOML, SCOM, NNCOML, NCOM,
3501	* MAXX1, MAXV, MAXA, MAXCOM, CDUM,
3502	* CRFMT, IUN, IOU, NDIAG, IERR )
3503	C
3504	C Subroutine to read file header for FFI=1020.
3505	C IERR = 0 = successful read.
3506	C = <0 = EOF encountered.
3507	C = >0 = read error.
3508	C
3509	C History:
3510	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
3511	C and TIXN routines, to `parse' numeric values in the
3512	C file header records.
3513	C
3514	C Required routines: PARHD, RHBGIN, RHSTRN, TIXN.
3515	C
3516	C
3517	CHARACTER() ANAME( * )
3518	CHARACTER() CDUM
3519	CHARACTER() CRFMT
3520	CHARACTER() MNAME
3521	CHARACTER() NCOM( * )
3522	CHARACTER() ONAME
3523	CHARACTER() ORG
3524	CHARACTER() SCOM( * )
3525	CHARACTER() SNAME
3526	CHARACTER*6 SUBFLG
3527	CHARACTER() VNAME( * )
3528	CHARACTER() XNAME
3529	C
3530	DIMENSION AMISS( * ), ASCAL( * )
3531	DIMENSION VMISS( * ), VSCAL( * )
3532	C
3533	DATA NSF / 6 /
3534	DATA SUBFLG / 'RH1020' /
3535	C
3536	C
3537	IERR = 0
3538	LINE = 0
3539	NCIDR = 0
3540	NBIDR = 0
3541	C
3542	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3543	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3544	* LINE, SUBFLG, NSF, CDUM, CRFMT,
3545	* IUN, IOU, NDIAG, IERR )
3546	IF( IERR .NE. 0 ) RETURN
3547	C
3548	CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
3549	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3550	* CRFMT, IUN, IOU, NDIAG, IERR )
3551	IF( IERR .NE. 0 ) RETURN
3552	IF( DX .EQ. 0.0 ) THEN
3553	WRITE(IOU,) ' *RH1020 error, DX=0'
3554	NDIAG = NDIAG + 1
3555	ENDIF
3556	C
3557	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NVPM', 4,
3558	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3559	* CRFMT, IUN, IOU, NDIAG, IERR )
3560	IF( IERR .NE. 0 ) RETURN
3561	NVPM = INT( DUM + 0.5 )
3562	CALL TIXN ( NVPM, 1, MAXX1, SUBFLG, NSF, 'NVPM', 4,
3563	* IUN, IOU, NDIAG, IERR )
3564	IF( IERR .NE. 0 ) RETURN
3565	C
3566	CALL RHSTRN ( XNAME, 1, SUBFLG, NSF, 'XNAME', 5,
3567	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3568	IF( IERR .NE. 0 ) RETURN
3569	C
3570	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
3571	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3572	* CRFMT, IUN, IOU, NDIAG, IERR )
3573	IF( IERR .NE. 0 ) RETURN
3574	NV = INT( DUM + 0.5 )
3575	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
3576	* IUN, IOU, NDIAG, IERR )
3577	IF( IERR .NE. 0 ) RETURN
3578	C
3579	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
3580	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3581	* CRFMT, IUN, IOU, NDIAG, IERR )
3582	IF( IERR .NE. 0 ) RETURN
3583	DO 40 N=1,NV
3584	IF( VSCAL(N) .EQ. 0.0 ) THEN
3585	WRITE(IOU,) ' *RH1020 error--VSCAL(N)=0, for N=', N
3586	ENDIF
3587	40 CONTINUE
3588	C
3589	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
3590	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3591	* CRFMT, IUN, IOU, NDIAG, IERR )
3592	IF( IERR .NE. 0 ) RETURN
3593	C
3594	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
3595	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3596	IF( IERR .NE. 0 ) RETURN
3597	C
3598	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
3599	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3600	* CRFMT, IUN, IOU, NDIAG, IERR )
3601	IF( IERR .NE. 0 ) RETURN
3602	NAUXV = INT( DUM + 0.5 )
3603	CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
3604	* IUN, IOU, NDIAG, IERR )
3605	IF( IERR .NE. 0 ) RETURN
3606	C
3607	IF( NAUXV .GT. 0 ) THEN
3608	CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
3609	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3610	* CRFMT, IUN, IOU, NDIAG, IERR )
3611	IF( IERR .NE. 0 ) RETURN
3612	DO 50 NA=1,NAUXV
3613	IF( ASCAL(NA) .EQ. 0.0 ) THEN
3614	WRITE(IOU,) ' *RH1020 error--ASCAL(I)=0, for I=', NA
3615	ENDIF
3616	50 CONTINUE
3617	C
3618	CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
3619	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3620	* CRFMT, IUN, IOU, NDIAG, IERR )
3621	IF( IERR .NE. 0 ) RETURN
3622	C
3623	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
3624	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3625	IF( IERR .NE. 0 ) RETURN
3626	ENDIF
3627	C
3628	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
3629	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3630	* CRFMT, IUN, IOU, NDIAG, IERR )
3631	IF( IERR .NE. 0 ) RETURN
3632	NSCOML = INT( DUM + 0.5 )
3633	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
3634	* IUN, IOU, NDIAG, IERR )
3635	IF( IERR .NE. 0 ) RETURN
3636	C
3637	IF( NSCOML .GT. 0 ) THEN
3638	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
3639	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3640	IF( IERR .NE. 0 ) RETURN
3641	ENDIF
3642	C
3643	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
3644	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3645	* CRFMT, IUN, IOU, NDIAG, IERR )
3646	IF( IERR .NE. 0 ) RETURN
3647	NNCOML = INT( DUM + 0.5 )
3648	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
3649	* IUN, IOU, NDIAG, IERR )
3650	IF( IERR .NE. 0 ) RETURN
3651	C
3652	IF( NNCOML .GT. 0 ) THEN
3653	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
3654	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3655	IF( IERR .NE. 0 ) RETURN
3656	ENDIF
3657	C
3658	IF( LINE .NE. NLHEAD ) THEN
3659	WRITE(IOU,) ' *RH1020 thinks NLHEAD may be in error'
3660	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
3661	NDIAG = NDIAG + 1
3662	ENDIF
3663	RETURN
3664	END
3665	SUBROUTINE RH2010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3666	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3667	* DX, NX, NXDEF, X1, XNAME,
3668	* NV, VSCAL, VMISS, VNAME,
3669	* NAUXV, ASCAL, AMISS, ANAME,
3670	* NSCOML, SCOM, NNCOML, NCOM,
3671	* MAXX1, MAXV, MAXA, MAXCOM, CDUM,
3672	* CRFMT, IUN, IOU, NDIAG, IERR )
3673	C
3674	C Subroutine to read file header for FFI=2010.
3675	C IERR = 0 = successful read.
3676	C = <0 = EOF encountered.
3677	C = >0 = read error.
3678	C
3679	C History:
3680	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
3681	C and TIXN routines, to `parse' numeric values in the
3682	C file header records.
3683	C
3684	C Required routines: PARHD, RHBGIN, RHSTRN,
3685	C TIXN, TMONO, TSTDX.
3686	C
3687	C
3688	CHARACTER() ANAME( * )
3689	CHARACTER() CDUM
3690	CHARACTER() CRFMT
3691	CHARACTER() MNAME
3692	CHARACTER() NCOM( * )
3693	CHARACTER() ONAME
3694	CHARACTER() ORG
3695	CHARACTER() SCOM( * )
3696	CHARACTER() SNAME
3697	CHARACTER*6 SUBFLG
3698	CHARACTER() VNAME( * )
3699	CHARACTER() XNAME( * )
3700	C
3701	DIMENSION AMISS( * ), ASCAL( * ), DX( * )
3702	DIMENSION VMISS( * ), VSCAL( * ), X1( * )
3703	C
3704	DATA NSF / 6 /
3705	DATA SUBFLG / 'RH2010' /
3706	C
3707	C
3708	IERR = 0
3709	LINE = 0
3710	NCIDR = 0
3711	NBIDR = 0
3712	C
3713	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3714	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3715	* LINE, SUBFLG, NSF, CDUM, CRFMT,
3716	* IUN, IOU, NDIAG, IERR )
3717	IF( IERR .NE. 0 ) RETURN
3718	C
3719	CALL PARHD ( DX, 2, NFIND, SUBFLG, NSF, 'DX', 2,
3720	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3721	* CRFMT, IUN, IOU, NDIAG, IERR )
3722	IF( IERR .NE. 0 ) RETURN
3723	C
3724	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NX', 2,
3725	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3726	* CRFMT, IUN, IOU, NDIAG, IERR )
3727	IF( IERR .NE. 0 ) RETURN
3728	NX = INT( DUM + 0.5 )
3729	CALL TIXN ( NX, 1, MAXX1, SUBFLG, NSF, 'NX', 2,
3730	* IUN, IOU, NDIAG, IERR )
3731	IF( IERR .NE. 0 ) RETURN
3732	C
3733	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NXDEF', 5,
3734	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3735	* CRFMT, IUN, IOU, NDIAG, IERR )
3736	IF( IERR .NE. 0 ) RETURN
3737	NXDEF = INT( DUM + 0.5 )
3738	CALL TIXN ( NXDEF, 1, NX, SUBFLG, NSF, 'NXDEF', 5,
3739	* IUN, IOU, NDIAG, IERR )
3740	IF( IERR .NE. 0 ) RETURN
3741	IF( NXDEF .GT. 1 .AND. NXDEF .LT. NX ) THEN
3742	WRITE( IOU,* ) ' ***RH2010 error--improper value for NXDEF'
3743	WRITE( IOU,* ) ' MAXX1,NXDEF,NX(1)=', MAXX1, NXDEF, NX
3744	IERR = 2
3745	NDIAG = NDIAG + 1
3746	RETURN
3747	ENDIF
3748	C
3749	CALL PARHD ( X1, NXDEF, NFIND, SUBFLG, NSF, 'X1', 2,
3750	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3751	* CRFMT, IUN, IOU, NDIAG, IERR )
3752	IF( IERR .NE. 0 ) RETURN
3753	IF( NXDEF .GT. 1 ) THEN
3754	CALL TMONO ( X1, NXDEF, DX, SUBFLG, NSF, 'X1', 2, NBAD, IOU )
3755	NDIAG = NDIAG + NBAD
3756	CALL TSTDX ( X1, NXDEF, NX, DX, SUBFLG, NSF, 'X1', 2,
3757	* NDIAG, IOU )
3758	ELSE
3759	IF( NX .GT. 1 .AND. DX(1) .EQ. 0.0 ) THEN
3760	WRITE( IOU,* ) ' **RH2010 error--DX(1)=0 and NXDEF<NX'
3761	WRITE( IOU,* ) ' X1(I) can not be properly defined'
3762	WRITE( IOU,* ) ' NXDEF, NX =', NXDEF, NX
3763	NDIAG = NDIAG + 1
3764	ENDIF
3765	DO 26 I=2,NX
3766	X1(I) = X1(1) + FLOAT( I-1 ) * DX(1)
3767	26 CONTINUE
3768	ENDIF
3769	C
3770	CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
3771	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3772	IF( IERR .NE. 0 ) RETURN
3773	C
3774	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
3775	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3776	* CRFMT, IUN, IOU, NDIAG, IERR )
3777	IF( IERR .NE. 0 ) RETURN
3778	NV = INT( DUM + 0.5 )
3779	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
3780	* IUN, IOU, NDIAG, IERR )
3781	IF( IERR .NE. 0 ) RETURN
3782	C
3783	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
3784	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3785	* CRFMT, IUN, IOU, NDIAG, IERR )
3786	IF( IERR .NE. 0 ) RETURN
3787	DO 40 N=1,NV
3788	IF( VSCAL(N) .EQ. 0.0 ) THEN
3789	WRITE(IOU,) ' *RH2010 error--VSCAL(N)=0, for N=', N
3790	ENDIF
3791	40 CONTINUE
3792	C
3793	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
3794	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3795	* CRFMT, IUN, IOU, NDIAG, IERR )
3796	IF( IERR .NE. 0 ) RETURN
3797	C
3798	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
3799	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3800	IF( IERR .NE. 0 ) RETURN
3801	C
3802	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
3803	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3804	* CRFMT, IUN, IOU, NDIAG, IERR )
3805	IF( IERR .NE. 0 ) RETURN
3806	NAUXV = INT( DUM + 0.5 )
3807	CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
3808	* IUN, IOU, NDIAG, IERR )
3809	IF( IERR .NE. 0 ) RETURN
3810	C
3811	IF( NAUXV .GT. 0 ) THEN
3812	CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
3813	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3814	* CRFMT, IUN, IOU, NDIAG, IERR )
3815	IF( IERR .NE. 0 ) RETURN
3816	DO 50 NA=1,NAUXV
3817	IF( ASCAL(NA) .EQ. 0.0 ) THEN
3818	WRITE(IOU,) ' *RH2010 error--ASCAL(I)=0, for I=', NA
3819	ENDIF
3820	50 CONTINUE
3821	C
3822	CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
3823	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3824	* CRFMT, IUN, IOU, NDIAG, IERR )
3825	IF( IERR .NE. 0 ) RETURN
3826	C
3827	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
3828	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3829	IF( IERR .NE. 0 ) RETURN
3830	ENDIF
3831	C
3832	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
3833	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3834	* CRFMT, IUN, IOU, NDIAG, IERR )
3835	IF( IERR .NE. 0 ) RETURN
3836	NSCOML = INT( DUM + 0.5 )
3837	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
3838	* IUN, IOU, NDIAG, IERR )
3839	IF( IERR .NE. 0 ) RETURN
3840	C
3841	IF( NSCOML .GT. 0 ) THEN
3842	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
3843	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3844	IF( IERR .NE. 0 ) RETURN
3845	ENDIF
3846	C
3847	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
3848	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3849	* CRFMT, IUN, IOU, NDIAG, IERR )
3850	IF( IERR .NE. 0 ) RETURN
3851	NNCOML = INT( DUM + 0.5 )
3852	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
3853	* IUN, IOU, NDIAG, IERR )
3854	IF( IERR .NE. 0 ) RETURN
3855	C
3856	IF( NNCOML .GT. 0 ) THEN
3857	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
3858	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3859	IF( IERR .NE. 0 ) RETURN
3860	ENDIF
3861	C
3862	IF( LINE .NE. NLHEAD ) THEN
3863	WRITE(IOU,) ' *RH2010 thinks NLHEAD may be in error'
3864	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
3865	NDIAG = NDIAG + 1
3866	ENDIF
3867	RETURN
3868	END
3869	SUBROUTINE RH2110 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3870	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3871	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
3872	* NAUXV, ASCAL, AMISS, ANAME,
3873	* NSCOML, SCOM, NNCOML, NCOM,
3874	* MAXV, MAXA, MAXCOM, CDUM,
3875	* CRFMT, IUN, IOU, NDIAG, IERR )
3876	C
3877	C Subroutine to read file header for FFI=2110.
3878	C IERR = 0 = successful read.
3879	C = <0 = EOF encountered.
3880	C = >0 = read error.
3881	C
3882	C History:
3883	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
3884	C and TIXN routines, to `parse' numeric values in the
3885	C file header records.
3886	C
3887	C Required routines: PARHD, RHBGIN, RHSTRN, TIXN.
3888	C
3889	C
3890	CHARACTER() ANAME( * )
3891	CHARACTER() CDUM
3892	CHARACTER() CRFMT
3893	CHARACTER() MNAME
3894	CHARACTER() NCOM( * )
3895	CHARACTER() ONAME
3896	CHARACTER() ORG
3897	CHARACTER() SCOM( * )
3898	CHARACTER() SNAME
3899	CHARACTER*6 SUBFLG
3900	CHARACTER() VNAME( * )
3901	CHARACTER() XNAME( * )
3902	C
3903	DIMENSION AMISS( * ), ASCAL( * ), DX( * )
3904	DIMENSION VMISS( * ), VSCAL( * )
3905	C
3906	DATA NSF / 6 /
3907	DATA SUBFLG / 'RH2110' /
3908	C
3909	C
3910	IERR = 0
3911	LINE = 0
3912	NCIDR = 0
3913	NBIDR = 0
3914	C
3915	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
3916	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
3917	* LINE, SUBFLG, NSF, CDUM, CRFMT,
3918	* IUN, IOU, NDIAG, IERR )
3919	IF( IERR .NE. 0 ) RETURN
3920	C
3921	CALL PARHD ( DX, 2, NFIND, SUBFLG, NSF, 'DX', 2,
3922	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3923	* CRFMT, IUN, IOU, NDIAG, IERR )
3924	IF( IERR .NE. 0 ) RETURN
3925	C
3926	CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
3927	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3928	IF( IERR .NE. 0 ) RETURN
3929	C
3930	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
3931	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3932	* CRFMT, IUN, IOU, NDIAG, IERR )
3933	IF( IERR .NE. 0 ) RETURN
3934	NV = INT( DUM + 0.5 )
3935	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
3936	* IUN, IOU, NDIAG, IERR )
3937	IF( IERR .NE. 0 ) RETURN
3938	C
3939	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
3940	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3941	* CRFMT, IUN, IOU, NDIAG, IERR )
3942	IF( IERR .NE. 0 ) RETURN
3943	DO 40 N=1,NV
3944	IF( VSCAL(N) .EQ. 0.0 ) THEN
3945	WRITE(IOU,) ' *RH2110 error--VSCAL(N)=0, for N=', N
3946	ENDIF
3947	40 CONTINUE
3948	C
3949	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
3950	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3951	* CRFMT, IUN, IOU, NDIAG, IERR )
3952	IF( IERR .NE. 0 ) RETURN
3953	C
3954	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
3955	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3956	IF( IERR .NE. 0 ) RETURN
3957	C
3958	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
3959	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3960	* CRFMT, IUN, IOU, NDIAG, IERR )
3961	IF( IERR .NE. 0 ) RETURN
3962	NAUXV = INT( DUM + 0.5 )
3963	CALL TIXN ( NAUXV, 1, MAXA, SUBFLG, NSF, 'NAUXV', 5,
3964	* IUN, IOU, NDIAG, IERR )
3965	IF( IERR .NE. 0 ) RETURN
3966	C
3967	CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
3968	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3969	* CRFMT, IUN, IOU, NDIAG, IERR )
3970	IF( IERR .NE. 0 ) RETURN
3971	DO 50 NA=1,NAUXV
3972	IF( ASCAL(NA) .EQ. 0.0 ) THEN
3973	WRITE(IOU,) ' *RH2110 error--ASCAL(I)=0, for I=', NA
3974	ENDIF
3975	50 CONTINUE
3976	C
3977	CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
3978	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3979	* CRFMT, IUN, IOU, NDIAG, IERR )
3980	IF( IERR .NE. 0 ) RETURN
3981	C
3982	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
3983	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3984	IF( IERR .NE. 0 ) RETURN
3985	C
3986	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
3987	* LINE, NREAD, CDUM, NCIDR, NBIDR,
3988	* CRFMT, IUN, IOU, NDIAG, IERR )
3989	IF( IERR .NE. 0 ) RETURN
3990	NSCOML = INT( DUM + 0.5 )
3991	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
3992	* IUN, IOU, NDIAG, IERR )
3993	IF( IERR .NE. 0 ) RETURN
3994	C
3995	IF( NSCOML .GT. 0 ) THEN
3996	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
3997	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
3998	IF( IERR .NE. 0 ) RETURN
3999	ENDIF
4000	C
4001	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
4002	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4003	* CRFMT, IUN, IOU, NDIAG, IERR )
4004	IF( IERR .NE. 0 ) RETURN
4005	NNCOML = INT( DUM + 0.5 )
4006	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
4007	* IUN, IOU, NDIAG, IERR )
4008	IF( IERR .NE. 0 ) RETURN
4009	C
4010	IF( NNCOML .GT. 0 ) THEN
4011	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
4012	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4013	IF( IERR .NE. 0 ) RETURN
4014	ENDIF
4015	C
4016	IF( LINE .NE. NLHEAD ) THEN
4017	WRITE(IOU,) ' *RH2110 thinks NLHEAD may be in error'
4018	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
4019	NDIAG = NDIAG + 1
4020	ENDIF
4021	RETURN
4022	END
4023	SUBROUTINE RH2160 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4024	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4025	* DX, LENX, XNAME, NV, VSCAL, VMISS, VNAME,
4026	* NAUXV, ASCAL, AMISS, ANAME,
4027	* NAUXC, LENA, CAMISS, DUMLEN,
4028	* NSCOML, SCOM, NNCOML, NCOM,
4029	* MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM,
4030	* CRFMT, IUN, IOU, NDIAG, IERR )
4031	C
4032	C Subroutine to read file header for FFI=2160.
4033	C IERR = 0 = successful read.
4034	C = <0 = EOF encountered.
4035	C = >0 = read error.
4036	C
4037	C History:
4038	C 93-03-11 - Added code to test for NAUXV+NAUXC > MAXA.
4039	C
4040	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
4041	C and TIXN routines, to `parse' numeric values in the
4042	C file header records.
4043	C
4044	C Required routines: PARHD, RHBGIN, RHSTRN, TIXN.
4045	C
4046	C
4047	CHARACTER() ANAME( * )
4048	CHARACTER() CAMISS( * )
4049	CHARACTER() CDUM
4050	CHARACTER() CRFMT
4051	CHARACTER() MNAME
4052	CHARACTER() NCOM( * )
4053	CHARACTER() ONAME
4054	CHARACTER() ORG
4055	CHARACTER() SCOM( * )
4056	CHARACTER() SNAME
4057	CHARACTER*6 SUBFLG
4058	CHARACTER() VNAME( * )
4059	CHARACTER() XNAME( * )
4060	C
4061	DIMENSION AMISS( * ), ASCAL( * ), LENA( * ), DUMLEN( * )
4062	DIMENSION VMISS( * ), VSCAL( * ), LENX( * )
4063	C
4064	DATA NSF / 6 /
4065	DATA SUBFLG / 'RH2160' /
4066	C
4067	C
4068	IERR = 0
4069	LINE = 0
4070	NCIDR = 0
4071	NBIDR = 0
4072	C
4073	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4074	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4075	* LINE, SUBFLG, NSF, CDUM, CRFMT,
4076	* IUN, IOU, NDIAG, IERR )
4077	IF( IERR .NE. 0 ) RETURN
4078	C
4079	CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
4080	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4081	* CRFMT, IUN, IOU, NDIAG, IERR )
4082	IF( IERR .NE. 0 ) RETURN
4083	C
4084	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'LENX(2)', 7,
4085	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4086	* CRFMT, IUN, IOU, NDIAG, IERR )
4087	IF( IERR .NE. 0 ) RETURN
4088	LENX(2) = INT( DUM + 0.5 )
4089	CALL TIXN ( LENX(2), 1, MAXCPL, SUBFLG, NSF, 'LENX(2)', 7,
4090	* IUN, IOU, NDIAG, IERR )
4091	IF( IERR .NE. 0 ) RETURN
4092	C
4093	CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
4094	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4095	IF( IERR .NE. 0 ) RETURN
4096	C
4097	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
4098	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4099	* CRFMT, IUN, IOU, NDIAG, IERR )
4100	IF( IERR .NE. 0 ) RETURN
4101	NV = INT( DUM + 0.5 )
4102	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
4103	* IUN, IOU, NDIAG, IERR )
4104	IF( IERR .NE. 0 ) RETURN
4105	C
4106	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
4107	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4108	* CRFMT, IUN, IOU, NDIAG, IERR )
4109	IF( IERR .NE. 0 ) RETURN
4110	DO 40 N=1,NV
4111	IF( VSCAL(N) .EQ. 0.0 ) THEN
4112	WRITE(IOU,) ' *RH2160 error--VSCAL(N)=0, for N=', N
4113	ENDIF
4114	40 CONTINUE
4115	C
4116	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
4117	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4118	* CRFMT, IUN, IOU, NDIAG, IERR )
4119	IF( IERR .NE. 0 ) RETURN
4120	C
4121	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
4122	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4123	IF( IERR .NE. 0 ) RETURN
4124	C
4125	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
4126	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4127	* CRFMT, IUN, IOU, NDIAG, IERR )
4128	IF( IERR .NE. 0 ) RETURN
4129	NAUXV = INT( DUM + 0.5 )
4130	CALL TIXN ( NAUXV, 1, MAXA, SUBFLG, NSF, 'NAUXV', 5,
4131	* IUN, IOU, NDIAG, IERR )
4132	IF( IERR .NE. 0 ) RETURN
4133	C
4134	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXC', 5,
4135	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4136	* CRFMT, IUN, IOU, NDIAG, IERR )
4137	IF( IERR .NE. 0 ) RETURN
4138	NAUXC = INT( DUM + 0.5 )
4139	CALL TIXN ( NAUXC, 0, MAXCA, SUBFLG, NSF, 'NAUXC', 5,
4140	* IUN, IOU, NDIAG, IERR )
4141	IF( IERR .NE. 0 ) RETURN
4142	C
4143	c CALL TIXN ( NAUXV+NAUXC, 0, MAXA, SUBFLG, NSF, 'NAUXV+NAUXC', 11,
4144	c * IUN, IOU, NDIAG, IERR )
4145	c IF( IERR .NE. 0 ) RETURN
4146	C
4147	CALL PARHD ( ASCAL, NAUXV-NAUXC, NFIND, SUBFLG, NSF, 'ASCAL', 5,
4148	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4149	* CRFMT, IUN, IOU, NDIAG, IERR )
4150	IF( IERR .NE. 0 ) RETURN
4151	DO 50 NA=1,NAUXV-NAUXC
4152	IF( ASCAL(NA) .EQ. 0.0 ) THEN
4153	WRITE(IOU,) ' *RH2160 error--ASCAL(I)=0, for I=', NA
4154	ENDIF
4155	50 CONTINUE
4156	C
4157	CALL PARHD ( AMISS, NAUXV-NAUXC, NFIND, SUBFLG, NSF, 'AMISS', 5,
4158	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4159	* CRFMT, IUN, IOU, NDIAG, IERR )
4160	IF( IERR .NE. 0 ) RETURN
4161	C
4162	IF( NAUXC .GT. 0 ) THEN
4163	CALL PARHD ( DUMLEN, NAUXC, NFIND, SUBFLG, NSF, 'LENA', 4,
4164	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4165	* CRFMT, IUN, IOU, NDIAG, IERR )
4166	IF( IERR .NE. 0 ) RETURN
4167	C
4168	DO 72 IC=1,NAUXC
4169	LENA(IC) = INT( DUMLEN(IC) + 0.5 )
4170	IF( LENA(IC) .LT. 1 .OR. LENA(IC) .GT. MAXCPL ) THEN
4171	WRITE( IOU,* ) ' ***RH2160 error--improper LENA', IC
4172	WRITE( IOU,* ) ' MAXCPL,LENA(IC)=', MAXCPL, LENA(IC)
4173	IERR = 2
4174	NDIAG = NDIAG + 1
4175	RETURN
4176	ENDIF
4177	72 CONTINUE
4178	C
4179	CALL RHSTRN ( CAMISS, NAUXC, SUBFLG, NSF, 'CAMISS', 6,
4180	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4181	IF( IERR .NE. 0 ) RETURN
4182	ENDIF
4183	C
4184	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
4185	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4186	IF( IERR .NE. 0 ) RETURN
4187	C
4188	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
4189	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4190	* CRFMT, IUN, IOU, NDIAG, IERR )
4191	IF( IERR .NE. 0 ) RETURN
4192	NSCOML = INT( DUM + 0.5 )
4193	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
4194	* IUN, IOU, NDIAG, IERR )
4195	IF( IERR .NE. 0 ) RETURN
4196	C
4197	IF( NSCOML .GT. 0 ) THEN
4198	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
4199	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4200	IF( IERR .NE. 0 ) RETURN
4201	ENDIF
4202	C
4203	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
4204	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4205	* CRFMT, IUN, IOU, NDIAG, IERR )
4206	IF( IERR .NE. 0 ) RETURN
4207	NNCOML = INT( DUM + 0.5 )
4208	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
4209	* IUN, IOU, NDIAG, IERR )
4210	IF( IERR .NE. 0 ) RETURN
4211	C
4212	IF( NNCOML .GT. 0 ) THEN
4213	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
4214	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4215	IF( IERR .NE. 0 ) RETURN
4216	ENDIF
4217	C
4218	IF( LINE .NE. NLHEAD ) THEN
4219	WRITE(IOU,) ' *RH2160 thinks NLHEAD may be in error'
4220	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
4221	NDIAG = NDIAG + 1
4222	ENDIF
4223	RETURN
4224	END
4225	SUBROUTINE RH2310 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4226	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4227	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
4228	* NAUXV, ASCAL, AMISS, ANAME,
4229	* NSCOML, SCOM, NNCOML, NCOM,
4230	* MAXV, MAXA, MAXCOM, CDUM,
4231	* CRFMT, IUN, IOU, NDIAG, IERR )
4232	C
4233	C Subroutine to read file header for FFI=2310.
4234	C IERR = 0 = successful read.
4235	C = <0 = EOF encountered.
4236	C = >0 = read error.
4237	C
4238	C History:
4239	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
4240	C and TIXN routines, to `parse' numeric values in the
4241	C file header records.
4242	C
4243	C Required routines: PARHD, RHBGIN, RHSTRN, TIXN.
4244	C
4245	C
4246	CHARACTER() ANAME( * )
4247	CHARACTER() CDUM
4248	CHARACTER() CRFMT
4249	CHARACTER() MNAME
4250	CHARACTER() NCOM( * )
4251	CHARACTER() ONAME
4252	CHARACTER() ORG
4253	CHARACTER() SCOM( * )
4254	CHARACTER() SNAME
4255	CHARACTER*6 SUBFLG
4256	CHARACTER() VNAME( * )
4257	CHARACTER() XNAME( * )
4258	C
4259	DIMENSION AMISS( * ), ASCAL( * ), DX( * )
4260	DIMENSION VMISS( * ), VSCAL( * )
4261	C
4262	DATA NSF / 6 /
4263	DATA SUBFLG / 'RH2310' /
4264	C
4265	C
4266	IERR = 0
4267	LINE = 0
4268	NCIDR = 0
4269	NBIDR = 0
4270	C
4271	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4272	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4273	* LINE, SUBFLG, NSF, CDUM, CRFMT,
4274	* IUN, IOU, NDIAG, IERR )
4275	IF( IERR .NE. 0 ) RETURN
4276	C
4277	CALL PARHD ( DX(2), 1, NFIND, SUBFLG, NSF, 'DX(2)', 5,
4278	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4279	* CRFMT, IUN, IOU, NDIAG, IERR )
4280	IF( IERR .NE. 0 ) RETURN
4281	C
4282	CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
4283	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4284	IF( IERR .NE. 0 ) RETURN
4285	C
4286	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
4287	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4288	* CRFMT, IUN, IOU, NDIAG, IERR )
4289	IF( IERR .NE. 0 ) RETURN
4290	NV = INT( DUM + 0.5 )
4291	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
4292	* IUN, IOU, NDIAG, IERR )
4293	IF( IERR .NE. 0 ) RETURN
4294	C
4295	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
4296	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4297	* CRFMT, IUN, IOU, NDIAG, IERR )
4298	IF( IERR .NE. 0 ) RETURN
4299	DO 40 N=1,NV
4300	IF( VSCAL(N) .EQ. 0.0 ) THEN
4301	WRITE(IOU,) ' *RH2310 error--VSCAL(N)=0, for N=', N
4302	ENDIF
4303	40 CONTINUE
4304	C
4305	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
4306	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4307	* CRFMT, IUN, IOU, NDIAG, IERR )
4308	IF( IERR .NE. 0 ) RETURN
4309	C
4310	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
4311	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4312	IF( IERR .NE. 0 ) RETURN
4313	C
4314	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
4315	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4316	* CRFMT, IUN, IOU, NDIAG, IERR )
4317	IF( IERR .NE. 0 ) RETURN
4318	NAUXV = INT( DUM + 0.5 )
4319	CALL TIXN ( NAUXV, 3, MAXA, SUBFLG, NSF, 'NAUXV', 5,
4320	* IUN, IOU, NDIAG, IERR )
4321	IF( IERR .NE. 0 ) RETURN
4322	C
4323	CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
4324	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4325	* CRFMT, IUN, IOU, NDIAG, IERR )
4326	IF( IERR .NE. 0 ) RETURN
4327	DO 50 NA=1,NAUXV
4328	IF( ASCAL(NA) .EQ. 0.0 ) THEN
4329	WRITE(IOU,) ' *RH2310 error--ASCAL(I)=0, for I=', NA
4330	ENDIF
4331	50 CONTINUE
4332	C
4333	CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
4334	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4335	* CRFMT, IUN, IOU, NDIAG, IERR )
4336	IF( IERR .NE. 0 ) RETURN
4337	C
4338	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
4339	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4340	IF( IERR .NE. 0 ) RETURN
4341	C
4342	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
4343	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4344	* CRFMT, IUN, IOU, NDIAG, IERR )
4345	IF( IERR .NE. 0 ) RETURN
4346	NSCOML = INT( DUM + 0.5 )
4347	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
4348	* IUN, IOU, NDIAG, IERR )
4349	IF( IERR .NE. 0 ) RETURN
4350	C
4351	IF( NSCOML .GT. 0 ) THEN
4352	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
4353	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4354	IF( IERR .NE. 0 ) RETURN
4355	ENDIF
4356	C
4357	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
4358	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4359	* CRFMT, IUN, IOU, NDIAG, IERR )
4360	IF( IERR .NE. 0 ) RETURN
4361	NNCOML = INT( DUM + 0.5 )
4362	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
4363	* IUN, IOU, NDIAG, IERR )
4364	IF( IERR .NE. 0 ) RETURN
4365	C
4366	IF( NNCOML .GT. 0 ) THEN
4367	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
4368	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4369	IF( IERR .NE. 0 ) RETURN
4370	ENDIF
4371	C
4372	IF( LINE .NE. NLHEAD ) THEN
4373	WRITE(IOU,) ' *RH2310 thinks NLHEAD may be in error'
4374	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
4375	NDIAG = NDIAG + 1
4376	ENDIF
4377	RETURN
4378	END
4379	SUBROUTINE RH3010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4380	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4381	* DX, NX, NXDEF, X1, X2, XNAME,
4382	* NV, VSCAL, VMISS, VNAME,
4383	* NAUXV, ASCAL, AMISS, ANAME,
4384	* NSCOML, SCOM, NNCOML, NCOM,
4385	* MAXX1, MAXX2, MAXV, MAXA, MAXCOM, CDUM,
4386	* CRFMT, IUN, IOU, NDIAG, IERR )
4387	C
4388	C Subroutine to read file header for FFI=3010.
4389	C IERR = 0 = successful read.
4390	C = <0 = EOF encountered.
4391	C = >0 = read error.
4392	C
4393	C History:
4394	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
4395	C and TIXN routines, to `parse' numeric values in the
4396	C file header records.
4397	C
4398	C Required routines: PARHD, RHBGIN, RHSTRN,
4399	C TIXN, TMONO, TSTDX.
4400	C
4401	C
4402	CHARACTER() ANAME( * )
4403	CHARACTER() CDUM
4404	CHARACTER() CRFMT
4405	CHARACTER() MNAME
4406	CHARACTER() NCOM( * )
4407	CHARACTER() ONAME
4408	CHARACTER() ORG
4409	CHARACTER() SCOM( * )
4410	CHARACTER() SNAME
4411	CHARACTER*6 SUBFLG
4412	CHARACTER() VNAME( * )
4413	CHARACTER() XNAME( * )
4414	C
4415	DIMENSION AMISS( * ), ASCAL( * ), DX( * ), NXDEF( * ), NX( * )
4416	DIMENSION VMISS( * ), VSCAL( * ), X1( * ), X2( * )
4417	C
4418	DATA NSF / 6 /
4419	DATA SUBFLG / 'RH3010' /
4420	C
4421	C
4422	IERR = 0
4423	LINE = 0
4424	NCIDR = 0
4425	NBIDR = 0
4426	C
4427	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4428	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4429	* LINE, SUBFLG, NSF, CDUM, CRFMT,
4430	* IUN, IOU, NDIAG, IERR )
4431	IF( IERR .NE. 0 ) RETURN
4432	C
4433	CALL PARHD ( DX, 3, NFIND, SUBFLG, NSF, 'DX', 2,
4434	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4435	* CRFMT, IUN, IOU, NDIAG, IERR )
4436	IF( IERR .NE. 0 ) RETURN
4437	C
4438	CALL PARHD ( VSCAL, 2, NFIND, SUBFLG, NSF, 'NX', 2,
4439	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4440	* CRFMT, IUN, IOU, NDIAG, IERR )
4441	IF( IERR .NE. 0 ) RETURN
4442	NX(1) = INT( VSCAL(1) + 0.5 )
4443	NX(2) = INT( VSCAL(2) + 0.5 )
4444	CALL TIXN ( NX(1), 1, MAXX1, SUBFLG, NSF, 'NX(1)', 5,
4445	* IUN, IOU, NDIAG, IER1 )
4446	CALL TIXN ( NX(2), 1, MAXX2, SUBFLG, NSF, 'NX(2)', 5,
4447	* IUN, IOU, NDIAG, IER2 )
4448	IF( IER1+IER2 .NE. 0 ) RETURN
4449	C
4450	CALL PARHD ( VSCAL, 2, NFIND, SUBFLG, NSF, 'NXDEF', 5,
4451	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4452	* CRFMT, IUN, IOU, NDIAG, IERR )
4453	IF( IERR .NE. 0 ) RETURN
4454	NXDEF(1) = INT( VSCAL(1) + 0.5 )
4455	NXDEF(2) = INT( VSCAL(2) + 0.5 )
4456	MAXX = MAXX1
4457	DO 22 N=1,2
4458	IF( NXDEF(N) .LT. 1 .OR. NXDEF(N) .GT. NX(N) .OR.
4459	* (NXDEF(N) .GT. 1 .AND. NXDEF(N) .LT. NX(N)) ) THEN
4460	WRITE( IOU,* )
4461	* ' ***RH3010 error--improper value for NXDEF',N
4462	WRITE( IOU,* ) ' MAXX,NXDEF,NX=', MAXX, NXDEF(N), NX(N)
4463	IERR = 2
4464	NDIAG = NDIAG + 1
4465	RETURN
4466	ENDIF
4467	MAXX = MAXX2
4468	22 CONTINUE
4469	C
4470	CALL PARHD ( X1, NXDEF(1), NFIND, SUBFLG, NSF, 'X1', 2,
4471	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4472	* CRFMT, IUN, IOU, NDIAG, IERR )
4473	IF( IERR .NE. 0 ) RETURN
4474	IF( NXDEF(1) .GT. 1 ) THEN
4475	CALL TMONO ( X1, NXDEF, DX, SUBFLG, NSF, 'X1', 2,
4476	* NBAD, IOU )
4477	NDIAG = NDIAG + NBAD
4478	CALL TSTDX ( X1, NXDEF, NX, DX, SUBFLG, NSF, 'X1', 2,
4479	* NDIAG, IOU )
4480	ELSE
4481	IF( NX(1) .GT. 1 .AND. DX(1) .EQ. 0.0 ) THEN
4482	WRITE( IOU,* )
4483	* ' **RH3010 error--DX(1)=0 and NXDEF(1)<NX(1)'
4484	WRITE( IOU,* ) ' X1(I) can not be properly defined'
4485	WRITE( IOU,* ) ' NXDEF(1),NX(1)= ', NXDEF(1), NX(1)
4486	NDIAG = NDIAG + 1
4487	ENDIF
4488	DO 26 I=2,NX(1)
4489	X1(I) = X1(1) + FLOAT( I-1 ) * DX(1)
4490	26 CONTINUE
4491	ENDIF
4492	C
4493	CALL PARHD ( X2, NXDEF(2), NFIND, SUBFLG, NSF, 'X2', 2,
4494	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4495	* CRFMT, IUN, IOU, NDIAG, IERR )
4496	IF( IERR .NE. 0 ) RETURN
4497	IF( NXDEF(2) .GT. 1 ) THEN
4498	CALL TMONO ( X2, NXDEF(2), DX(2), SUBFLG, NSF, 'X2', 2,
4499	* NBAD, IOU )
4500	NDIAG = NDIAG + NBAD
4501	CALL TSTDX ( X2, NXDEF(2), NX(2), DX(2), SUBFLG, NSF, 'X2', 2,
4502	* NDIAG, IOU )
4503	ELSE
4504	IF( NX(2) .GT. 1 .AND. DX(2) .EQ. 0.0 ) THEN
4505	WRITE( IOU,* )
4506	* ' **RH3010 error--DX(2)=0 and NXDEF(2)<NX(2)'
4507	WRITE( IOU,* ) ' X2(I) can not be properly defined'
4508	WRITE( IOU,* ) ' NXDEF(2), NX(2)= ', NXDEF(2), NX(2)
4509	NDIAG = NDIAG + 1
4510	ENDIF
4511	DO 28 I=2,NX(2)
4512	X2(I) = X2(1) + FLOAT( I-1 ) * DX(2)
4513	28 CONTINUE
4514	ENDIF
4515	C
4516	CALL RHSTRN ( XNAME, 3, SUBFLG, NSF, 'XNAME', 5,
4517	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4518	IF( IERR .NE. 0 ) RETURN
4519	C
4520	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
4521	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4522	* CRFMT, IUN, IOU, NDIAG, IERR )
4523	IF( IERR .NE. 0 ) RETURN
4524	NV = INT( DUM + 0.5 )
4525	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
4526	* IUN, IOU, NDIAG, IERR )
4527	IF( IERR .NE. 0 ) RETURN
4528	C
4529	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
4530	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4531	* CRFMT, IUN, IOU, NDIAG, IERR )
4532	IF( IERR .NE. 0 ) RETURN
4533	DO 40 N=1,NV
4534	IF( VSCAL(N) .EQ. 0.0 ) THEN
4535	WRITE(IOU,) ' *RH3010 error--VSCAL(N)=0, for N=', N
4536	ENDIF
4537	40 CONTINUE
4538	C
4539	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
4540	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4541	* CRFMT, IUN, IOU, NDIAG, IERR )
4542	IF( IERR .NE. 0 ) RETURN
4543	C
4544	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
4545	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4546	IF( IERR .NE. 0 ) RETURN
4547	C
4548	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
4549	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4550	* CRFMT, IUN, IOU, NDIAG, IERR )
4551	IF( IERR .NE. 0 ) RETURN
4552	NAUXV = INT( DUM + 0.5 )
4553	CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
4554	* IUN, IOU, NDIAG, IERR )
4555	IF( IERR .NE. 0 ) RETURN
4556	C
4557	IF( NAUXV .GT. 0 ) THEN
4558	CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
4559	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4560	* CRFMT, IUN, IOU, NDIAG, IERR )
4561	IF( IERR .NE. 0 ) RETURN
4562	DO 50 NA=1,NAUXV
4563	IF( ASCAL(NA) .EQ. 0.0 ) THEN
4564	WRITE(IOU,) ' *RH3010 error--ASCAL(I)=0, for I=', NA
4565	ENDIF
4566	50 CONTINUE
4567	C
4568	CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
4569	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4570	* CRFMT, IUN, IOU, NDIAG, IERR )
4571	IF( IERR .NE. 0 ) RETURN
4572	C
4573	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
4574	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4575	IF( IERR .NE. 0 ) RETURN
4576	ENDIF
4577	C
4578	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
4579	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4580	* CRFMT, IUN, IOU, NDIAG, IERR )
4581	IF( IERR .NE. 0 ) RETURN
4582	NSCOML = INT( DUM + 0.5 )
4583	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
4584	* IUN, IOU, NDIAG, IERR )
4585	IF( IERR .NE. 0 ) RETURN
4586	C
4587	IF( NSCOML .GT. 0 ) THEN
4588	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
4589	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4590	IF( IERR .NE. 0 ) RETURN
4591	ENDIF
4592	C
4593	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
4594	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4595	* CRFMT, IUN, IOU, NDIAG, IERR )
4596	IF( IERR .NE. 0 ) RETURN
4597	NNCOML = INT( DUM + 0.5 )
4598	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
4599	* IUN, IOU, NDIAG, IERR )
4600	IF( IERR .NE. 0 ) RETURN
4601	C
4602	IF( NNCOML .GT. 0 ) THEN
4603	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
4604	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4605	IF( IERR .NE. 0 ) RETURN
4606	ENDIF
4607	C
4608	IF( LINE .NE. NLHEAD ) THEN
4609	WRITE(IOU,) ' *RH3010 thinks NLHEAD may be in error'
4610	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
4611	NDIAG = NDIAG + 1
4612	ENDIF
4613	RETURN
4614	END
4615	SUBROUTINE RH4010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4616	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4617	* DX, NX, NXDEF, X1, X2, X3, XNAME,
4618	* NV, VSCAL, VMISS, VNAME,
4619	* NAUXV, ASCAL, AMISS, ANAME,
4620	* NSCOML, SCOM, NNCOML, NCOM,
4621	* MAXX1, MAXX2, MAXX3, MAXV, MAXA, MAXCOM, CDUM,
4622	* CRFMT, IUN, IOU, NDIAG, IERR )
4623	C
4624	C Subroutine to read file header for FFI=4010.
4625	C IERR = 0 = successful read.
4626	C = <0 = EOF encountered.
4627	C = >0 = read error.
4628	C
4629	C History:
4630	C 91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
4631	C and TIXN routines, to `parse' numeric values in the
4632	C file header records.
4633	C
4634	C Required routines: PARHD, RHBGIN, RHSTRN,
4635	C TIXN, TMONO, TSTDX.
4636	C
4637	C
4638	CHARACTER() ANAME( * )
4639	CHARACTER() CDUM
4640	CHARACTER() CRFMT
4641	CHARACTER() MNAME
4642	CHARACTER() NCOM( * )
4643	CHARACTER() ONAME
4644	CHARACTER() ORG
4645	CHARACTER() SCOM( * )
4646	CHARACTER() SNAME
4647	CHARACTER*6 SUBFLG
4648	CHARACTER() VNAME( * )
4649	CHARACTER() XNAME( * )
4650	C
4651	DIMENSION AMISS( * ), ASCAL( * ), DX( * ), NXDEF( * ), NX( * )
4652	DIMENSION VMISS( * ), VSCAL( * ), X1( * ), X2( * ), X3( * )
4653	C
4654	DATA NSF / 6 /
4655	DATA SUBFLG / 'RH4010' /
4656	C
4657	C
4658	IERR = 0
4659	LINE = 0
4660	NCIDR = 0
4661	NBIDR = 0
4662	C
4663	CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4664	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4665	* LINE, SUBFLG, NSF, CDUM, CRFMT,
4666	* IUN, IOU, NDIAG, IERR )
4667	IF( IERR .NE. 0 ) RETURN
4668	C
4669	CALL PARHD ( DX, 4, NFIND, SUBFLG, NSF, 'DX', 2,
4670	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4671	* CRFMT, IUN, IOU, NDIAG, IERR )
4672	IF( IERR .NE. 0 ) RETURN
4673	C
4674	CALL PARHD ( VSCAL, 3, NFIND, SUBFLG, NSF, 'NX', 2,
4675	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4676	* CRFMT, IUN, IOU, NDIAG, IERR )
4677	IF( IERR .NE. 0 ) RETURN
4678	NX(1) = INT( VSCAL(1) + 0.5 )
4679	NX(2) = INT( VSCAL(2) + 0.5 )
4680	NX(3) = INT( VSCAL(3) + 0.5 )
4681	CALL TIXN ( NX(1), 1, MAXX1, SUBFLG, NSF, 'NX(1)', 5,
4682	* IUN, IOU, NDIAG, IER1 )
4683	CALL TIXN ( NX(2), 1, MAXX2, SUBFLG, NSF, 'NX(2)', 5,
4684	* IUN, IOU, NDIAG, IER2 )
4685	CALL TIXN ( NX(3), 1, MAXX3, SUBFLG, NSF, 'NX(3)', 5,
4686	* IUN, IOU, NDIAG, IER3 )
4687	IF( IER1+IER2+IER3 .NE. 0 ) RETURN
4688	C
4689	CALL PARHD ( VSCAL, 3, NFIND, SUBFLG, NSF, 'NXDEF', 5,
4690	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4691	* CRFMT, IUN, IOU, NDIAG, IERR )
4692	IF( IERR .NE. 0 ) RETURN
4693	NXDEF(1) = INT( VSCAL(1) + 0.5 )
4694	NXDEF(2) = INT( VSCAL(2) + 0.5 )
4695	NXDEF(3) = INT( VSCAL(3) + 0.5 )
4696	MAXX = MAXX1
4697	DO 22 N=1,3
4698	IF( N .EQ. 2 ) THEN
4699	MAXX = MAXX2
4700	ELSE IF( N .EQ. 3 ) THEN
4701	MAXX = MAXX3
4702	ENDIF
4703	IF( NXDEF(N) .LT. 1 .OR. NXDEF(N) .GT. NX(N) .OR.
4704	* (NXDEF(N) .GT. 1 .AND. NXDEF(N) .LT. NX(N)) ) THEN
4705	WRITE( IOU,* )
4706	* ' ***RH4010 error--improper value for NXDEF',N
4707	WRITE( IOU,* ) ' MAXX,NXDEF,NX=', MAXX, NXDEF(N), NX(N)
4708	IERR = 2
4709	NDIAG = NDIAG + 1
4710	RETURN
4711	ENDIF
4712	22 CONTINUE
4713	C
4714	CALL PARHD ( X1, NXDEF(1), NFIND, SUBFLG, NSF, 'X1', 2,
4715	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4716	* CRFMT, IUN, IOU, NDIAG, IERR )
4717	IF( IERR .NE. 0 ) RETURN
4718	IF( NXDEF(1) .GT. 1 ) THEN
4719	CALL TMONO ( X1, NXDEF(1), DX(1), SUBFLG, NSF, 'X1', 2,
4720	* NBAD, IOU )
4721	NDIAG = NDIAG + NBAD
4722	CALL TSTDX ( X1, NXDEF(1), NX, DX, SUBFLG, NSF, 'X1', 2,
4723	* NDIAG, IOU )
4724	ELSE
4725	IF( NX(1) .GT. 1 .AND. DX(1) .EQ. 0.0 ) THEN
4726	WRITE( IOU,* )
4727	* ' **RH4010 error--DX(1)=0 and NXDEF(1)<NX(1)'
4728	WRITE( IOU,* ) ' X1(I) can not be properly defined'
4729	WRITE( IOU,* ) ' NXDEF(1), NX(1)= ', NXDEF(1), NX(1)
4730	NDIAG = NDIAG + 1
4731	ENDIF
4732	DO 26 I=2,NX(1)
4733	X1(I) = X1(1) + FLOAT( I-1 ) * DX(1)
4734	26 CONTINUE
4735	ENDIF
4736	C
4737	CALL PARHD ( X2, NXDEF(2), NFIND, SUBFLG, NSF, 'X2', 2,
4738	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4739	* CRFMT, IUN, IOU, NDIAG, IERR )
4740	IF( IERR .NE. 0 ) RETURN
4741	IF( NXDEF(2) .GT. 1 ) THEN
4742	CALL TMONO ( X2, NXDEF(2), DX(2), SUBFLG, NSF, 'X2', 2,
4743	* NBAD, IOU )
4744	NDIAG = NDIAG + NBAD
4745	CALL TSTDX ( X2, NXDEF(2), NX(2), DX(2), SUBFLG, NSF, 'X2', 2,
4746	* NDIAG, IOU )
4747	ELSE
4748	IF( NX(2) .GT. 1 .AND. DX(2) .EQ. 0.0 ) THEN
4749	WRITE( IOU,* )
4750	* ' **RH4010 error--DX(2)=0 and NXDEF(2)<NX(2)'
4751	WRITE( IOU,* ) ' X2(I) can not be properly defined'
4752	WRITE( IOU,* ) ' NXDEF(2), NX(2)= ', NXDEF(2), NX(2)
4753	NDIAG = NDIAG + 1
4754	ENDIF
4755	DO 28 I=2,NX(2)
4756	X2(I) = X2(1) + FLOAT( I-1 ) * DX(2)
4757	28 CONTINUE
4758	ENDIF
4759	C
4760	CALL PARHD ( X3, NXDEF(3), NFIND, SUBFLG, NSF, 'X3', 2,
4761	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4762	* CRFMT, IUN, IOU, NDIAG, IERR )
4763	IF( IERR .NE. 0 ) RETURN
4764	IF( NXDEF(3) .GT. 1 ) THEN
4765	CALL TMONO ( X3, NXDEF(3), DX(3), SUBFLG, NSF, 'X3', 2,
4766	* NBAD, IOU )
4767	NDIAG = NDIAG + NBAD
4768	CALL TSTDX ( X3, NXDEF(3), NX(3), DX(3), SUBFLG, NSF, 'X3', 2,
4769	* NDIAG, IOU )
4770	ELSE
4771	IF( NX(3) .GT. 1 .AND. DX(3) .EQ. 0.0 ) THEN
4772	WRITE( IOU,* )
4773	* ' **RH4010 error--DX(3)=0 and NXDEF(3)<NX(3)'
4774	WRITE( IOU,* ) ' X3(I) can not be properly defined'
4775	WRITE( IOU,* ) ' NXDEF(3), NX(3)= ', NXDEF(3), NX(3)
4776	NDIAG = NDIAG + 1
4777	ENDIF
4778	DO 30 I=2,NX(3)
4779	X3(I) = X3(1) + FLOAT( I-1 ) * DX(3)
4780	30 CONTINUE
4781	ENDIF
4782	C
4783	CALL RHSTRN ( XNAME, 4, SUBFLG, NSF, 'XNAME', 5,
4784	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4785	IF( IERR .NE. 0 ) RETURN
4786	C
4787	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
4788	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4789	* CRFMT, IUN, IOU, NDIAG, IERR )
4790	IF( IERR .NE. 0 ) RETURN
4791	NV = INT( DUM + 0.5 )
4792	CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
4793	* IUN, IOU, NDIAG, IERR )
4794	IF( IERR .NE. 0 ) RETURN
4795	C
4796	CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
4797	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4798	* CRFMT, IUN, IOU, NDIAG, IERR )
4799	IF( IERR .NE. 0 ) RETURN
4800	DO 40 N=1,NV
4801	IF( VSCAL(N) .EQ. 0.0 ) THEN
4802	WRITE(IOU,) ' *RH4010 error--VSCAL(N)=0, for N=', N
4803	ENDIF
4804	40 CONTINUE
4805	C
4806	CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
4807	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4808	* CRFMT, IUN, IOU, NDIAG, IERR )
4809	IF( IERR .NE. 0 ) RETURN
4810	C
4811	CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
4812	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4813	IF( IERR .NE. 0 ) RETURN
4814	C
4815	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
4816	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4817	* CRFMT, IUN, IOU, NDIAG, IERR )
4818	IF( IERR .NE. 0 ) RETURN
4819	NAUXV = INT( DUM + 0.5 )
4820	CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
4821	* IUN, IOU, NDIAG, IERR )
4822	IF( IERR .NE. 0 ) RETURN
4823	C
4824	IF( NAUXV .GT. 0 ) THEN
4825	CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
4826	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4827	* CRFMT, IUN, IOU, NDIAG, IERR )
4828	IF( IERR .NE. 0 ) RETURN
4829	DO 50 NA=1,NAUXV
4830	IF( ASCAL(NA) .EQ. 0.0 ) THEN
4831	WRITE(IOU,) ' *RH4010 error--ASCAL(I)=0, for I=', NA
4832	ENDIF
4833	50 CONTINUE
4834	C
4835	CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
4836	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4837	* CRFMT, IUN, IOU, NDIAG, IERR )
4838	IF( IERR .NE. 0 ) RETURN
4839	C
4840	CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
4841	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4842	IF( IERR .NE. 0 ) RETURN
4843	ENDIF
4844	C
4845	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
4846	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4847	* CRFMT, IUN, IOU, NDIAG, IERR )
4848	IF( IERR .NE. 0 ) RETURN
4849	NSCOML = INT( DUM + 0.5 )
4850	CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
4851	* IUN, IOU, NDIAG, IERR )
4852	IF( IERR .NE. 0 ) RETURN
4853	C
4854	IF( NSCOML .GT. 0 ) THEN
4855	CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
4856	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4857	IF( IERR .NE. 0 ) RETURN
4858	ENDIF
4859	C
4860	CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
4861	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4862	* CRFMT, IUN, IOU, NDIAG, IERR )
4863	IF( IERR .NE. 0 ) RETURN
4864	NNCOML = INT( DUM + 0.5 )
4865	CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
4866	* IUN, IOU, NDIAG, IERR )
4867	IF( IERR .NE. 0 ) RETURN
4868	C
4869	IF( NNCOML .GT. 0 ) THEN
4870	CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
4871	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4872	IF( IERR .NE. 0 ) RETURN
4873	ENDIF
4874	C
4875	IF( LINE .NE. NLHEAD ) THEN
4876	WRITE(IOU,) ' *RH4010 thinks NLHEAD may be in error'
4877	WRITE(IOU,*) ' NLHEAD,LINE=', NLHEAD, LINE
4878	NDIAG = NDIAG + 1
4879	ENDIF
4880	RETURN
4881	END
4882	SUBROUTINE RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4883	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4884	* LINE, SUBFLG, NSF, CDUM,
4885	* CRFMT, IUN, IOU, NDIAG, IERR )
4886	C
4887	C Subroutine to read and return the first seven lines from file headers.
4888	C
4889	C History:
4890	C 91-12-17 - Modified to use PARHD to read numeric values, and
4891	C TIXN to test and diagnose them.
4892	C
4893	C
4894	C Required routines: PARHD, RHSTRN, TIXN.
4895	C
4896	CHARACTER() CDUM
4897	CHARACTER() CRFMT
4898	CHARACTER() MNAME
4899	CHARACTER() ONAME
4900	CHARACTER() ORG
4901	CHARACTER() SNAME
4902	CHARACTER() SUBFLG
4903	C
4904	DIMENSION DUM( 10 )
4905	C
4906	NCIDR = 0
4907	NBIDR = 0
4908	CALL PARHD ( DUM, 2, NFIND, 'RHBGIN', 6, 'NLHEAD,FFI', 10,
4909	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4910	* CRFMT, IUN, IOU, NDIAG, IERR )
4911	IF( IERR .NE. 0 ) RETURN
4912	NLHEAD = INT( DUM(1) + 0.5 )
4913	IFFI = INT( DUM(2) + 0.5 )
4914	C
4915	CALL RHSTRN ( ONAME, 1, 'RHBGIN', 6, 'ONAME', 5,
4916	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4917	IF( IERR .NE. 0 ) RETURN
4918	C
4919	CALL RHSTRN ( ORG, 1, 'RHBGIN', 6, 'ORG', 3,
4920	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4921	IF( IERR .NE. 0 ) RETURN
4922	C
4923	CALL RHSTRN ( SNAME, 1, 'RHBGIN', 6, 'SNAME', 5,
4924	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4925	IF( IERR .NE. 0 ) RETURN
4926	C
4927	CALL RHSTRN ( MNAME, 1, 'RHBGIN', 6, 'MNAME', 5,
4928	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
4929	IF( IERR .NE. 0 ) RETURN
4930	C
4931	CALL PARHD ( DUM, 2, NFIND, 'RHBGIN', 6, 'IVOL,NVOL', 9,
4932	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4933	* CRFMT, IUN, IOU, NDIAG, IERR )
4934	IF( IERR .NE. 0 ) RETURN
4935	IVOL = INT( DUM(1) + 0.5 )
4936	NVOL = INT( DUM(2) + 0.5 )
4937	CALL TIXN ( NVOL, 1, 9, 'RHBGIN', 6, 'NVOL', 4,
4938	* IUN, IOU, NDIAG, IER1 )
4939	CALL TIXN ( IVOL, 1, NVOL, 'RHBGIN', 6, 'IVOL', 4,
4940	* IUN, IOU, NDIAG, IER2 )
4941	IF( IER1+IER2 .NE. 0 ) RETURN
4942	C
4943	CALL PARHD ( DUM, 6, NFIND, 'RHBGIN', 6, 'DATE,RDATE', 10,
4944	* LINE, NREAD, CDUM, NCIDR, NBIDR,
4945	* CRFMT, IUN, IOU, NDIAG, IERR )
4946	IF( IERR .NE. 0 ) RETURN
4947	IYR = INT( DUM(1) + 0.5 )
4948	IMO = INT( DUM(2) + 0.5 )
4949	IDY = INT( DUM(3) + 0.5 )
4950	IRYR = INT( DUM(4) + 0.5 )
4951	IRMO = INT( DUM(5) + 0.5 )
4952	IRDY = INT( DUM(6) + 0.5 )
4953	IDATE = IYR * 10000 + IMO * 100 + IDY
4954	IRDATE = IRYR * 10000 + IRMO * 100 + IRDY
4955	IF( IDATE .GT. IRDATE .OR. IDATE .LT. 19000000 ) THEN
4956	WRITE( IOU,* ) ' **RHBGIN error--improper DATE, RDATE'
4957	WRITE( IOU,* ) ' RHBGIN called by ',SUBFLG(1:NSF)
4958	IF( IDATE .GT. IRDATE ) WRITE(IOU,*) ' RDATE .LT. DATE'
4959	WRITE( IOU,* ) ' IYR, IMO, IDY=', IYR, IMO, IDY
4960	WRITE( IOU,* ) ' IRYR,IRMO,IRDY=', IRYR, IRMO, IRDY
4961	NDIAG = NDIAG + 1
4962	ENDIF
4963	RETURN
4964	END
4965	SUBROUTINE RHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
4966	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
4967	* DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
4968	* NV, NVPM, VSCAL, VMISS, VNAME,
4969	* NAUXV, ASCAL, AMISS, ANAME,
4970	* NAUXC, LENA, CAMISS,
4971	* NSCOML, SCOM, NNCOML, NCOM,
4972	* MAXX1, MAXX2, MAXX3,
4973	* MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM,
4974	* MNAME0, CRFMT, IUN, IOU, ISUBV, NDIAG, IERR,
4975	* DBHEAD )
4976	C History:
4977	C 96-02-29 (JDW)
4978	C Modified to skip over database header if DBHEAD = .TRUE.
4979	C
4980	C Subroutine to drive file header reading routines.
4981	C ISUBV is defined in this routine and used in subroutine RDATA
4982	C to determine which data reading routine to call.
4983	C
4984	C Required routines: LASTNB,
4985	C RH1001, RH1010, RH1020,
4986	C RH2010, RH2110, RH2160, RH2310,
4987	C RH3010, RH4010.
4988	C
4989	CHARACTER() ANAME( * )
4990	CHARACTER() CAMISS( * )
4991	CHARACTER() CDUM
4992	CHARACTER() CRFMT
4993	CHARACTER() MNAME
4994	CHARACTER() MNAME0
4995	CHARACTER() NCOM( * )
4996	CHARACTER() ONAME
4997	CHARACTER() ORG
4998	CHARACTER() SCOM( * )
4999	CHARACTER() SNAME
5000	CHARACTER() VNAME( * )
5001	CHARACTER() XNAME( * )
5002	C
5003	DIMENSION DX( * ), NX( * ), NXDEF( * )
5004	DIMENSION X1( * ), X2( * ), X3( * )
5005	DIMENSION AMISS( * ), ASCAL( * ), LENA( * )
5006	DIMENSION VMISS( * ), VSCAL( * ), LENX( * )
5007	C
5008	LOGICAL DBHEAD
5009	C
5010	C Initialize some variables that may otherwise cause problems
5011	C in the kluges at the end of this routine.
5012	C
5013	NAUXV = 0
5014	NAUXC = 0
5015	C
5016	C Obtain FFI.
5017	C
5018	IF (DBHEAD) READ (IUN,*)
5019	READ( IUN,*,IOSTAT=IERR ) NLHEAD, JFFI
5020	IF( IERR .NE. 0 ) THEN
5021	WRITE( IOU,* ) ' ***RHEAD error reading FFI'
5022	NDIAG = NDIAG + 1
5023	RETURN
5024	ENDIF
5025	REWIND IUN
5026	IF (DBHEAD) READ (IUN,*)
5027	IF( JFFI .EQ. 1001 ) THEN
5028	ISUBV = 1
5029	CALL RH1001 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5030	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5031	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
5032	* NSCOML, SCOM, NNCOML, NCOM,
5033	* MAXV, MAXCOM, CDUM,
5034	* CRFMT, IUN, IOU, NDIAG, IERR )
5035	ELSE IF ( JFFI .EQ. 1010 ) THEN
5036	ISUBV = 2
5037	CALL RH1010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5038	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5039	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
5040	* NAUXV, ASCAL, AMISS, ANAME,
5041	* NSCOML, SCOM, NNCOML, NCOM,
5042	* MAXV, MAXA, MAXCOM, CDUM,
5043	* CRFMT, IUN, IOU, NDIAG, IERR )
5044	ELSE IF ( JFFI .EQ. 1020 ) THEN
5045	ISUBV = 3
5046	CALL RH1020 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5047	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5048	* DX, NVPM, XNAME, NV, VSCAL, VMISS, VNAME,
5049	* NAUXV, ASCAL, AMISS, ANAME,
5050	* NSCOML, SCOM, NNCOML, NCOM,
5051	* MAXX1, MAXV, MAXA, MAXCOM, CDUM,
5052	* CRFMT, IUN, IOU, NDIAG, IERR )
5053	ELSE IF ( JFFI .EQ. 2010 ) THEN
5054	ISUBV = 4
5055	CALL RH2010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5056	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5057	* DX, NX, NXDEF, X1, XNAME,
5058	* NV, VSCAL, VMISS, VNAME,
5059	* NAUXV, ASCAL, AMISS, ANAME,
5060	* NSCOML, SCOM, NNCOML, NCOM,
5061	* MAXX1, MAXV, MAXA, MAXCOM, CDUM,
5062	* CRFMT, IUN, IOU, NDIAG, IERR )
5063	ELSE IF ( JFFI .EQ. 2110 ) THEN
5064	ISUBV = 5
5065	CALL RH2110 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5066	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5067	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
5068	* NAUXV, ASCAL, AMISS, ANAME,
5069	* NSCOML, SCOM, NNCOML, NCOM,
5070	* MAXV, MAXA, MAXCOM, CDUM,
5071	* CRFMT, IUN, IOU, NDIAG, IERR )
5072	ELSE IF ( JFFI .EQ. 2160 ) THEN
5073	ISUBV = 6
5074	CALL RH2160 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5075	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5076	* DX, LENX, XNAME, NV, VSCAL, VMISS, VNAME,
5077	* NAUXV, ASCAL, AMISS, ANAME,
5078	* NAUXC, LENA, CAMISS, X1,
5079	* NSCOML, SCOM, NNCOML, NCOM,
5080	* MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM,
5081	* CRFMT, IUN, IOU, NDIAG, IERR )
5082	ELSE IF ( JFFI .EQ. 2310 ) THEN
5083	ISUBV = 7
5084	CALL RH2310 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5085	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5086	* DX, XNAME, NV, VSCAL, VMISS, VNAME,
5087	* NAUXV, ASCAL, AMISS, ANAME,
5088	* NSCOML, SCOM, NNCOML, NCOM,
5089	* MAXV, MAXA, MAXCOM, CDUM,
5090	* CRFMT, IUN, IOU, NDIAG, IERR )
5091	ELSE IF ( JFFI .EQ. 3010 ) THEN
5092	ISUBV = 8
5093	CALL RH3010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5094	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5095	* DX, NX, NXDEF, X1, X2, XNAME,
5096	* NV, VSCAL, VMISS, VNAME,
5097	* NAUXV, ASCAL, AMISS, ANAME,
5098	* NSCOML, SCOM, NNCOML, NCOM,
5099	* MAXX1, MAXX2, MAXV, MAXA, MAXCOM, CDUM,
5100	* CRFMT, IUN, IOU, NDIAG, IERR )
5101	ELSE IF ( JFFI .EQ. 4010 ) THEN
5102	ISUBV = 9
5103	CALL RH4010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
5104	* IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
5105	* DX, NX, NXDEF, X1, X2, X3, XNAME,
5106	* NV, VSCAL, VMISS, VNAME,
5107	* NAUXV, ASCAL, AMISS, ANAME,
5108	* NSCOML, SCOM, NNCOML, NCOM,
5109	* MAXX1, MAXX2, MAXX3, MAXV, MAXA, MAXCOM, CDUM,
5110	* CRFMT, IUN, IOU, NDIAG, IERR )
5111	ELSE
5112	WRITE( IOU,* ) ' ***RHEAD error--unknown value for FFI=', JFFI
5113	NDIAG = NDIAG + 1
5114	IERR = 2
5115	RETURN
5116	ENDIF
5117	IF( IERR .NE. 0 ) RETURN
5118	C
5119	C Test for proper mission name.
5120	C
5121	c CALL LASTNB ( MNAME0, LEN(MNAME0), L0 )
5122	c IFOUND = INDEX( MNAME, MNAME0(1:L0) )
5123	c IF( IFOUND .LT. 1 ) THEN
5124	c CALL LASTNB ( MNAME, LEN(MNAME), L )
5125	c WRITE( IOU,* ) ' **RHEAD error--improper mission name'
5126	c WRITE( IOU,* ) ' MNAME0=',MNAME0(1:L0)
5127	c WRITE( IOU,* ) ' MNAME =',MNAME(1:L)
5128	c NDIAG = NDIAG + 1
5129	c ELSE
5130	c CALL FRSTNB ( MNAME, LEN(MNAME), L1 )
5131	c CALL LASTNB ( MNAME, LEN(MNAME), L2 )
5132	c IF( L1 .NE. IFOUND ) THEN
5133	c WRITE( IOU,* ) ' **RHEAD error--improper mission name'
5134	c WRITE( IOU,* ) ' MNAME0=',MNAME0(1:L0)
5135	c WRITE( IOU,* ) ' MNAME =',MNAME(1:L2)
5136	c WRITE( IOU,* )
5137	c * ' MNAME0 must be first non-blank character'
5138	c NDIAG = NDIAG + 1
5139	c ENDIF
5140	c ENDIF
5141	C
5142	C This is kluged test for improper missing values.
5143	C It would be better to test each data value to ensure it is .LE. the
5144	C appropriate missing value, but this kluge is less time consuming.
5145	C
5146	DO 70 N=1,NV
5147	IF( VMISS(N) .LT. 0.0 ) THEN
5148	WRITE( IOU,* )
5149	* ' **RHEAD error--improper VMISS value'
5150	WRITE( IOU,* )
5151	* ' N, VMISS(N) = ', N, VMISS(N)
5152	WRITE( IOU,* )
5153	* ' VMISS should be larger than "good" data values'
5154	NDIAG = NDIAG + 1
5155	ENDIF
5156	70 CONTINUE
5157	IF( NAUXV-NAUXC .GT. 0 ) THEN
5158	DO 72 IA=1,NAUXV-NAUXC
5159	IF( AMISS(IA) .LT. 0.0 ) THEN
5160	WRITE( IOU,* )
5161	* ' **RHEAD error--improper AMISS value'
5162	WRITE( IOU,* )
5163	* ' IA, AMISS(IA) = ', IA, AMISS(IA)
5164	WRITE( IOU,* )
5165	* ' AMISS should be larger than "good" data values'
5166	NDIAG = NDIAG + 1
5167	ENDIF
5168	72 CONTINUE
5169	ENDIF
5170	RETURN
5171	END
5172	SUBROUTINE RHSTRN ( VNAME, NV, SUBFLG, NSF, VALFLG, NVF,
5173	* LINE, CRFMT, IUN, IOU, NDIAG, IERR )
5174	C
5175	C Subroutine to read character string records.
5176	C
5177	C
5178	CHARACTER() CRFMT
5179	CHARACTER() SUBFLG
5180	CHARACTER() VALFLG
5181	CHARACTER() VNAME( * )
5182	C
5183	C
5184	DO 50 N=1,NV
5185	READ( IUN,FMT=CRFMT,IOSTAT=IERR ) VNAME(N)
5186	IF( IERR .NE. 0 ) THEN
5187	WRITE( IOU,* )
5188	* ' ***RHSTRN error reading ',VALFLG(1:NVF),' at line ', LINE+1
5189	WRITE( IOU,* ) ' RHSTRN called by ',SUBFLG(1:NSF)
5190	NDIAG = NDIAG + 1
5191	RETURN
5192	ENDIF
5193	LINE = LINE + 1
5194	50 CONTINUE
5195	RETURN
5196	END
5197	SUBROUTINE TCIVM ( CX, LENX, CVAL, VALFLG, NVF, NIVM,
5198	* NDIAG, IOU, IERR )
5199	C
5200	C Subroutine to test character independent variable marks to see if
5201	C they are monotonic.
5202	C
5203	C Required routines: L3CVAL, TMONC.
5204	C
5205	CHARACTER() CVAL( * )
5206	CHARACTER() CX
5207	CHARACTER*5 SUBFLG
5208	CHARACTER() VALFLG
5209	C
5210	DATA NSF / 5 /
5211	DATA SUBFLG / 'TCIVM' /
5212	C
5213	IF( IERR .EQ. 0 ) THEN
5214	NIVM = NIVM + 1
5215	CALL L3CVAL ( CX, LENX, NIVM, CVAL )
5216	CALL TMONC ( CVAL, LENX, NIVM, SUBFLG, NSF, VALFLG, NVF,
5217	* NBAD, IOU )
5218	NDIAG = NDIAG + NBAD
5219	ENDIF
5220	RETURN
5221	END
5222	SUBROUTINE TIXN ( N, NMIN, NMAX, SUBFLG, NSF, VALFLG, NVF,
5223	* IUN, IOU, NDIAG, IERR )
5224	C
5225	C Subroutine to test range of integer value and print diagnostics.
5226	C
5227	CHARACTER() SUBFLG
5228	CHARACTER() VALFLG
5229	C
5230	IERR = 0
5231	IF( N .LT. NMIN .OR. N .GT. NMAX ) THEN
5232	WRITE(IOU,*)
5233	* ' ***TIXN error--improper value for ',VALFLG(1:NVF)
5234	WRITE(IOU,*) ' TIXN called by ',SUBFLG(1:NSF)
5235	WRITE(IOU,*)
5236	* ' ',VALFLG(1:NVF),'MIN,',VALFLG(1:NVF),'MAX=',
5237	* NMIN, NMAX
5238	WRITE(IOU,*) ' ',VALFLG(1:NVF),'=', N
5239	IERR = 2
5240	NDIAG = NDIAG + 1
5241	RETURN
5242	ENDIF
5243	RETURN
5244	END
5245	SUBROUTINE TMON3 ( X, N, DX, SUBFLG, NSF, VALFLG, NVF, NBAD, IOU )
5246	C
5247	C Subroutine to test vector X, maximum length of three, to see if
5248	C it is monotonically increasing or decreasing.
5249	C
5250	C Required routines: None.
5251	C
5252	C History:
5253	C 940803 (SEG) - Added loop to test each X.
5254	C
5255	C
5256	CHARACTER() SUBFLG
5257	CHARACTER() VALFLG
5258	C
5259	DIMENSION X( * )
5260	C
5261	NBAD = 0
5262	IF( N .GT. 2 ) THEN
5263	IF( DX .EQ. 0.0 ) THEN
5264	DD = X(3) - X(1)
5265	ELSE
5266	DD = DX
5267	ENDIF
5268	J = 3
5269	ELSE IF( N .EQ. 2 ) THEN
5270	IF( DX .NE. 0.0 ) THEN
5271	DD = DX
5272	J = 2
5273	ELSE
5274	RETURN
5275	ENDIF
5276	ELSE
5277	RETURN
5278	ENDIF
5279	DO 20 I=2,J
5280	IF( SIGN(1.0,DD)*(X(I)-X(I-1)) .LE. 0.0 ) THEN
5281	WRITE( IOU,* )
5282	* ' **TMON3 error--',VALFLG(1:NVF),' not monotonic'
5283	WRITE( IOU,* ) ' TMON3 called by ',SUBFLG(1:NSF)
5284	WRITE( IOU,* ) ' ',VALFLG(1:NVF),'(I-1)=', X(I-1)
5285	WRITE( IOU,* ) ' ',VALFLG(1:NVF),'(I) =', X(I)
5286	NBAD = NBAD + 1
5287	ENDIF
5288	20 CONTINUE
5289	RETURN
5290	END
5291	SUBROUTINE TMONC ( X, LX, N, SUBFLG, NSF, VALFLG, NVF,
5292	* NBAD, IOU )
5293	C
5294	C Subroutine to test vector X, maximum length of three, to see if
5295	C it is monotonically increasing or decreasing.
5296	C
5297	C Required routines: None.
5298	C
5299	CHARACTER() SUBFLG
5300	CHARACTER() VALFLG
5301	CHARACTER() X( * )
5302	C
5303	NBAD = 0
5304	IF( N .LT. 3 ) RETURN
5305	IF( X(2)(1:LX) .GT. X(1)(1:LX) .AND.
5306	* X(3)(1:LX) .GT. X(2)(1:LX) ) RETURN
5307	IF( X(2)(1:LX) .LT. X(1)(1:LX) .AND.
5308	* X(3)(1:LX) .LT. X(2)(1:LX) ) RETURN
5309	WRITE( IOU,* )
5310	* ' **TMONC error--',VALFLG(1:NVF),' not monotonic'
5311	WRITE( IOU,* ) ' TMONC called by ',SUBFLG(1:NSF)
5312	WRITE( IOU,* ) ' ',VALFLG(1:NVF),'(I-2)= ',X(1)(1:LX)
5313	WRITE( IOU,* ) ' ',VALFLG(1:NVF),'(I-1)= ',X(2)(1:LX)
5314	WRITE( IOU,* ) ' ',VALFLG(1:NVF),'(I) = ',X(3)(1:LX)
5315	NBAD = NBAD + 1
5316	RETURN
5317	END
5318	SUBROUTINE TMONO ( X, N, DX, SUBFLG, NSF, VALFLG, NVF, NBAD, IOU )
5319	C
5320	C Subroutine to test vector X to see if it is monotonically
5321	C increasing or decreasing.
5322	C
5323	C Required routines: None.
5324	C
5325	CHARACTER() SUBFLG
5326	CHARACTER() VALFLG
5327	C
5328	DIMENSION X( * )
5329	C
5330	NBAD = 0
5331	IF( N .LT. 2 ) RETURN
5332	IF( DX .EQ. 0.0 ) THEN
5333	DD = X(N) - X(1)
5334	ELSE
5335	DD = DX
5336	ENDIF
5337	DO 20 I=2,N
5338	IF( SIGN(1.0,DD)*(X(I)-X(I-1)) .LE. 0.0 ) THEN
5339	WRITE( IOU,* )
5340	* ' **TMONO error--',VALFLG(1:NVF),' not monotonic'
5341	WRITE( IOU,* ) ' TMONO called by ',SUBFLG(1:NSF)
5342	WRITE( IOU,* ) ' ',VALFLG(1:NVF),'(I-1)=', X(I-1)
5343	WRITE( IOU,* ) ' ',VALFLG(1:NVF),'(I) =', X(I)
5344	NBAD = NBAD + 1
5345	ENDIF
5346	20 CONTINUE
5347	RETURN
5348	END
5349	SUBROUTINE TRIVM ( X, DX, RVAL, VALFLG, NVF, NIVM, XIV0,
5350	* NDIAG, IOU, IERR )
5351	C
5352	C Subroutine to test real independent variable marks to see if they are
5353	C monotonic and if they are recorded at the proper interval.
5354	C
5355	C Required routines: L3RVAL, TSTDX, TMON3.
5356	C
5357	C History:
5358	C 91-06-26 (SEG) Improved DX tests.
5359	C
5360	CHARACTER*5 SUBFLG
5361	CHARACTER() VALFLG
5362	C
5363	DIMENSION RVAL( * ), TVAL( 2 )
5364	C
5365	DATA NSF / 5 /
5366	DATA SUBFLG / 'TRIVM' /
5367	C
5368	IF( IERR .EQ. 0 ) THEN
5369	NIVM = NIVM + 1
5370	CALL L3RVAL ( X, NIVM, RVAL, XIV0 )
5371	CALL TMON3 ( RVAL, MIN0(NIVM,3), DX, SUBFLG, NSF,
5372	* VALFLG, NVF, NBAD, IOU )
5373	NDIAG = NDIAG + NBAD
5374	ENDIF
5375	TVAL(1) = XIV0
5376	TVAL(2) = RVAL(MIN0(3,NIVM))
5377	CALL TSTDX ( TVAL, MIN0(NIVM-1,2), NIVM, DX, SUBFLG, NSF,
5378	* VALFLG, NVF, NDIAG, IOU )
5379	RETURN
5380	END
5381	SUBROUTINE TSTDX ( X, NXP, NX, DX, SUBFLG, NSF, VALFLG, NVF,
5382	* NDIAG, IOU )
5383	C
5384	C Subroutine to test vector X to see if its values are uniformly
5385	C spaced.
5386	C NXP is the number of values of X passed to this routine (could be
5387	C just the first and last value), whereas NX is the actual
5388	C number of defined values of X.
5389	C This routine only tests to see if NX = ( X(NX) - X(1) ) / DX + 1
5390	C so that the index of a particular X(I) can be calculated as
5391	C I = ( X(I) - X(1) ) / DX + 1
5392	C where I is evaluated as the nearest integer to the term on the rhs.
5393	C
5394	C Required routines: None.
5395	C
5396	C History:
5397	C 91-06-26 (SEG) Modified DX tests to loop over NXP-1 values of X, and
5398	C only test for ICAL=I.
5399	C
5400	CHARACTER() SUBFLG
5401	CHARACTER() VALFLG
5402	C
5403	DIMENSION X( * )
5404	C
5405	C
5406	IF( NXP .LT. 2 .OR. DX .EQ. 0.0 ) RETURN
5407	IF( NXP .EQ. 2 ) THEN
5408	NCAL = INT( (X(NXP)-X(1))/DX + 0.5 ) + 1
5409	IF( NCAL .NE. NX ) THEN
5410	WRITE( IOU,* )
5411	* ' **TSTDX error--Non-uniform ',VALFLG(1:NVF),' interval'
5412	WRITE( IOU,* ) ' TSTDX called by ',SUBFLG(1:NSF)
5413	WRITE( IOU,* ) ' NCAL,NX=', NCAL, NX
5414	WRITE( IOU,* ) ' X(1),X(NX),DX=', X(1),X(NXP),DX
5415	NDIAG = NDIAG + 1
5416	ENDIF
5417	ELSE
5418	DO 40 I=2,NXP
5419	ICAL = INT( (X(I)-X(1))/DX + 0.5 ) + 1
5420	IF( ICAL .NE. I ) THEN
5421	WRITE( IOU,* )
5422	* ' **TSTDX error--Non-uniform ',VALFLG(1:NVF),' interval'
5423	WRITE( IOU,* ) ' TSTDX called by ',SUBFLG(1:NSF)
5424	WRITE( IOU,* ) ' ICAL,I=', ICAL, I
5425	WRITE( IOU,* ) ' NXP,NX=', NXP, NX
5426	WRITE( IOU,* ) ' X(1),X(I),DX=', X(1),X(I),DX
5427	NDIAG = NDIAG + 1
5428	ENDIF
5429	40 CONTINUE
5430	ENDIF
5431	RETURN
5432	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats: