1 SUBROUTINE TLIP1X(X1,Y,NP1,XA1,YA,LX1L,LX1U,MESS,NMSS,ROUT) 2C 3C*** LINEAR INTERPOLATION FOR A PACKED TABLE Y=F(X) 4C 5C AJT DIMENSION Y(2),X1(2),DA(3),MESS(20),ROUT(2),NP1(7) 6 DIMENSION Y(*),X1(*),DA(3),MESS(*),ROUT(*),NP1(*) 7 DIMENSION MSSCL(9),RMSCL(9) 8 EQUIVALENCE (RMSCL(1),MSSCL(1)) 9 LOGICAL NOIN1,NAS1,X1A,X1B,MSSG1,EX1,LG(7) 10 EQUIVALENCE (NOIN1,LG(1)),(X1A,LG(2)),(X1B,LG(3)),(MSSG1,LG(4)), 11 1 (EX1,LG(5)),(DA(1),D0),(DA(2),D1),(DA(3),D2),(NAS1,LG(6)) 12 DATA TLIN /4H1TIN/, HOL1 /4H1EXP/ 13 DATA MSSCL /4HTLIP,4H1X ,2*0,1,4*0/ 14C 15 NX1=IABS(NP1(1)) 16 CALL SWITCH(LG,LX1L,LX1U,XA1,X1,NX1) 17 IF(LG(7))GO TO 1030 18 CALL GLOOK(NX1,XA1,X1,NAS1,NOIN1,I1,T1) 19 YI1=YUP(I1,NP1,Y) 20 D2=YI1 21 IF(NOIN1)GO TO 1000 22 YI1M1=YUP(I1-1,NP1,Y) 23 D2=YI1M1+T1*(D2-YI1M1) 24 1000 YA=D2 25 IF(MSSG1)GO TO 1010 26 RETURN 27 1010 IF(ROUT(1).NE.TLIN)GO TO 1020 28 ROUT(1)=HOL1 29 RETURN 30C 31C ----PRINT EXTRAPOLATION MESSAGE 32C 33 1020 MSSCL(3)=NMSS 34 RMSCL(4)=YA 35 RMSCL(6)=XA1 36 MSSCL(7)=NX1 37 MSSCL(8)=LX1L 38 MSSCL(9)=LX1U 39 CALL MESSGE(ROUT,MESS,X1,LG,LG,LG,MSSCL) 40 RETURN 41C 42C ----HERE FOR EXTRAPOLATION 43C 44 1030 IF(X1B)GO TO 1060 45C 46C ----HERE FOR XA1 ABOVE 47C 48 YNX1=YUP(NX1,NP1,Y) 49 YNX1M1=YUP(NX1-1,NP1,Y) 50 IF(LX1U.GT.1.AND.NX1.GT.2)GO TO 1040 51C 52C ----LINEAR EXTRAPOLATION 53C 54 T1=(XA1-X1(NX1))/(X1(NX1)-X1(NX1-1)) 55 YA=YNX1+T1*(YNX1-YNX1M1) 56 GO TO 1010 57C 58C ----QUADRATIC EXTRAPOLATION 59C 60 1040 D2=YNX1 61 D1=YNX1M1 62 IX=NX1-2 63 D0=YUP(IX,NP1,Y) 64 1050 CALL QUAD(X1(IX),DA,XA1,YA) 65 GO TO 1010 66C 67C ----HERE FOR XA1 BELOW 68C 69 1060 Y1=YUP(1,NP1,Y) 70 Y2=YUP(2,NP1,Y) 71 IF(LX1L.GT.1.AND.NX1.GT.2)GO TO 1070 72C 73C ----LINEAR EXTRAPOLATION 74C 75 T1=(XA1-X1(1))/(X1(2)-X1(1)) 76 YA=Y1+T1*(Y2-Y1) 77 GO TO 1010 78 1070 D0=Y1 79 D1=Y2 80 D2=YUP(3,NP1,Y) 81 IX=1 82 GO TO 1050 83 END 84