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 DBIV0 (NQAREC, NINFO)
C=======================================================================
C --*** DBIV0 *** (EXOLIB) Initialize for DBIVAR
C --
C --DBIV0 and DBIV1 initialize for the DBIVAR routine.
C --
C --Parameters:
C -- NQAREC - IN - the number of QA records
C -- NINFO - IN - the number of information records
C --
C --Database state is maintained within DBIVIN and DBIVAR, and should
C --not be moved between calls to these routines.
INTEGER NQAREC, NINFO
INTEGER NELBLK
INTEGER NVARHI, NVARGL, NVARNP, NVAREL
c LOGICAL ISEVOK(*)
integer ISEVOK(*)
LOGICAL REWDB
INTEGER NDB
INTEGER NUMVAR
INTEGER IVAR(*)
INTEGER ISTEP
INTEGER LENVAR
INTEGER NUMELB(*)
REAL VAR(*)
CHARACTER*80 ERRMSG
CHARACTER TYP, T
LOGICAL WHOTIM
INTEGER NQASV, NINSV, NELBSV, NVELSV
SAVE NQASV, NINSV, NELBSV, NVELSV
C --NQASV, NINSV, NELBSV, NVELSV - the saved values for
C -- NQAREC, NINFO, NELBLK, NVAREL
INTEGER NREC0, NRECST
SAVE NREC0, NRECST
C --NREC0 - the number of database records before the time steps
C --NRECST - the number of database records for each whole time step
INTEGER IHVR0, IGVR0, INVR0, IEVR0
SAVE IHVR0, IGVR0, INVR0, IEVR0
C --IHVR0, IGVR0, INVR0, IEVR0 - the variable record number offset,
C -- including the time record
INTEGER NCSTEP, NCREC, NCEND
SAVE NCSTEP, NCREC, NCEND
C --NCSTEP - the current database step number; <0 if database should be
C -- rewound
C --NCREC - the current database record within time step
C --NCEND - the number of database records in current time step
DATA NQASV, NINSV, NELBSV / -999, -999, -999 /
DATA NREC0, NRECST / -999, -999 /
DATA IHVR0, IGVR0, INVR0, IEVR0 / -999, -999, -999, -999 /
DATA NCSTEPL / -999 /
C --Save the input parameters
NQASV = NQAREC
NINSV = NINFO
GOTO 120
C=======================================================================
ENTRY DBIV1 (NELBLK, NVARHI, NVARGL, NVARNP, NVAREL, ISEVOK)
C=======================================================================
C --*** DBIV1 *** (EXOLIB) Initialize for DBIVAR
C -- Written by Amy Gilkey - revised 11/04/87
C --
C --DBIV0 and DBIV1 initialize for the DBIVAR routine.
C --
C --Parameters:
C -- NELBLK - IN - the number of element blocks
C -- NVARHI - IN - the number of history variables
C -- NVARGL - IN - the number of global variables
C -- NVARNP - IN - the number of nodal variables
C -- NVAREL - IN - the number of element variables
C -- ISEVOK - IN - the element block variable truth table;
C -- variable i of block j exists iff ISEVOK(j,i)
C --
C --Database state is maintained within DBIVIN and DBIVAR, and should
C --not be moved between calls to these routines.
C --Save the input parameters
NELBSV = NELBLK
NVELSV = NVAREL
C --Set NRECST = the number of records in a whole time step
IF (NRECST .LT. 0) THEN
NRECST = 1 + 1 + 1 + NVARNP
DO 110 IELB = 1, NELBLK
DO 100 I = 1, NVAREL
IF (ISEVOK(0+(ielb-1)*NVAREL+i) .ne. 0) THEN
NRECST = NRECST + 1
END IF
100 CONTINUE
110 CONTINUE
END IF
C --Set the variable record number offsets
IF (IHVR0 .LT. 0) THEN
IHVR0 = 1
IGVR0 = IHVR0 + 1
INVR0 = IGVR0 + 1
IEVR0 = INVR0 + NVARNP
END IF
C --DBIV0 and DBIV1 converge at this point
120 CONTINUE
C --Set NREC0 = the number of records before the time steps
IF (NREC0 .LT. 0) THEN
IF ((NELBSV .GE. 0)
& .AND. (NQASV .GE. 0) .AND. (NINSV .GE. 0)) THEN
NREC0 = 1 + 1 + 1 + 1 + NELBSV * (1 + 1 + 1) + 5 + 8
& + 1 + NQASV + 1 + NINSV + 1 + 1 + 1 + 1 + 1
END IF
END IF
RETURN
C=======================================================================
ENTRY DBIVIN (REWDB)
C=======================================================================
C --*** DBIVIN *** (EXOLIB) Initialize for DBIVAR
C -- Written by Amy Gilkey - revised 11/04/87
C --
C --DBIVIN initializes for the DBIVAR routine.
C --
C --Parameters:
C -- REWDB - IN - if true, database should be rewound, else database is
C -- at start of time steps
C --
C --Database state is maintained within DBIVIN and DBIVAR, and should
C --not be moved between calls to these routines.
IF (REWDB) THEN
NCSTEP = -999
ELSE
NCSTEP = 1
NCREC = 0
END IF
RETURN
C=======================================================================
ENTRY DBIVAR (NDB, NUMVAR, IVAR, ISTEP, LENVAR, IELBLK,
& NELBLK, NUMELB, ISEVOK, VAR, *)
C=======================================================================
C --*** DBIVAR *** (EXOLIB) Read variable
C -- Written by Amy Gilkey - revised 08/16/88
C --
C --DBIVAR returns the values for the requested variables for the
C --requested time step. Several variables may be read, but all must
C --be of the same type. Element variables may be read for a single
C --block (because of the way they are stored, this prevents rewinding).
C --
C --DBIVIN must be called before this routine is called and the database
C --cannot be moved between calls to DBIVIN and DBIVAR.
C --
C --Parameters:
C -- NDB - IN - the database number
C -- NUMVAR - IN - the number of variables to be read (for nodal and
C -- element variables only)
C -- IVAR - IN - the variable indices; no repetitions allowed
C -- ISTEP - IN - the time step number
C -- LENVAR - IN - the length of VAR
C -- IELBLK - IN - the element block number to read, 0 for all
C -- (for element variables only)
C -- NELBLK - IN - the number of element blocks
C -- (for element variables only)
C -- NUMELB - IN - the number of elements per block
C -- (for element variables only)
C -- ISEVOK - IN - the element block variable truth table;
C -- variable i of block j exists iff ISEVOK(i,j)
C -- (for element variables only)
C -- NOTE: ISEVOK is indexed as singly-dimensioned array.
C -- VAR - OUT - the variable values
C -- * - return statement if error encountered, message is printed
C --Find the variable type and ID
CALL DBVTYP (IVAR(1), TYP, MINID)
MAXID = MINID
DO 130 I = 2, NUMVAR
CALL DBVTYP (IVAR(I), T, ID)
IF (TYP .NE. T) THEN
CALL PRTERR ('PROGRAM',
& 'Variables of different types requested')
GOTO 320
END IF
MINID = MIN (MINID, ID)
MAXID = MAX (MAXID, ID)
130 CONTINUE
IF (MINID .EQ. 0) TYP = 'T'
IF (TYP .EQ. ' ') THEN
CALL PRTERR ('PROGRAM', 'Invalid variable requested')
GOTO 320
END IF
C --Find the starting variable record number
IF (TYP .EQ. 'T') THEN
IVREC = 1
ELSE IF (TYP .EQ. 'H') THEN
IVREC = IHVR0 + 1
ELSE IF (TYP .EQ. 'G') THEN
IVREC = IGVR0 + 1
ELSE IF (TYP .EQ. 'N') THEN
IVREC = INVR0 + MINID
ELSE IF (TYP .EQ. 'E') THEN
IF (IELBLK .GE. 1) THEN
ISELB = IELBLK
IEELB = IELBLK
ELSE
ISELB = 1
IEELB = NELBLK
END IF
C --Check that some record must be read, otherwise return
DO 150 IELB = ISELB, IEELB
DO 140 I = 1, NUMVAR
CALL DBVTYP (IVAR(I), T, ID)
IF (ISEVOK(0+(IELB-1)*NVELSV+id) .ne. 0) GOTO 160
140 CONTINUE
150 CONTINUE
RETURN
160 CONTINUE
IVREC = IEVR0 + 1
DO 180 IELB = 1, ISELB-1
DO 170 I = 1, NVELSV
IF (ISEVOK(0+(IELB-1)*NVELSV+i) .ne. 0) THEN
IVREC = IVREC + 1
END IF
170 CONTINUE
180 CONTINUE
DO 190 ID = 1, MINID-1
IF (ISEVOK(0+(ISELB-1)*NVELSV+ID) .ne. 0) THEN
IVREC = IVREC + 1
END IF
190 CONTINUE
END IF
C --Rewind the database if past record (or state is unknown)
IF ((NCSTEP .LT. 0) .OR. (ISTEP .LT. NCSTEP)
& .OR. ((ISTEP .EQ. NCSTEP) .AND. (IVREC .LE. NCREC))) THEN
REWIND (NDB, ERR=310)
NCSTEP = 0
NCREC = 0
DO 200 I = NCREC+1, NREC0
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
NCREC = NCREC + 1
200 CONTINUE
NCSTEP = 1
NCREC = 0
END IF
C --Scan rest of partially-read current time step (if not needed)
IF ((NCSTEP .LT. ISTEP) .AND. (NCREC .GT. 0)) THEN
DO 210 I = NCREC+1, NCEND
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
NCREC = NCREC + 1
210 CONTINUE
NCSTEP = NCSTEP + 1
NCREC = 0
END IF
C --Scan past preceding time steps
DO 230 IS = NCSTEP, ISTEP-1
NCREC = 0
READ (NDB, END=310, ERR=310, IOSTAT=IERR) TIME, HISTFL
NCREC = NCREC + 1
WHOTIM = (HISTFL .EQ. 0.0)
IF (WHOTIM) THEN
NCEND = NRECST
ELSE
NCEND = 2
END IF
DO 220 I = NCREC+1, NCEND
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
NCREC = NCREC + 1
220 CONTINUE
NCSTEP = NCSTEP + 1
NCREC = 0
230 CONTINUE
C --Scan to needed record in this time step
IF (NCREC .LE. 0) THEN
READ (NDB, END=310, ERR=310, IOSTAT=IERR) TIME, HISTFL
NCREC = 1
WHOTIM = (HISTFL .EQ. 0.0)
IF (WHOTIM) THEN
NCEND = NRECST
ELSE
NCEND = 2
END IF
END IF
IF (IVREC .GT. NCEND) THEN
CALL PRTERR ('PROGRAM',
& 'History variables only on this time step')
GOTO 320
END IF
DO 240 I = NCREC+1, IVREC-1
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
NCREC = NCREC + 1
240 CONTINUE
C --Read variable values
IF (TYP .EQ. 'T') THEN
VAR(1) = TIME
ELSE IF ((TYP .EQ. 'H') .OR. (TYP .EQ. 'G')) THEN
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
& (VAR(I), I=1,LENVAR)
NCREC = NCREC + 1
ELSE IF (TYP .EQ. 'N') THEN
CALL DBVIX (TYP, 1, IX1)
DO 250 ID = MINID, MAXID
IX = LOCINT (ID+IX1-1, NUMVAR, IVAR)
IF (IX .GT. 0) THEN
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
& (VAR( (IX-1)*LENVAR+I ), I=1,LENVAR)
NCREC = NCREC + 1
END IF
250 CONTINUE
ELSE IF (TYP .EQ. 'E') THEN
CALL DBVIX (TYP, 1, IX1)
IEL0 = 0
DO 260 IELB = 1, ISELB-1
IEL0 = IEL0 + NUMELB(IELB)
260 CONTINUE
DO 300 IELB = ISELB, IEELB
IF (IELB .GT. ISELB) THEN
DO 270 ID = 1, MINID-1
IF (ISEVOK( 0+(IELB-1)*NVELSV+ID) .ne. 0) THEN
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
NCREC = NCREC + 1
END IF
270 CONTINUE
END IF
DO 280 ID = MINID, MAXID
IX = LOCINT (ID+IX1-1, NUMVAR, IVAR)
IF (IX .GT. 0) THEN
IF (ISEVOK( 0+(IELB-1)*NVELSV+id) .ne. 0) THEN
READ (NDB, END=310, ERR=310, IOSTAT=IERR)
& (VAR( (IX-1)*LENVAR+IEL0+NE), NE=1,NUMELB(IELB))
NCREC = NCREC + 1
END IF
ELSE
IF (ISEVOK( 0+(IELB-1)*NVELSV+ID) .ne. 0) then
read (ndb, end=310, err=310, iostat=ierr)
ncrec = ncrec + 1
end if
end if
280 continue
if (ielb .lt. ieelb) then
do 290 id = maxid+1, nvelsv
if (isevok( (id-1)*nelblk+ielb ) .ne. 0) then
read (ndb, end=310, err=310, iostat=ierr)
ncrec = ncrec + 1
end if
290 continue
end if
iel0 = iel0 + numelb(ielb)
300 continue
end if
if (ncrec .ge. ncend) then
ncstep = ncstep + 1
ncrec = 0
end if
return
310 continue
errmsg = 'time step variable'
call dberr (ierr, errmsg)
ncstep = -999
320 continue
return 1
end