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
C IWHAT=0 => PHIUG1
C IWHAT=1 => PHIUG2
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
READ(1,90) IRN1,IRN2
90 FORMAT('VON VERS-NR ='I5/'BIS VERS-NR ='I5)
READ(1,95) RRI
95 FORMAT('WIDERSTANDSWERTE R(I) REAL: ',F6.1)
C WERTE: 0,0.5,1,2,4,8,20,40,100 KOHM
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)
IHILF=IRN1
200 IF (IHILF-IRN2) 300,300,2000
DO 500 K=1,IHILF
300 CALL IOPEN('SYS','BATCHD')
READ(4,400) RQ,RC1,RC2,RC3,M1,M2,DATEI
400 FORMAT(F4.1/F4.1/F4.1/F4.1/A1/A2/A6)
500 CONTINUE
OUT=OFILE(IHILF)
WRITE(1,140) OUT
IHILF=IHILF+1
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
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
RXSUM=0.0
RVALK=RTEM2
DO 1000 IK=1,IN
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-RRI
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
CALL OCLOSE
GOTO 200
2000 IF (IWHAT-1) 1400,111,1400
1400 CALL EXIT
END