Wrong line number in runtime error-message

Hi,

when executing my program I receive this errormessage

'Reference through dangling Fortran Pointer at adress ...'

but the line number indicated in the following detail apparently points to the wrong line:

            else
              	pPlantActual%iAge = pPlantActual%iAge + 1									! Alter um 1 erhöht
                if (pPlantActual%iAge .ge. pPlantActual%iSeedSurvivalActual) then
                    print *,'Vertrocknet: Samen Nr. ', pPlantActual%iNumber 
                  	iRslt = EG_KillPlant(pPlantActual)								! Wenn vertrocknet, dann löschen
                    cycle
				endif
        

The line indicated is the cycle statement. The pointer pPlantActual gets deallocated and nullified in EG_KillPlant.

I added the print-statements prior to this line. This executes without any issue.

I am using FTN95, version 8.80 (personal edition) with Plato 5.4.0 in a Windows11 environment. The code was compiled with /x64.

Cheers Norbert

Finally I was able to pinpoint this nasty bug - but at a completely different location than flagged by this errormessage (see my previous posting).

Here is the first part of the routine in Question:

	subroutine EG_Plants()

    use EG_Data
	implicit none
    include <windows.ins>,nolist

    INTERFACE
    	integer function EG_KillPLant(pPlantActual)
        type (Plants), pointer :: pPlantActual
        end function EG_KillPlant

        integer function EG_NewPlant (pMother, cMode)
        type (Plants), pointer :: pMother
		character(*), intent(in) :: cMode
        end function EG_NewPlant        
    END INTERFACE

   	integer EG_NewPlant
    integer EG_KillPlant

    character*20 cBuffer

    integer iRslt
    integer EG_Pause

    type (Plants), pointer :: pPlantNext
    type (Plants), pointer :: pPlantActual						! Zeiger auf aktuelle Pflanze. 

	iRslt = 0
    iRslt = iRslt	! Vermeiden der Warnung

    if (iiTSeed .eq. iiNTage)  then
      	nullify (ppPlantCurrent)
      	iRslt = EG_NewPlant (ppPlantCurrent, 'AUSSAAT')		! ppPlantCurrent wird bei der Aussaat eigentlich nicht gebraucht!
        return
    endif

    if (iiNPlants .le. 0) return
	pPlantNext => ppPlantHead
    
!	Lebenslauf der Pflanzen

    do
		if (.not. associated(pPlantNext)) exit
        pPlantActual => pPlantNext
        nullify (pPlantNext)
        if (associated (pPlantActual%pNext)) pPlantNext => pPlantActual%pNext

!		Keimung und ggf. Vertrocknen der Samen

		if (pPlantActual%lSeedFlag) then															! Wenn dieses Teil noch Samen ist ...
           	if (ttPlanSquares(pPlantActual%iPlanX, pPlantActual%iPlanY)%iWater .gt. 0) then 		! ... und es gibt Wasser
            	pPlantActual%iWater = min (iiMaxValue, pPlantActual%iWater + 1)						! dann Wasser um 1 erhöhen
                if (pPlantActual%iWater .gt. pPlantActual%iSeedWater) then							! Wenn die gespeicherte Wassermenge die zum Keimen erforderliche Menge übersteigt, dann keimen					
                  	pPlantActual%lSeedFlag = .false.
                    pPlantActual%iAge = 0
                    pPlantActual%iWater = 0
					pPlantActual%iTNextSpread = iiNTage + pPlantActual%iSpreadMinAge
                    iiNSeeds = iiNSeeds - 1
                endif
            else
              	pPlantActual%iAge = pPlantActual%iAge + 1											! Restlebensdauer als Samen um 1 verringert
                if (pPlantActual%iAge .ge. pPlantActual%iSeedSurvivalActual) then
                  	iRslt = EG_KillPlant(pPlantActual)												! Wenn vertrocknet, dann löschen
                    cycle										! < - this was the line flagged by the errormessage
				endif
            endif
        else				! Ist kein Samen mehr, sondern gekeimte Pflanze

!			Alter, Tod wenn maximalalter überschritten
            
!			pPlantActual%iAge = ppPlantCurrent%iAge + 1			! < - This was the faulty codeline
			pPlantActual%iAge = pPlantActual%iAge + 1			! < - This is the proper codeline.		

            if (pPlantActual%iAge .gt. pPlantActual%iPlantMaxAgeActual) then
              	iRslt = EG_KillPlant(pPlantActual)									! Wenn überaltert, dann löschen
                cycle
            endif

