Dynamic Allocation

[Juan_Diego_E_]

Good morning,

I would like to know what is the reason for the following:

I am dynamically allocating some arrays in my code as:

allocate(dzgpbp(Nzbpg), STAT = AllocateStatus)
if (AllocateStatus /= 0) STOP "*** Not Enough Memory (Line 122 - Gridding Module): vector dzgpbp, if top packer = top modeling interval, and not limiting the geometric spacing ***"

Variable Nzbpg has already been defined previously.

I compile the program, and when I run it I get my message due to not enough memory.

However, if I comment out the line: !if (AllocateStatus /= 0) STOP "*** Not Enough Memory (Line 122 - Gridding Module): vector dzgpbp, if top packer = top modeling interval, and not limiting the geometric spacing ***"

I compile the program, and it successfully run, with STAT = 0.

It seems that the allocation-verifying statement is giving some troubles. What could be the reason? is there any other way I can implement to know whether the allocation was successful or not?

Thanks in advanced.

Juan

[jimdempseyatthecove]

Are you using "implicit none"?

What is the type of AllocateStatus?

What do you see when commenting out !if(AllocateStatus... and inserting

write(*,*) AllocateStatus

Jim Dempsey

[Juan_Diego_E_]

Hi Jim,

Thanks for your prompt response.

My main program looks like this:

program maintwod
    use minput
    use mgridding
    use mvectors

    implicit none
        write(*,*) 'calling subrinput'
        call subrinput      
        write(*,*) 'calling subrgridding'
        call subrgridding
        write(*,*) 'calling subrvectors'
        call subrvectors

    print *,  Nz, Nzapg, Nzp, Nzbpg, dzgp/ft2m, AllocateStatus  
    
 end program maintwod

Yes I am using implicit none in my main program and in each of the modules, such as:
 

module mgridding
use minput
implicit none
save

    integer :: ct
    real(dp) :: alphar, igbs, dzhalfp, alphazb, alphaza, igbs2, igbs3
    real(dp),dimension(Nr) :: rgp
    real(dp),dimension(Nr-1) :: rtr, rgb
    integer :: AllocateStatus, DeAllocateStatus

    real,dimension(:),allocatable :: dztemp, dztemp2, dzgp, dztr, dzgpp, dzgpbp, dztrp, dztrbp, dzgpap, dztrap, dzgpbp2, dztrbp2, dzgpap2, dztrap2, abc

    contains
    
    subroutine subrgridding
    implicit none     
 
        call subrinput

                igbs = dzp/(Nzp-1.0_dp)                                                     !initial size between VERTICAL GRID POINTS in the modelling interval = packer
                allocate(dzgp(Nzp), STAT = AllocateStatus)
                write(*,*) AllocateStatus
                !if (AllocateStatus /= 0) STOP "*** Not Enough Memory (Line 64 - Gridding Module): vector dzgp, if packer = modeling interval, and not limiting the geometric spacing ***"
                dzgp(1) = dotl                                                              !initializing first vertical depth of grid points (using same reference depth as for the depth of top layer). First depth corresponds to the top of layer!!!!
                dzgp(Nzp) = dotl + dzp
                ct = 0
                do i = 2,(Nzp-1)
                    ct = ct + 1
                    dzgp(i) = dzgp(ct) + igbs                                               !initializing vertical depth of grid points for this case of packer wrt modeling interval
                end do
                
                allocate(dztr(Nzp-1), STAT = AllocateStatus)
                write(*,*) AllocateStatus
                !if (AllocateStatus /= 0) STOP "*** Not Enough Memory (Line 74 - Gridding Module): vector dztr, if packer = modeling interval, and not limiting the geometric spacing ***"
                ct = 1
                do i = 1,(Nzp-1)
                    ct = ct + 1
                    dztr(i) = (dzgp(i) + dzgp(ct))/2.0_dp                                   !initializing vertical depth of transmissibility interface inside packer for this case of packer wrt modeling interval
                end do 

Is here, inside this subroutine, where I allocate this and the other vectors (allocatable ones).

It is worth to mention that, if I do not use the module mvectors I do not have any problem at all. However, I do need to use this module. I tried by commenting out the statement mentioned in the first message and it worked.

That being said, when I insert write(*,*) AllocateStatus after commenting out the former statement I get the following:
 

calling subrinput
calling subrgridding
          0
          0
calling subrvectors
        151
        151

I also get what I asked the code to print for me (which is correct, as per my hand calculations).

It looks like if initially the vectors were successfully allocated, but then when calling the subroutine subrvectors, something is happening?

Regards,

Juan

[Steven_L_Intel1]

151 is "Array is already allocated". You don't show routine subvectors, but since the allocatable arrays are module variables, they will retain their allocation across calls.

You think you don't have a problem when you comment out the STOP statement because the array is still allocated and you are reusing the memory. I can't tell from your excerpt what you want here, but maybe you should do an IF (ALLOCATED(arrayname)) test before allocating.

[Juan_Diego_E_]

Hi Steve,

Thank you for your advice.

The module and subroutine "vectors", just make use of some the allocatable vectors (dzgp, dztr) that were initialized in the module-subroutine gridding. I do not make any other allocation to these vectors in the module-subroutine "vectors". So I cannot get why am I getting the problem using the "if (AllocateStatus /= 0) STOP" statement. I would like to still use this statement (correctly) in order to detect whether an allocation failed.

Here below is and excerpt of the module-subroutine "vectors" on which I make use of the dzgp and dztr arrays dynamically allocated in the module-subroutine gridding:

module mvectors
use minput
use mgridding
implicit none
save

    !DECLARING VARIABLES, VECTORS AND MATRIX NEEDED FOR THIS MODULE
    !Static Allocations
    integer :: j, ctt, ct2, idx
    integer,dimension(1) :: idxx 
    real(dp) :: rs1, rs, ks, kavr, sumksk, sumkavr
    real(dp),dimension(Nr-1) :: tmp
    !Dynamic Allocations
    real,dimension(:),allocatable :: kr, kz, mobr, mobz, ksk, deltatrz, mobfr, mobfz

    contains
    
    subroutine subrvectors
    implicit none
    
        call subrinput
        call subrgridding

        allocate(deltatrz(Nz), STAT = AllocateStatus)
        deltatrz(1) = dztr(1) - dzgp(1)
        deltatrz(Nz) = dzgp(Nz) - dztr(Nz-1)
        do i = 2,(Nz-1)
           deltatrz(i) = dztr(i) - dztr(i-1)
        end do

    end subroutine subrvectors
end module mvectors

Thank you.

Juan

[Steven_L_Intel1]

You call these routines more than once, yes? The first time you call the allocate succeeds. The second time it fails, but you ignore the error and go on reusing the previously allocated memory. You have not shown enough of the program for me to understand what you intend here.

The problem you need to focus on is not the test for failure, which is working correctly - it's why you are trying to do a second allocation on an array that is already allocated.

[Juan_Diego_E_]

Hi Steve,

Thank you. I actually call more than once the subroutines. Please find below the main program as well as the 3 modules I am working with. Can you please let me know what is wrong, and what do I need to do in order to have it in the proper way? As it is below and allowing the "if(AllocateStatus /=0 ) STOP" statement, the program is actually stopped.

program maintwod
    use minput
    use mgridding
    use mvectors

    implicit none
        write(*,*) 'calling subrinput'
        call subrinput      
        write(*,*) 'calling subrgridding'
        call subrgridding
        write(*,*) 'calling subrvectors'
        call subrvectors
 end program maintwod

module minput
implicit none
save

module mgridding
use minput
implicit none
save


    !DECLARING VARIABLES, VECTORS AND MATRIX NEEDED FOR THIS MODULE
    !Static Allocations 
    integer :: ct
    real(dp) :: alphar, igbs, dzhalfp, alphazb, alphaza, igbs2, igbs3
    real(dp),dimension(Nr) :: rgp
    real(dp),dimension(Nr-1) :: rtr, rgb
    integer :: AllocateStatus, DeAllocateStatus
    !Dynamic Allocations   
    real,dimension(:),allocatable :: dztemp, dztemp2, dzgp, dztr, dzgpp, dzgpbp, dztrp, dztrbp, dzgpap, dztrap, dzgpbp2, dztrbp2, dzgpap2, dztrap2
     
        
    contains
    
    subroutine subrgridding
    implicit none     
  
        call subrinput
               allocate(dzgp(Nzp), STAT = AllocateStatus)
                print *, AllocateStatus
                !write(*,*) AllocateStatus
                if (AllocateStatus /= 0) STOP "*** Not Enough Memory (Line 64 - Gridding Module): vector dzgp, if packer = modeling interval, and not limiting the geometric spacing ***" 
                dzgp(1) = dotl                                                              !initializing first vertical depth of grid points (using same reference depth as for the depth of top layer). First depth corresponds to the top of layer!!!!
                dzgp(Nzp) = dotl + dzp
                ct = 0
                do i = 2,(Nzp-1)
                    ct = ct + 1
                    dzgp(i) = dzgp(ct) + igbs                                               !initializing vertical depth of grid points for this case of packer wrt modeling interval
                end do
                
                allocate(dztr(Nzp-1), STAT = AllocateStatus)
                !write(*,*) AllocateStatus
                if (AllocateStatus /= 0) STOP "*** Not Enough Memory (Line 74 - Gridding Module): vector dztr, if packer = modeling interval, and not limiting the geometric spacing ***" 
                print *, AllocateStatus
                ct = 1
                do i = 1,(Nzp-1)
                    ct = ct + 1
                    dztr(i) = (dzgp(i) + dzgp(ct))/2.0_dp                                   !initializing vertical depth of transmissibility interface inside packer for this case of packer wrt modeling interval
                end do 

    end subroutine subrgridding 
      
end module mgridding

module mvectors
use minput
use mgridding
implicit none
save

    contains
    
    subroutine subrvectors
    implicit none
    
        call subrinput
        call subrgridding

               allocate(deltatrz(Nz), STAT = AllocateStatus)
                if (AllocateStatus /= 0) STOP "*** Not enough memory to allocate deltaz vector to get ksk to further account for skin ***"
                deltatrz(1) = dztr(1) - dzgp(1)
                deltatrz(Nz) = dzgp(Nz) - dztr(Nz-1)
                do i = 2,(Nz-1)
                    deltatrz(i) = dztr(i) - dztr(i-1)
                end do

    end subroutine subrvectors
end module mvectors

Thank you.

Juan.

[Steven_L_Intel1]

Ok. Your main program calls subrinput, subrgridding, and subrvectors in that order. But subrgridding calls subrinput and subrvectors calls both subrinput and subrgridding (which in turns calls subrinput again.) So you end up with this sequence:

subrinput, subrgridding, subrinput, subrvectors, subrinput, subrgridding, subrinput

Note that subrgridding is called twice and subrinput is called four times. You did not show subrinput but subrgridding allocates dzgp and dztr, so the second time it is called it tries to allocate these again and this fails with error 151.

Perhaps, and this is just a guess - you know what your program wants - you need to remove the calls to subrinput and subrgridding from subrgridding and subrvectors. This way each routine gets called once from the main program and the arrays are allocated only once.

[Juan_Diego_E_]

Hi Steve,

Thank you very much for the explanation, I got it. Right now I have the main program and the 3 modules as follow:

program maintwod

    use minput
    use mgridding
    use mvectors

    implicit none
        write(*,*) 'calling subrinput'
        call subrinput      
        write(*,*) 'calling subrgridding'
        call subrgridding
        write(*,*) 'calling subrvectors'
        call subrvectors

 end program maintwod

module minput
implicit none
save

    contains
    
    subroutine subrinput
    implicit none

    end subroutine subrinput
        
end module minput

module mgridding
use minput
implicit none
save
     
        
    contains
    
    subroutine subrgridding
    implicit none       

end subroutine subrgridding 
      
end module mgridding

module mvectors
use minput
use mgridding
implicit none
save


    contains
    
    subroutine subrvectors
    implicit none

    end subroutine subrvectors
end module mvectors

I also realized than even though I am including USE in each module (to make use of the other modules' variables/arrays), it is not enough to have the CALL statements in the main program, I still need to include USE (for each of the 3 modules) in the main program, why?

Regards,

Juan

[Steven_L_Intel1 · Accepted solution]

The USE statements make the declarations in the modules available. Without that, the compiler doesn't know the definitions of any module variables or routines, and the calls are assumed to be to "external" routines not in modules.

[Juan_Diego_E_]

Hi Steve,

I appreciate your help today. Now it makes more sense to me.

Thank you very much!

Regards,

Juan.