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

C	DIESES PROGRAMM DIENT ZUR BERECHNUNG DER DICHTE BZW.
C	VERTEILUNGSFUNKTION KLEIN PHIUG UND GROSS PHIUG


	COMMON APIM,APRB,OFILE
	DIMENSION APIM(10,2), APRB(500,2), OFILE(27)

	READ(1,100) IN
100	FORMAT('ANZAHL DER SCHRITTE: 'I7)

	READ(1,110) DATEI,LANG,OUT
110	FORMAT('EINGABEDATEI FUER PHIIM: 'A6/'LAENGE: 'I4/
	1'AUSGABEDATEINAMENDATEI: 'A6)

	IWHAT=0
	READ(1,110) R2DAT,I2LG,R2OUT
111	IF (IWHAT) 112,115,112
112	DATEI=R2DAT
	LANG=I2LG
	OUT=R2OUT
115	IWHAT=IWHAT+1

	CALL IOPEN('SYS',DATEI)

	DO 120 K=1,LANG
	READ(4,130) APIM(K,1)
	READ(4,130) APIM(K,2)
130	FORMAT(F15.10)
120	CONTINUE

	CALL IOPEN('SYS',OUT)

	READ(4,140) (OFILE(I), I=1,27)
140	FORMAT(A6)


200	IK1=0
	CALL IOPEN('SYS','BATCHD')
	READ(4,300) RQ,RC1,RC2,RC3,M1,M2,DATEI
300	FORMAT(F4.1/F4.1/F4.1/F4.1/A1/A2/A6)
	GOTO 500
400	IK1=IK1+1
	IF (IK1-27) 410,2000,2000
410	CALL IOPEN('SYS','BATCHD')
	DO 440 J=1,IK1
	DO 430 I=1,7
	READ(4,420) ILAUF
420	FORMAT(I0)
430	CONTINUE
440	CONTINUE
	READ(4,300) RQ,RC1,RC2,RC3,M1,M2,DATEI
500	CONTINUE


	CALL IOPEN('SYS',DATEI)

	DO 600 K=1,IN
	READ(4,550) APRB(K,1), APRB(K,2)
550	FORMAT(E15.6,F15.10)
600	CONTINUE



C	BERECHNUNG VON KLEIN PHIUG

	OUT=OFILE(IK1+1)
	RTIN=1.0/FLOAT(IN)
	RMRB=RC3+RQ+1.5
	RMIM=840.0
	RTEM1=RMRB*840.0
	RTEM2=(RC1+0.3)*6.5

	RBETA=RTIN*ALOG(840.0/6.5)
	RGAMM=RTIN*ALOG(RTEM1/RTEM2)

	REXPB=EXP(RBETA)
	REXPG=EXP(RGAMM)

	CALL OOPEN('DSKB',OUT)

C	BERECHNUNG VON KLEIN PHIUG

	IL=IN-1
	RXSUM=0.0
	RVALK=RTEM2

	DO 1000 IK=1,IL
	RVALJ=6.5
	RSUM=0.0

	DO 800 IJ=1,IN
	PHIIM=SORTI(RVALJ,RMIM,APIM)
	IF (PHIIM) 700,750,700
700	RREST=RVALK/RVALJ
	PHIRB=SORTR(RREST,RMRB,APRB)
	RSUM=RSUM+PHIIM*PHIRB
750	RVALJ=RVALJ*REXPB
800	CONTINUE

	RSUM=RBETA*RSUM
	RXSUM=RXSUM+RVALK*RSUM
	RSOUT=RGAMM*RXSUM
	WRITE(4,900) RVALK,RSOUT
900	FORMAT(E15.6,F15.10)
	RVALK=RVALK*REXPG
1000	CONTINUE

	RSUM=1.0
	WRITE(4,900) RVALK,RSUM

	CALL OCLOSE
	GOTO 400

2000	IF (IWHAT-1) 1400,111,1400

1400	CALL EXIT
	END