File: DINPUT.FT of Tape: Various/ETH/prog1
(Source file text) 

      SUBROUTINE INPUT
C 
      COMMON/INI/ ANF(10,10),DANF(10,10),PH(10,10),DPH(10,10) 
     $,AF(10,10),DAF(10,10),ETA(10,10),DETA(10,10),EMU(10,10), 
     $T(10),DT(10),ANFM(10),DANFM(10)
CDC  $,F(10,512)
      COMMON/TESPAR/ A0M,DA0M,AMU0,AF0(10),ETA0(10),A0(10)
     $,TDJ(10),DTDJ(10),TDM,DTDM
      COMMON/PARAM/IDENT,HANG,HI,HF,DK,NP,PI,SQHI,DKHI,I0DH,H0AL
      COMMON/STEER/MR,ADENT(10),MF,FREQ(10),I0
      COMMON /LINE/ A,B,DA,DB,SA,SB,SAB,TD,AMU,RR,RMSD,CHI
      COMMON /REGRES/ XL(10),YL(10),DY(10)
      COMMON/FRERUN/ IF,JR,INIT,LS
      COMMON/ACCUR/ DDMU1,DDMU2,DCHI,ERRMU
C 
      REAL APM(10),I0DH
      LOGICAL ERRMU 
  610 FORMAT(A2)
  620 FORMAT(A6)
  630 FORMAT(I2)
  640 FORMAT(8(G10.3))
  650 FORMAT(A3,A1,A2)
  670 FORMAT(1X,'INPUT: I,J:ANF,PH,AF,ETA,DANF,DPH,DAF,DETA,
     $EMU',/)
  680 FORMAT(1X,2I2,' :',9G10.3)
C 
C     WRITE(4,670)
      PI=4*ATAN(1.) 
      DDMU1=1.E-4
      DDMU2=1.E-4 
      ICHAN=6 
      DO 5 J=1,10 
    5 APM(J)=1. 
      DO 10 J=1,MR
    1 REWIND ICHAN
    2 READ(ICHAN,610) AMIST 
      IF (AMIST.NE.2H$$) GO TO 2
      READ(ICHAN,630) IMIST 
      IF (IMIST.NE.1) GO TO 2 
      READ(ICHAN,620) ANAME 
      IF (ANAME.NE.ADENT(J)) GO TO 2
      BACKSPACE ICHAN 
      READ(ICHAN,650) IMIST,IDENT,IMIST 
      READ(ICHAN,630) IMIST 
      READ(ICHAN,640) DK,HANG,HI,AMIST,T(J),DT(J),AMIST,FNP 
      IMIST=IMIST-8 
      IF (IMIST.GT.0) READ(ICHAN,640) (APM(I),I=1,IMIST)
      NP=IFIX(FNP)
C     TEST: NP=256
      NP=256
      DK=DK*1.E-3 
      READ(ICHAN,610) AMIST 
      READ(ICHAN,630) IMIST 
      READ(ICHAN,630) NFREQ 
      DO 20 K=1,NFREQ 
      READ(ICHAN,640) QN1,QN2,QN3,QN4,DQN1,DQN2,DQN3,DQN4 
      DO 30 I=1,MF
      IF (ABS(QN1-FREQ(I)).GT.1./(DK*NP)) GO TO 30
      ANF(I,J)=QN1
      PH(I,J)=QN2 
      AF(I,J)=QN3 
      ETA(I,J)=QN4
      DANF(I,J)=DQN1
      DPH(I,J)=DQN2 
      DAF(I,J)=DQN3 
      DETA(I,J)=DQN4
      EMU(I,J)=APM(K-1)*1.E-3*ANF(I,J)
C     WRITE(4,680)I,J,QN1,QN2,QN3,QN4,DQN1,DQN2,DQN3,DQN4,
C    $EMU(I,J)
   30 CONTINUE
   20 CONTINUE
   10 CONTINUE
      HF=HI/(1+DK*(NP-1)*HI)
      SQHI=SQRT(HI) 
      DKHI=DK*HI
      I0DH=(1.+I0*DKHI) 
C     WRITE(4,660) I0DH
      H0AL=HI/14.69/I0DH
      I0DH=SQRT(I0DH) 
      IF(IDENT.NE.1HM)SQHI=1./SQHI
      DO 40 I=1,MF
      SA=.0
      SB=.0
      SP=.0 
      DO 50 J=1,MR
      ANFP=(1./DANF(I,J))**2. 
      SA=SA+ANF(I,J)*ANFP 
      SB=SB+ANF(I,J)**2*ANFP
      SP=SP+ANFP
   50 CONTINUE
      ANFM(I)=SA/SP 
      DANFM(I)=SQRT((SB/SP-ANFM(I)**2)/(MR-1))
   40 CONTINUE
      RETURN
      END