How do I chase down this error?

I have been through my code and re-written the base routine as free-form Fortran; and it works exactly as the older version…including an error!?

Note: The following floating-point exceptions are signalling: IEEE_OVERFLOW_FLAG IEEE_DENORMAL

I believe I have checked each variable and set them as double precision (this might change if I can get to understand why I might use the real suggestion I got recently).

How do I begin to chase this down?

If it does not show the line where the error occurs, you can try to compile your program in debug mode (-g option). You may obtain more info when executing.

The error is happening in runtime, so not sure debugging in compiling would help.(?)

There are 30000 steps and the program ends by producing a lot of data - all correct and complete.

At present, no other file is used, so I could output data at given points, but I’m unsure what I am looking to find, given the above!?!

You are right, -g is not sufficient but you can use ieee_set_halting_mode:

program main
  use, intrinsic :: iso_fortran_env, only: dp=>real64
  use, intrinsic :: ieee_exceptions
  implicit none
  real(dp) :: x

  call ieee_set_halting_mode(ieee_overflow, .true.)

  x = 1d308 
  x = x*x
  print *, x
end program main
$ gfortran -g main.f90 && ./a.out

Program received signal SIGFPE: Floating-point exception - erroneous arithmetic operation.

Backtrace for this error:
#0  0x7ff0ceb3f820 in ???
#1  0x7ff0ceb3e9c5 in ???
#2  0x7ff0ce97103f in ???
#3  0x5571ba4551f2 in MAIN__
        at /tmp/essai/app/main.f90:10
#4  0x5571ba4552a3 in main
        at /tmp/essai/app/main.f90:3
Exception en point flottant (core dumped)

Yes, sorry. I refer to it as an error simply because it is not a clean finish; something is not quite right somewhere and I always like to know where.

So, not an error but the note tells me that something is in there that is incorrect. It might not be an error now but it might prove to be later on! Hahahaha! :slight_smile:

EDIT: Looks like this command doesn’t work under x86…

Undefined symbols for architecture x86_64:
  "_ieee_set_halting_mode_", referenced from:
      _MAIN__ in cc3P4waF.o
ld: symbol(s) not found for architecture x86_64
collect2: error: ld returned 1 exit status

I am working on an Intel Core i3, therefore a x86_64 architecture.
Which compiler do you use?

And you were totally correct! :slight_smile:

However, I’m not getting output beyond the original note.
I believe I have set it all correctly and run it accordingly, but all I got was this…

gfortran -g dummymain.f90 && ./a.out > dummymain.lst 
Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG

Happy to share the code, just that it is a little long; but here goes…

module stellar_values

	implicit none
	
	integer, parameter			::	MJ    		= 4000
	integer, parameter			::	MH    		= 4
	integer, parameter			::	ME    		= 9
	integer, parameter			::  MTAU  		= 20000
	
	double precision, parameter	::	sig   		= 5.67051d-5
	double precision, parameter	::	pi    		= 3.14159265359d0
    double precision, parameter	::	grav  		= 6.6704d-8
    double precision, parameter	::	cc    		= 2.99792458d10
    double precision, parameter	::	hmass 		= 1.6732d-24
    double precision, parameter	::	xm_sun      = 1.989d33      	! Solar Mass (g)
    double precision, parameter ::	r_sun       = 6.9599d10   		! Solar Radius (cm)
    double precision, parameter ::	xl_sun      = 3.83d33     		! Solar Luminosity (erg/s)
    double precision, parameter ::	yr          = 3.1556736d7		! yr in sec
    double precision, parameter ::	xmdot_sunyr = 6.30268d25		! acc. Rate in M_sun/yr
    
end module

module dummy_routines

	contains
	
		subroutine record_time(sf)

			character (len = *), intent(in), optional	::	sf

			character (100) ::	sf_
			character (8) 	:: 	curdate     = "000000:00"
			character (10)  :: 	curtime		= "000000:00"

			logical			:: 	fileexist	= .FALSE.

			real, save		:: 	start		= 0.00
			real, save 		:: 	finish		= 0.00
			
			if (present(sf)) then
		   
				sf_ = sf

			else
			
				sf_ = "begin"

			end if
			
			
			inquire (file = "data.lst", exist = fileexist)

			if (fileexist) then
			
				open(7, file = "data.lst", status = "old", position = "append")
				
			else
				
				open(7, file = "data.lst", status = "new")
				
			end if

			call date_and_time(DATE = curdate, TIME = curtime)

			if (sf_ == "begin") then
					
				write (7, *) "Date of run (yyyymmdd) = ", curdate
				write (7, *) "Time of run (hhmmss.mmm) = ", curtime
					
				call cpu_time (start)
				
			else
				
				call cpu_time (finish)

				open (7, file = "data.lst", position = "append")
				write (7, *) "Execution time (s) = ", finish - start
				
			end if
				
			call flush (7)
			close (7)
			
		end subroutine
	

