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