
C **********************************************************************
C  READPDB.F       ADDED TEMPERATURE MAR 02 ARDEAN LEITH
C
C **********************************************************************
C=*                                                                    *
C=* This file is part of:   SPIDER - Modular Image Processing System.  *
C=* SPIDER System Authors:  Joachim Frank & ArDean Leith               *
C=* Copyright 1985-2010  Health Research Inc.,                         *
C=* Riverview Center, 150 Broadway, Suite 560, Menands, NY 12204.      *
C=* Email: spider@wadsworth.org                                        *
C=*                                                                    *
C=* SPIDER is free software; you can redistribute it and/or            *
C=* modify it under the terms of the GNU General Public License as     *
C=* published by the Free Software Foundation; either version 2 of the *
C=* License, or (at your option) any later version.                    *
C=*                                                                    *
C=* SPIDER is distributed in the hope that it will be useful,          *
C=* but WITHOUT ANY WARRANTY; without even the implied warranty of     *
C=* merchantability or fitness for a particular purpose.  See the GNU  *
C=* General Public License for more details.                           *
C=* You should have received a copy of the GNU General Public License  *
C=* along with this program. If not, see <http://www.gnu.org/licenses> *
C=*                                                                    *
C **********************************************************************
C 
C  READPDM
C
C  PURPOSE:  READ PDB FILE, GET COORDINATES,
C            GENERATE A 3-D SPIDER FORMAT VOLUME
C 
C **********************************************************************

	SUBROUTINE READPDB
	
        INCLUDE 'CMBLOCK.INC'
        INCLUDE 'CMLIMIT.INC'

	REAL, ALLOCATABLE, DIMENSION(:,:,:) ::  BUF
        CHARACTER(LEN=MAXNAM):: PDBFILE,SPIDERFILE,RECLIN
        CHARACTER(LEN=10)::     HEAD*10
        CHARACTER(LEN=3)::      ATOM*3
        CHARACTER(LEN=1)::      NULL,CENTER,CTEMP
	LOGICAL ::              ZNUM,TEMP

	ZNUM = .FALSE.
	NATOM = 0
	TMASS = 0.0
   	NULL  = CHAR(0)
        LUN1  = 8
	LUN2  = 10
	XMAX  = -1.0E23
	XMIN  = 1.0E23
	YMAX  = -1.0E23
	YMIN  = 1.0E23
	ZMAX  = -1.0E23
	ZMIN  = 1.0E23
	UX    = 0.0
	UY    = 0.0
	UZ    = 0.0
	
