You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
139 lines
4.1 KiB
139 lines
4.1 KiB
2 years ago
|
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
||
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
||
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
||
|
|
C
|
||
|
|
C See packages/seacas/LICENSE for details
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE RWQA (NTXT, NDB, C, QAINFO, *)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** RDQA *** (TXTEXO) Read QA and information records
|
||
|
|
C -- Written by Amy Gilkey - revised 02/08/88
|
||
|
|
C --
|
||
|
|
C --RDQA reads the QA records and the information records.
|
||
|
|
C --
|
||
|
|
C --Note that the number of QA records and information records to be read
|
||
|
|
C --are read in this routine.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NTXT - IN - the text file
|
||
|
|
C -- MAXQA - IN - the maximum number of QA records to store
|
||
|
|
C -- MAXINF - IN - the number of information records to store
|
||
|
|
C -- NQAREC - OUT - the number of QA records; <0 if not read
|
||
|
|
C -- QAREC - OUT - the QA records containing:
|
||
|
|
C -- (1) - the analysis code name
|
||
|
|
C -- (2) - the analysis code QA descriptor
|
||
|
|
C -- (3) - the analysis date
|
||
|
|
C -- (4) - the analysis time
|
||
|
|
C -- NINFO - OUT - the number of information records; <0 if not read
|
||
|
|
C -- INFO - OUT - the information records
|
||
|
|
C -- EXODUS - OUT - set false if GENESIS format, true if EXODUS so far
|
||
|
|
C -- * - return statement if error encountered, including end-of-file;
|
||
|
|
C -- NOT used if valid GENESIS file; message is printed
|
||
|
|
C --
|
||
|
|
C --Database must be positioned at start of QA records upon entry;
|
||
|
|
C --upon exit positioned at end of information records.
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
CHARACTER*1 C(*)
|
||
|
|
CHARACTER*(MXSTLN) QAINFO(6)
|
||
|
|
|
||
|
|
READ (NTXT, *, END=150, ERR=150)
|
||
|
|
READ (NTXT, *, END=150, ERR=150) NQAREC
|
||
|
|
|
||
|
|
nqarec = nqarec + 1
|
||
|
|
call mcrsrv('QAREC', kqarec, mxstln*4*nqarec)
|
||
|
|
call mcstat (nerr, mem)
|
||
|
|
if (nerr .ne. 0) then
|
||
|
|
call memerr()
|
||
|
|
return 1
|
||
|
|
end if
|
||
|
|
|
||
|
|
call rwqa1(ntxt, ndb, nqarec, c(kqarec), qainfo, *190)
|
||
|
|
|
||
|
|
call mcdel('QAREC')
|
||
|
|
call mcstat (nerr, mem)
|
||
|
|
if (nerr .ne. 0) then
|
||
|
|
call memerr()
|
||
|
|
return 1
|
||
|
|
end if
|
||
|
|
|
||
|
|
READ (NTXT, *, END=170, ERR=170)
|
||
|
|
READ (NTXT, *, END=170, ERR=170) NINFO
|
||
|
|
|
||
|
|
call mcrsrv('INFO', kinfo, mxlnln*ninfo)
|
||
|
|
call mcstat (nerr, mem)
|
||
|
|
if (nerr .ne. 0) then
|
||
|
|
call memerr()
|
||
|
|
return 1
|
||
|
|
end if
|
||
|
|
|
||
|
|
call rwinfo(ntxt, ndb, ninfo, c(kinfo), *190)
|
||
|
|
|
||
|
|
call mcdel('INFO')
|
||
|
|
call mcstat (nerr, mem)
|
||
|
|
if (nerr .ne. 0) then
|
||
|
|
call memerr()
|
||
|
|
return 1
|
||
|
|
end if
|
||
|
|
|
||
|
|
return
|
||
|
|
150 CONTINUE
|
||
|
|
CALL PRTERR ('FATAL', 'Reading NUMBER OF QA RECORDS')
|
||
|
|
GOTO 190
|
||
|
|
170 CONTINUE
|
||
|
|
CALL PRTERR ('FATAL', 'Reading NUMBER OF INFORMATION RECORDS')
|
||
|
|
GOTO 190
|
||
|
|
190 continue
|
||
|
|
return 1
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine rwqa1(ntxt, ndb, nqarec, qarec, qainfo, *)
|
||
|
|
include 'exodusII.inc'
|
||
|
|
character*(mxstln) qarec(4,*)
|
||
|
|
character*(mxstln) qainfo(6)
|
||
|
|
character*32 stra
|
||
|
|
|
||
|
|
DO 100 IQA = 1, NQAREC-1
|
||
|
|
READ (NTXT, '(A)', END=160, ERR=160)
|
||
|
|
& (QAREC(I,IQA), I=1,4)
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
C ... Add record for this code
|
||
|
|
qarec(1,nqarec) = qainfo(1)
|
||
|
|
qarec(2,nqarec) = qainfo(3)
|
||
|
|
qarec(3,nqarec) = qainfo(5)
|
||
|
|
qarec(4,nqarec) = qainfo(6)
|
||
|
|
|
||
|
|
if (nqarec .gt. 0) then
|
||
|
|
call expqa(ndb, nqarec, qarec, ierr)
|
||
|
|
if (ierr .ne. 0) return 1
|
||
|
|
end if
|
||
|
|
return
|
||
|
|
160 CONTINUE
|
||
|
|
CALL INTSTR (1, 0, IQA, STRA, LSTRA)
|
||
|
|
CALL PRTERR ('FATAL', 'Reading QA RECORD ' // STRA(:LSTRA))
|
||
|
|
return 1
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine rwinfo(ntxt, ndb, ninfo, info, *)
|
||
|
|
include 'exodusII.inc'
|
||
|
|
character*(mxlnln) info(*)
|
||
|
|
character*32 stra
|
||
|
|
|
||
|
|
if (ninfo .le. 0) return
|
||
|
|
DO 120 I = 1, NINFO
|
||
|
|
READ (NTXT, '(A)', END=180, ERR=180) INFO(I)
|
||
|
|
120 CONTINUE
|
||
|
|
|
||
|
|
call expinf(ndb, ninfo, info, ierr)
|
||
|
|
if (ierr .ne. 0) return 1
|
||
|
|
return
|
||
|
|
180 CONTINUE
|
||
|
|
CALL INTSTR (1, 0, I, STRA, LSTRA)
|
||
|
|
CALL PRTERR ('FATAL',
|
||
|
|
& 'Reading INFORMATION RECORD ' // STRA(:LSTRA))
|
||
|
|
return 1
|
||
|
|
end
|