File: MEAST.FT of Disk: Disks/MyPDP/m8-1-rka1-rkb1

(Source file text) 

---

     	SUBROUTINE MEAST
	COMMON/TITLE/FNAME(6),MOTODI,IRUN
	COMMON/SAMPLE/SPL,SPA,SPV,HANG
	COMMON/FIELD/NP,HHI,HLO,DRHE3,DRH,DELDRH,VIND,IMIN,ISEC

	COMMON/PARAM/PS(2),PT(2),PF(2),CALI(2)
	COMMON/TEMP/TMEAN,TVAR,PM,PV,TM,TV,TSET,DELTP,DELTI,VAPRE
C
	DIMENSION FRE(10),PHI(10),AMP(10),TAU(10),EMAS(10)
C
	LOGICAL VAPRE
C
	ITERM=4
	IFILE=6
	PI=3.14159
C
	WRITE(ITERM,2000)
	READ(ITERM,1000) NF
	DO 10 I=1,NF
	WRITE(ITERM,2001)
	READ(ITERM,1001) FRE(I)
	WRITE(ITERM,2002)
	READ(ITERM,1001) PHI(I)
	WRITE(ITERM,2003)
	READ(ITERM,1001) AMP(I)
	WRITE(ITERM,2004)
	READ(ITERM,1001) TAU(I)
	WRITE(ITERM,2005)
	READ(ITERM,1001) EMAS(I)
	EMAS(I)=EMAS(I)*FRE(I)*1.E-3
	FRE(I)=2.*PI*FRE(I)*DRH
	PHI(I)=PI*PHI(I)/180.
	TAU(I)=TAU(I)*DRH*NP
10	CONTINUE
	WRITE(ITERM,2006)
	READ(ITERM,1001) TMEAN
	WRITE(ITERM,2007)
	READ(ITERM,1001) TVAR
	SPV=1.
	CALI(2)=1.
	PM=0.
	PV=0.
	TM=0.
	TV=0.
	DO 20 I=1,NP
	TORQ=0.
	REALI=FLOAT(I-1)
	DKHI=1.+REALI*DRH*HHI
	SQ=1./SQRT(DKHI)
	DO 30 J=1,NF
C	EX1=EXP(-REALI*TAU(J)/NP)/(1.-EXP(-TAU(J)))
C	EX2=1.-EXP(-2.*14.69*EMAS(J)*TMEAN*DKHI/HHI)
C	WRITE(ITERM,2008) FRE(J),PHI(J),TAU(J),EMAS(J),EX1,EX2
	EX2=1.
C	WRITE(ITERM,2008) AMP(J),SQ,REALI
C	TORQ=TORQ+AMP(J)*TAU(J)*SQ*EX1*COS(REALI*FRE(J)-PHI(J))/EX2
	TORQ=TORQ+AMP(J)*SQ*COS(REALI*FRE(J)-PHI(J))
C	WRITE(ITERM,2008) TORQ
30	CONTINUE
	WRITE(IFILE,3000) TORQ
20	CONTINUE
1000	FORMAT	(I2)
1001	FORMAT	(F8.4)
1002	FORMAT	(1X,5E15.6)
C
2000	FORMAT	(1X,'NUMBER OF FREQUENCIES:'T70,$)
2001	FORMAT	(1X,'FREQUENCY [T]:',T70,$)
2002	FORMAT	(1X,'PHASE:',T70,$)
2003	FORMAT	(1X,'AMPLITUDE:',T70,$)
2004	FORMAT	(1X,'DECAY:',T70,$)
2005	FORMAT	(1X,'PERMAS:',T70,$)
2006	FORMAT	(1X,'TMEAN:',T70,$)
2007	FORMAT	(1X,'TVAR:',T70,$)
2008	FORMAT	(1X,8F9.4)
C
3000	FORMAT	(F8.3)
C
	END

---