calcmac.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	calcmac (neq, z, zz, nev, xmac, xmaccpx, istartnmd, iendnmd, nmd, cyclicsymmetry, neqact, bett, betm)

Function/Subroutine Documentation

calcmac()

subroutine calcmac	(	integer	neq,
		real*8, dimension(neq,*)	z,
		real*8, dimension(2*neqact,*)	zz,
		integer	nev,
		real*8, dimension(nev,*)	xmac,
		complex*16, dimension(nev,*)	xmaccpx,
		integer, dimension(*)	istartnmd,
		integer, dimension(*)	iendnmd,
		integer	nmd,
		integer	cyclicsymmetry,
		integer	neqact,
		real*8, dimension(*)	bett,
		real*8, dimension(*)	betm
	)

!     
!     calculates the Modal Assurance Criterium MAC=<z,zz>/(||z||*||zz||)
!     
      implicit none
!     
      integer neq,nev,i,j,k,l,istartnmd(*),iendnmd(*),nmd,
     &     cyclicsymmetry,neqact
!     
      real*8 bett(*),betm(*),xmac(nev,*),z(neq,*),zz(2*neqact,*)
!     
      complex*16 xmaccpx(nev,*)
!     
      if(cyclicsymmetry.eq.0)then
!     size of vectors
         do i=1,nev
            do k=1,neq
               bett(i)=bett(i)+z(k,i)**2
               betm(i)=betm(i)+zz(k,i)**2+zz(k+neq,i)**2
            enddo
         enddo
         do i=1,nev
            bett(i)=dsqrt(bett(i))
            betm(i)=dsqrt(betm(i)) 
         enddo
!     Calculation of MAC
         do i=1,nev
            do j=1,nev
               do k=1,neq  
                  xmaccpx(i,j)=xmaccpx(i,j)+z(k,i)
     &                 *(zz(k,j)+zz(k+neq,j)*(0.d0,1.d0))
               enddo
               xmac(i,j)=cdabs(xmaccpx(i,j))
               xmac(i,j)=xmac(i,j)/bett(i)/betm(j)
            enddo
         enddo
!     
!     Cyclic Symmetry
!     size of vectors
!     
      else
         do i=1,nev
            do k=1,neqact
               bett(i)=bett(i)+z(k,i)**2+z(k+neqact,i)**2
               betm(i)=betm(i)+zz(k,i)**2+zz(k+neqact,i)**2
            enddo
            bett(i)=dsqrt(bett(i))
            betm(i)=dsqrt(betm(i))
         enddo
!     Calculation of MAC
         do l=1,nmd
            do i=istartnmd(l),iendnmd(l)
               do j=istartnmd(l),iendnmd(l)
                  xmac(i,j)=0
                  do k=1,neqact,2
                     xmaccpx(i,j)=xmaccpx(i,j)+
     &                    (z(k,i)-z(k+neqact,i)*(0.d0,1.d0))*
     &                    (zz(k,j)+zz(k+neqact,j)*(0.d0,1.d0))
                  enddo
                  xmac(i,j)=cdabs(xmaccpx(i,j))
                  xmac(i,j)=(xmac(i,j))/bett(i)/betm(j)
               enddo
            enddo
         enddo
      endif
!     
      return