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.
101 lines
3.3 KiB
101 lines
3.3 KiB
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
|
|
SUBROUTINE MXLONG (NAME1, NEWLEN, NEWLOC, MYV, MYCHAR, MYLOC,
|
|
* MYCLOC, UCLOC, COFFST, OFFSET,
|
|
* DICT, DPOINT, LDICT, NNAMES, VOID, LVOID, NVOIDS,
|
|
* FILL, FDATA, CFILL, CFDATA, CHRNUM, CHRCOL, LASTER)
|
|
|
|
IMPLICIT INTEGER (A-Z)
|
|
INCLUDE 'params.inc'
|
|
|
|
C***********************************************************************
|
|
|
|
C NAME1 Name of the vector which changes length
|
|
CHARACTER*8 NAME1
|
|
C NEWLEN The new length of the vector
|
|
C NEWLOC The new location of the vector (returned)
|
|
C MYV Internal reference array
|
|
DIMENSION MYV(*)
|
|
C MYCHAR Internal reference array.
|
|
CHARACTER MYCHAR(*)
|
|
C MYLOC Address of internal array
|
|
C MYCLOC Address of internal character array.
|
|
C UCLOC Address of user's character array.
|
|
C COFFST Offset between internal numeric array and user's
|
|
C character array.
|
|
C OFFSET Address offset from internal array to user's array
|
|
C DICT Dictionary name table
|
|
C DPOINT Dictionary pointer table
|
|
C LDICT Dimension of dictionary
|
|
C NNAMES Number of names in the dictionary
|
|
CHARACTER DICT(LDICT,CHRCOL)
|
|
DIMENSION DPOINT(LDICT,CHRCOL,3), NNAMES(2)
|
|
C VOID Void table
|
|
C LVOID Dimension of void table
|
|
C NVOIDS Number of voids
|
|
DIMENSION VOID(LVOID,CHRCOL,2), NVOIDS(2)
|
|
C FILL Flag for data fill.
|
|
C FDATA Data for fill.
|
|
LOGICAL FILL
|
|
C CFILL Flag for character data fill.
|
|
C CFDATA Data for fill.
|
|
LOGICAL CFILL
|
|
CHARACTER*1 CFDATA
|
|
C CHRNUM Number of characters per numeric storage unit
|
|
C CHRCOL Number of column for character names.
|
|
C LASTER Error return
|
|
|
|
C***********************************************************************
|
|
|
|
C Get current location and length.
|
|
|
|
CALL MXFIND (NAME1, DICT, DPOINT, LDICT, NNAMES,
|
|
* CHRCOL, LASTER, ROW)
|
|
IF (LASTER .NE. SUCCESS) RETURN
|
|
|
|
C Save the current location of the array.
|
|
|
|
OLDLOC = DPOINT(ROW,1,1)
|
|
OLDLEN = DPOINT(ROW,1,2)
|
|
|
|
LASTER = SUCCESS
|
|
oldadr = oldloc+myloc-1
|
|
memret = -998
|
|
memlen = newlen
|
|
|
|
C ... If the old length == 0, then we don't have a valid pointer.
|
|
C Need to call malloc instead of realloc.
|
|
if (oldlen .eq. 0) then
|
|
memret = 0
|
|
if (memlen .gt. 0) then
|
|
call exmemy(memlen, oldadr, memret)
|
|
end if
|
|
else
|
|
call exmemy(-memlen, oldadr, memret)
|
|
end if
|
|
|
|
if (memret .lt. 0 .or. memret .gt. memlen) then
|
|
laster = ilblk
|
|
write (*,*) 'ERROR in mxlong ', memret, memlen
|
|
return
|
|
end if
|
|
|
|
IF (LASTER .NE. SUCCESS) RETURN
|
|
|
|
DPOINT(ROW,1,1) = oldadr+1-myloc
|
|
NEWLOC = DPOINT(ROW,1,1) + OFFSET
|
|
DPOINT(ROW,1,2) = NEWLEN
|
|
|
|
C Perform data fill if appropriate.
|
|
|
|
IF (FILL) THEN
|
|
DO J = DPOINT(ROW,1,1)+OLDLEN, DPOINT(ROW,1,1)+NEWLEN-1
|
|
MYV(J) = FDATA
|
|
end do
|
|
END IF
|
|
|
|
RETURN
|
|
END
|
|
|