Fundamental Technologies

Ulysses HISCALE Pages

Appendix 9 Geometric Factor Study for the Deflected and Unscattered Electrons of HISCALE (Buckley MS Thesis continued)

 

*				PROGRAM I.14				      *
*******************************************************************************
*                                 POLY                                        *
* THIS PROGRAM READS THE COORDINATES OF THE PLANES THAT ARE TO BE TESTED      *
* FROM A FILE AND COMPUTES THE COEFFICIENTS A,B,C,D OF THE CORRESPONDING PLANE*
* BY CALLING THE ROUTINE 'PLANECOEFF'. THESE PLANES FORM THE GEOMETRY OF THE  *
* SENSOR.                                                                     *
*******************************************************************************
      PROGRAM POLYIN
      IMPLICIT NONE
      CHARACTER*72 FNAME
      INTEGER I,I1,I2,J,K,M,MAXCOO,MAXSURF,NCOL,NERR,NVERT,NTY
      PARAMETER (MAXCOO=55,MAXSURF=55)
      REAL*8 A,B,C,CHAN(MAXSURF,MAXCOO),COEFF(MAXSURF,4),D,VERT(35,3)
      INTEGER NV(MAXSURF)
      OPEN (UNIT=2,STATUS='NEW',FILE='COEFF.DAT')
      WRITE(6,*) 'ENTER THE NAME OF THE FILE OF COORDINATES'
      READ(5,10) FNAME
      OPEN (UNIT=1,STATUS='OLD',FILE=FNAME)  
      READ (1,*)
2     READ(1,*,END=70) NTY
      READ(1,*) NVERT
      CHAN(NTY,1) = DFLOAT(NVERT)
      I1=2
3     READ(1,20,ERR=2) (CHAN(NTY,K),K=I1,I1+2)
      WRITE (6,*) (CHAN(NTY,M),M=1,3)
      I1=K
      GO TO 3
70    CLOSE(1)
      

C  TO INITIALISE THE ARRAY WITH THE COORDINATES TO FIND THE COEFFICIENTS
      DO I=1,NTY
       I1 = 2 
       NVERT = IDINT(CHAN(I,1))
       NCOL = NVERT*3 + 1
       J = 1
       DO I2=1,NVERT
        DO WHILE ((J .LE. 3) .AND. (I1 .LE. NCOL))
         VERT(I2,J) = CHAN(I,I1)
         J = J+1
         I1 = I1+1
        END DO
        J = 1
       END DO
       CALL PLANECOEFF(I,VERT,NVERT,A,B,C,D,NERR)
C  TO INITIALISE THE ARRAY COEFF WITH THE COEFFICIENTS OF THE PLANE
       COEFF(I,1) = A
       COEFF(I,2) = B
       COEFF(I,3) = C
       COEFF(I,4) = D
       WRITE(2,30) I,NVERT,(COEFF(I,J),J=1,4)
       DO J=1,3
        VERT(I,J) = 0.0D0
       END DO
      END DO
  
 10   FORMAT(A72)
 20   FORMAT(3(X,F9.6))
 30   FORMAT(1X,I3,1X,I3,4(1X,D13.6))
      STOP
      END
C---------------------------------------------------------------
      SUBROUTINE PLANECOEFF(I,VE,NVERT,A,B,C,D,NERR)
      IMPLICIT NONE
      INTEGER I,K,I2,J,NERR,NVERT
      REAL*8 A,B,C,D,DIF,TOL,VE(35,3)
      DATA TOL/1.0D-03/
      
      A=0.D0
      B=0.D0
      C=0.D0
      D=0.D0
C     SOLVE THE COFACTORS OF A DETERMINANT TO GET A,B,C,D
      DO K=1,3
         IF (K.NE.3) THEN
            J=K+1
         ELSE
            J=1
         END IF
         A=A+(VE(K,2)*VE(J,3)-VE(K,3)*VE(J,2))
         B=B+(VE(K,3)*VE(J,1)-VE(K,1)*VE(J,3))
         C=C+(VE(K,1)*VE(J,2)-VE(K,2)*VE(J,1))
      END DO
      D=VE(1,1)*(VE(2,3)*VE(3,2)-VE(3,3)*VE(2,2))
      D=D+VE(1,2)*(VE(2,1)*VE(3,3)-VE(3,1)*VE(2,3))
      D=D+VE(1,3)*(VE(2,2)*VE(3,1)-VE(2,1)*VE(3,2))
C     TEST IF THE REST OF THE VERTICES LIE IN THE PLANE
C
      K=4
      DO WHILE (K.LE.NVERT.AND.DIF.LE.TOL)
         DIF=DABS(A*VE(K,1)+B*VE(K,2)+C*VE(K,3)+D)
         WRITE (6,*) 'PLANE #: ',I,'VERTEX #: ',K,' DIF: ',DIF
         K=K+1
      END DO
      IF (DIF.LE.TOL) THEN
         NERR=0
	 WRITE(6,*) 'PLANE',I,'FOR VERTEX',K,'CORRECT.'
      ELSE
         NERR=1
         WRITE(6,*) 'ERROR IN THE COEFFICIENTS OF PLANE:',I
	 WRITE(6,*) 'VERTEX #:',K
      END IF
      RETURN
      END