matmul.f 3.15 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
      MODULE m_matmul
!
! makes a matrix-matrix multiplication for 3x3 matrices A and B
! whereby      A       B
!            integer  integer  ... matmul1
!            real     real     ... matmul2
!            integer  real     ... matmul3
! additionally, integer rotation matrices + nonsymmorphic 
! translations can be multiplied in matmul4
!
      CONTAINS
!--------------------------------------------------------
      SUBROUTINE matmul1 (ma,mb,mc)

      IMPLICIT NONE
      INTEGER, INTENT (IN) :: ma(3,3)
      INTEGER, INTENT (IN) :: mb(3,3)
      INTEGER, INTENT (OUT):: mc(3,3)

      INTEGER :: i,j,k

      INTEGER x
      DO i=1,3
         DO k=1,3
         x = 0
            DO j=1,3
               x = x + ma(i,j)*mb(j,k)
            ENDDO
         mc(i,k) = x
         END DO
      END DO

      END SUBROUTINE matmul1
!--------------------------------------------------------
      SUBROUTINE matmul2 (a,b,c)

      IMPLICIT NONE
      REAL,    INTENT (IN) :: a(3,3)
      REAL,    INTENT (IN) :: b(3,3)
      REAL,    INTENT (OUT):: c(3,3)

      INTEGER :: i,j,k
      REAL x
      DO i=1,3
         DO k=1,3
         x=0.e0
            DO j=1,3
               x = x + a(i,j)*b(j,k)
            ENDDO
         c(i,k) = x
         END DO
      END DO

      END SUBROUTINE matmul2
!--------------------------------------------------------
      SUBROUTINE matmul3 (ma,b,c)

      IMPLICIT NONE
      INTEGER, INTENT (IN) :: ma(3,3)
      REAL,    INTENT (IN) ::  b(3,3)
      REAL,    INTENT (OUT)::  c(3,3)

      INTEGER :: i,j,k
      REAL x
      DO i=1,3
         DO k=1,3
         x=0.e0
            DO j=1,3
               x = x + ma(i,j)*b(j,k)
            ENDDO
         c(i,k) = x
         END DO
      END DO

      END SUBROUTINE matmul3
!--------------------------------------------------------
      SUBROUTINE matmul3r (ma,b,c)

      REAL, INTENT (IN) :: ma(3,3)
      REAL, INTENT (IN) ::  b(3,3)
      REAL, INTENT (OUT)::  c(3,3)

      INTEGER :: i,j,k
      REAL x
      DO i=1,3
         DO k=1,3
         x=0.e0
            DO j=1,3
               x = x + ma(i,j)*b(j,k)
            ENDDO
         c(i,k) = x
         END DO
      END DO
      RETURN
      END SUBROUTINE matmul3r
!--------------------------------------------------------
      SUBROUTINE matmul4 (ma,ta,mb,tb,mc,tc)

      IMPLICIT NONE
      INTEGER, INTENT (IN) :: ma(3,3),mb(3,3)
      REAL,    INTENT (IN) :: ta(3),tb(3)
      INTEGER, INTENT (OUT):: mc(3,3)
      REAL,    INTENT (OUT):: tc(3)

      INTEGER :: i,j,k
      REAL x,xa(4,4),xb(4,4),xc(4,4)

      xa(:,:) = 0.0 ; xa(4,4) = 1.0 ; xb(:,:) = xa(:,:)
      xa(1:3,1:3) = real(ma(1:3,1:3)) ; xa(1:3,4) = ta(:) 
      xb(1:3,1:3) = real(mb(1:3,1:3)) ; xb(1:3,4) = tb(:)
      DO i=1,4
         DO k=1,4
         x=0.e0
            DO j=1,4
               x = x + xa(i,j)*xb(j,k)
            ENDDO
         xc(i,k) = x
         END DO
      END DO
      mc(1:3,1:3) = nint(xc(1:3,1:3)) ; tc(:) = xc(1:3,4) 
      DO i = 1,3
        IF (tc(i).GT.1.0) THEN
          tc(i) = tc(i) - int(tc(i))
        ELSEIF (tc(i).LT.0.0) THEN
          tc(i) = tc(i) + int(tc(i)) + 1
        ENDIF
      ENDDO

      END SUBROUTINE matmul4

      END MODULE m_matmul