ms2dot.f

来自「最经典的分子对结软件」· F 代码 · 共 156 行

      PROGRAM MS2DOT

**********************************************************
* program to convert connolly file to sybyl surface file (ACG)
**********************************************************

      INTEGER D1, D2, D3, D4, B, ERR
      INTEGER COLOR, STATUS
      INTEGER I,J

      REAL * 8 COORD(3), MATRIX(4,4)
     
      CHARACTER * 80 TEXT, CRAP, INFILE, OUTFILE
      CHARACTER * 1 ATOM_TEST


      EXTERNAL XWOPEN
      EXTERNAL XWBGNDYN
      EXTERNAL XWPOINT
      EXTERNAL XWCLOSE
*      EXTERNAL XWARBDAT
 
************************************
* determine surface color
************************************

      WRITE(6,*) 'Enter the name of the MS surface file (UCSF format):'
      READ(5,'(A)') INFILE
      WRITE(6,*) 'Enter the name for the SYBYL dot file output:'
      READ(5,'(A)') OUTFILE
      WRITE(6,*) 'Choose a color:'
      WRITE(6,*) '    0.  green'
      WRITE(6,*) '    1.  cyan'
      WRITE(6,*) '    2.  blue'
      WRITE(6,*) '    3.  magenta'
      WRITE(6,*) '    4.  purple'
      WRITE(6,*) '    5.  red'
      WRITE(6,*) '    6.  orange'
      WRITE(6,*) '    7.  yellow'
      WRITE(6,*) '    8.  white'
      WRITE(6,*) '    9.  green-blue'
      WRITE(6,*) '   10.  red-orange'
      WRITE(6,*) '   11.  violet'
      WRITE(6,*) '   12.  invisible'
      WRITE(6,'($,A)') ' Your choice: '
      READ(5,*) COLOR
      COLOR=MAX(0,COLOR)


************************************
* initialize rotation matrix
************************************

      DO I = 1, 4

         DO J = 1, 4

            IF (I .EQ. J) THEN 
               MATRIX (I,J) = 1.00
            ELSE
               MATRIX (I,J) = 0.00
            END IF

         END DO

       END DO


************************
* open sybyl dot file
************************


       CALL XWOPEN (STATUS,OUTFILE,0)


********************************************************************
* write molecule name to file - here '<unnamed>' -  also write color
* here arbitary 'red'
********************************************************************

       CALL XWARBDAT (STATUS,10,'<unnamed>')

       CALL XWARBDAT (STATUS,3,'RED')


***************************
* allocate dynamic segment 
***************************

       CALL XWBGNDYN (STATUS,0,MATRIX)
       

************************
* open connolly file
************************

        OPEN (UNIT=10, STATUS='OLD', FORM = 'FORMATTED', ACCESS =
     &  'SEQUENTIAL', FILE = INFILE)


*****************************************************
* read line of input data - quit if end is reached
*****************************************************

1000    READ (10,'(A40,A1)',END=2000) CRAP, ATOM_TEST


************************
* test for atom record
************************

        IF (ATOM_TEST .EQ. 'A') THEN

***********************************
* do nothing and go to next record
***********************************

        ELSE

*****************************************
* read coordinate data for surface point
*****************************************

           BACKSPACE(10)
           READ(10,'(A13,F8.4,1X,F8.4,1X,F8.4)') CRAP, COORD(1),
     &                                      COORD(2), COORD(3) 



******************************
* write data to sybyl file
******************************

        CALL XWPOINT (STATUS,COLOR,COORD,0)

**************************************
* repeat unless end of file detected
**************************************


        END IF

        GOTO 1000


***************
* close files 
***************

2000    CLOSE (UNIT = 10)

        CALL XWCLOSE(STATUS)

        END