C       OPEN PDB FILE (WHICH IS READABLE ASCII) AS FORMATTED SEQ.       
        LENREC = 0
        CALL OPAUXFILE(.TRUE.,PDBFILE,NULL,LUN1,LENREC,'O',
     &                 'PDB INPUT',.TRUE.,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

15	READ(LUN1,20) RECLIN
20	FORMAT(A80)

C       GET MIN AND MAX OF X,Y,Z  AND CALCULATE OFFSET

35	IF (RECLIN(1:4) .EQ. 'ATOM') THEN
	   READ (RECLIN,50) HEAD,ATOM,X,Y,Z,OCCUPANCY,TEMPERATURE
	   IF (OCCUPANCY .GT. 1.0 ) ZNUM = .TRUE.

C          COORDINATE SYSTEM IS DIFFERENT IN O AND SPIDER 
           W = X
           X = Y
           Y = W
           Z = -Z

	   XMAX=AMAX1(XMAX,X)
	   XMIN=AMIN1(XMIN,X)
	   YMAX=AMAX1(YMAX,Y)
	   YMIN=AMIN1(YMIN,Y)
	   ZMAX=AMAX1(ZMAX,Z)
	   ZMIN=AMIN1(ZMIN,Z)
           UX=UX+X
           UY=UY+Y
           UZ=UZ+Z
           NATOM=NATOM+1
	   GOTO 15

	ELSEIF (RECLIN(1:3) .NE. 'END') THEN
	   GOTO 15
	ENDIF

        IF (NATOM .LE. 0)  THEN
          CALL ERRT(101,'NO ATOMS IN THE PDB FILE',NE)
          GOTO 9999
        ENDIF

C       SET CELL DIMENSION

	SX=(XMAX-XMIN)+3.0
	SY=(YMAX-YMIN)+3.0
	SZ=(ZMAX-ZMIN)+3.0
	WRITE(NOUT,*)' CELL SIZE: ',SX,SY,SZ

	REWIND   LUN1

C       INPUT SAMPLE SIZE
        TEMP = .FALSE.
	CALL RDPRM(PIXEL,NOT_USED,'PIXEL SIZE [A]')

        CALL RDPRMC(CENTER,NCHAR,.TRUE.,'CENTER (Y/N)?',NULL,IRTFLG)
	IF (CENTER .NE. 'Y')  THEN
          UX=0.0
          UY=0.0
          UZ=0.0
        ELSE
          UX=UX/NATOM
          UY=UY/NATOM
          UZ=UZ/NATOM
        ENDIF

        CALL RDPRMC(CTEMP,NCHAR,.TRUE.,
     &      'ATOMS OR TEMPERATURE (A/T)?',NULL,IRTFLG)
	TEMP = (CTEMP .EQ. 'T')
 
	NX = NINT(SX/PIXEL)+1
	NY = NINT(SY/PIXEL)+1
	NZ = NINT(SZ/PIXEL)+1
	WRITE(NOUT,506) NX,NY,NZ
506	FORMAT(' Minimum size of the volume: ',3I6)

        CALL RDPRI3S(NX,NY,NZ,NOT_USED,'VOLUME NX, NY & NZ',IRTFLG)

	ALLOCATE(BUF(NX,NY,NZ),STAT=IRTFLG)
	IF (IRTFLG.NE.0) THEN
           CALL  ERRT(46,'CP FROM PDB, BUF',IER)
           GOTO 9997
        ENDIF
	
	I=NX/2+1
	XOFFSET=PIXEL*I
	I=NY/2+1
	YOFFSET=PIXEL*I
	I=NZ/2+1
	ZOFFSET=PIXEL*I
	
C       CHECK IF THE VOLUME IS LARGE ENOUGH TO CONTAIN THE OBJECT
        IF (XMIN-UX .LT. (-1.*XOFFSET) .OR. YMIN-UY .LT. (-1.*YOFFSET)
     &              .OR. ZMIN-UZ .LT. (-1.*ZOFFSET)) THEN
            CALL ERRT(101,'VOLUME TOO SMALL TO CONTAIN OBJECT',NE)
            GOTO 9997
        ENDIF
 
        TMPX=FLOAT(NX-1)*PIXEL-XOFFSET
        TMPY=FLOAT(NY-1)*PIXEL-YOFFSET
        TMPZ=FLOAT(NZ-1)*PIXEL-ZOFFSET
        IF (XMAX-UX .GT. TMPX .OR. YMAX-UY .GT. TMPY
     &              .OR. ZMAX-UZ .GT. TMPZ) THEN
            CALL ERRT(101,'VOLUME TOO SMALL TO CONTAIN OBJECT.',NE)
            GOTO 9997
        ENDIF

C       ZERO WHOLE BUF
        BUF = 0.0

        IFORM = 3
        MAXIM = 0
        CALL OPFILEC(0,.TRUE.,SPIDERFILE,LUN2,'U',IFORM,
     &              NX,NY,NZ, MAXIM,'SPIDER OUTPUT', .FALSE.,IRTFLG)
	IF (IRTFLG .EQ. 1) GOTO 9997
	
C       READ IN ATOMS
        NATOM = 0
        TMAX = -100

40	CONTINUE
	READ(LUN1,20) RECLIN
	IF (RECLIN(1:4) .EQ. 'ATOM' ) THEN
 	   READ(RECLIN,50)HEAD,ATOM,X,Y,Z,OCCUPANCY,TEMPERATURE
50	   FORMAT(A6,5X,1X,A3,2X,3X,1X,1X,4X,1X,3X,3F8.3,2F6.2)	
C	   WRITE(NOUT,*)'ATOM #',NATOM,'  ',ATOM,' AT ',X,Y,Z,
C    &                    OCCUPANCY,TEMPERATURE

	     IF (TEMP) THEN
                VATOM = TEMPERATURE
                TMAX  = MAX(TMAX,TEMPERATURE)

	     ELSEIF (.NOT. ZNUM) THEN
		IF (ATOM(2:2) .EQ. 'H') THEN
		   VATOM=1.0
		ELSEIF (ATOM(2:2) .EQ. 'C') THEN
		   VATOM=6.0
		ELSEIF (ATOM(2:2) .EQ. 'N') THEN
		   VATOM=7.0
		ELSEIF (ATOM(2:2) .EQ. 'O') THEN
		   VATOM=8.0
	        ELSEIF (ATOM(2:2) .EQ. 'S') THEN
		   VATOM=16.0
		ELSEIF (ATOM(2:2) .EQ. 'P') THEN
		   VATOM=15.0
		ELSEIF (ATOM(2:2) .EQ. 'X' .AND. ATOM(1:3) .EQ. 'OXT')
     &             THEN
C                  TRNA THREE PRIME TERMINAL
		   VATOM=8.0
		ELSE
		   WRITE(NOUT, *) ' SPECIAL ATOM ENCOUNTERED IN: '
		   WRITE(NOUT,*) RECLIN 
	           GOTO 9997
		ENDIF
C	        VATOM = VATOM*OCCUPANCY
	     ELSE 
	        VATOM = OCCUPANCY
	     ENDIF

C            COORDINATE SYSTEM IS DIFFERENT IN O AND SPIDER 
	     W = X
	     X = Y
	     Y = W
	     Z = -Z

             X = X-UX
             Y = Y-UY
             Z = Z-UZ

C            TRILINEAR INTERPOLATION
	     IX = IFIX((X+XOFFSET)/PIXEL)
	     AX = (X+XOFFSET)/PIXEL-FLOAT(IX)
	     IY = IFIX((Y+YOFFSET)/PIXEL)
	     AY = (Y+YOFFSET)/PIXEL-FLOAT(IY)
	     IZ = IFIX((Z+ZOFFSET)/PIXEL)
	     AZ = (Z+ZOFFSET)/PIXEL-FLOAT(IZ)
             IF (TEMP) THEN
                BUF(IX,IY,IZ) = VATOM
             ELSE

                DO I3=1,0,-1
                   DO I2=1,0,-1
                     DO I1=1,0,-1
                        BUF(IX-I1+1,IY-I2+1,IZ-I3+1) =
     &                    BUF(IX-I1+1,IY-I2+1,IZ-I3+1)+
     &                    VATOM*(REAL(I1)-(2*I1-1)*AX)*
     &                    (REAL(I2)-(2*I2-1)*AY)*(REAL(I3)-(2*I3-1)*AZ)    
                     ENDDO 
                   ENDDO 
                 ENDDO 
             ENDIF

             NATOM = NATOM + 1
	     TMASS = TMASS + VATOM
	     GOTO 40

	  ELSEIF (RECLIN(1:3) .NE. 'END') THEN
	     GOTO 40
	  ENDIF

	 DO I=1,NZ
           DO J=1,NY
              CALL WRTLIN(LUN2,BUF(1,J,I),NX,(I-1)*NY+J)
           ENDDO
         ENDDO

         IF (TEMP) WRITE(NOUT,*)  ' MAX. TEMPERATURE:',TMAX

         WRITE(NOUT,8701)  NATOM,TMASS
8701     FORMAT(' NUMBER OF ATOMS PLACED: ',I8,
     &              '  TOTAL MASS:',1PE10.3)

9997     CLOSE(LUN2)
    	 IF (ALLOCATED(BUF)) DEALLOCATE(BUF) 
9999     CLOSE(LUN1)

	END

