Fortran Coder

标题: 子函数中被赋值的指针传递到主函数中丢失 [打印本页]
作者: 紫雪封尘    时间: 2019-12-12 01:48
标题: 子函数中被赋值的指针传递到主函数中丢失
我在子函数中吧一个全1矩阵赋值给指针B吗，然后我调用子函数后，在主函数输出指针B，发现有的值变成极小数，请问这是怎么回事？
[Fortran] 纯文本查看 复制代码
program main

integer::icmpx,icmpy,ihx,ihy,f

    real*4,allocatable::A1(:,:,:,:),A2(:,:,:,:)

    real*4,allocatable,target::B4(:,:)

    real*4,pointer::B(:,:) 

    integer::ncmpx,ncmpy,nhx,nhy

    ncmpx=3

    ncmpy=4

    nhx=5

    nhy=6

    allocate(A1(ncmpx,ncmpy,nhx,nhy))

    allocate(B4(nhy,ncmpx*ncmpy*nhx)

    f=4

    call PMF_unfold(A1,ncmpx,ncmpy,nhx,nhy,f,B)

   write(*,*)B(5,:)



end program 



subroutine PMF_unfold(A,ncmpx,ncmpy,nhx,nhy,f,B)

    implicit none

    integer::icmpx,icmpy,ihx,ihy,m,n,f

    integer::ncmpx,ncmpy,nhx,nhy

    real*4,pointer::B(:,:) 

    real*4,target::B4(nhy,ncmpx*ncmpy*nhx)



     if(f==4)then

     B4=1

             B=>B4(:,:)

                end if

    end subroutine


捕获1.JPG (61.52 KB, 下载次数: 344)

输出结果

输出结果
作者: li913    时间: 2019-12-12 09:12
1、你的代码有错误，不能编译执行；
2、子程序中的b4，在退出子程序后会被释放，导致b的结果错误。
作者: 紫雪封尘    时间: 2019-12-12 09:47
li913 发表于 2019-12-12 09:12
1、你的代码有错误，不能编译执行；
2、子程序中的b4，在退出子程序后会被释放，导致b的结果错误。 ...

那应该如何改正啊，我怎么才能保证B4内存不被释放，求老师指教
作者: necrohan    时间: 2019-12-12 10:01
你这个程序片段截取的乱七八糟的，很多变量都没用。
使用指针作为参数，必须有显式接口。我简化了一下举个例子
[Fortran] 纯文本查看 复制代码
implicit none

! 接口

interface

  subroutine PMF_unfold(B,B4)

  real*4,pointer::B(:,:)

  real*4,target::B4(6,2)

  end subroutine PMF_unfold

end interface

real*4,pointer::B(:,:)

real*4,target::B4(6,2)



call PMF_unfold(B,B4)

write(*,*)B(5,:)

end program

!-----------------------------

subroutine PMF_unfold(B,B4)

  implicit none

  real*4,pointer::B(:,:)

  real*4,target::B4(6,2)

  B4=1

  B=>B4 ! (:,:)

end subroutine PMF_unfold
作者: 紫雪封尘    时间: 2019-12-12 10:15
necrohan 发表于 2019-12-12 10:01
你这个程序片段截取的乱七八糟的，很多变量都没用。
使用指针作为参数，必须有显式接口。我简化了一下举个 ...
[Fortran] 纯文本查看 复制代码
program main

    implicit none

    interface 

    subroutine PMF_unfold(A,ncmpx,ncmpy,nhx,nhy,f,B)

    integer::icmpx,icmpy,ihx,ihy,m,n,f

    integer::ncmpx,ncmpy,nhx,nhy

    real*4::A(ncmpx,ncmpy,nhx,nhy)

    real*4,pointer::B(:,:)

    real*4,target::B1(ncmpx,ncmpy*nhx*nhy),B2(ncmpy,ncmpx*nhx*nhy),B3(nhx,ncmpx*ncmpy*nhy),B4(nhy,ncmpx*ncmpy*nhx)

    end subroutine

     end interface

！主函数

integer::icmpx,icmpy,ihx,ihy,f

    real*4,allocatable::A1(:,:,:,:)

    real*4,allocatable,target::B1(:,:),B2(:,:),B3(:,:),B4(:,:)

    real*4,pointer::B(:,:) 

    integer::ncmpx,ncmpy,nhx,nhy

    ncmpx=3

    ncmpy=4

    nhx=5

    nhy=6

    allocate(A1(ncmpx,ncmpy,nhx,nhy))

    allocate(B1(ncmpx,ncmpy*nhx*nhy),B2(ncmpy,ncmpx*nhx*nhy),B3(nhx,ncmpx*ncmpy*nhy),B4(nhy,ncmpx*ncmpy*nhx))

    !生成四维数组 

    do ihy=1,nhy

        do ihx=1,nhx

            do icmpy=1,ncmpy

                do icmpx=1,ncmpx

                    A1(icmpx,icmpy,ihx,ihy)=icmpx+(icmpy-1)*ncmpx+(ihx-1)*ncmpx*ncmpy+(ihy-1)*nhx*                                                              ncmpx*ncmpy+1000     

                end do

            end do

        end do

    end do 

    f=4！当F等于四时，调用函数

    call PMF_unfold(A1,ncmpx,ncmpy,nhx,nhy,f,B)

   write(*,*)B(5,:)

！子函数

subroutine PMF_unfold(A,ncmpx,ncmpy,nhx,nhy,f,B)

    implicit none

    integer::icmpx,icmpy,ihx,ihy,m,n,f

    integer::ncmpx,ncmpy,nhx,nhy

    real*4::A(ncmpx,ncmpy,nhx,nhy)

    real*4,pointer::B(:,:) 

    real*4,target::B1(ncmpx,ncmpy*nhx*nhy),B2(ncmpy,ncmpx*nhx*nhy)

    real*4,target::B1B3(nhx,ncmpx*ncmpy*nhy),B4(nhy,ncmpx*ncmpy*nhx)

    !将四维数组沿第一维展开得到B1矩阵

    if(f==1)then

        do ihy=1,nhy

            do ihx=1,nhx

                do icmpy=1,ncmpy

                    do icmpx=1,ncmpx

                        m=icmpx

                        n=(ihy-1)*nhx*ncmpy+(ihx-1)*ncmpy+icmpy

                        B1(m,n)=A(icmpx,icmpy,ihx,ihy)

                    end do

                end do

            end do

        end do 

        B=>B1(1:ncmpx,1:ncmpy*nhx*nhy)

    end if

    !沿第二维即cmpy维展开得到B2矩阵

    if(f==2)then

        do ihy=1,nhy

            do ihx=1,nhx

                do icmpy=1,ncmpy

                    do icmpx=1,ncmpx

                        m=icmpy

                        n=(icmpx-1)*nhy*nhx+(ihy-1)*nhx+ihx

                        B2(m,n)=A(icmpx,icmpy,ihx,ihy)            

                    end do

                end do

            end do

        end do 

        B=>B2(:,:)

    end if 

    !沿着第三维即hx维展开得到B3矩阵

    if(f==3)then

        do ihy=1,nhy

            do ihx=1,nhx

                do icmpy=1,ncmpy

                    do icmpx=1,ncmpx

                        m=ihx

                        n=(icmpy-1)*nhy*ncmpx+(icmpx-1)*nhy+ihy

                        B3(m,n)=A(icmpx,icmpy,ihx,ihy)            

                    end do

                end do

            end do

        end do 

        B=>B3(:,:)

    end if

    !沿第四维即hy维展开得到B4矩阵

     if(f==4)then

        do ihy=1,nhy

            do ihx=1,nhx

                do icmpy=1,ncmpy

                    do icmpx=1,ncmpx

                        m=ihy

                        n=(ihx-1)*ncmpy*ncmpx+(icmpy-1)*ncmpx+icmpx

                        B4(m,n)=A(icmpx,icmpy,ihx,ihy)     

                    end do

                end do

            end do

        end do 

             B=>B4(:,:)

     end if

    end subroutine
作者: 紫雪封尘    时间: 2019-12-12 10:19
necrohan 发表于 2019-12-12 10:01
你这个程序片段截取的乱七八糟的，很多变量都没用。
使用指针作为参数，必须有显式接口。我简化了一下举个 ...

您好，我粘贴了我的代码，和您给的例子是一样的但是，就是结果会出现上图那种最后几个值出现错误的情况
作者: necrohan    时间: 2019-12-13 08:40
子程序中声明的数组是只能在子程序内使用的，在子程序返回后就没有意义了，返回的指针指向的数组那块内存仍然存在，但是里面的数据随时可能修改，因此返回的指针是不可靠的。下面这个例子你看下
[Fortran] 纯文本查看 复制代码
program main

implicit none

interface

  subroutine PMF_unfold(A,ncmpx,ncmpy,nhx,nhy,f,B,B1,B2,B3,B4)

  integer::ncmpx,ncmpy,nhx,nhy,f

  real*4::A(ncmpx,ncmpy,nhx,nhy)

  real*4,pointer::B(:,:)

  real*4,target::B1(ncmpx,ncmpy*nhx*nhy),B2(ncmpy,ncmpx*nhx*nhy),B3(nhx,ncmpx*ncmpy*nhy),B4(nhy,ncmpx*ncmpy*nhx)

  end subroutine

end interface

!主函数

real*4,allocatable::A1(:,:,:,:)

real*4,allocatable,target::B1(:,:),B2(:,:),B3(:,:),B4(:,:)

real*4,pointer::B(:,:)

integer::ncmpx,ncmpy,nhx,nhy,f



ncmpx=3; ncmpy=4; nhx=5; nhy=6;

allocate(A1(ncmpx,ncmpy,nhx,nhy))

allocate(B1(ncmpx,ncmpy*nhx*nhy),B2(ncmpy,ncmpx*nhx*nhy),B3(nhx,ncmpx*ncmpy*nhy),B4(nhy,ncmpx*ncmpy*nhx))



!调用函数

do f=1,4

  call PMF_unfold(A1,ncmpx,ncmpy,nhx,nhy,f,B,B1,B2,B3,B4)

  write(*,'(10f4.1)')B

  write(*,*)

enddo

deallocate(A1,B1,B2,B3,B4)

end ! program main

!---------------------------------------

!子函数

subroutine PMF_unfold(A,ncmpx,ncmpy,nhx,nhy,f,B,B1,B2,B3,B4)

implicit none

integer::ncmpx,ncmpy,nhx,nhy,f

real*4::A(ncmpx,ncmpy,nhx,nhy)

real*4,pointer::B(:,:)

real*4,target::B1(ncmpx,ncmpy*nhx*nhy),B2(ncmpy,ncmpx*nhx*nhy),B3(nhx,ncmpx*ncmpy*nhy),B4(nhy,ncmpx*ncmpy*nhx)

B1=1; B2=2; B3=3; B4=4; ! 测试数据

if(f==1)then

  B=>B1(:,:)

elseif(f==2)then

  B=>B2(:,:)

elseif(f==3)then

  B=>B3(:,:)

elseif(f==4)then

  B=>B4(:,:)

end if

end ! subroutine





欢迎光临 Fortran Coder (http://bbs.fcode.cn/) Powered by Discuz! X3.2