end module

program main

	use stellar_values, only: xm_sun
	use dummy_routines
	
	use, intrinsic :: iso_fortran_env, only: dp => real64
	use, intrinsic :: ieee_exceptions
	implicit none

    double precision :: acc				= 0.0		            	! accretion rate (real)
    double precision :: accL			= 0.0
    double precision :: acon			= 0.0
    double precision :: alpha			= 0.0
    double precision :: corL			= 0.0
    double precision :: corM 			= 9.94373e31    			! Core mass
    double precision :: corR			= 0.0
    double precision :: decel			= 0.0
    double precision :: decelr			= 0.0
    double precision :: deetee			= 1.0 / 3.0d04
    double precision :: divpart			= 0.0
    double precision ::	dtime 			= 1.052e9
    double precision :: epsilon			= 0.3
    double precision :: fburst			= 0.9
    double precision :: finalmass		= 1.0						! final mass as multiple of solar mass
	double precision :: fluxM
	double precision :: fluxM1			= 0.0
	double precision :: fluxM2			= 0.0
    double precision :: fluxmin			= 0.0
    double precision :: fluxold			= 0.0
    double precision :: fsolmass  		= 1.0                    	! target solar mass  
    double precision :: grav			= 0.0
    double precision :: initialrate		= 0.0
    double precision :: mdotstar		= 0.0
    double precision :: mdotstarramped	= 0.0
    double precision :: mdotzero		= 0.0
    double precision :: numru
    double precision :: rateunit		= 0.0						! accretion per year
    double precision :: smass			= 0.0
    double precision :: taueee			= 0.0
    double precision :: tauf			= 0.0
    double precision :: taur			= 0.0
    double precision :: tburst  		= 0.0 
    double precision :: teeaye			= 0.0  
    double precision :: tnaught			= 1.0d06
    double precision :: tostar			= 0.0						! initial accretion rate
    double precision :: totL			= 0.0
    double precision :: tpeak
    double precision :: yearins			= 3.1556736d7				! year in seconds
    
    real			 ::	time 			= 0.
    
    integer 		 :: accmethod		= 1                     	! Selected method 
    integer 		 :: iacc			= 3000                  	! accretion rate (integer)
    integer			 :: i				= 0
    integer 		 :: ic				= 30
    integer 		 :: im				= 10
    integer 		 :: im1				= 0
    integer			 ::	iprint			= 1							! STELCOR write frequency
    integer			 ::	late_evolve 	= 30001         			! Point when late evolution begins    
    integer			 ::	steps 			= 30000						! Total steps

    character (1)  	 :: temp1			= ""
    
    logical			 ::	massonly		= .true.
    
    acc			= real(iacc)
    tburst  	= 1. / real(im)
    im1			= im - 1
    finalmass	= fsolmass * xm_sun
    rateunit	= xm_sun / yearins
    tostar		= (tnaught / steps) * acc
                     
    call ieee_set_halting_mode(ieee_overflow, .true.)
 
    if (command_argument_count() == 1) then

        call get_command_argument(1, temp1)

        if (temp1 == '1') then
        
            massonly = .true.
        
        endif
    
    endif
    
    call record_time("begin")
      
    if (accmethod == 1) then
            
		divpart 		= tostar * (1.0 - epsilon)
        initialrate 	= fsolmass / divpart
        mdotzero 		= initialrate * rateunit
        mdotstar 		= mdotzero * (1.0 - epsilon)
        mdotstarramped 	= mdotstar / 900.0
        fluxM1 			= (1. - fburst) / (1. - tburst) * mdotstar
        fluxM2 			= fburst / tburst * mdotstar
        fluxold			= 0.0 
        
    else if (accmethod == 2) then
    
        alpha 	 = 1.75            									! As defined in Smith (2014)
        acon 	 = (exp(1.0) / alpha)**alpha
        tostar 	 = 2.0d04         									! 100kyr standard evolution
        mdotzero = (2.d4/tostar) * rateunit * 2.7184d-5 * fsolmass
        mdotstar = mdotzero * (1.0 - epsilon)
        fluxmin  = rateunit * 1.0d-10
        fluxold  = rateunit * 1.0d-08

    else if (accmethod == 3) then
    
        tostar 		= (tnaught / steps) * acc
        initialrate = rateunit * fsolmass * 2.5 / tostar
        mdotstar 	= initialrate * (1. - epsilon)
        decel 		= 1.05
        decelr 		= 1.0 / (decel - 1.0)
        fluxmin 	= rateunit * 1.0d-08
        fluxold 	= rateunit * 1.0d-07

    else if (accmethod == 4) then
    
        tostar 	 = 1.0d5
        mdotzero = rateunit * 1.9804d-05 * fsolmass
        mdotstar = mdotzero * (1.0 - epsilon)
        tauf     = 0.5 * (tostar / tnaught)
        taur     = 0.1 * tauf
        taueee   = exp(2.0 * sqrt(taur/tauf))
        fluxmin  =  rateunit * 1.0d-09
        fluxold  = rateunit * 1.0d-09
        
    endif
    
	do i = 1, steps
      
        if (i < late_evolve) then

            if (accmethod == 1) then

                if(i <= 30 .and. i <= iacc) then
                
                    fluxM = mdotstarramped * (i * i)
                    
                else if (i > 30 .and. i <= iacc) then
                
                    if (mod(i/ic,im) == im1) then
                    
                        fluxM = fluxM2
                            
                    else
                    
                        fluxM = fluxM1
                        
                    end if
                    
                else
                        
                    fluxM = rateunit * 1.0d-08
                    
                end if

            else if (accmethod == 2) then
            
                tpeak  = real(i) * deetee * tnaught / tostar
                teeaye = tpeak**(-alpha)
                fluxM  = mdotstar * acon * teeaye * exp(-1.0 / tpeak)
                fluxM1 = (1. - fburst) / (1. - tburst) * fluxM
                fluxM2 = fburst / tburst * fluxM

                if (i <= 30 .AND. i <= iacc) then
                
                    fluxM = fluxM
                
                else if (i > 30 .AND. i <= iacc) then
                    
                    if (mod(i / ic, im) == im1) then
                    
                        fluxM = fluxM2
                    
                    else
                    
                        fluxM = fluxM1
                    
                    end if
                    
                end if

                if (i > iacc .and. fluxM <= fluxmin) then
                
                    fluxM = fluxmin
                
                end if

            else if (accmethod == 3) then
                
                tpeak  = real(i) * deetee * tnaught / tostar
                fluxM  = mdotstar * tpeak
                fluxM1 = (1. - fburst) / (1. - tburst) * fluxM
                fluxM2 = fburst / tburst * fluxM

                if (i <= 30 .and. i <= iacc) then
                
                    fluxM = fluxM
                    
                else if (i > 30 .and. i <= iacc) then
                    
                    if (mod(i/ic,im) == im1) then
                    
                        fluxM = fluxM2
                        
                    else
                    
                        fluxM = fluxM1
                        
                    end if
                        
                else if (i > iacc) then
                    
                    fluxM = decelr * mdotstar * (decel - tpeak)
                        
                else if (tpeak > decel) then
                    
                    fluxM = 1.0d17
                        
                end if

            else if (accmethod == 4) then
            
                tpeak  = real(i) * deetee
                fluxM  = mdotstar * taueee
                fluxM  = fluxM * exp(-taur / tpeak)
                fluxM  = fluxM * exp(-tpeak / tauf)
                fluxM1 = (1. - fburst) / (1. - tburst) * fluxM
                fluxM2 = fburst / tburst * fluxM

                if (i <= 30 .and. i <= iacc) then
            
                    fluxM = fluxM
            
                else if (i > 30 .and. i <= iacc) then
            
                    if (mod(i/ic,im) == im1) then
            
                        fluxM = fluxM1
            
                    end if
            
                else
            
                    fluxM = fluxM2
            
                end if

                if (i > iacc .and. fluxM < fluxmin) then
            
                    fluxM = fluxmin
            
                end if
            
            end if
          
        else if (i == late_evolve) then
        
            fluxM   = 0.001 * fluxold          
            fluxold = 0.001 * fluxold
            dtime   = 1.00025 * dtime
          
        else
        
            dtime = 1.00025 * dtime
        
        end if

        time = time + dtime
        CorM = CorM + dtime * 0.5 * (fluxM + fluxold)

        if (massonly .eqv. .false.) then
            
