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