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 LNKSTO (NAMEGV, NUMSTO, LTMENT, MERR)
C=======================================================================
C --*** LNKSTO *** (ALGEBRA) Assign storage for variables
C -- Written by Amy Gilkey - revised 11/30/87
C --
C --LNKSTO sets up the storage locations for all the variables.
C --Input and output variables of the same name share storage (unless
C --one is a history/global and the other is not). Time and history/global
C --variables are all in the first storage location: time is in slot 1,
C --followed by the input history variables (if any), the input global
C --variables (if any), then the output only history/global variables.
C --IDVAR contains the slot index of the time or history/global variables.
C --
C --Parameters:
C -- NAMEGV - IN - the global variable names
C -- NUMSTO - OUT - the number of variable storage locations needed
C -- LTMENT - OUT - the number of slots in the time /globals entry
C -- * - return statement if an error is found; message is printed
C --
C --Common Variables:
C -- Sets ISTVAR, IDVAR of /VAR../
C -- Uses NUMINP, IXLHS, NAMVAR, TYPVAR of /VAR../
C -- Uses NVARGL of /DBNUMS/
C -- Uses IHVBEG, IHVEND, IGVBEG, IGVEND of /DBXVAR/
PARAMETER (ICURTM = 1, ILSTTM = 2, IONETM = 3)
include 'ag_namlen.blk'
include 'ag_var.blk'
include 'ag_dbnums.blk'
include 'ag_dbxvar.blk'
INTEGER MERR
CHARACTER*(namlen) NAMEGV(*)
INTEGER ISTTHG(3)
MERR = 0
ccSave entry 1 for time and history/global variables
C Save entry 1 for time and global variables
NUMSTO = 1
C --Assign current, last and first location for all time global
C --variables
ISTTHG(ICURTM) = NUMSTO
ISTTHG(ILSTTM) = 0
ISTTHG(IONETM) = 0
DO 110 IVAR = 1, NUMINP
IF ((TYPVAR(IVAR) .EQ. 'T')
& .OR. (TYPVAR(IVAR) .EQ. 'G')) THEN
DO 100 ITM = 1, 3
IF (ISTVAR(ITM,IVAR) .NE. 0) THEN
IF (ISTTHG(ITM) .EQ. 0) THEN
NUMSTO = NUMSTO + 1
ISTTHG(ITM) = NUMSTO
END IF
END IF
100 CONTINUE
END IF
110 CONTINUE
DO 130 IVAR = IXLHS, MAXVAR
IF ((TYPVAR(IVAR) .EQ. 'T')
& .OR. (TYPVAR(IVAR) .EQ. 'G')) THEN
DO 120 ITM = 1, 3
IF (ISTVAR(ITM,IVAR) .NE. 0) THEN
IF (ISTTHG(ITM) .EQ. 0) THEN
NUMSTO = NUMSTO + 1
ISTTHG(ITM) = NUMSTO
END IF
END IF
120 CONTINUE
END IF
130 CONTINUE
C --Check if any history or global variables must be input, and assign
C --index in time entry
c IXHV = 0
IXGV = 0
DO 140 IVAR = 1, NUMINP
IF (TYPVAR(IVAR) .EQ. 'G') THEN
IXGV = 1
END IF
140 CONTINUE
LTMENT = 1
IF (IXGV .GT. 0) THEN
IXGV = LTMENT + 1
LTMENT = LTMENT + NVARGL
END IF
C --Reserve storage for all input variables
DO 160 IVAR = 1, NUMINP
C --If previous time is needed, current time must be read
IF (ISTVAR(ILSTTM,IVAR) .NE. 0) ISTVAR(ICURTM,IVAR) = 1
IF ((TYPVAR(IVAR) .EQ. 'T')
& .OR. (TYPVAR(IVAR) .EQ. 'G')) THEN
C --Assign current and last for all time /global variables so
C --current to last move is done properly
IF (ISTVAR(ICURTM,IVAR) .NE. 0) THEN
ISTVAR(ICURTM,IVAR) = ISTTHG(ICURTM)
IF (ISTTHG(ILSTTM) .GT. 0)
& ISTVAR(ILSTTM,IVAR) = ISTTHG(ILSTTM)
END IF
IF (ISTVAR(IONETM,IVAR) .NE. 0)
& ISTVAR(IONETM,IVAR) = ISTTHG(IONETM)
IF (TYPVAR(IVAR) .EQ. 'T') THEN
C --TIME is in slot 1 (output time shares storage)
IDVAR(IVAR) = 1
ELSE IF (TYPVAR(IVAR) .EQ. 'G') THEN
C --Input globals start at assigned slot
IDVAR(IVAR) = IXGV
END IF
ELSE
C --Reserve entry for array variable for current, last, and
C --first time (as needed)
DO 150 ITM = 1, 3
IF (ISTVAR(ITM,IVAR) .NE. 0) THEN
NUMSTO = NUMSTO + 1
ISTVAR(ITM,IVAR) = NUMSTO
END IF
150 CONTINUE
END IF
160 CONTINUE
C --Reserve storage for output variables or link to input variable
DO 190 IVAR = IXLHS, MAXVAR
IF ((TYPVAR(IVAR) .EQ. 'T')
& .OR. (TYPVAR(IVAR) .EQ. 'G')) THEN
C --Assign current and last for all time / history/global variables
C --so current to last move is done properly; output history/globals
C --are in same entry as input history/globals
IF (ISTVAR(ICURTM,IVAR) .NE. 0) THEN
ISTVAR(ICURTM,IVAR) = ISTTHG(ICURTM)
IF (ISTTHG(ILSTTM) .GT. 0)
& ISTVAR(ILSTTM,IVAR) = ISTTHG(ILSTTM)
END IF
IF (ISTVAR(IONETM,IVAR) .NE. 0)
& ISTVAR(IONETM,IVAR) = ISTTHG(IONETM)
IF (TYPVAR(IVAR) .EQ. 'T') THEN
C --Output time shares storage with input time
IDVAR(IVAR) = 1
ELSE IF (TYPVAR(IVAR) .EQ. 'G') THEN
C --Share slot with input global variable of the same name (if any)
C --or reserve new slot
IF (IXGV .GT. 0) THEN
IINP = LOCSTR (NAMVAR(IVAR), NVARGL, NAMEGV)
ELSE
IINP = 0
END IF
IF (IINP .GT. 0) THEN
IDVAR(IVAR) = IINP + IXGV - 1
ELSE
LTMENT = LTMENT + 1
IDVAR(IVAR) = LTMENT
END IF
END IF
ELSE
C --Share array storage with input variable of the same name (if any)
C --or reserve entry for array variable
IINP = LOCSTR (NAMVAR(IVAR), NUMINP, NAMVAR)
IF (IINP .GT. 0) THEN
IF ((TYPVAR(IINP) .EQ. 'H')
& .OR. (TYPVAR(IINP) .EQ. 'G')) IINP = 0
END IF
IF (IINP .LE. 0) THEN
C --Reserve entry for array variable for current, last, and
C --first time (as needed)
DO 170 ITM = 1, 3
IF (ISTVAR(ITM,IVAR) .NE. 0) THEN
NUMSTO = NUMSTO + 1
ISTVAR(ITM,IVAR) = NUMSTO
END IF
170 CONTINUE
ELSE
C --Share array storage with input variable; if either has
C --current/last pair, both must have current and last so
C --current to last move is done properly
DO 180 ITM = 1, 3
IF ((ISTVAR(ITM,IVAR) .NE. 0)
& .OR. (ISTVAR(ITM,IINP) .NE. 0)) THEN
IF (ISTVAR(ITM,IINP) .EQ. 0) THEN
NUMSTO = NUMSTO + 1
ISTVAR(ITM,IVAR) = NUMSTO
IF (ITM .NE. IONETM) ISTVAR(ITM,IINP) = NUMSTO
ELSE
ISTVAR(ITM,IVAR) = ISTVAR(ITM,IINP)
END IF
END IF
180 CONTINUE
END IF
END IF
190 CONTINUE
C --Fix up variables which request the first time but not the current time
C --by changing the current storage location to the first storage location
C --negated
DO 200 IVAR = 1, NUMINP
IF ((ISTVAR(ICURTM,IVAR) .EQ. 0)
& .AND. (ISTVAR(IONETM,IVAR) .NE. 0)) THEN
ISTVAR(ICURTM,IVAR) = - ISTVAR(IONETM,IVAR)
END IF
200 CONTINUE
RETURN
END