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.
80 lines
2.3 KiB
80 lines
2.3 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 RDQA (NDB, NQAREC, NINFO, KQAREC, KINFO, C)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** RDQA *** (EXPLORE) Read QA and information records
|
||
|
|
C --
|
||
|
|
C --RDQA reads the QA records and the information records.
|
||
|
|
C --An error message is displayed if the end of file is read, unless
|
||
|
|
C --end of GENESIS file.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NDB - IN - the database number
|
||
|
|
C -- NQAREC - OUT - the number of QA records
|
||
|
|
C -- NINFO - OUT - the number of information records
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
|
||
|
|
CHARACTER*1 C(*)
|
||
|
|
|
||
|
|
CHARACTER*80 ERRMSG
|
||
|
|
|
||
|
|
NQAREC = 0
|
||
|
|
NINFO = 0
|
||
|
|
|
||
|
|
call exinq(ndb, EXQA, nqarec, rdum, cdum, ierr)
|
||
|
|
call exinq(ndb, EXINFO, ninfo, rdum, cdum, ierr)
|
||
|
|
call mcrsrv('QAREC', kqarec, nqarec*4*MXSTLN)
|
||
|
|
call mcrsrv('INFREC', kinfo, ninfo*MXLNLN)
|
||
|
|
CALL MCSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) GOTO 160
|
||
|
|
|
||
|
|
if (nqarec .gt. 0) then
|
||
|
|
C ... Wrapper to get strings the right length
|
||
|
|
call exgqaw(ndb, c(kqarec), ierr)
|
||
|
|
if (ierr .ne. 0) go to 180
|
||
|
|
end if
|
||
|
|
if (ninfo .gt. 0) then
|
||
|
|
C ... Wrapper to get info record the right length
|
||
|
|
call exginw(ndb, c(kinfo), ierr)
|
||
|
|
if (ierr .ne. 0) go to 190
|
||
|
|
end if
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
160 CONTINUE
|
||
|
|
WRITE (ERRMSG, 10000, IOSTAT=IDUM) 'Memory Allocation'
|
||
|
|
GOTO 210
|
||
|
|
180 CONTINUE
|
||
|
|
WRITE (ERRMSG, 10000, IOSTAT=IDUM) 'QA RECORDS'
|
||
|
|
GOTO 210
|
||
|
|
190 CONTINUE
|
||
|
|
WRITE (ERRMSG, 10000, IOSTAT=IDUM) 'INFORMATION RECORDS'
|
||
|
|
GOTO 210
|
||
|
|
210 CONTINUE
|
||
|
|
CALL WDBERR (IERR, ERRMSG)
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10000 FORMAT (A)
|
||
|
|
END
|
||
|
|
|
||
|
|
subroutine exgqaw(ndb, qarec, ierr)
|
||
|
|
include 'exodusII.inc'
|
||
|
|
character*(mxstln) qarec(4, *)
|
||
|
|
call exgqa(ndb, qarec, ierr)
|
||
|
|
return
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine exginw(ndb, info, ierr)
|
||
|
|
include 'exodusII.inc'
|
||
|
|
character*(mxlnln) info(*)
|
||
|
|
call exginf(ndb, info, ierr)
|
||
|
|
return
|
||
|
|
end
|