mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
76 lines
2.3 KiB
Fortran
76 lines
2.3 KiB
Fortran
*DECK IPLOC
|
|
INTEGER FUNCTION IPLOC (LOC, SX, IX)
|
|
C***BEGIN PROLOGUE IPLOC
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to SPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (IPLOC-S, IDLOC-D)
|
|
C***KEYWORDS RELATIVE ADDRESS DETERMINATION FUNCTION, SLATEC
|
|
C***AUTHOR Hanson, R. J., (SNLA)
|
|
C Wisniewski, J. A., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C Given a "virtual" location, IPLOC returns the relative working
|
|
C address of the vector component stored in SX, IX. Any necessary
|
|
C page swaps are performed automatically for the user in this
|
|
C function subprogram.
|
|
C
|
|
C LOC is the "virtual" address of the data to be retrieved.
|
|
C SX ,IX represent the matrix where the data is stored.
|
|
C
|
|
C***SEE ALSO SPLP
|
|
C***ROUTINES CALLED PRWPGE, XERMSG
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 810306 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 890606 Restructured to match double precision version. (WRB)
|
|
C 890606 REVISION DATE from Version 3.2
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
|
|
C 910731 Added code to set IPLOC to 0 if LOC is non-positive. (WRB)
|
|
C***END PROLOGUE IPLOC
|
|
REAL SX(*)
|
|
INTEGER IX(*)
|
|
C***FIRST EXECUTABLE STATEMENT IPLOC
|
|
IF (LOC.LE.0) THEN
|
|
CALL XERMSG ('SLATEC', 'IPLOC',
|
|
+ 'A value of LOC, the first argument, .LE. 0 was encountered',
|
|
+ 55, 1)
|
|
IPLOC = 0
|
|
RETURN
|
|
ENDIF
|
|
C
|
|
C Two cases exist: (1.LE.LOC.LE.K) .OR. (LOC.GT.K).
|
|
C
|
|
K = IX(3) + 4
|
|
LMX = IX(1)
|
|
LMXM1 = LMX - 1
|
|
IF (LOC.LE.K) THEN
|
|
IPLOC = LOC
|
|
RETURN
|
|
ENDIF
|
|
C
|
|
C Compute length of the page, starting address of the page, page
|
|
C number and relative working address.
|
|
C
|
|
LPG = LMX-K
|
|
ITEMP = LOC - K - 1
|
|
IPAGE = ITEMP/LPG + 1
|
|
IPLOC = MOD(ITEMP,LPG) + K + 1
|
|
NP = ABS(IX(LMXM1))
|
|
C
|
|
C Determine if a page fault has occurred. If so, write page NP
|
|
C and read page IPAGE. Write the page only if it has been
|
|
C modified.
|
|
C
|
|
IF (IPAGE.NE.NP) THEN
|
|
IF (SX(LMX).EQ.1.0) THEN
|
|
SX(LMX) = 0.0
|
|
KEY = 2
|
|
CALL PRWPGE (KEY, NP, LPG, SX, IX)
|
|
ENDIF
|
|
KEY = 1
|
|
CALL PRWPGE (KEY, IPAGE, LPG, SX, IX)
|
|
ENDIF
|
|
RETURN
|
|
END
|