forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Odd error messages from FTN95 compiler and SLINK

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Wed Feb 21, 2018 5:17 pm    Post subject: Odd error messages from FTN95 compiler and SLINK Reply with quote

While compiling a package, I made a couple of mistakes, and saw rather strange behavior from the compiler and the linker. I know now to avoid the mistakes, but perhaps the confusing messages and behavior can be rectified.

I placed an interface block into a small source file, intending to INCLUDE the file wherever an interface was needed. Mistake-1: I named the file "fvec-int.f90" instead of "fvec-int.inc".
Code:
INTERFACE
  SUBROUTINE fvec(x, f, m, n)
    IMPLICIT NONE
    REAL, INTENT(IN)  :: x(:)
    REAL, INTENT(OUT) :: f(:)
    INTEGER, INTENT(IN)    :: m, n
  END SUBROUTINE fvec
END INTERFACE

Mistake-2: Lazily, I compiled all the files (ftn95 *.f90). Even though the above file does not have a compilable unit, FTN95 takes it and produces a zero-length OBJ file. Other compilers refuse to compile this source file. The linker (SLINK) said
Code:
s:\NLEQ\bug>slink *.obj
*** No object files loaded

I tried typing in the file names in full:
Code:
s:\NLEQ\bug>slink hahn1.obj tenslv.obj fvec_int.obj
*** Could not open:  fvec_int.obj
^C

That is when I listed the directory and saw that the file was a zero-length file.

All this was in 32-bit mode. With /64, a 15-byte OBJ file was produced, but SLINK64 produced an EXE.

The source files with the executable code are (i) hahn1.f90:
Code:
MODULE fdata
IMPLICIT NONE
INTEGER, PARAMETER :: NDAT = 236, NCOEF = 7
REAL :: t(NDAT),y(NDAT)
END MODULE FDATA

PROGRAM xhahn1
USE tensolve
USE fdata
IMPLICIT NONE

INTEGER            :: m, n, msg, termcd, i
REAL               :: x0(NCOEF)

INTERFACE
  SUBROUTINE fhahn1 ( x, f, m, n )
    IMPLICIT NONE
    REAL , INTENT(IN)             :: x(:)
    REAL , INTENT(OUT)            :: f(:)
    INTEGER, INTENT(IN)               :: m
    INTEGER, INTENT(IN)               :: n
  END SUBROUTINE fhahn1
END INTERFACE

!     Set dimensions of the problem.

m      = NDAT
n      = NCOEF

x0 = (/ 1.08d0, -1.23d-3, 4.09d-3, -1.43d-6, -5.76d-3, 2.40d-4, -1.23d-7 /)
msg    = 24

CALL tsnesi(x0, m, n, fhahn1, msg, termcd )

WRITE(*, '(a, i5)')     ' Termination code = ', termcd

!     end of example1 main program.
STOP
END PROGRAM xhahn1

SUBROUTINE fhahn1 ( x, f, m, n )
USE fdata
IMPLICIT NONE
REAL , INTENT(IN)   :: x(:)
REAL , INTENT(OUT)  :: f(:)
INTEGER, INTENT(IN)     :: m
INTEGER, INTENT(IN)     :: n

INTEGER :: i

DO i = 1,m
   f(i) = (((x(4)*t(i)+x(3))*t(i)+x(2))*t(i)+x(1))/ &
          (((x(7)*t(i)+x(6))*t(i)+x(5))*t(i)+1d0 ) &
          - y(i)
END DO

RETURN
END SUBROUTINE fhahn1

[TO BE CONTINUED]


Last edited by mecej4 on Wed Feb 21, 2018 6:48 pm; edited 2 times in total
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Wed Feb 21, 2018 5:18 pm    Post subject: Reply with quote

[CONTINUED]
and (ii) tenslv.f90:
Code:
MODULE tensolve

IMPLICIT NONE

REAL, PARAMETER  :: zero = 0.0, one = 1.0

REAL, ALLOCATABLE, SAVE  :: fc(:), anls(:,:), aja(:,:), s(:,:)
INTEGER, SAVE                 :: qrank, meqns, nvars

CONTAINS

SUBROUTINE tsnesi(x0, m, n, fvec, msg, termcd)

REAL, INTENT(IN OUT)  :: x0(:)
INTEGER, INTENT(IN)        :: m
INTEGER, INTENT(IN)        :: n
INTEGER, INTENT(IN OUT)    :: msg
INTEGER, INTENT(OUT)       :: termcd

include 'fvec_int.f90'   ! for interface to fvec()

REAL :: dfn(m)

IF(msg > 0) print *,'MSG = ',msg
call fvec(x0,dfn,m,n)
termcd = 5
RETURN
END SUBROUTINE tsnesi

END MODULE tensolve
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Fri Feb 23, 2018 8:56 am    Post subject: Reply with quote

Many thanks for the feedback. I have made a note of this.
Back to top
View user's profile Send private message AIM Address
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Sat Mar 10, 2018 5:26 pm    Post subject: Reply with quote

This has been fixed for the next release of FTN95.
Back to top
View user's profile Send private message AIM Address
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group