子函数中被赋值的指针传递到主函数中丢失-Fortran语法讨论-专业Fortran论坛

紫雪封尘 发表于 2019-12-12 01:48:24

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

我在子函数中吧一个全1矩阵赋值给指针B吗，然后我调用子函数后，在主函数输出指针B，发现有的值变成极小数，请问这是怎么回事？
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

li913 发表于 2019-12-12 09:12:17

1、你的代码有错误，不能编译执行；
2、子程序中的b4，在退出子程序后会被释放，导致b的结果错误。

紫雪封尘 发表于 2019-12-12 09:47:06

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

那应该如何改正啊，我怎么才能保证B4内存不被释放{:4_116:}，求老师指教

necrohan 发表于 2019-12-12 10:01:15

你这个程序片段截取的乱七八糟的，很多变量都没用。
使用指针作为参数，必须有显式接口。我简化了一下举个例子
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:56

necrohan 发表于 2019-12-12 10:01
你这个程序片段截取的乱七八糟的，很多变量都没用。
使用指针作为参数，必须有显式接口。我简化了一下举个 ...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:13

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

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

necrohan 发表于 2019-12-13 08:40:31

子程序中声明的数组是只能在子程序内使用的，在子程序返回后就没有意义了，返回的指针指向的数组那块内存仍然存在，但是里面的数据随时可能修改，因此返回的指针是不可靠的。下面这个例子你看下
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

页: [1]

Fortran Coder's Archiver

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