* f77 can't write to a file opened with F SUBROUTINE OPENFILE(ILUN,CHFILE,IOS) CHARACTER*(*) CHFILE OPEN(ILUN,FILE=CHFILE,IOSTAT=IOS) END SUBROUTINE CLOSEFILE(ILUN,IOS) CLOSE(ILUN,IOSTAT=IOS) END SUBROUTINE WRITECH(ILUN,CHLINE) CHARACTER*(*) CHLINE WRITE(ILUN,*)CHLINE END ** For PAW : **************************************************************** * F has no common blocks SUBROUTINE PAWCOM() PARAMETER (NWPAWC = 1 000 000) DIMENSION HMEMOR(NWPAWC) COMMON /PAWC/ HMEMOR CALL HLIMIT(NWPAWC) END ** For MIDAS Data : **************************************************************** SUBROUTINE READWORD(ILUN,IDATA,IOS) INTEGER*4 IWORD,IDATA CHARACTER*1 CDATA(4) EQUIVALENCE(CDATA,IWORD) NBYTE = 4 CALL READCH(ILUN,CDATA,NBYTE,IOS) IDATA = IWORD END **************************************************************** SUBROUTINE READHWORD(ILUN,IDATA,IOS) INTEGER*2 IHWORD,IDATA CHARACTER*1 CDATA(2) EQUIVALENCE(CDATA,IHWORD) NBYTE = 2 CALL READCH(ILUN,CDATA,NBYTE,IOS) IDATA = IHWORD END **************************************************************** SUBROUTINE READBYTE(ILUN,IDATA,IOS) INTEGER*1 IBYTE,IDATA CHARACTER*1 CDATA EQUIVALENCE(CDATA,IBYTE) NBYTE = 1 CALL READCH(ILUN,CDATA,NBYTE,IOS) IDATA = IBYTE END **************************************************************** * the F compiler doesn't know FGETC, but g77 does SUBROUTINE READCH(ILUN,CDATA,NBYTE,IOS) CHARACTER*1 CDATA(NBYTE) DO I=1,NBYTE IOS = FGETC(ILUN,CDATA(I)) IF( IOS.NE.0 ) RETURN ENDDO END SUBROUTINE READINT(ILUN,IVAL,NBYTE,IOS) CHARACTER*1 CDATA(4) INTEGER IVAL,IWORD EQUIVALENCE(CDATA,IWORD) DO I=NBYTE,1,-1 IOS = FGETC(ILUN,CDATA(I)) IF( IOS.NE.0 ) RETURN ENDDO IVAL = IWORD END