!           call stelcor(CorM, CorR, CorL, fluxM, time, iprint)
                
        end if

        accL 	= 0.75 * grav * CorM * fluxM / CorR
        fluxold = fluxM
        totL 	= accL + CorL
        smass 	= CorM / xm_sun

        if (massonly .eqv. .false.) then
            
            write(6,201) i, time, dtime, CorM, CorR, CorL, totL, fluxM, smass
                
        else
        
            write(6,202) i, time, dtime, CorM, fluxM, smass
        
        endif

    enddo

    call record_time("end")
    stop

 201    format(' HYDRO OUTPUT: ', 1i5, 1p, 7d15.5, 0p, 1f12.7)
 202    format(' HYDRO OUTPUT: ', 1i5, 1p, 4d15.5, 0p, 1f12.7)

end program

Not answering your question, but I must say that .eqv. is rarely needed in Fortran and that

        if (massonly .eqv. .false.) then
            write(6,201) i, time, dtime, CorM, CorR, CorL, totL, fluxM, smass                
        else
            write(6,202) i, time, dtime, CorM, fluxM, smass
        endif

should be written as

        if (massonly) then
            write(6,202) i, time, dtime, CorM, fluxM, smass
        else
            write(6,201) i, time, dtime, CorM, CorR, CorL, totL, fluxM, smass                
        endif

