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