Directory of image this file is from
This file as a plain text file

       PROGRAM GSAN
       COMMON X(100),Y(100),YC(100),E(10),XO(10),D(10),AR(10)
       COMMON P(30),PS(30),DY(30,100),DYDE(10,100),DYDX(10,100)
       COMMON DYDD(10,100),A(30,30),B(30,1)
       READ,IN,IX
       GO TO (50,70),IX
       50 READ,(X(I),I=1,IN)
       GO TO 100
       70 READ,X(1),XD
       DO 90 I=2,IN
       90 X(I)=X(I-1)+XD
       100 READ, (Y(I),I=1,IN)
       PRINT 112
       112 FORMAT (*JN*)
       INPUT,JN
       JN3=3*JN
       NVAR=JN3
       MA=30
       PRINT 132
       132 FORMAT (* E XO D*)
       INPUT,(E(J),XO(J),D(J),J=1,JN)
       PRINT 152 , (E(J),J=1,JN)
       152 FORMAT (* COMPONENT PEAK HEIGHTS*/10F7.2)
       YMAX=0.
       DO 200 I=1,IN
       IF (Y(I).GT.YMAX) 190,200
       190 YMAX=Y(I)
       200 CONTINUE
       GO TO 280
       220 PRINT 222
       222 FORMAT (*J*)
       230 INPUT,J
       IF (J.EQ.O) 280,250
       250 PRINT 132
       INPUT, E(J),XO(J),D(J)
       GO TO 220
       280 ASSIGN 520 TO N1
       ASSIGN 500 TO N3
       DO 330 J=1,JN
       J3=3*J
       P(J3-2)=E(J)
       P(J3-1)=XO(J)
       P(J3)=D(J)
       330 CONTINUE
       340 DO 400 J=1,JN
       DO 400 I=1,IN
       Z=(X(I)-XO(J))/D(J)
       DYDE(J,I)= 2.**(-Z*Z)
       DYDX(J,I)= 1.3863*E(J)*Z*DYDE(J,I)/D(J)
       DYDD(J,I)= Z*DYDX(J,I)
       400 CONTINUE
       DO 420 I=1,IN
       420 YC(I)=0.
       DO 450 I=1,IN
       DO 450 J=1,JN
       450 YC(I)=YC(I)+E(J)*DYDE(J,I)
       SY=0.
       DO 480 I=1,IN
       480 SY=SY+(Y(I)-YC(I))**2
       SY=100.*SQRT(SY/FLOAT(IN))/YMAX
       GO TO N3
       500 PRINT 502,SY
       502 FORMAT (F6.2,* RMS DEV*)
       GO TO N1
       520 PRINT 522
       522 FORMAT (* NREP. -1 REVISE, O PRINT*)
       INPUT,NREP
       IF(NREP) 220,1000,550
       550 ASSIGN 560 TO N1
       560 NREP=NREP-1
       IF (NREP.LE.-1) 520,580
       580 DO 630 J=1,JN
       J3=3*J
       DO 630 I=1,IN
       DY(J3-2,I)=DYDE(J,I)
       DY(J3-1,I)=DYDX(J,I)
       DY(J3,I)=DYDD(J,I)
       630 CONTINUE
       DO 660 K=1,JN3
       DO 660 L=1,JN3
       660 A(K,L)=0.
       DO 740 K=1,JN3
       DO 740 L=1,JN3
       DO 740 I=1,IN
       IF (K.GT.L) 730,710
       710 A(K,L)=A(K,L)+DY(K,I)*DY(L,I)
       GO TO 740
       730 A(K,L)=A(L,K)
       740 CONTINUE
       DO 760 K=1,JN3
       760 B(K,1)=0.
       DO 790 K=1,JN3
       DO 790 I=1,IN
       790 B(K,1)=B(K,1)+DY(K,I)*(Y(I)-YC(I))
       NB=1
       CALL MATINV (A,NVAR,B,NB,DETERM,MA)
       IF (NB) 1160,820,1160
       820 ASSIGN 900 TO N3
       SYS1=SY
       SYS=SY
       DO 840 J=1,JN3
       840 PS(J)=P(J)
       DO 915 ICF=1,7
       CF=10.**(0.5*(1.-FLOATF(ICF)))
       DO 860 J=1,JN3
       860 P(J)=PS(J)+CF*B(J,1)
       DO 890 J=1,JN
       J3=3*J
       E(J)=P(J3-2)
       XO(J)=P(J3-1)
       D(J)=P(J3)
       890 CONTINUE
       GO TO 340
       900 IF(SY.LT.SYS) 905,915
       905 SYS=SY
       CFS=CF
       915 CONTINUE
       ASSIGN 500 TO N3
       IF (SYS.EQ.SYS1) 925,935
       925 PRINT 926
       926 FORMAT (* NO DESCENT, REVISE PARAMETERS*)
       GO TO 520
       DO 940 J=1,JN3
       940 P(J)=PS(J)+CFS*B(J)
       DO 970 J=1,JN
       J3=3*J
       E(J)=P(J3-2)
       XO(J)=P(J3-1)
       D(J)=P(J3)
       970 CONTINUE
       PRINT 982,(E(J),J=1,JN)
       982 FORMAT(10F7.2)
       GO TO 340
       1000 DO 1040 J=1,JN
       1040 AR(J)=2.13039*E(J)*D(J)
       PRINT 1052,(J,E(J),XO(J),D(J),AR(J),J=1,JN)
       1052 FORMAT (*   HEIGHT   POSITION   WIDTH   AREA*/
      +(I3,4G11.4))
       1060 PRINT 1062
       1062 FORMAT (*   1 GO ON, 0 DATA, -1 END*)
       1070 INPUT,N2
       IF (N2) 1170,1090,520
       1090 DO 1110 I=1,IN
       DO 1110 J=1,JN
       1110 DYDE(J,I)=DYDE(J,I)*E(J)
       PRINT 1122
       1122 FORMAT (*  X Y DATA Y CALC*)
       DO 1140 I=1,IN
       1140 PRINT 1142,X(I),Y(I),YC(I),(DYDE(J,I),J=1,JN)
       1142 FORMAT ((F6.1,12F5.2))
       GO TO 1060
       1160 PRINT 1162
       1162 FORMAT (*IMPOSSIBLE MATRIX INVERSION*)
       1170 CONTINUE
       END
       SUBROUTINE MATINV (A,NVAR,B,NB,DETERM, MA)
 /ENDJOB