      SUBROUTINE PRETRD (CSTMX,NCSTMX)        
C        
C     PRETRD SETS UP EVENTUAL CALLS TO TRANSD.  FOR A MODULE TO USE     
C     TRANSD A CALL TO PRETRD MUST BE INITIATED BY THE MODULE DRIVER    
C     ONCE AND ONLY ONCE.  CSTMX IS ARRAY OF COORDINATE SYSTEM        
C     TRANSFORMATION MATRICES AND MCSTMX IS THE LENGTH OF THIS ARRAY.   
C        
C     THE ARRAY CSTMX MUST BE WITHIN OPEN CORE BOUND, AND THERE IS NO   
C     CHECK ON THIS CONDITION.        
C        
C     GIVEN THE ECPT ARRAY OF LENGTH 4, THE FIRST WORD BEING AN INTEGER 
C     COORDINATE SYSTEM IDENTIFICATION NUMBER AND THE NEXT WORDS BEING  
C     THE REAL COORDINATES OF A POINT IN BASIC COORDINATES, THIS ROUTINE
C     COMPUTES THE TRANSFORMATION (DIRECTION COSINE) MATRIX TA WHICH    
C     WILL MAP A VECTOR FROM THE LOCAL SYSTEM LABELED ECPT(1) TO BASIC  
C     COORDINATES.  TA IS A DOUBLE PRECISION MATRIX.        
C        
C     REVISED  7/92 BY G.CHAN/UNISYS. NEW REFERENCE TO CSTM ARRAY SUCH  
C     THAT THE SOURCE CODE IS UP TO ANSI FORTRAN 77 STANDARD.        
C        
      INTEGER          OFFSET        
      DOUBLE PRECISION TA(9),TL(9),XN(3),X,Y,Z,R,KE(9),XL        
      DIMENSION        CSTMX(1),ECPT(4)        
CZZ   COMMON /XNSTRN/  CSTM(1)        
      COMMON /ZZZZZZ/  CSTM(1)        
      EQUIVALENCE      (FL1,INT1),(FL2,INT2)        
C        
      NCSTM  = NCSTMX        
      OFFSET = LOCFX(CSTMX(1)) - LOCFX(CSTM(1))        
      IF (OFFSET .LT. 0) CALL ERRTRC ('PRETRD  ',1)        
      ICHECK = 123456789        
      RETURN        
C        
C        
      ENTRY TRANSD (ECPT,TA)        
C     ======================        
C        
      FL1 = ECPT(1)        
      IF (INT1 .EQ. 0) GO TO 90        
      IF (ICHECK .NE. 123456789) CALL ERRTRC ('PRETRD  ',10)        
      DO 10 J = 1,NCSTM,14        
      I   = J + OFFSET        
      FL2 = CSTM(I)        
      IF (INT1 .NE. INT2) GO TO 10        
      KK  = I        
      FL2 = CSTM(I+1)        
      GO TO (20,40,40), INT2        
   10 CONTINUE        
C        
C     THE COORDINATE SYSTEM ID. COULD NOT BE FOUND IN THE CSTM.        
C        
      CALL MESAGE (-30,25,INT1)        
C        
C     THE COORDINATE SYSTEM IS RECTANGULAR.        
C        
   20 DO 30 J = 1,9        
      K = KK + 4 + J        
   30 TA(J) = CSTM(K)        
      RETURN        
C        
   40 XN(1) = ECPT(2) - CSTM(KK+2)        
      XN(2) = ECPT(3) - CSTM(KK+3)        
      XN(3) = ECPT(4) - CSTM(KK+4)        
      X = CSTM(KK+5)*XN(1) + CSTM(KK+ 8)*XN(2) + CSTM(KK+11)*XN(3)      
      Y = CSTM(KK+6)*XN(1) + CSTM(KK+ 9)*XN(2) + CSTM(KK+12)*XN(3)      
      Z = CSTM(KK+7)*XN(1) + CSTM(KK+10)*XN(2) + CSTM(KK+13)*XN(3)      
      R = DSQRT(X**2+Y**2)        
      IF (R .EQ. 0.0D0) GO TO 20        
      DO 50 J = 1,9        
      K = KK + 4 + J        
   50 KE(J) = CSTM(K)        
      GO TO (60,60,70), INT2        
C        
C     THE COORDINATE SYSTEM IS CYLINDRICAL.        
C        
   60 TL(1) = X/R        
      TL(2) =-Y/R        
      TL(3) = 0.0D0        
      TL(4) =-TL(2)        
      TL(5) = TL(1)        
      TL(6) = 0.0D0        
      TL(7) = 0.0D0        
      TL(8) = 0.0D0        
      TL(9) = 1.0D0        
      GO TO 80        
C        
C     THE COORDINATE SYSTEM IS SPHERICAL.        
C        
   70 XL = DSQRT(X*X + Y*Y + Z*Z)        
      TL(1) = X/XL        
      TL(2) = (X*Z)/(R*XL)        
      TL(3) =-Y/R        
      TL(4) = Y/XL        
      TL(5) = (Y*Z)/(R*XL)        
      TL(6) = X/R        
      TL(7) = Z/XL        
      TL(8) =-R/XL        
      TL(9) = 0.0D0        
   80 CALL GMMATD (KE(1),3,3,0, TL(1),3,3,0, TA(1))        
      RETURN        
C        
C     THE LOCAL SYSTEM IS BASIC.        
C        
   90 DO 100 I = 1,9        
  100 TA(I) = 0.0D0        
      TA(1) = 1.0D0        
      TA(5) = 1.0D0        
      TA(9) = 1.0D0        
      RETURN        
      END        
