C $DEBUG CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE EIN C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE EIN(IOUTD,IOUT,IN,INFILE,ISTEUER,DATEN,APAR X ,IPAR,RPAR) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*2 (I-M) CHARACTER*2 APAR(128) CHARACTER*24 FILN REAL*8 DATEN(4096),RPAR(24) INTEGER*2 IPAR(32),IOUT,IN,INFILE,ISTEUER,RECLN INTEGER*4 IERR IF(ISTEUER.EQ.1) GOTO 500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DATENEINLESEN VOM FILE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC WRITE(IOUT,1300) 1300 FORMAT( ' MESSDATENFILE (EIN): ' ) READ(IN,'(A)') FILN 919 CONTINUE WRITE(IOUTD,'(A)') FILN OPEN(INFILE,ACCESS='DIRECT', X FILE=FILN,STATUS='OLD',IOSTAT=IERR) IF(IERR.NE.0)THEN WRITE(IOUT,1400)IERR 1400 FORMAT(' OPEN FILE ERROR ',I4) ISTEUER=3 WRITE(*,1300) READ(*,'(A)')FILN GOTO 919 ENDIF 500 CONTINUE READ(INFILE,ERR=777) (APAR(I),I=1,128) X ,(IPAR(I),I=1,32),(RPAR(I),I=1,24) write(*,*) (APAR(I),I=1,128) X ,(IPAR(I),I=1,32),(RPAR(I),I=1,24) ISTEUER=IPAR(9) DO 123 I=1,IPAR(5),64 READ(INFILE,ERR=777)(DATEN(K),K=I,I+63) write(*,*)(DATEN(K),K=I,I+63) 123 CONTINUE IF(ISTEUER.NE.1) CLOSE(INFILE) GOTO 999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 777 CONTINUE IF(ISTEUER.EQ.1) THEN WRITE(IOUT,7001) 7001 FORMAT(' FILE ZUENDE') ISTEUER=2 CLOSE(INFILE) GOTO 999 ELSE WRITE(IOUT,7002) 7002 FORMAT(' DATENFILE NICHT IN ORDNUNG') ISTEUER=3 GOTO 999 ENDIF 999 RETURN END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE EIN C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE EINA(IOUTD,IOUT,IN,INFILE,ISTEUER,DATEN,APAR X ,IPAR,RPAR) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*2 (I-M) CHARACTER*2 APAR(128) CHARACTER*24 FILN integer*4 ierr REAL*8 DATEN(4096),RPAR(24) INTEGER*2 IPAR(32),IOUT,IN,INFILE,ISTEUER IF(ISTEUER.EQ.1) GOTO 500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DATENEINLESEN VOM FILE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC WRITE(IOUT,1300) 1300 FORMAT( ' MESSDATENFILE (eina): ' ) READ(IN,'(A)')FILN 919 CONTINUE WRITE(IOUTD,'(A)') FILN OPEN(INFILE,FILE=FILN,STATUS='OLD',IOSTAT=IERR) IF(IERR.NE.0)THEN WRITE(IOUT,1400)IERR 1400 FORMAT(' OPEN FILE ERROR ',I4) ISTEUER=3 WRITE(*,1300) READ(*,'(A)')FILN GOTO 919 ENDIF 500 CONTINUE READ(INFILE,'(BN,4I8,2E16.9,A2)',END=777,ERR=500) IPAR(1) X ,IPAR(6),IPAR(5),IPAR(8),RPAR(1),RPAR(10) write(*,*) IPAR(1) X ,IPAR(6),IPAR(5),IPAR(8),RPAR(1),RPAR(10) IF(IPAR(6).NE.0) GOTO 777 C IF(IPAR(5).GT.1024) IPAR(5)=1024 READ(INFILE,'(5E16.9)') (DATEN(I),I=1,IPAR(5)) c DO ihh=1, ipar(5) c write(*,*) daten(ihh) c end do ISTEUER=IPAR(9) IF(ISTEUER.NE.1) CLOSE(INFILE) GOTO 999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 777 CONTINUE IF(ISTEUER.EQ.1) THEN WRITE(IOUT,7001) 7001 FORMAT(' FILE ZUENDE') ISTEUER=2 CLOSE(INFILE) GOTO 999 ELSE WRITE(IOUT,7002) 7002 FORMAT(' DATENFILE NICHT IN ORDNUNG') ISTEUER=3 GOTO 999 ENDIF 999 RETURN END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE EIN ASCII/BESTMANN C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE EINAB(IOUTD,IOUT,IN,INFILE,ISTEUER,DATEN,APAR X ,IPAR,RPAR) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*2 (I-M) CHARACTER*2 APAR(128) CHARACTER*24 FILN integer*4 ierr REAL*8 DATEN(4096),RPAR(24) INTEGER*2 IPAR(32),IOUT,IN,INFILE,ISTEUER,IDAT(1024) IF(ISTEUER.EQ.1) GOTO 500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DATENEINLESEN VOM FILE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC WRITE(IOUT,1300) 1300 FORMAT( ' MESSDATENFILE: ' ) READ(IN,'(A24)')FILN 919 CONTINUE WRITE(IOUTD,'(A24)') FILN OPEN(INFILE,FILE=FILN,STATUS='OLD',IOSTAT=IERR) IF(IERR.NE.0)THEN WRITE(IOUT,1400)IERR 1400 FORMAT(' OPEN FILE ERROR ',I4) ISTEUER=3 WRITE(*,1300) READ(*,'(A24)')FILN GOTO 919 ENDIF 500 CONTINUE READ(INFILE,'(4I8,2E16.9,A2)',END=777,ERR=500) IPAR(1),IPAR(6) X ,IPAR(5),IPAR(8),RPAR(1) RPAR(10)=50. IF(IPAR(6).NE.0) GOTO 777 IF(IPAR(5).GT.1024) IPAR(5)=1024 READ(INFILE,'(10I8)') (IDAT(I),I=1,IPAR(5)) ISTEUER=IPAR(9) DO 77 I=1,IPAR(5) DATEN(I)=IDAT(I) 77 CONTINUE IF(ISTEUER.NE.1) CLOSE(INFILE) GOTO 999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 777 CONTINUE IF(ISTEUER.EQ.1) THEN WRITE(IOUT,7001) 7001 FORMAT(' FILE ZUENDE') ISTEUER=2 CLOSE(INFILE) GOTO 999 ELSE WRITE(IOUT,7002) 7002 FORMAT(' DATENFILE NICHT IN ORDNUNG') ISTEUER=3 GOTO 999 ENDIF 999 RETURN END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE EIN C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE EINAR(IOUTD,IOUT,IN,INFILE,ISTEUER,DATEN,APAR X ,IPAR,RPAR) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*2 (I-M) CHARACTER*2 APAR(128) CHARACTER*24 FILN CHARACTER*44 TEXT integer*4 ierr REAL*8 DATEN(4096),RPAR(24) INTEGER*2 IPAR(32),IOUT,IN,INFILE,ISTEUER,IDAT(1024) IF(ISTEUER.EQ.1) GOTO 500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DATENEINLESEN VOM FILE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC WRITE(IOUT,1300) 1300 FORMAT( ' MESSDATENFILE: ' ) READ(IN,'(A24)')FILN 919 CONTINUE WRITE(IOUTD,'(A24)') FILN OPEN(INFILE,FILE=FILN,STATUS='OLD',IOSTAT=IERR) IF(IERR.NE.0)THEN WRITE(IOUT,1400)IERR 1400 FORMAT(' OPEN FILE ERROR ',I4) ISTEUER=3 WRITE(*,1300) READ(*,'(A24)')FILN GOTO 919 ENDIF 500 CONTINUE READ(INFILE,'(4I8,2E16.9,A2)',END=777,ERR=500) IPAR(1),IPAR(6) X ,IPAR(5),IPAR(8),RPAR(1) IF(IPAR(1).LE.0) IPAR(1)=10 RPAR(1)=RPAR(1)*1000. RPAR(10)=50. IF(IPAR(6).NE.0) GOTO 777 IF(IPAR(5).GT.1024) IPAR(5)=1024 READ(INFILE,'(5E16.9)') RPAR(6),RPAR(7),RPAR(4),RPAR(5) IPAR(9)=1 READ(INFILE,'(A44)') TEXT WRITE(IOUTD,'(A44)') TEXT WRITE(IOUT,'(A44)') TEXT READ(INFILE,'(10I8)') (IDAT(I),I=1,IPAR(5)) DO 77 I=1,IPAR(5) DATEN(I)=FLOAT(IDAT(I)) 77 CONTINUE ISTEUER=IPAR(9) IF(ISTEUER.NE.1) CLOSE(INFILE) GOTO 999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 777 CONTINUE IF(ISTEUER.EQ.1) THEN WRITE(IOUT,7001) 7001 FORMAT(' FILE ZUENDE') ISTEUER=2 CLOSE(INFILE) GOTO 999 ELSE WRITE(IOUT,7002) 7002 FORMAT(' DATENFILE NICHT IN ORDNUNG') ISTEUER=3 GOTO 999 ENDIF 999 RETURN END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE AUS C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE AUS(IOUTD,IOUT,IN,INFILE,ISTEUER,DATEN X ,APAR,IPAR,RPAR) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*2 (I-M) CHARACTER*2 APAR(128) CHARACTER*24 FILN integer*4,ierr REAL*8 DATEN(4096),RPAR(24) INTEGER*2 IPAR(32),IOUT,IN,INFILE,ISTEUER,IOUTD IF(ISTEUER.EQ.1) GOTO 500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DATENAUSLESEN AUF FILE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 919 CONTINUE WRITE(IOUT,1300) 1300 FORMAT( ' RESIDUENFILE: ' ) READ(IN,'(A24)')FILN WRITE(IOUTD,'(A24)') FILN OPEN(INFILE,ACCESS='DIRECT',RECL=512, X FILE=FILN,STATUS='NEW',IOSTAT=IERR) IF(IERR.NE.0)THEN WRITE(IOUT,1400)IERR 1400 FORMAT(' OPEN FILE ERROR ',I4) OPEN(INFILE,ACCESS='DIRECT',RECL=512, X FILE=' ZUVIEL.RES',IOSTAT=IERR) WRITE(IOUTD,*)' FILE SCHON VORHANDEN:RESIDUUM IN ZUVIEL.RES' WRITE(*,*)' FILE SCHON VORHANDEN:RESIDUUM IN ZUVIEL.RES' IF(IERR.NE.0) STOP ENDIF 500 CONTINUE IPAR(10)=IPAR(10)+1 WRITE(INFILE) (APAR(I),I=1,128) X ,(IPAR(I),I=1,32),(RPAR(I),I=1,24) DO 123 I=1,IPAR(5),64 WRITE(INFILE) (DATEN(K),K=I,I+63) 123 CONTINUE ISTEUER=IPAR(9) 999 RETURN END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SUBROUTINE AUS C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE AUSA(IOUTD,IOUT,IN,INFILE,ISTEUER,DATEN X ,APAR,IPAR,RPAR) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*2 (I-M) CHARACTER*2 APAR(128) CHARACTER*24 FILN integer*4 ierr REAL*8 DATEN(4096),RPAR(24) INTEGER*2 IPAR(32),IOUT,IN,INFILE,ISTEUER IF(ISTEUER.EQ.1) GOTO 500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DATENEINLESEN VOM FILE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 919 CONTINUE WRITE(IOUT,1300) 1300 FORMAT( ' RESIDUENFILE: ' ) READ(IN,'(A24)')FILN WRITE(IOUTD,'(A24)') FILN OPEN(INFILE,FILE=FILN,STATUS='NEW',IOSTAT=IERR) IF(IERR.NE.0)THEN WRITE(IOUT,1400)IERR 1400 FORMAT(' OPEN FILE ERROR ',I4) OPEN(INFILE,FILE=' ZUVIEL.RES',IOSTAT=IERR) WRITE(IOUTD,*)' FILE SCHON VORHANDEN:RESIDUUM IN ZUVIEL.RES' WRITE(*,*)' FILE SCHON VORHANDEN:RESIDUUM IN ZUVIEL.RES' IF(IERR.NE.0) STOP ENDIF 500 CONTINUE IPAR(10)=IPAR(10)+1 WRITE(INFILE,'(4I8,2E16.9,A2)') IPAR(1),IPAR(6),IPAR(5) X ,IPAR(8),RPAR(1),RPAR(10) WRITE(INFILE,'(5E16.9)') (DATEN(I),I=1,IPAR(5)) ISTEUER=IPAR(9) 999 RETURN END