Directory of image this file is from
This file as a plain text file
C AUSGABEPROGRAMM ZUR ERMITTLUNG DER VERTEILUNGSFUNKTIONSWERTE
C GROSS PHI(UG) FUER R(GES)=R(I)+R(A)+R(K)+R(UE),DER
C SERIENWIDERSTAENDE
C DATUM: 1.9.78
C NAME: OPUGRI = OPHIUG(RI)
COMMON RIPUT,WERT,IAR1
DIMENSION RIPUT(54),WERT(100),IAR1(100)
C EINLESEN DER BENOETIGTEN DATEIEN FUER DIE BERECHNUNG
C VON PHIUG
CALL IOPEN('SYS','INDATA')
DO 20 K=1,54
READ(4,10) RIPUT(K)
10 FORMAT(A6)
20 CONTINUE
C EINLESEN DER WIDERSTANDSWERTE
READ(1,25) RRI
25 FORMAT('WIDERSTAND R(I) REAL: 'F6.1)
C EINLESEN DER KOMBINATIONSFOLGEN
READ(1,26) IRN1,IRN2
26 FORMAT('VON KOMBINATIONSNR: 'I5/'BIS KOMBINATIONSNR: 'I5)
IN=1
C BERECHNUNG DER PHIUG MIT AUSGABE
C ********************************
DO 2000 IRUN=IRN1,IRN2
C WERT ZUR NORMIERUNG AUF WKEIT(PHIUG)=1
CALL IOPEN('DSKB',RIPUT(IRUN))
DO 40 K=1,500
READ(4,30) RARG,RH
30 FORMAT(E15.6,F15.10)
40 CONTINUE
RHLAST=RH
C ERMITTELN DER PHIUG IN ZEHNERPOTENZSCHRITTEN
WRITE(1,10) RIPUT(IRUN)
CALL IOPEN('DSKB',RIPUT(IRUN))
READ(4,30) RVARG,RVH
RVH=RVH/RHLAST
I=-9
N=1
RL=10.0**I
RTL1=10.0**(-1)
DO 1000 K=1,500
READ(4,30) RARG,RH
IF (RL-RTL1) 50,50,1000
50 RH=RH/RHLAST
IF (RH-RL) 100,200,300
100 RVARG=RARG
RVH=RH
GOTO 1000
200 WERT(N)=RARG
GOTO 400
300 RT1=(RL-RVH)/(RH-RVH)
RDIFF=RARG-RVARG
WERT(N)=RT1*RDIFF+RVARG
400 IAR1(N)=I
N=N+1
I=I+1
RL=10.0**I
1000 CONTINUE
IAR1(N)=0
WERT(N)=RARG
WRITE(1,10) RIPUT(IRUN)
WRITE(1,30) RARG,RH
WRITE(1,1001) N
1001 FORMAT(I3/)
C AUSGABE DER FORMATIERTEN WERTE AUF DECWRITER
CALL OOPEN('DCWR',0)
WRITE(4,1010) IN,IRUN,RRI
1010 FORMAT(10X'PHIUG 'I1'('I2') R(I)='F6.1' :'//)
WRITE(4,1020)
1020 FORMAT(10X,'GROSS PHI(UG/V)',10X,'UG/V'//)
IZEIL=6
DO 1200 K=1,N
WRITE(4,1100) IAR1(K),WERT(K)
1100 FORMAT(14X,'1**10',I2,F25.10/)
IZEIL=IZEIL+2
1200 CONTINUE
IZEIL=66-IZEIL
DO 1400 K=1,IZEIL
WRITE(4,1300) IZEIL
1300 FORMAT(I0)
1400 CONTINUE
CALL OCLOSE
IN=IN+1
IF (IN-2) 1600,1600,1500
1500 IN=1
1600 CONTINUE
2000 CONTINUE
CALL EXIT
END