Second part will follow with my next reply.

I indicated where the error was flagged and the codeline that proved faulty in reality, that is, where this dangling pointer occurred. Note: the loop was processed three times after the flagged line was processed for the last time before the error occurred.

I am happy with my program running - but somebody might be interested to look into this matter.

Just for completion: here is the final part of the code:

!			Wasseraufnahme und Verbrauch, Tod, wenn Wasser = 0   
         
			if (ttPlanSquares(pPlantActual%iPlanX, pPlantActual%iPlanY)%iWater .gt. 0) then 		! wenn es Wasser gibt, dann 			
				pPlantActual%iWater = pPlantActual%iWater + pPlantActual%iWaterGetActual			! Steigt der Wassergehgalt
                pPlantActual%iWater = min (pPlantActual%iWater, pPlantActual%iWaterCapacityActual)	! bis zum Maximum
            else
				pPlantActual%iWater = pPlantActual%iWater - pPlantActual%iWaterUseActual			! sonst sinkt er
                if (pPlantActual%iWater .le. 0) then												! wenn kein Wasservorrat mehr vorhanden
              		iRslt = EG_KillPlant(pPlantActual)												! vertrocknet die Pflanze
                endif
                cycle
            endif

!			Wachstum 
!			Idee: Wchstumspotenzial aufteilen zwischen  Wurzel / Pflanze / Schutz (=Stamm). Wasser versickern lassen. Begrenzte Kapazität Wurzel. 

			if (pPlantActual%iWater .ge. pPlantActual%iGrowWaterNeededActual) then					! Sofern genügend Feuchtigkeit gespeichert ist: 
            	pPlantActual%rSize = pPlantActual%rSize + pPlantActual%rPlantGrowStepActual			! Wachsen
                pPlantActual%iWater = pPlantActual%iWater - pPlantActual%iGrowWaterUsedActual		! und Wasser verbauchen
                if (pPlantActual%rSize .gt. pPlantActual%rPlantMaxSizeActual) then					! Wenn aber die Maximalgröße erreicht ist
                  	pPlantActual%rSize = pPlantActual%rPlantMaxSizeActual							! dann bleibt es bei der Maximalgröße
					pPlantActual%iWater = pPlantActual%iWater - pPlantActual%iGrowWaterUsedActual	! und das Wasser wird nicht verbraucht 
                endif
                pPlantActual%rRBlocked = pPlantActual%rSize / 2.0
            endif 

!			Vermehrung

			if ((iiNTage .gt. pPlantActual%iTNextSpread) .and. (pPlantActual%iWater .gt. pPlantActual%iSpreadMinWaterActual) .and. (pPlantActual%rSize .gt. pPlantActual%rSpreadMinSizeActual)) then
                pPlantActual%iTNextSpread = iiNTage + pPlantActual%iSpreadPeriodActual
 				iRslt = EG_NewPlant(pPlantActual, 'VERMEHRUNG')

			endif
        endif
    enddo 

    return
    end

If somebody could point out a way to a proper format for code it would be appreciated.

Cheers Norbert

It is possible that the line numbers are not exactly right. There has been one or more related bug fixes for FTN95 v8.90.

I have not looked at the detail of the code presented here. I would need a fully working sample in order to understand what is happening.

As a general rule, the point at which the program fails (for a dangling pointer error) is not the same as the line where the programming error occurs. Here is a simple example which requires (for example) the command line option /checkmate.

program allocation
    integer, allocatable, target :: p1(:)
    integer, pointer :: p2(:)

    print*, 'Program entered.'
    allocate(p1(10))
    p2 => p1
    call destroy
    p2 = 10
    print*, 'Program terminated, logical error not detected.'

contains
    subroutine destroy
        deallocate(p1)
    end subroutine
end

The call to destroy is an error. p2 = 10 fails.

Yes, it is perfectly clear, that the programming error can be at a completely different piece of code from where the error finally manifests itself and in case of a fatal error, execution is aborted.

In your example the error message flags line #9 which is the statement, that could not be executed (p2 = 10).

In my case however the flagged line was not the one where the error manifested itself.

Cheers Norbert

P.S. The next time I have such an error, I will forward a copy of my code to you.