Fortran Coder

查看: 9678|回复: 6
打印 上一主题 下一主题

[子程序] 子函数中被赋值的指针传递到主函数中丢失

[复制链接]

25

帖子

10

主题

0

精华

熟手

F 币
158 元
贡献
82 点
跳转到指定楼层
楼主
发表于 2019-12-12 01:48:24 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
我在子函数中吧一个全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, 下载次数: 269)

输出结果

输出结果
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

834

帖子

2

主题

0

精华

大宗师

F 币
3922 元
贡献
2332 点
沙发
发表于 2019-12-12 09:12:17 | 只看该作者
1、你的代码有错误,不能编译执行;
2、子程序中的b4,在退出子程序后会被释放,导致b的结果错误。

25

帖子

10

主题

0

精华

熟手

F 币
158 元
贡献
82 点
板凳
 楼主| 发表于 2019-12-12 09:47:06 | 只看该作者
li913 发表于 2019-12-12 09:12
1、你的代码有错误,不能编译执行;
2、子程序中的b4,在退出子程序后会被释放,导致b的结果错误。 ...

那应该如何改正啊,我怎么才能保证B4内存不被释放,求老师指教

250

帖子

2

主题

0

精华

宗师

F 币
1731 元
贡献
872 点

规矩勋章

地板
发表于 2019-12-12 10:01:15 | 只看该作者
你这个程序片段截取的乱七八糟的,很多变量都没用。
使用指针作为参数,必须有显式接口。我简化了一下举个例子
[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

25

帖子

10

主题

0

精华

熟手

F 币
158 元
贡献
82 点
5#
 楼主| 发表于 2019-12-12 10:15:56 | 只看该作者
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

25

帖子

10

主题

0

精华

熟手

F 币
158 元
贡献
82 点
6#
 楼主| 发表于 2019-12-12 10:19:13 | 只看该作者
necrohan 发表于 2019-12-12 10:01
你这个程序片段截取的乱七八糟的,很多变量都没用。
使用指针作为参数,必须有显式接口。我简化了一下举个 ...

您好,我粘贴了我的代码,和您给的例子是一样的但是,就是结果会出现上图那种最后几个值出现错误的情况

250

帖子

2

主题

0

精华

宗师

F 币
1731 元
贡献
872 点

规矩勋章

7#
发表于 2019-12-13 08:40:31 | 只看该作者
子程序中声明的数组是只能在子程序内使用的,在子程序返回后就没有意义了,返回的指针指向的数组那块内存仍然存在,但是里面的数据随时可能修改,因此返回的指针是不可靠的。下面这个例子你看下
[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

您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-11-1 07:14

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表