SUBROUTINE TTTT(N,ALPHA,A,G,NAT,ICO,R)
C     Transforms A and G to local origins (ICO=1) or common origin (ICO=2);
C     sets A and G to zero for ICO=3.
C     R supposed to be passed in in A
C
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER*4 (I-N)
      PARAMETER (MX=600)
      DIMENSION ALPHA(N,3,3),G(N,3,3),A(N,3,3,3),R(3,NAT),X(3,MX)
C
C     transfer into atomic coordinates:
      DO 5 I=1,3
      DO 5 J=1,NAT
5     X(I,J)=R(I,J)/0.529177D0
C
      IF(ICO.EQ.1)SIGN=1.0
      IF(ICO.EQ.2)SIGN=-1.0
      IF(ICO.EQ.3)SIGN=0.0
      W=1.0
C     supposedly the static limit G/w is calculated
C
      DO 2 IA=1,3
      DO 2 IB=1,3
      DO 2 L=1,NAT
      DO 2 IE=1,3
      IIND=3*(L-1)+IE
      SUM=0.0
      DO 1 IG=1,3
      DO 1 ID=1,3
1     SUM=SUM+SIGN*(0.5*W)*EPS(IB,IG,ID)*X(IG,L)*ALPHA(IIND,IA,ID)
      G(IIND,IA,IB)=G(IIND,IA,IB)+SUM
      IF(ICO.EQ.3)G(IIND,IA,IB)=0.0
2     CONTINUE
      IF(ICO.EQ.1)WRITE(3,*)' G transformed into atomic origins'
      IF(ICO.EQ.2)WRITE(3,*)' G transformed into common origin'
      IF(ICO.EQ.3)WRITE(3,*)' G set to zero'
C
      DO 3 IA=1,3
      DO 3 IB=1,3
      DO 3 IC=1,3
      DO 3 L=1,NAT
      DO 3 IE=1,3
      IIND=3*(L-1)+IE
      SUM=0.0
      IF(IB.EQ.IC)THEN
       DO 4 ID=1,3
4      SUM=SUM+X(ID,L)*ALPHA(IIND,IA,ID)*SIGN
      ENDIF
      A(IIND,IA,IB,IC)=A(IIND,IA,IB,IC)+SUM
     1-1.5*SIGN*(X(IB,L)*ALPHA(IIND,IA,IC)+X(IC,L)*ALPHA(IIND,IA,IB))
      IF(ICO.EQ.3)A(IIND,IA,IB,IC)=0.0
3     CONTINUE
      IF(ICO.EQ.1)WRITE(3,*)' A transformed into atomic origins'
      IF(ICO.EQ.2)WRITE(3,*)' A transformed into common origin'
      IF(ICO.EQ.3)WRITE(3,*)' A set to zero'
      RETURN
      END