I was looking for something to replace the .eqv. with!

And that is such an obvious answer, but not one I spotted; thank you.

There’s no shorthand for .and., etc is there? Couldn’t find it when I searched.

EDIT: Is there a NOT equivalence?

I have one select statement where the only option is if massonly is NOT true; there is no true part to run; having an empty if with an else seems wrong…

        if (massonly .eqv. .false.) then
            
           call stelcor(CorM, CorR, CorL, fluxM, time, iprint)
                
        end if

becomes…?

        if (massonly .eqv. .false.) then

        else
            
           call stelcor(CorM, CorR, CorL, fluxM, time, iprint)
                
        end if

Write

        if (.not. massonly) then            
           call stelcor(CorM, CorR, CorL, fluxM, time, iprint)                
        end if

or preferably IMO using the one-line if

if (.not. massonly) call stelcor(CorM, CorR, CorL, fluxM, time, iprint)

I did wonder if that was it.

Sorry, I don’t like the one-line if (unless the action is particularly simple and small).

You did state IMO, so we’re happy to disagree on this minor difference. :slight_smile:

The reason for all the declarations is that I inherited this program with a large number of variables. I am declaring like this so that I can identify which ones are used and which ones aren’t (if any - there appear to be 2 at present; ignoring the module variables), then I will be condensing this down again.

I’m doing the same with rationalising. The module has a variable (and only 1) that is used to define a single variable. I should be able to lose either the one defined variable or the whole module; saving space (I’ll be doing the latter, unless I encounter a good reason not to).

Thank you for the other information; I will check this out. The peculiar thing is that my ‘error’ (note) is intermittent, despite the code running exactly the same way every time! I’ll find it (or get bored trying). :laughing:

I initialised corR but it is only ever altered when the program runs the stelcor program (currently commented out).

And, no, that was not the intent; might I ask where?
Should get that resolved.

Thank you.

EDIT:
Sorry. I am frequently reading these as emails on my phone, whilst being in a rush. I really should take more time before responding - I will endeavour to do so.

I did note what you ACTUALLY said about corR and I missed the error in relation to my setting of two characters where I initialised them beyond their defined characters (with no reason to do so). I have corrected this and will be reducing these down now anyway.

Thank you.

Gfortran has the -Wunused option and Intel Fortran the -warn unused option, so for the program

program xunused
implicit none
integer, parameter :: n = 3
integer :: i,j
i = 4
print*,i
end program xunused

they warn that j is unused.

That is excellent; thank you!

Also, this is a good read