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

C	AUSGABEPROGRAMM ZUR ERMITTLUNG DISKRETER WIDERSTANDSWERTE RB
C	FUER VORGEGEBENE VERTEILUNGSFUNKTIONSWERTE GROSS PHI(IM)
C	BATCHVERSION;   (NAEHERES SIEHE PRINTOUT)
C	NAME:  OPHIJM

	COMMON RIPUT,WERT,IAR1,IAR2
	DIMENSION RIPUT(54),WERT(100),IAR1(100),IAR2(100)

	CALL IOPEN('SYS','INDATA')

	DO 15 K=1,54
	READ(4,10) RIPUT(K)
10	FORMAT(A6)
15	CONTINUE

	ITGE=0
	IN=0
	DO 2000 IRUN=1,54
	IN=IN+1

	WRITE(1,10) RIPUT(IRUN)
	CALL IOPEN('DSKB',RIPUT(IRUN))

	READ(4,20) RVARG,RVH
20	FORMAT(E15.6,F15.10)

	J=1
	I=-9
	N=1
	RTL1=FLOAT(9)*(10.0**(-1))

	DO 1000 K=1,500
	READ(4,20) RARG,RH
100	IF (J-10) 300,200,300
200	I=I+1
	J=1
300	RL=FLOAT(J)*(10.0**I)

	IF (RL-RTL1) 350,350,1000
350	IF (RH-RL) 400,500,600
400	RVARG=RARG
	RVH=RH
	GOTO 1000

500	WERT(N)=RARG
	GOTO 700

600	RT1=(RL-RVH)/(RH-RVH)
	RDIFF=RARG-RVARG
	WERT(N)=RT1*RDIFF+RVARG

700	IAR1(N)=J
	IAR2(N)=I
	N=N+1
	J=J+1
	GOTO 100
1000	CONTINUE

	IAR1(N)=J
	IAR2(N)=I
	WERT(N)=RARG

	J=1
	I=1
	IBLATT=1
	CALL OOPEN('DCWR',0)
1005	IF (ITGE) 1010,1030,1010
1010	WRITE(4,1020) IN
1020	FORMAT(10X'PHIUG 2('I2') :'//)
	IAN=0
	GOTO 1045
1030	WRITE(4,1040) IN
1040	FORMAT(10X'PHIUG 1('I2') :'//)
	IAN=1

1045	WRITE(4,1046)
1046	FORMAT(10X,'GROSS PHI(UG/V)',10X,'UG/V'/)

	IZEIL=5
1050	DO 1200 K=1,9
	WRITE(4,1100) IAR1(I),IAR2(I),WERT(I)
1100	FORMAT(I15'*10**',I2,F25.10)
	I=I+1
	IZEIL=IZEIL+1
	IF (I-N) 1200,1200,1350
1200	CONTINUE

	WRITE(4,1300)
1300	FORMAT(/)
	IZEIL=IZEIL+2

	IF (J-5) 1600,1350,1600
1350	IZEIL=66-IZEIL
	DO 1500 K=1,IZEIL
	WRITE(4,1400) IZEIL
1400	FORMAT(I0)
1500	CONTINUE
	IF (IBLATT-2) 1520,1510,1520
1510	CALL OCLOSE
	ITGE=IAN
	GOTO 2000
1520	J=1
	IBLATT=IBLATT+1
	GOTO 1005
1600	J=J+1
	GOTO 1050

2000	CONTINUE

	CALL EXIT
	END