*DECK LA05ED SUBROUTINE LA05ED (A, IRN, IP, N, IW, IA, REALS) C***BEGIN PROLOGUE LA05ED C***SUBSIDIARY C***PURPOSE Subsidiary to DSPLP C***LIBRARY SLATEC C***TYPE DOUBLE PRECISION (LA05ES-S, LA05ED-D) C***AUTHOR (UNKNOWN) C***DESCRIPTION C C THIS SUBPROGRAM IS A SLIGHT MODIFICATION OF A SUBPROGRAM C FROM THE C. 1979 AERE HARWELL LIBRARY. THE NAME OF THE C CORRESPONDING HARWELL CODE CAN BE OBTAINED BY DELETING C THE FINAL LETTER =D= IN THE NAMES USED HERE. C REVISED SEP. 13, 1979. C C ROYALTIES HAVE BEEN PAID TO AERE-UK FOR USE OF THEIR CODES C IN THE PACKAGE GIVEN HERE. ANY PRIMARY USAGE OF THE HARWELL C SUBROUTINES REQUIRES A ROYALTY AGREEMENT AND PAYMENT BETWEEN C THE USER AND AERE-UK. ANY USAGE OF THE SANDIA WRITTEN CODES C DSPLP( ) (WHICH USES THE HARWELL SUBROUTINES) IS PERMITTED. C C***SEE ALSO DSPLP C***ROUTINES CALLED (NONE) C***COMMON BLOCKS LA05DD C***REVISION HISTORY (YYMMDD) C 811215 DATE WRITTEN C 890831 Modified array declarations. (WRB) C 891214 Prologue converted to Version 4.0 format. (BAB) C 900402 Added TYPE section. (WRB) C***END PROLOGUE LA05ED LOGICAL REALS DOUBLE PRECISION A(*),SMALL INTEGER IRN(*), IW(*) INTEGER IP(*) COMMON /LA05DD/ SMALL, LP, LENL, LENU, NCP, LROW, LCOL C***FIRST EXECUTABLE STATEMENT LA05ED NCP = NCP + 1 C COMPRESS FILE OF POSITIVE INTEGERS. ENTRY J STARTS AT IRN(IP(J)) C AND CONTAINS IW(J) INTEGERS,J=1,N. OTHER COMPONENTS OF IRN ARE ZERO. C LENGTH OF COMPRESSED FILE PLACED IN LROW IF REALS IS .TRUE. OR LCOL C OTHERWISE. C IF REALS IS .TRUE. ARRAY A CONTAINS A FILE ASSOCIATED WITH IRN C AND THIS IS COMPRESSED TOO. C A,IRN,IP,IW,IA ARE INPUT/OUTPUT VARIABLES. C N,REALS ARE INPUT/UNCHANGED VARIABLES. C DO 10 J=1,N C STORE THE LAST ELEMENT OF ENTRY J IN IW(J) THEN OVERWRITE IT BY -J. NZ = IW(J) IF (NZ.LE.0) GO TO 10 K = IP(J) + NZ - 1 IW(J) = IRN(K) IRN(K) = -J 10 CONTINUE C KN IS THE POSITION OF NEXT ENTRY IN COMPRESSED FILE. KN = 0 IPI = 0 KL = LCOL IF (REALS) KL = LROW C LOOP THROUGH THE OLD FILE SKIPPING ZERO (DUMMY) ELEMENTS AND C MOVING GENUINE ELEMENTS FORWARD. THE ENTRY NUMBER BECOMES C KNOWN ONLY WHEN ITS END IS DETECTED BY THE PRESENCE OF A NEGATIVE C INTEGER. DO 30 K=1,KL IF (IRN(K).EQ.0) GO TO 30 KN = KN + 1 IF (REALS) A(KN) = A(K) IF (IRN(K).GE.0) GO TO 20 C END OF ENTRY. RESTORE IRN(K), SET POINTER TO START OF ENTRY AND C STORE CURRENT KN IN IPI READY FOR USE WHEN NEXT LAST ENTRY C IS DETECTED. J = -IRN(K) IRN(K) = IW(J) IP(J) = IPI + 1 IW(J) = KN - IPI IPI = KN 20 IRN(KN) = IRN(K) 30 CONTINUE IF (REALS) LROW = KN IF (.NOT.REALS) LCOL = KN RETURN END