File: SCOFOU.FT of Tape: Various/ETH/f2
(Source file text)
SUBROUTINE SCOPE(LALL,LONE,ISTARP) C COMMON /TITLE/ ADENT,GLOBAL,RUN,ICREAT COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI, $ UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX COMMON /PARAM/ DKHI,SHFACT,CHISQ,ITORQ,IDILA,DK,DL,HANG $ ,HUP,HDOWN,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,CAP,EICH COMMON /PEAKS/ TASWI,KBLOW,KBLOW1,KMAX,K1,K3,CHI, $ Q(11,4),HIGHT(21),INDEX(21) COMMON /VECT/ C(44),D1(11,4),DIAGEL(44),D(44),E(44) COMMON /DATIN/ F(512),NP COMMON /CONST/ PI,TWOPI COMMON /PLOTC/ PLTBUF(400) COMMON /FAF/ A(2049),B(2049),N DIMENSION AR(44,44),Z(44,44) EQUIVALENCE (A,AR),(B,Z) INTEGER RUN REAL K3 LOGICAL ITORQ,IDILA,ITEST,TASWI C LOGICAL LALL,LONE C CDC100 FORMAT(1H1,T50,#INITIAL SPECTRUM#,1H ) CDC105 FORMAT(1H1,T50,#RESIDUAL SPECTRUM#,1H ) CDC110 FORMAT(1X,#FREQUENCY (T)#,T107,#AMPLITUDE#,7X,#PHASE#/) CDC120 FORMAT(1X,1PE11.4,T19,80A1,T105,1PE11.4,6X,0PF7.2) C CDC IF (LONE) WRITE(3,100) CDC IF (.NOT.LONE) WRITE(3,105) CDC NN=((NP-1)/256+1)*256 CDC ISTAR=ISTARP CDC IST=ISTAR+1 CDC IEND=ISTAR+NN CDC IASCAL=N/NN CDC SCAL1=1.E-20 CDC ISTEP=1 CDC IF(LALL) ISTEP=IASCAL/2 CDC DO 10 I=IST,IEND CDC J=I*ISTEP CDC COMP=ABS(A(J))*IASCAL CDC IF (COMP.GT.SCAL1) SCAL1=COMP CDC10 CONTINUE CDC FAKTOR=79./SCAL1 CDC DO 12 J=1,80 CDC12 PLTBUF(J)=1H CDC DO 15 I=IST,IEND CDC J=I*ISTEP CDC IF(LALL) PHA=B(J)*180./PI CDC AMPL=A(J)*IASCAL CDC IF(LALL) FNU=J/(IASCAL*DK*1.E-3*NN) CDC LINDEX=1+INT(FAKTOR*AMPL+.5) CDC AMPL=AMPL*EICH CDC PLTBUF(LINDEX)=1H* CDC WRITE(3,120) FNU,(PLTBUF(K),K=1,80),AMPL,PHA CDC PLTBUF(LINDEX)=1H CDC15 CONTINUE CDC RETURN CDC END CDC REMOVE THE FOLLOWING PDP PART 100 FORMAT(1H ,'START NOW:',I4,$) C150 FORMAT(1H ,'SCALE=',2(F10.4,2X)) C155 FORMAT(1H ,'VALUES=',3(F10.4,2X)) C160 FORMAT(1H ,'FNUPHIAFTAU=',4(F10.4,2X)) 170 FORMAT(1H ,/,20(2H+ ,/)) 200 FORMAT(I4) C FN=256./1.25 ISTAR=ISTARP 5 NN=256 C IF (LONE) GO TO 6 WRITE(4,100) ISTAR READ(4,200) ISTAR IF (ISTAR.LT.0) RETURN 6 IF (LALL) NN=NN/2 IST=ISTAR+1 IEND=ISTAR+NN SCAL1=1.E-20 SCAL2=1.E-20 DO 10 I=IST,IEND COMP=2.*ABS(A(I)) IF (COMP.GT.SCAL1) SCAL1=COMP 10 CONTINUE DO 15 I=IST,IEND FI=FLOAT(I-IST)/FN 15 CALL PLOTR(1,FI,A(I)/SCAL1+.5,I-ISTAR) IF (.NOT.LALL) GO TO 30 DO 20 I=IST,IEND COMP=2.*ABS(B(I)) IF (COMP.GT.SCAL2) SCAL2=COMP 20 CONTINUE DO 25 I=IST,IEND FI=FLOAT(I+NN-IST)/FN 25 CALL PLOTR(1,FI,B(I)/SCAL2+.5,I-ISTAR+NN) 30 SCAL1=SCAL1/2. SCAL2=SCAL2/2. C WRITE(4,150) SCAL1,SCAL2 C SCAL1=B(IST+1)-B(IST) C IF (.NOT.LALL) GO TO 50 C WRITE(4,155) A(IST),B(IST),SCAL1 C CALL TAUFOU(IST,FNU,PHI,AF,TAU) C WRITE(4,160) FNU,PHI,AF,TAU 50 CONTINUE C IF (LONE) WRITE(4,170) C IF (.NOT.LONE) GO TO 5 GO TO 5 RETURN END