File OPHIJM.

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 WERT,IAR1,IAR2
	DIMENSION WERT(100),IAR1(100),IAR2(100)

	READ(1,10) DATEI
10	FORMAT('EINGABEDATEI: ',A6)
	READ(1,40) ITGE
40	FORMAT('T+GE (=0) ODER T+GEB (=/0): ',I3)

	CALL IOPEN('SYS',DATEI)

	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)
1020	FORMAT(10X'PHIJM (T+GEB) :'//)
	GOTO 1045
1030	WRITE(4,1040)
1040	FORMAT(10X'PHIJM (T+GE) :'//)

1045	WRITE(4,1046)
1046	FORMAT(10X,'GROSS PHI(IM/MA)',10X,'IM/MA'/)

	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
	GOTO 1700
1520	J=1
	IBLATT=IBLATT+1
	GOTO 1005
1600	J=J+1
	GOTO 1050

1700	CALL EXIT

	END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search