Prevention of change of variables with intent (c)

so we read the next question ( Proper use of FORTRAN INTENT () for large arrays ). I learned that defining a variable with intent (in) is not enough, because when a variable is passed to another routine / function, it can be changed again. So how can I avoid this? In the original topic, they talked about including a subroutine in a module, but that doesn't help me. For example, I want to compute a determinant of a matrix with LU factorization. Therefore, I use the zaprf Lapack function, but this function changes my input matrix, and the compiler does not display any warnings. So what can I do?

module matHelper
    implicit none
    contains

    subroutine initMat(AA)
        real*8                      ::  u
        double complex, dimension(:,:), intent(inout)   ::  AA
        integer                     ::  row, col, counter

        counter = 1
        do row=1,size(AA,1)
            do col=1,size(AA,2)
                AA(row,col)=cmplx(counter ,0)
                counter=counter+1 
            end do
        end do

    end subroutine initMat

    !subroutine to write a Matrix to file
    !Input: AA      -   double complex matrix
    !       fid     -   integer file id
    !       fname   -   file name
    !       stat        -   integer status =replace[0] or old[1]
    subroutine writeMat(AA,fid, fname, stat)
        integer                     ::  fid, stat
        character(len=*)                ::  fname
        double complex, dimension(:,:), intent(in)  ::  AA
        integer                     ::  row, col
        character (len=64)                ::  fmtString

        !opening file with given options
        if(fid  /= 0) then
            if(stat == 0) then
                open(unit=fid, file=fname, status='replace', &
                    action='write')
            else if(stat ==1) then
                open(unit=fid, file=fname, status='old', &
                    action='write')
            else
                print*, 'Error while trying to open file with Id', fid
                return
            end if
        end if

        !initializing matrix print format
        write(fmtString,'(I0)') size(aa,2)
        fmtString = '('// trim(fmtString) //'("{",ES10.3, ",", 1X, ES10.3,"}",:,1X))'
        !write(*,*) fmtString

        !writing matrix to file by iterating through each row
        do row=1,size(aa,1)
            write(fid,fmt = fmtString) AA(row,:)
        enddo
        write(fid,*) ''
    end subroutine writeMat



    !function to calculate the determinant of the input
    !Input: AA              -   double complex matrix
    !Output determinantMat  -   double complex, 
    !                           0 if AA not a square matrix
    function determinantMat(AA)
        double complex, dimension(:,:), intent(in)  ::  AA
        double complex              ::  determinantMat
        integer, dimension(min(size(AA,1),size(AA,2)))&
                                    ::  ipiv
        integer                     ::  ii, info

        !check if not square matrix, then set determinant to 0
        if(size(AA,1)/= size(AA,2)) then
            determinantMat = 0
            return
        end if

        !compute LU facotirzation with LAPACK function
        call zgetrf(size(AA,1),size(AA,2), AA,size(AA,1), ipiv,info)

        if(info /= 0) then
            determinantMat = cmplx(0.D0, 0.D0)
            return
        end if
        determinantMat = cmplx(1.D0, 0.D0)
        !determinant of triangular matrix is product of diagonal elements
        do ii=1,size(AA,1)
            if(ipiv(ii) /= ii) then
                !a permutation was done, so a factor of -1 
                determinantMat = -determinantMat *AA(ii,ii)
            else
                !no permutation, so no -1 
                determinantMat = determinantMat*AA(ii,ii)
            end if      
        end do

    end function determinantMat

end module matHelper
!***********************************************************************


!module which stores matrix elements, dimension, trace, determinant

program test
    use matHelper
    implicit none
    double complex, dimension(:,:), allocatable ::  AA, BB
    integer                                 ::  n, fid

    fid  = 0;

    allocate(AA(3,3))
    call initMat(AA)
    call writeMat(AA,0,' ', 0)
    print*, 'Determinante: ',determinantMat(AA) !changes AA
    call writeMat(AA,0, ' ', 0)
end program test

PS: I am using ifort v15.0.3 20150407 compiler

+1
1

ifort, "-check interfaces" , , "-ipo". "zgetrf" "-check interfaces" , , . 'function defininantMat' 'PURE FUNCTION decinantMat', , , 'zgetrf' PURE ELEMENTAL. ^.

LAPACK , zgetrf PURE/ELEMENTAL. https://software.intel.com/en-us/articles/blas-and-lapack-fortran95-mod-files

:

-check interfaces -ipo

( , ):

-check all -warn all

- . ( , .)

PURE FUNCTION determinantMat(AA)
USE LAPACK95                       !--New Line--!
IMPLICIT NONE                      !--New Line--!
double complex, dimension(:,:)  , intent(IN   )  ::  AA
double complex                                   ::  determinantMat !<- output
!--internals--
integer, dimension(min(size(AA,1),size(AA,2)))   ::  ipiv
!!--Next line is new--
double complex, dimension(size(AA,1),size(AA,2)) ::  AA_Temp  !!<- I have no idea if this will work, you may need an allocatable??
integer                                          ::  ii, info

!check if not square matrix, then set determinant to 0
if(size(AA,1)/= size(AA,2)) then
    determinantMat = 0
    return
end if

!compute LU factorization with LAPACK function
!!--Next line is new--
AA_Temp = AA  !--Initialise AA_Temp to be the same as AA--!
call zgetrf(size(AA_temp,1),size(AA_Temp,2), AA_Temp,size(AA_Temp,1), ipiv,info)

if(info /= 0) then
    determinantMat = cmplx(0.D0, 0.D0)
    return
end if

determinantMat = cmplx(1.D0, 0.D0)
!determinant of triangular matrix is product of diagonal elements
do ii=1,size(AA_Temp,1)
    if(ipiv(ii) /= ii) then
        !a permutation was done, so a factor of -1 
        determinantMat = -determinantMat *AA_Temp(ii,ii)
    else
        !no permutation, so no -1 
        determinantMat = determinantMat*AA_Temp(ii,ii)
    end if      
end do

end function determinantMat

"USE LAPACK95" , , PURE, , PURE, .

+2

Source: https://habr.com/ru/post/1661357/


All Articles