C HAUPTPROGRAMM C NAME: RB2704 C BERECHNET KLEINPHIRB UND GROSSPHIRB COMMON ASUM,BSUM DIMENSION ASUM(500),BSUM(500) READ(1,100) IN 100 FORMAT('ANZAHL DER SCHRITTE: 'I7) 200 IK1=0 CALL IOPEN('SYS','BATCHD') READ(4,300) RQ,RC1,RC2,RC3,M1,M2,DATEI 300 FORMAT(F4.1/F4.1/F4.1/F4.1/A1/A2/A6) GOTO 500 400 IK1=IK1+1 IF (IK1-27) 410,2000,2000 410 CALL IOPEN('SYS','BATCHD') DO 440 J=1,IK1 DO 430 I=1,7 READ(4,420) ILAUF 420 FORMAT(I0) 430 CONTINUE 440 CONTINUE READ(4,300) RQ,RC1,RC2,RC3,M1,M2,DATEI 500 RTIN=1.0/(FLOAT(IN)) RALPH=RTIN*RQ RBETA=RTIN*(1.2+RQ) RGAMM=RTIN*(1.2+RC3-RC1+RQ) C **** BERECHNUNG VON KLEIN PHIRA+RK **** C IF (RQ) 1000,1405,1000 1000 CALL SQUAR(0.3,1.5,0.,RM,RB,RH) PHIRA=1.0/RQ DO 1200 J=1,IN SUM=0. DO 1100 I=1,IN RT1=0.3+RBETA*FLOAT(J-1)-RALPH*FLOAT(I-1) IF (RT1-0.3) 1100,1100,1020 1020 IF (RT1-1.5) 1040,1040,1100 C GO 1100, CAUSE PHIRK=0.0 1040 PHIRK=RT1*RM+RB SUM=SUM+PHIRA*PHIRK 1100 CONTINUE BSUM(J)=RALPH*SUM 1200 CONTINUE C BERECHNUNG VON KLEINPHIRB CALL SQUAR(RC1,RC2,RC3,RM,RB,RH) DO 1400 K=1,IN SUM=0. DO 1300 J=1,IN RT1=RC1+RGAMM*FLOAT(K-1)-RBETA*FLOAT(J-1) IF (RT1-RC1) 1300,1300,1202 1202 IF (RT1-RC3) 1205,1205,1300 1205 IF (RT1-RC2) 1210,1220,1220 1210 PHIRU=RM*RT1+RB GOTO 1230 1220 PHIRU=RH 1230 SUM=SUM+BSUM(J)*PHIRU 1300 CONTINUE ASUM(K)=RBETA*SUM 1400 CONTINUE GOTO 1700 C *** SONDERFALL MIT Q=0 *** 1405 CALL SQUAR(0.3,1.5,0.,RSTEI,RORD,RH) CALL SQUAR(RC1,RC2,RC3,RM,RB,RH) DO 1600 K=1,IN SUM=0. DO 1500 J=1,IN RT1=RC1+RGAMM*FLOAT(K-1)-RBETA*FLOAT(J-1) RT2=0.3+RBETA*FLOAT(J-1) IF (RT2-0.3) 1500,1500,1403 1403 IF (RT2-1.5) 1404,1404,1500 1404 IF (RT1-RC1) 1500,1500,1407 1407 IF (RT1-RC3) 1409,1409,1500 1409 IF (RT1-RC2) 1410,1420,1420 1410 PHIRU=RM*RT1+RB GOTO 1430 1420 PHIRU=RH 1430 PHIRK=RSTEI*RT2+RORD SUM=SUM+PHIRK*PHIRU 1500 CONTINUE ASUM(K)=RBETA*SUM 1600 CONTINUE 1700 CALL OOPEN('SYS',DATEI) C BERECHNUNG VON GROSS PHIRB WRITE(4,1800) M1,M2 1800 FORMAT(A1,A2) DO 1950 K=1,IN SUM=0. DO 1900 J=1,K SUM=SUM+ASUM(J) 1900 CONTINUE SUM=SUM*RGAMM RT1=RC1+0.3+RGAMM*FLOAT(K-1) WRITE(4,1910) RT1,SUM 1910 FORMAT(E15.6,F15.10) 1950 CONTINUE RT1=1.5+RC3+RQ SUM=1.0 WRITE(4,1910) RT1,SUM CALL OCLOSE GOTO 400 2000 CALL EXIT END