C Copyright 1995, Columbia University, all rights reserved. C Permission is granted to utilize and disseminate this code or C document without charge, provided that (1) this copyright notice is C not removed, and (2) all changes made by other than members of the C MacroModel Development Group at Columbia University are, if further C disseminated, (a) noted as such; for example, by means of source-code C comment lines, and (b) communicated back to the author for possible C inclusion in subsequent versions. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C *** $RCSfile: fcmmio.f,v $ C *** $Revision: 1.8 $ C *** $Date: 1996/01/24 16:43:51 $ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C fcmmio: read mmod files from input and copy them to output. C Usage: fcmmio [-cf] C if the "-f" option is given, always write full CTs on output even if C compressed CTs are present in input. This is the default, and C will uncompress a compressed mmod file. C if "-c" is specified, then compressed CTs will be written to the output C whenever they appear in the input. This amounts to a copy of the C input file. C fcmmio does not compress full CTs. C fcmmio has two purposes: to provide an example of how to use the mmio API, C and to make sure that some simple facilities of the mmio library are C working correctly. fcmmio always gives verbose output, which would not C be desirable in a "real" application. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC PROGRAM FMMIO C *** Driver for mmio library, FORTRAN API: IMPLICIT NONE INCLUDE 'mmio.inc' CHARACTER*(MMIO_L_STRLEN) READ_FNAME, WRITE_FNAME, STR INTEGER NSTR, IARGC, CT_TYPE_REQUESTED, LNSTR INTEGER ISTAT, CT_TYPE, ICT, IATOM CHARACTER*(MMIO_L_STRLEN) TITLE INTEGER NATOM INTEGER MMOD_IATOM INTEGER ITYPE INTEGER NBOND INTEGER BOND_ATOM( MMIO_MAXBOND ) INTEGER BOND_ORDER( MMIO_MAXBOND ) REAL XYZ( 3 ) REAL CHARGE1 REAL CHARGE2 CHARACTER CHAIN INTEGER COLOR INTEGER RESNUM CHARACTER RESNAME1 CHARACTER*(MMIO_S_STRLEN) RESNAME4 CHARACTER*(MMIO_S_STRLEN) PDBNAME INTEGER IREAD INTEGER IWRITE C *** parse cmdline opts, getting file type requested and IO file names: CALL GETARG( 1, STR ) NSTR = IARGC() IF( STR(1:1) .EQ. '-' )THEN IF( NSTR .NE. 3 )THEN CALL USAGE() STOP '*** fcmmio: ERROR' ENDIF IF( STR(2:2) .EQ. 'f' )THEN CT_TYPE_REQUESTED = MMIO_FULL ELSEIF( STR(2:2) .EQ. 'c' )THEN CT_TYPE_REQUESTED = MMIO_COMPRESSED ENDIF CALL GETARG( 2, STR ) READ_FNAME = STR CALL GETARG( 3, STR ) WRITE_FNAME = STR ELSE IF( NSTR .NE. 4 )THEN CALL USAGE() STOP '*** fcmmio: ERROR' ENDIF CT_TYPE_REQUESTED = MMIO_FULL READ_FNAME = STR CALL GETARG( 2, STR ) WRITE_FNAME = STR ENDIF C *** report fnames for reading and writing: WRITE( 6, '(A,A,1X,A)' )'fcmmio: readfile, writefile= ', & READ_FNAME(1:LNSTR(READ_FNAME)), & WRITE_FNAME(1:LNSTR(WRITE_FNAME)) C *** set stdout for location of err msgs from library: CALL MMIOF_ERRFILE( 6 ) C *** open file for reading: CALL MMIOF_OPEN( IREAD, READ_FNAME, MMIO_READ, ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A,A,A)' )'fcmmio: MMIOF_OPEN returns ', & STR(1:LNSTR(STR)), ' for read_file ', & READ_FNAME(1:LNSTR(READ_FNAME)) IF( ISTAT .EQ. MMIO_ERR )STOP '*** fcmmio: ERROR' C *** open file for writing: CALL MMIOF_OPEN( IWRITE, WRITE_FNAME, MMIO_WRITE, ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A,A,A)' )'fcmmio: MMIOF_OPEN returns ', & STR(1:LNSTR(STR)), ' for write_file ', & WRITE_FNAME(1:LNSTR(WRITE_FNAME)) IF( ISTAT .EQ. MMIO_ERR )STOP '*** fcmmio: ERROR' ICT = 1 10 CONTINUE C *** Begin infinite loop, reading CTs, to be exited when we C *** reach EOF on input: C *** Get the next CT header line: CALL MMIOF_GET_CT( IREAD, CT_TYPE_REQUESTED, NATOM, TITLE, & ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A,A,I5)' )'fcmmio: MMIOF_GET_CT returns ', & STR(1:LNSTR(STR)), ' for ict= ', ICT IF( ISTAT .EQ. MMIO_ERR )STOP '*** fcmmio: ERROR' WRITE( 6, '(A,I5,A,A,A,A)' )' natom, title= ', & NATOM, ', ', '''', TITLE(1:LNSTR(TITLE)), '''' IF( ISTAT .EQ. MMIO_EOF )GOTO 20 C *** Put the header line on output: CT_TYPE = ISTAT CALL MMIOF_PUT_CT( IWRITE, CT_TYPE, NATOM, TITLE, ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A,A,I5)' )'fcmmio: MMIOF_PUT_CT returns ', & STR(1:LNSTR(STR)), ' for ict= ', ICT IF( ISTAT .EQ. MMIO_ERR )STOP '*** fcmmio: ERROR' C *** Alternately get and put atom info for each atom; this C *** interleaving of Get and Put is not a requirement of the C *** mmio library; rather, it was just the most convenient C *** way to write this application: DO 30 IATOM = 1, NATOM C *** Get: CALL MMIOF_GET_ATOM( IREAD, MMOD_IATOM, ITYPE, NBOND, & BOND_ATOM, BOND_ORDER, XYZ, CHARGE1, CHARGE2, CHAIN, & COLOR, RESNUM, RESNAME1, RESNAME4, PDBNAME, ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A,A,I5,I5)' )'fcmmio: MMIOF_GET_ATOM returns ', & STR(1:LNSTR(STR)), ' for iatom, mmio_iatom= ', IATOM, & MMOD_IATOM IF( ISTAT .EQ. MMIO_ERR )STOP '*** fcmmio: ERROR' C *** Put: CALL MMIOF_PUT_ATOM( IWRITE, MMOD_IATOM, ITYPE, NBOND, & BOND_ATOM, BOND_ORDER, XYZ, CHARGE1, CHARGE2, CHAIN, & COLOR, RESNUM, RESNAME1, RESNAME4, PDBNAME, ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A)' )'fcmmio: MMIOF_PUT_ATOM returns ', & STR(1:LNSTR(STR)) IF( ISTAT .EQ. MMIO_ERR )STOP '*** fcmmio: ERROR' 30 CONTINUE C *** Done with printing this CT; increment CT index: ICT = ICT + 1 C *** Close infinite loop. GOTO 10 C *** Branch here when EOF is found on input: 20 CONTINUE WRITE( 6, '(A,I5,A)' ) & 'fcmmio: ', ICT-1, ' CTs found in input file' C *** Try MMIOF_GET_CT again, just for fun; should return EOF: WRITE( 6, '(A)' ) & 'fcmmio: trying MMIOF_GET_CT again; should return EOF:' CALL MMIOF_GET_CT( IREAD, CT_TYPE_REQUESTED, NATOM, TITLE, & ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A)' )'fcmmio: MMIOF_GET_CT returns ', & STR(1:LNSTR(STR)) C *** Close input file (not really necessary under UNIX): WRITE( 6, '(A)' ) 'fcmmio: trying MMIOF_CLOSE for readfile' CALL MMIOF_CLOSE( IREAD, ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A)' )'fcmmio: MMIOF_CLOSE returns ', & STR(1:LNSTR(STR)) C *** Close output file (not really necessary under UNIX): WRITE( 6, '(A)' ) 'fcmmio: trying MMIOF_CLOSE for writefile' CALL MMIOF_CLOSE( IWRITE, ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A)' )'fcmmio: MMIOF_CLOSE returns ', & STR(1:LNSTR(STR)) C *** tell mmio to free up any allocated storage (not really C *** necessary under UNIX: CALL MMIOF_CLEANUP( ISTAT ) CALL MMIOF_RETURN_CODE( ISTAT, STR ) WRITE( 6, '(A,A)' )'fcmmio: MMIOF_CLEANUP returns ', & STR(1:LNSTR(STR)) C *** tell the world we've succeeded: WRITE( 6, '(A)' )'fcmmio: SUCCESSFUL COMPLETION' END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE USAGE() WRITE( 6, '(A)' )'Usage: fcmmio [-cf] ' END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC INTEGER FUNCTION LNSTR( STR ) C *** Function returning the index to the last character in a string which C *** is neither a blank nor an ASCII NUL; NULs sometimes arise C *** in C/Fortran string passing. C *** If string is all blanks or nulls, LNSTR returns 1, not zero; this C *** is to allow calling program to say, for example: C *** WRITE( 6, '(A)' ) STR(1:LNSTR(STR)) C *** Original version: Peter Shenkin, March, 1993 IMPLICIT NONE C *** dummy vars: CHARACTER*(*) STR C *** local vars: INTEGER I, L L = LEN( STR ) DO 10 I = L, 1, -1 IF( STR(I:I).NE.' ' .AND. ICHAR(STR(I:I)).NE.0 )THEN LNSTR = I RETURN ENDIF 10 CONTINUE C *** we get here only if all chars were either blank or ASCI-NUL: STR = ' ' LNSTR = 1 END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC