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: mmio_uncompress.f,v $
C *** $Revision: 1.5 $
C *** $Date: 1996/05/28 19:20:48 $
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      PROGRAM MMIO_UNCOMPRESS
C     *** pss. 1/95.  Didactic example.
C     *** Read an MMIO file, possibly containing compressed structures,
C     ***  from stdin; write corresponding full structures on stdout.
C     *** Report any error messages on stderr (Fortran IO unit 0).

      IMPLICIT NONE
      INCLUDE 'mmio.inc'

      CHARACTER*(MMIO_L_STRLEN) FNAME, STR
      INTEGER ISTAT, IATOM, IBOND

      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     *** tell MMIOF to report errors, if any, to IO-unit 0:
      CALL MMIO_ERRFILE( 0 )

C     *** open files for reading and writing, specifying stdin and stdout
C     ***  by means of the special name '-'; FNAME, the variable that is 
C     ***  passed to MMIO_OPEN, must be declared as CHARACTER*(MMIO_L_STRLEN):
      FNAME = '-'
      CALL MMIO_OPEN( IREAD, FNAME, MMIO_READ, ISTAT )
      IF( ISTAT .EQ. MMIO_ERR )STOP '*** MMIO_OPEN fails for stdin'
      CALL MMIO_OPEN( IWRITE, FNAME, MMIO_WRITE, ISTAT )
      IF( ISTAT .EQ. MMIO_ERR )STOP '*** MMIO_OPEN fails for stdout'

C     *** Begin infinite loop, to be exited when EOF is detected on input:
10    CONTINUE

C       *** Read the next CT and return header info:
        CALL MMIO_GET_CT( IREAD, MMIO_FULL, NATOM, TITLE, ISTAT )
C       *** check for EOF or ERR:
        IF( ISTAT .EQ. MMIO_EOF )GOTO 30
        IF( ISTAT .EQ. MMIO_ERR )STOP '*** MMIO_GET_CT fails'

C       *** Prepare to output a CT:
        CALL MMIO_PUT_CT( IWRITE, MMIO_FULL, NATOM, TITLE, ISTAT )
        IF( ISTAT .EQ. MMIO_ERR )STOP '*** MMIO_PUT_CT fails'

C       *** Get and put atom info for each atom:
        DO 20 IATOM = 1, NATOM

C         *** Get:
          CALL MMIO_GET_ATOM( IREAD, MMOD_IATOM, ITYPE, NBOND,
     &     BOND_ATOM, BOND_ORDER, XYZ, CHARGE1, CHARGE2, CHAIN,
     &     COLOR, RESNUM, RESNAME1, RESNAME4, PDBNAME, ISTAT ) 
          IF( ISTAT .EQ. MMIO_ERR )STOP '*** MMIO_GET_ATOM fails'

C         *** Put:
          CALL MMIO_PUT_ATOM( IWRITE, MMOD_IATOM, ITYPE, NBOND,
     &     BOND_ATOM, BOND_ORDER, XYZ, CHARGE1, CHARGE2, CHAIN,
     &     COLOR, RESNUM, RESNAME1, RESNAME4, PDBNAME, ISTAT ) 
          IF( ISTAT .EQ. MMIO_ERR )STOP '*** MMIO_PUT_ATOM fails'

20      CONTINUE

C     *** Get next CT from file; ends infinite loop:
      GOTO 10

C     *** Branch to here when EOF is found in input file:
30    CONTINUE

      END

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC