org.eclipse.photran.core.vpg.tests/parser-test-code/reg_tests/bug118965.f90

module CmatProduct_m

use MatranUtil_m
use Cmat_m

implicit none



  real(wp), parameter :: ZERO = 0, ONE = 1

  interface Times
     module procedure CmTimesComplexScalarRm, CmTimesComplexScalarCm, &
     CmTimesRealScalarCm, CmTimesRealScalarRm
  end interface Times

!    interface operator(*)
!       module procedure RmTimesScalarRm_o, RmTimesRmScalar_o, &
!                        RmTimesRmRm_o
!    end interface
!
!    interface TimesXhy
!       module procedure RmTimesXhy
!    end interface TimesXhy
!
!    interface operator(.xhy.)
!       module procedure RmTimes_xhy
!    end interface
!
!    interface TimesXyh
!       module procedure RmTimesXyh
!    end interface TimesXyh
!   !    interface operator(.xyh.)
!       module procedure RmTimes_xyh
!    end interface
!
!    interface TimesXhx
!       module procedure RmTimesXhx
!    end interface
!
!    interface operator(.xhx.)
!       module procedure RmTimes_xhx
!    end interface
!
!    interface TimesXxh
!       module procedure RmTimesXxh
!    end interface
!
!    interface operator(.xxh.)
!       module procedure RmTimes_xxh
!    end interface

contains

  subroutine CmTimesComplexScalarRm(C, s, A)
     type(Cmat), intent(inout) :: C
     complex(wp), intent(in) :: s
     type(Rmat), intent(in) :: A

     integer :: m, n, i, j

     m = A%nrow
     n = A%ncol

     call GuardTemp(A)
     call ReshapeAry(C, m, n)

     if (m==0 .or. n==0) then
        C%tag = 'yy'
     !else                C%tag = 'xx'
     else
                     C%tag = 'xx'
        forall (i=1:m,j=1:n)
            C%a(i,j) = s*cmplx(A%a(i,j),0)
        end forall

     end if

     call CleanTemp(A)

  end subroutine CmTimesComplexScalarRm

  subroutine CmTimesRealScalarCm(C, s, A)
     type(Cmat), intent(out) :: C
     real(wp), intent(in) :: s
     type(Cmat), intent(in) :: A

     integer m, n

     m = A%nrow
     n = A%ncol

     call GuardTemp(A)
     call ReshapeAry(C, m, n)

     if (m==0 .or. n==0) then
        C%tag = 'GE'

     else

        if (s>=0 .OR. A%tag/='HP') then
           C%tag = A%tag
        else
           C%tag = 'HE'
        end if
        C%a(1:m,1:n) = s*A%a(1:m,1:n)

     end if

     call CleanTemp(A)

  end subroutine CmTimesRealScalarCm

  subroutine CmTimesRealScalarRm(C, s, A)
     type(Cmat), intent(out) :: C
     real(wp), intent(in) :: s
     type(Rmat), intent(in) :: A

     integer m, n

     m = A%nrow
     n = A%ncol

     call GuardTemp(A)
     call ReshapeAry(C, m, n)

     if (m==0 .or. n==0) then
        C%tag = 'GE'

     else

        if (s>=0 .OR. A%tag/='HP') then
           C%tag = A%tag
        else
           C%tag = 'HE'
        end if
        C%a(1:m,1:n) = s*A%a(1:m,1:n)

     end if

     call CleanTemp(A)

  end subroutine CmTimesRealScalarRm

  subroutine CmTimesComplexScalarCm(C, s, A)
     type(Cmat), intent(out) :: C
     complex(wp), intent(in) :: s
     type(Cmat), intent(in) :: A

     integer m, n

     m = A%nrow
     n = A%ncol

     call GuardTemp(A)
     call ReshapeAry(C, m, n)

     if (m==0 .or. n==0) then
        C%tag = 'GE'

     else

        C%tag = 'HE'
        C%a(1:m,1:n) = s*A%a(1:m,1:n)

     end if

     call CleanTemp(A)

  end subroutine CmTimesComplexScalarCm



end module CmatProduct_m