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

C	FORTRAN
C	WAHRSCHEINLICHKEITEN PHIJM(T+GE)
C		 	     PHIJM(T+GEB)

	READ(1,100) IN
100	FORMAT('*******  N = ',I5)

	COMMON ADICHT, ALOWUG
	DIMENSION	ADICHT(500),
	1		ALOWUG(500),
	1		AFLD1(6,3),
	1		AFLD2(17,2)

	RTEM=1.0/(FLOAT(IN)-1.0)
	RALPHA=RTEM*ALOG(11.2)
	RBETA=RTEM*ALOG(67.2)

	REXPA=EXP(RALPHA)
	REXPB=EXP(RBETA)

	READ(1,200) DAT1
200	FORMAT('DICHTE VON K-DATEI: ',A6)
	READ(1,300) DAT2
300	FORMAT('DICHTE VON IK(T+...)-DATEI: ',A6)
	READ(1,350) DAT3
350	FORMAT('AUSGABEDATEI: ',A6)

	CALL IOPEN( 'SYS',DAT1)

	DO 400 J=1,3
	READ(4,500) (AFLD1(I,J), I=1,6)
400	CONTINUE
500	FORMAT(F11.7)

	CALL IOPEN('SYS',DAT2)

	DO 600 J=1,2
	READ(4,500) (AFLD2(I,J), I=1,17)
600	CONTINUE

C	BERECHNUNG VON KLEINPHIJM

	RVALJ=12.5
	DO 1000 IJ=1,IN
	RVALI=25.0
	IC1=1
	RSUM=0.0

	DO 800 II=1,IN
	IF (RVALI-280.0) 605,604,604
604	RPHIJK=0.0
	GOTO 616
605	IF (RVALI-AFLD2(IC1,1)) 615,610,610
610	IC1=IC1+1
	GOTO 605
615	RPHIJK=AFLD2(IC1,2)

616	RREST=RVALJ/RVALI
	IC2=1
	IF (RREST-0.5) 617,617,618
617	RPHIK=0.0
	GOTO 640
618	IF (RREST-3.0) 620,617,617
620	RB=RREST-AFLD1(IC2,1)
	IF (RREST-AFLD1(IC2+1,1)) 630,630,625
625	IC2=IC2+1
	GOTO 620
630	RPHIK=AFLD1(IC2,2)*RB+AFLD1(IC2,3)
640	RSUM=RSUM+RPHIJK*RPHIK
	RVALI=REXPA*RVALI
800	CONTINUE

	RSUM=RSUM*RALPHA
	ADICHT(IJ)=RSUM
	RVALJ=REXPB*RVALJ
1000	CONTINUE

	CALL OOPEN('SYS',DAT3)

C	BERECHNUNG VON GROSSPHIJM

	RVALJ=12.5
	DO 1200 IJ=1,IN
	RVALI=12.5
	RSUM=0.0

	DO 1100 II=1,IJ
	RSUM=RSUM+ADICHT(II)*RVALI
	RVALI=RVALI*REXPB
1100	CONTINUE	

	RSUM=RSUM*RBETA
	WRITE(4,1150) RVALJ,RSUM
1150	FORMAT(E15.6,F15.10)
	RVALJ=RVALJ*REXPB
1200	CONTINUE

	RVALJ=RVALJ/REXPB
	RSUM=1.0
	WRITE(4,1150) RVALJ,RSUM

	CALL OCLOSE
	CALL EXIT

	END