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