Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0137/bmd/bmdx64.for
There is 1 other file named bmdx64.for in the archive. Click here to see a list.
00100	C      PROGRAM WAS CONVERTED FROM FORTRAN 2 TO 7090 FORTRAN IV
00200	C        IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
00300	      COMMON JFA(9100)
00400	      COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
00500	     100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
00600	     2  ,FA1(100),DAN1(100)
00700	C
00800	      DOUBLE PRECISION P,PQ,PP,PO
00900	      DATA RE/2HNO/
01000	      DATA PQ,PP/'FINISH','PROBLM'/
01100	C
01200	   30 FORMAT('1BMDX64 - GENERAL LINEAR HYPOTHESIS - REVISED ',
01300	     1'JANUARY 20, 1969'/
01400	     241H HEALTH SCIENCES COMPUTING FACILITY, UCLA//
01500	     X14H PROBLEM CODE ,9(1H.,1X),A6/22H NUMBER OF COVARIATES ,5(1H.,1X)
01600	     X,I6/32H NUMBER OF DUMMY VARIABLE CARDS ,I6/24H NUMBER OF OBSERVATI
01700	     XONS ,4(1H.,1X),I6/18H NUMBER OF INDICES,7(1H.,1X),I6)
01800	C
01900		CALL USAGEB('BMDX64')
02000	    5 READ(5,1) P,PO,NIV,NFA,NH,LH,MT,NF,NCELLS,NI,(NN(I),I=1,10),MMRT
02100	     1,REW
02200	C
02300	 1    FORMAT(A6,A6,5I2,I1,I5,12I2,A2)
02400	      LPT=0
02500	      IF(P .EQ. PP) GO TO 7
02600	 6    IF(P .EQ. PQ) GO TO 8
02700	 9    WRITE (6,10)
02800	 10   FORMAT(30H0ILLEGAL FINISH OR PROBLM CARD    )
02900	 8    CALL EXIT
03000	 7    NGV=0
03100	      WRITE (6,30) PO,NIV,NFA,NCELLS,NI
03200	      L2=0
03300	      IF(MT.EQ.0) MT=5
03400	      IF(REW.EQ.RE .OR.MT.EQ.5) GO TO 454
03500	      REWIND MT
03600	 454  DO 2 I=1,NFA
03700	      L1=L2+1
03800	      L2=L2+NI
03900	      READ(5,3)  PO,    FA(I),FA1(I),(JFA(L),L=L1,L2)
04000	    3 FORMAT(A6,   A4,A2,10I2)
04100	      N=1
04200	      LF1(I)=NGV+1
04300	      DO 4 L=L1,L2
04400	 4    N=N*MAX0(JFA(L),1)
04500	      NGV=NGV+N
04600	 2    LF2(I)=NGV
04700	      LL=NGV+NIV+MAX0(LH,10)+1
04800	      L21=L2+MOD(L2,2)+3
04900	      A=4500-L21/2-1
05000	      B=LL*LL
05100	      IF(A-B)21,21,20
05200	 21   II=SQRT(A)
05300	      II=LL-II
05400	      WRITE (6,22) II
05500	 22   FORMAT(17H THIS PROBLEM HAS    I4,22H TOO MANY VARIABLES        )
05600	      STOP
05700	 20   LLL=L21+LL*LL*2+2
05800	      LXL=(9900-LLL)/2
05900	      CALL DOIT(JFA,NI,NFA,JFA(L21),LL,JFA(LLL),LXL,MMRT)
06000	      GO TO 5
06100	      END
06200	      SUBROUTINE DOIT(JFA,NU,NV,A,LL,X,LXL,MMRT)
06300	      COMMON LFB(9100)
06400	      COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
06500	     100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
06600	     2  ,FA1(100),DAN1(100)
06700	      DIMENSION A(LL,LL),JFA(NU,NV),F(180),II(10),X(200),IX(200),
06800	     1DA(100),SS(100),DF(100),DN(100),BV(100),DR(32),DS1(18),FP(10)
06900	      DIMENSION FI(10)
07000	      DOUBLE PRECISION JOR,IAR
07100	      DOUBLE PRECISION A,U,X,DA,SS,Y,TN,XX,RSS,TOL,AM,BV
07200	      DATA HYP/'HYPO'/
07300	      DATA BBB,ANON,COV,ERR/4H    ,4HNONE,4HCOVS,4HERRO/,
07400	     1 DR/'(//  ','     ','     ','X,7H ','CELL ','     ','     ','X,10H
07500	     2','PREDI','CTED,','8X,9H','GENER','ATED/','     ','     ','     ',
07600	     3'     ','     ','X,7HI','NDICE','S    ','     ','X,10H','   VA','L
07700	     4UE  ',',8X,9','HVARI','ABLES',')    ','     ','     ','     '/,
07800	     5DS1/'(    ','     ','     ','I3,  ','     ','     ','X,F11','.5,5X
07900	     6',',    ','     ','I2/( ','     ','     ','X,   ','     ','     '
08000	     7,'I2)) ','     '/
08100	      DATA ERR1/4HR   /
08200	      DATA DN             /2H 1,2H 2,2H 3,2H 4,2H 5,2H 6,2H 7,2H 8,2H 9,
08300	     12H10,2H11,2H12,2H13,2H14,2H15,2H16,2H17,2H18,2H19,2H20,2H21,2H22,2
08400	     2H23,2H24,2H25,2H26,2H27,2H28,2H29,2H30,2H31,2H32,2H33,2H34,2H35,2H
08500	     336,2H37,2H38,2H39,2H40,2H41,2H42,2H43,2H44,2H45,2H46,2H47,2H48,2H4
08600	     49,2H50,2H51,2H52,2H53,2H54,2H55,2H56,2H57,2H58,2H59,2H60,2H61,2H62
08700	     5,2H63,2H64,2H65,2H66,2H67,2H68,2H69,2H70,2H71,2H72,2H73,2H74,2H75,
08800	     62H76,2H77,2H78,2H79,2H80,2H81,2H82,2H83,2H84,2H85,2H86,2H87,2H88,2
08900	     7H89,2H90,2H91,2H92,2H93,2H94,2H95,2H96,2H97,2H98,2H99,3H100/
09000	      DATA JOR/'DESIGN  '/
09100	      REWIND 1
09200	      ID=1
09300	      NVR=NIV+1
09400	      MN=0
09500	      DO 400 I=1,NFA
09600	       MN=MN+1
09700	      IF(FA(I)-BBB)402,401,402
09800	 402  DAN(MN)=FA(I)
09900	      DAN1(MN) = FA1(I)
10000	      GO TO 400
10100	 401  DAN(MN)=DN(MN)
10200	      DAN1(MN) = BBB
10300	 400  CONTINUE
10400	      DO 32 I=1,LL
10500	      DO 32 J=1,I
10600	 32   A(J,I)=0.0
10700	      K=MAX0(1,3*(NI/2)-2)
10800	      L=MAX0(2,3*((NI+1)/2)-4)
10900	      M=1+(9-3*NI)*(3/(NI+1))
11000	      J=16+M+3*NI
11100	      I=(131-J)/2
11200	      DS1(3)=DN(NI)
11300	      DS1(6)=DN(M)
11400	      DS1(10)=DN(I)
11500	      DS1(13)=DN(J)
11600	      DS1(16)=DN(I)
11700	      DR(3)=DN(K)
11800	      DR(7)=DN(L)
11900	      DR(18)=DN(K)
12000	      DR(22)=DN(L)
12100	      FP(1)=0.
12200	      NF=18*MAX0(1,NF)
12300	      READ ( 5,23) (F(I),I=1,NF)
12400	      WRITE (6,7849) (F(I),I=1,NF)
12500	 7849 FORMAT(16H0VARIABLE FORMAT  1X,18A4/(17X,18A4))
12600	   23 FORMAT(18A4)
12700	      NIVT=NIV+NGV
12800	      NVT=NIVT+1
12900	 27   M6=NGV+1
13000	      DO 800 I=1,NVT
13100	 800  DA(I)=0.
13200	      FNC=0.
13300	      IAR=BBB
13400	      NBV=0
13500	      IF(MMRT.LE.0)GO TO 5001
13600	      DO 5000 I=1,NI
13700	 5000 NBV=NBV+NN(I)-1
13800	      NCRD=MMRT
13900	      GO TO 5002
14000	 5001 NCRD=1
14100	      FNC=NCELLS
14200	 5002 DO 5011 ICRD=1,NCRD
14300	      IF(MMRT)5006,5006,5003
14400	 5003 READ(5,5004)IAR,NCELLS,(BV(I),I=1,14)
14500	 5004 FORMAT(A6,I3,14F5.0)
14600	      IF(IAR.EQ.JOR.AND.NBV.GT.14)READ(5,5005)(BV(I),I=15,NBV)
14700	 5005 FORMAT(9X,14F5.0)
14800	      FNC=FNC+NCELLS
14900	      DO  5056 I=1,10
15000	 5056 FI(I)=BV(I)
15100	 5006 DO 4 LQ=1,NCELLS
15200	      IF(MMRT)5007,5007,5008
15300	 5007 READ(MT,F)(FI(I),I=1,NI),(X(I),I=M6,NVT)
15400	      GO TO 5009
15500	 5008 READ(MT,F)(X(I),I=M6,NVT)
15600	      WRITE(1)(BV(I),I=1,NBV)
15700	 5009 DO 801 I=M6,NVT
15800	  801 DA(I)=DA(I)+X(I)
15900	      IF(IAR.EQ.JOR)GO TO 5010
16000	      NBV=0
16100	      DO 1 I=1,NI
16200	      IF(FI(I)-FP(I))2,1,2
16300	    1 CONTINUE
16400	      GO TO 901
16500	    2 DO 5 I=1,NI
16600	      FP(I)=FI(I)
16700	    5 II(I)=FI(I)
16800	 5010 CALL GENVAR(X,JFA,NU,II,NBV,BV)
16900	  901 DO 4 I=1,NVT
17000	      DO 4 J=1,I
17100	   4  A(J,I)=A(J,I)+X(J)*X(I)
17200	 5011 CONTINUE
17300	      NCELLS=FNC
17400	      NCL=NCELLS
17500	 664  DO 44 I=1,NVT
17600	      X(I)=DA(I)/FNC
17700	 44   DA(I)=A(I,I)
17800	      REWIND 1
17900	      LPT=0
18000	      WRITE (6,89)
18100	 89   FORMAT(//24H REGRESSION COEFFICIENTS   //)
18200	      IND(NVT)=1
18300	      LLH=0
18400	      TOL=1.E-13
18500	      DO 57 I=1,NFA
18600	      L1=LF1(I)
18700	      L2=LF2(I)
18800	      DO 58 J=1,NIVT
18900	 58   IND(J)=0
19000	      DO 59 J=L1,L2
19100	 59   IND(J)=-1
19200	      DO 60 J=2,NVT
19300	      J1=J-1
19400	      DO 61 K=1,J1
19500	 61   A(J,K)=A(K,J)
19600	 60   A(J,J)=DA(J)
19700	      A(1,1) = DA(1)
19800	      CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
19900	      CALL PT(A,LL,DAN(I),DAN1(I))
20000	      SS(I)=A(NVT,NVT)
20100	 57   DF(I)=ID
20200	      IF(NH)63,63,62
20300	 62   READ ( 5,23) (F(J),J=1,18)
20400	      WRITE(6,666)
20500	  666 FORMAT(39H0D-TYPE VARIABLE FORMAT CARD FOR HYPOTH)
20600	      WRITE(6,6666)(F(J),J=1,18)
20700	 6666 FORMAT(1X,18A4)
20800	      DO 65 I=1,NH
20900	      READ (5,66) PM,PM1,HLL,HLL1,LLH
21000	   66 FORMAT(A4,A2,A4,A2,I2)
21100	      IF(PM.NE.HYP) GO TO 719
21200	      L1=NVT+1
21300	      L2=NVT+LLH
21400	      DO 67 K=L1,L2
21500	      DO 667 J=1,K
21600	 667  A(K,J)=0.
21700	 67   READ ( 5,F) (A(K,J),J=1,NVT)
21800	      DO 68 J=1,L2
21900	 68   IND(J)=0
22000	      IND(NVT)=1
22100	      DO 80 J=2,NVT
22200	      J1=J-1
22300	      DO 81 K=1,J1
22400	 81   A(J,K)=A(K,J)
22500	 80   A(J,J)=DA(J)
22600	      A(1,1) = DA(1)
22700	      CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
22800	      MN=MN+1
22900	      IF(HLL-BBB)303,304,303
23000	 304  DAN(MN)=DN(MN)
23100	      DAN1(MN) = BBB
23200	      GO TO 305
23300	 303  DAN(MN)=HLL
23400	      DAN1(MN)=HLL1
23500	 305  CALL PT(A,LL,DAN(MN),DAN1(MN))
23600	      SS(MN)=A(NVT,NVT)
23700	 65   DF(MN)=ID
23800	 63   IF(NIV)306,306,307
23900	 307  NGV1=NGV+1
24000	      LLH=0
24100	      DO 310 I=NGV1,NIVT
24200	 310  IND(I)=-1
24300	      DO 311 I=1,NGV
24400	 311  IND(I)=0
24500	      DO 55 I=2,NVT
24600	      K1=I-1
24700	      DO 56 J=1,K1
24800	 56   A(I,J)=A(J,I)
24900	 55   A(I,I)=DA(I)
25000	      A(1,1) = DA(1)
25100	      CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
25200	      MN=MN+1
25300	      SS(MN)=A(NVT,NVT)
25400	      DF(MN)=ID
25500	      DAN(MN)=COV
25600	      DAN1(MN) = BBB
25700	      CALL PT(A,LL,DAN(MN),DAN1(MN))
25800	 306  DO 312 I=1,NIVT
25900	 312  IND(I)=0
26000	      DO 308 I=2,NVT
26100	      I1=I-1
26200	      DO 309 J=1,I1
26300	 309  A(I,J)=A(J,I)
26400	 308  A(I,I)=DA(I)
26500	      A(1,1) = DA(1)
26600	      LLH=0
26700	      CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
26800	       FID=ID
26900	      RSS=A(NVT,NVT)
27000	      CALL PT(A,LL,ANON,BBB)
27100	      CALL PT(A,LL,-1,0)
27200	      WRITE (6,314)
27300	 314  FORMAT(///15X,27H ANALYSIS OF VARIANCE TABLE    //57H SOURCE    SU
27400	     1M OF SQUARES   D.F.   MEAN SQUARE          F//)
27500	      FDR=FLOAT(NCELLS)-FID
27600	      RMS=0.
27700	      IF(FDR.NE.0.)RMS=SNGL(RSS)/FDR
27800	      DO 315 I=1,MN
27900	 313  SS(I)=SS(I)-RSS
28000	      DF(I)=FID-DF(I)
28100	      ID=DF(I)
28200	      IF(ID)860,860,850
28300	 860  SS(I)=0.
28400	      SM=0.
28500	      FF=0.
28600	      GO TO 315
28700	 850   SM=SNGL(SS(I))/DF(I)
28800	      FF=0.
28900	      IF(RMS.NE.0.)FF=SM/RMS
29000	  315 WRITE(6,316)   DAN(I),DAN1(I),SS(I),ID,SM,FF
29100	  316 FORMAT(1X,A4,A2,F17.5,I7,F14.5,F14.5)
29200	      IF(NIV)326,326,317
29300	 317  DO 318 I=NGV1,NIVT
29400	      ID=-I
29500	      CALL SOLVIT(A,LL,NIVT,LLH,TOL,ID,IND)
29600	      J=I-NGV
29700	      IF(ID)807,807,808
29800	 807  ST=0.
29900	      FF=0.
30000	      GO TO 318
30100	 808  ST=-A(NVT,I)*A(NVT,I)/A(I,I)
30200	      FF=ST/RMS
30300	 318  WRITE (6,319) J,ST,ID,ST,FF
30400	 319  FORMAT(5H COV.I2,F17.5,I7,F14.5,F14.5)
30500	 326  ID=FDR
30600	      WRITE (6,316)ERR,ERR1,RSS,ID,RMS
30700	      DO 729 I=1,NI
30800	 729  II(I)=1
30900	 1234 FORMAT(//)
31000	      IF(NBV) 783,783,751
31100	 751  WRITE (6,758)
31200	 758  FORMAT(35 H- CELL    PREDICTED       GENERATED/36H NUMBER     VALU
31300	     1E         VARIABLES  //)
31400	      DO 752 J=1,NCL
31500	      READ(1)(BV(I),I=1,NBV)
31600	      CALL GENVAR(X,JFA,NU,II,NBV,BV)
31700	      TN=0.0
31800	      DO 753 I=1,NIVT
31900	      IX(I)=X(I)
32000	 753  TN=TN+A(NVT,I)*X(I)
32100	 752  WRITE (6,755) J,TN,(IX(I),I=1,NGV)
32200	 755  FORMAT(I4,F14.5,22I5/(18X,22I5))
32300	      RETURN
32400	 783  WRITE (6,DR)
32500	      WRITE (6,1234)
32600	      NBV=0
32700	 702  CALL GENVAR(X,JFA,NU,II,NBV,BV)
32800	      TN=0.
32900	      DO 703 I=1,NIVT
33000	      IX(I)=X(I)
33100	 703  TN=TN+A(NVT,I)*X(I)
33200	      WRITE (6,DS1) (II(I),I=1,NI),TN,(IX(I),I=1,NGV)
33300	      I=NI
33400	 717  II(I)=II(I)+1
33500	      IF(II(I)-NN(I))702,702,704
33600	 704  II(I)=1
33700	      I=I-1
33800	      IF(I)718,718,717
33900	719   WRITE(6,720)
34000	720   FORMAT(55H0HYPOTH IS PUNCHED WRONG OR HYPOTH CARD OUT OF SEQUENCE)
34100	 9876 FORMAT(10A8)
34200	      STOP
34300	 718  RETURN
34400	      END
34500	      SUBROUTINE SOLVIT(A,LL,N1,N2,T,IDF,IND)
34600	      DIMENSION A(LL,LL),U(100),V(100),IN(100),IND(2)
34700	      DOUBLE PRECISION A,U,V,G,H,X,T,T1
34800	      IF(IDF)20,30,30
34900	 20   I=-IDF
35000	      IF(IN(I))21,21,22
35100	 22   DO 23 J=1,N1
35200	      IF(IN(J))24,24,23
35300	 24   IF(I-J)26,26,25
35400	 25   T1=A(I,J)
35500	      GO TO 27
35600	 26   T1=A(J,I)
35700	 27   IF((A(J,J)-T1*T1/A(I,I))/V(I)-T)23,23,21
35800	 23   CONTINUE
35900	      IDF=1
36000	      RETURN
36100	 21   IDF=0
36200	      RETURN
36300	 30   MR=0
36400	      MI=0
36500	      N=N1+N2+1
36600	      L=N1+1
36700	      DO 1 I=1,N
36800	      V(I)=A(I,I)
36900	 1    IN(I)=IND(I)
37000	 2    L=L+1
37100	      IF(L-N)3,3,4
37200	 3    G=0.
37300	      DO 5 I=1,N1
37400	      IF(IN(I))5,6,5
37500	 6    H=DABS(A(I,I)/V(I)*A(L,I))
37600	      IF(H-G)5,5,7
37700	 7    G=H
37800	      K=I
37900	 5    CONTINUE
38000	      IF(G)2,2,9
38100	 9    NN=1
38200	 19   T1=G
38300	      MI=MI+1
38400	      IN(K)=1
38500	 10   DO 11 I=1,K
38600	      U(I)=A(K,I)
38700	 11   A(K,I)=0.
38800	      X=U(K)
38900	      DO 12 I=K,N
39000	      U(I)=A(I,K)
39100	 12   A(I,K)=0.
39200	      U(K)=-1.
39300	      DO 8 I=1,N
39400	      DO 8 J=1,I
39500	 8    A(I,J)=A(I,J)-U(I)*U(J)/X
39600	      IF(NN)14,2,13
39700	 13   NN=0
39800	      MR=MR+1
39900	      K=L
40000	      GO TO 10
40100	 4    NN=-1
40200	 14   G=T
40300	      DO 15 I=1,N1
40400	      IF(IN(I))15,16,15
40500	 16   H=A(I,I)/V(I)
40600	      IF(H-G)15,15,17
40700	 17   G=H
40800	      K=I
40900	 15   CONTINUE
41000	      IF(G-T)18,18,19
41100	 18   A(LL,LL)=T1
41200	      IDF=MI-MR
41300	      N11=N1+1
41400	      DO 31 I=1,N1
41500	      IF(IN(I))31,32,31
41600	 32   A(N11,I)=0.
41700	 31   CONTINUE
41800	      RETURN
41900	      END
42000	      SUBROUTINE PT(A,LL,MM,MM1)
42100	      COMMON LFB(9100)
42200	      COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
42300	     100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
42400	     2  ,FA1(100),DAN1(100)
42500	      DIMENSION A(LL,LL),MMM(10),MMM1(10)
42600	      DOUBLE PRECISION A
42700	      IF(MM+1)2,1,2
42800	 2    LPT=LPT+1
42900	      L=LPT+NVT
43000	      MMM(LPT)=MM
43100	      MMM1(LPT) = MM1
43200	      DO 3 I=1,NIVT
43300	      IF(IND(I))11,10,11
43400	 11   A(I,L)=0.0
43500	      GO TO 3
43600	 10   A(I,L)= A(NVT,I)
43700	 3    CONTINUE
43800	      A(NVT,L)=A(LL,LL)
43900	      IF(LPT-10)4,1,1
44000	    1 WRITE(6,8)  (MMM(I),MMM1(I),I=1,LPT)
44100	 8    FORMAT(/20X,10HHYPOTHESIS//5X,10(5X,A4,A2))
44200	      WRITE (6,9)
44300	 9    FORMAT(6H  VAR.)
44400	      L1=NVT+1
44500	      L2=NVT+LPT
44600	      DO 5 I=1,NIVT
44700	 5    WRITE (6,6) I,(A(I,J),J=L1,L2)
44800	 6    FORMAT(I5,10F11.5)
44900	      WRITE (6,7) (A(NVT,J),J=L1,L2)
45000	 7    FORMAT(10H0TOLERANCE/(5X,10F11.5))
45100	      LPT=0
45200	 4    RETURN
45300	      END
45400	      SUBROUTINE GENVAR(X,JFA,NU,II,NBV,BV)
45500	      DIMENSION X(200),JFA(NU,NU),II(2),U(100),BV(2)
45600	      DOUBLE PRECISION X,U,Y,BV
45700	      COMMON LFB(9100)
45800	      COMMON NIV,NFA,NH,LH,NI,NN(10),MT,NF,NCELLS,FA(100),LF1(100),LF2(1
45900	     100),IND(100),NGV,NVT,NIVT,LPT,DAN(100)
46000	      M=0
46100	      DO 30 L=1,NFA
46200	      LLL=0
46300	      M=M+1
46400	      X(M)=1.0
46500	      M0=M
46600	      DO 30 K=1,NI
46700	      LL=LLL
46800	      NNK=NN(K)
46900	      NNK1=NNK-1
47000	      IF(JFA(K,L))30,30,34
47100	 34   IF(NBV)1,1,2
47200	 2    DO 3 J=1,NNK1
47300	      LL=LL+1
47400	 3    U(J)=BV(LL)
47500	      GO TO 19
47600	 1    IF(II(K)-NN(K))16,15,222
47700	 222  WRITE (6,1111)
47800	 1111  FORMAT(19H0INDEX OUT OF RANGE)
47900	      CALL EXIT
48000	 22   FORMAT(11I3)
48100	 15   DO 17 J=1,NNK
48200	 17   U(J)=-1.0
48300	      GO TO 19
48400	 16   DO 18 J=1,NNK
48500	 18   U(J)=0.0
48600	      IIK=II(K)
48700	      U(IIK)=1.0
48800	 19   U(NNK)=1.0
48900	      JFAN=JFA(K,L)
49000	      MM=M-M0+1
49100	      DO 20 I=M0,M
49200	      N=I
49300	      Y=X(I)
49400	      DO 20 J=1,JFAN
49500	      X(N)=Y*U(J)
49600	 20   N=N+MM
49700	      M=N-MM
49800	 30   LLL=LLL+NNK1
49900	      RETURN
50000	      END
50100