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