C PROGRAMME SVY081 SOLUTION OF CONDITION EQUATIONS ,DIFFERING VARIANCES C PREPARED BY J.S.ALLMAN, JANUARY 1969 COMMENTS C INITIAL DATA CARD C COLUMNS 1,2 =NUMBER OF CONDITION EQUATIONS..MAXIMUM = 36 C COLUMNS 4,5 =NUMBER OF OBSERVATIONS..MAXIMUM = 75 C THE REMAINING COLUMNS MAY BE PUNCHED WITH A JOB TITLE C C **NOTE IF COLUMN 3 PUNCHED -, THEN THE RESULTS ARE PUNCHED C C SECOND DATA CARD C COLUMNS 3,4 =NUMBER OF VARIANCES TO BE PUNCHED C COLUMNS 11,13 =NUMBER OF THE OBSERVATION C COLUMNS 14,20 = THE VARIANCE F7.4 C THIS PATTERN FOR NUMBER AND COEFFICIENT IS REPEATED TO THE END OF THE C CARD AND FROM COLUMN 11 ON SUBSEQUENT CARDS C** NOTE IF VARIANCE IS NOT SPECIFIED, UNITY IS ADOPTED C C SUBSEQUENT DATA CARDS GIVE THE CONDITIONS C COLUMNS 1,2 = THE IDENTIFYING NO OF THE CONDITION C COLUMNS 3,4 = THE NUMBER OF VARIATES IN THE CONDITION C COLUMNS 5,10 = THE MISCLOSE .. F6.3 C COLUMNS 11,13= THE NO OF THE VARIATE C COLUMNS 14,20= THE COEFFICIENT OF THE VARIATE..F7.4 C THIS PATTERN FOR NUMBER AND COEFFICIENT IS REPEATED TO THE END OF THE C CARD AND FROM COLUMN 11 ON SUBSEQUENT CARDS C C THE PROGRAMME RETURNS TO THE START ON COMPLETION OF ONE DATA SET C DIMENSION DESC(19),CONS(36),AA(36,36),B(75,36),II(75),IPIV(36), 1IND(36,2),IOBS(75),A(75),VAR(75) MI=5 MO=6 MM=MO 999 READ (MI,310,END=953) N,M,DESC 310 FORMAT (I2,I3,18A4,A3) DO 300 I=1,36 DO 300 J=1,36 300 AA(I,J)=0. DO 301 I=1,75 VAR(I)=1. IOBS(I)=0. DO 301 J=1,36 301 B(I,J)=0. IF (M)312,312,313 312 M=-M MM=7 GO TO 314 313 MM=6 314 WRITE (MM,311) DESC 311 FORMAT (1H1,4X,18A4,A3//5X,19HCONDITION EQUATIONS/5X,9(1H-),1X, 1 9(1H-)/) READ (MI,316) NO,NOBS,X,(II(J),A(J),J=1,7) IF (NOBS.EQ.0) GO TO 365 IF (NOBS.LE.7) GO TO 360 NA=(NOBS-1)/7 DO 358 IJ=1,NA IA=IJ*7+1 IB=(IJ+1)*7 358 READ (MI,316) IX,IY,Z,(II(J),A(J),J=IA,IB) 360 DO 361 J=1,NOBS IA=II(J) 361 VAR(IA)=A(J) 365 DO 315 I=1,N READ (MI,316) NO,NOBS,CONS(I),(II(J),A(J),J=1,7) 316 FORMAT (2I2,F6.3,7(I3,F7.4)) IF (NOBS-7) 317,317,318 318 NA=(NOBS-1)/7 DO 998 IJ=1,NA IA=IJ*7+1 IB=(IJ+1)*7 998 READ (MI,316) IX,IY,Z,(II(J),A(J),J=IA,IB) 317 WRITE (MM,321) CONS(I),(A(J),II(J),J=1,NOBS) 321 FORMAT (1H /1X,2H0=,F8.4,7(F9.4,1HV,I2)/5(10X,7(F9.4,1HV,I2)/)) DO 320 J=1,NOBS IA=II(J) IOBS(IA)=1. 320 B(IA,I)=A(J) 315 CONTINUE DO 330 K=1,75 IF (IOBS(K))329,330,329 329 DO 331 I=1,N DO 331 J=1,N 331 AA(I,J)=B(K,I)*B(K,J)*VAR(K)+AA(I,J) 330 CONTINUE WRITE (MM,333) DO 335 I=1,N 335 WRITE (MM,332) (AA(I,J),J=1,N) 333 FORMAT (1H1,16HNORMAL EQUATIONS/1X,6(1H-),1X,9(1H-)) 332 FORMAT (1H /10(8F10.4/)) D=1.0 DO 10 I=1,N 10 IPIV(I)=0 DO 220 I=1,N AMAX=0.0 DO 65 J=1,N IF (IPIV(J))80,30,65 30 DO 60 K=1,N IF (IPIV(K)-1) 40,60,80 40 IF (ABS(AA(J,K))-AMAX) 60,60,50 50 IROW=J ICOL=K AMAX=ABS(AA(J,K)) 60 CONTINUE 65 CONTINUE IPIV(ICOL)=IPIV(ICOL) + 1 IF(AMAX-1.0E-50) 80,80,90 70 FORMAT(//10X, 20H MATRIX IS SINGULAR ) 80 WRITE (6,70) STOP 90 IF (IROW-ICOL) 95,130,95 95 D=-D DO 100 K=1,N AMAX=AA(IROW,K) AA(IROW,K)=AA(ICOL,K) 100 AA(ICOL,K)=AMAX 110 AMAX=CONS(IROW) CONS(IROW) = CONS(ICOL) 120 CONS(ICOL) = AMAX 130 IND(I,1)=IROW IND(I,2)=ICOL AMAX=AA(ICOL,ICOL) D=D*AMAX AA(ICOL,ICOL)=1.0 DO 140 K=1,N 140 AA(ICOL,K)=AA(ICOL,K)/AMAX 160 CONS(ICOL) = CONS(ICOL)/AMAX 170 DO 220 J=1,N IF(J-ICOL) 180,220,180 180 AMAX=AA(J,ICOL) AA(J,ICOL) =0.0 DO 190 K=1,N 190 AA(J,K)=AA(J,K)-AA(ICOL,K)*AMAX 210 CONS(J) =CONS(J)-CONS(ICOL)*AMAX 220 CONTINUE 230 DO 260 I=1,N J=N+1-I IF(IND(J,1)-IND(J,2)) 240,260,240 240 IROW=IND(J,1) ICOL=IND(J,2) DO 250 K=1,N AMAX=AA(K,IROW) AA(K,IROW)=AA(K,ICOL) 250 AA(K,ICOL)=AMAX 260 CONTINUE DO 342 K=1,N 342 CONS(K)=-CONS(K) WRITE (MM,343) (CONS(K),K=1,N) 343 FORMAT (1H1,16HCORRELATE VALUES/1X,9(1H-),1X,6(1H-)/8(8F10.4/)) VARFAC=0. AN=N WRITE (MM,347) 347 FORMAT(1H0/12X,13HNO CORRECTION,5X,'WEIGHT COEFF'/12X,'--', 11X,5('--'),5X,12('-')/) DO 345 K=1,75 IF (IOBS(K)) 346,345,346 346 CORR=0. DO 344 I=1,N 344 CORR =CONS(I)*B(K,I)*VAR(K)+CORR WRITE (MM,348) K,CORR,VAR(K) 348 FORMAT (1H ,11X,I2,F10.4,F13.6) VARFAC=VARFAC+CORR*CORR/VAR(K)/AN 345 CONTINUE WRITE (MM,349) VARFAC 349 FORMAT (1H //11X,15HVARIANCE FACTOR,F10.4/'1',10X,'WEIGHT COEFFICI 1ENT MATRIX FOR CORRELATES'/11X,40('-')) DO 350 I=1,N DO 350 J=1,N 350 AA(I,J)=AA(I,J)*VARFAC DO 355 I=1,N 355 WRITE(MM,332) (AA(I,J),J=1,N) GO TO 999 953 WRITE(MM,952) 952 FORMAT('1 ') STOP END