Results 1 to 5 of 5

Thread: NEQNJ routine throws up error for DOUBLE PRECISION

  1. #1
    Junior Member
    Join Date
    Oct 2016
    Location
    Chennai, India
    Posts
    5

    NEQNJ routine throws up error for DOUBLE PRECISION

    Hi,

    I am trying to use the NEQNJ routine for double precision data. I have modified the example code given in the IMSL Fortran documentation to use double precision data type. However the code on execution keeps throwing the error 3 (from DNEQNJ), i.e., The iteration has not made good progress. The user may try a new initial guess.

    I have included the modified MWE code.

    I believe I am messing up somewhere. Can't figure out though!


    Thanks!


    Code:
          USE NEQNJ_INT
          USE UMACH_INT
     
          IMPLICIT   NONE
    !                                 Declare variables
          INTEGER    N
          PARAMETER  (N=3)
    !
          INTEGER    K, NOUT
          DOUBLE PRECISION     FNORM, X(N), XGUESS(N)
          EXTERNAL   FCN, LSJAC
    !                                 Set values of initial guess
    !                                 XGUESS = (  4.0  4.0  4.0  )
    !
          DATA XGUESS/4.0D0, 4.0D0, 4.0D0/
    !
    !
          CALL UMACH (2, NOUT)
    !                                 Find the solution
          !WRITE(NOUT,*) 'XGUESS:', XGUESS
          CALL D_NEQNJ (FCN, LSJAC, X, XGUESS=XGUESS, FNORM=FNORM)
    !                                 Output
          WRITE (NOUT,99999) (X(K),K=1,N), FNORM
    99999 FORMAT ('  The roots found are', /, '  X = (', 3F5.1, &
                ')', /, '  with FNORM = ',F5.4, //)
    !
          END
    !                                 User-supplied subroutine
          SUBROUTINE FCN (X, F, N)
          INTEGER    N
          REAL       X(N), F(N)
    !
          REAL       EXP, SIN
          INTRINSIC  EXP, SIN
    !
          F(1) = X(1) + EXP(X(1)-1.0D0) + (X(2)+X(3))*(X(2)+X(3)) - 27.0D0
          F(2) = EXP(X(2)-2.0D0)/X(1) + X(3)*X(3) - 10.0D0
          F(3) = X(3) + SIN(X(2)-2.0D0) + X(2)*X(2) - 7.0D0
          RETURN
          END
    !                                 User-supplied subroutine to
    !                                 compute Jacobian
          SUBROUTINE LSJAC (N, X, FJAC)
          INTEGER    N
          REAL       X(N), FJAC(N,N)
    !
          REAL       COS, EXP
          INTRINSIC  COS, EXP
    !
          FJAC(1,1) = 1.0D0 + EXP(X(1)-1.0D0)
          FJAC(1,2) = 2.0D0*(X(2)+X(3))
          FJAC(1,3) = 2.0D0*(X(2)+X(3))
          FJAC(2,1) = -EXP(X(2)-2.0D0)*(1.0D0/X(1)**2)
          FJAC(2,2) = EXP(X(2)-2.0D0)*(1.0D0/X(1))
          FJAC(2,3) = 2.0D0*X(3)
          FJAC(3,1) = 0.0D0
          FJAC(3,2) = COS(X(2)-2.0D0) + 2.0D0*X(2)
          FJAC(3,3) = 1.0D0
          RETURN
          END

  2. #2
    Senior Member mecej4's Avatar
    Join Date
    Dec 2009
    Posts
    127
    You changed the precision of the real variables in the main program, but what about the real variables in subroutines FCN and LSJAC?
    Last edited by mecej4; 07-25-2018 at 04:32 AM.

  3. #3
    Junior Member
    Join Date
    Oct 2016
    Location
    Chennai, India
    Posts
    5
    Quote Originally Posted by mecej4 View Post
    You changed the precision of the real variables in the main program, but what about the real variables in FCN and LSJAC?
    Oops! That was real dumb on my part. Thanks for that quick response!

  4. #4
    Senior Member mecej4's Avatar
    Join Date
    Dec 2009
    Posts
    127
    The compiler can detect mismatches for you if you help it by providing interfaces for arguments that are functions or subroutines. The following is a modified version of your code, with the two subroutines recast as CONTAINed subroutines. Please run your compiler on it, with options (if needed) to check interfaces.
    Code:
          PROGRAM XNE
          USE NEQNJ_INT
          USE UMACH_INT
     
          IMPLICIT   NONE
    !                                 Declare variables
          INTEGER    N
          PARAMETER  (N=3)
    !
          INTEGER    K, NOUT
          DOUBLE PRECISION     FNORM, X(N), XGUESS(N)
    !                                 Set values of initial guess
    !                                 XGUESS = (  4.0  4.0  4.0  )
    !
          DATA XGUESS/4.0D0, 4.0D0, 4.0D0/
    !
    !
          CALL UMACH (2, NOUT)
    !                                 Find the solution
          !WRITE(NOUT,*) 'XGUESS:', XGUESS
          CALL D_NEQNJ (FCN, LSJAC, X, XGUESS=XGUESS, FNORM=FNORM)
    !                                 Output
          WRITE (NOUT,99999) (X(K),K=1,N), FNORM
    99999 FORMAT ('  The roots found are', /, '  X = (', 3F5.1, &
                ')', /, '  with FNORM = ',F5.4, //)
    !
          CONTAINS
    !                                 User-supplied subroutine
          SUBROUTINE FCN (X, F, N)
          INTEGER    N
          REAL       X(N), F(N)
    !
          F(1) = X(1) + EXP(X(1)-1.0D0) + (X(2)+X(3))*(X(2)+X(3)) - 27.0D0
          F(2) = EXP(X(2)-2.0D0)/X(1) + X(3)*X(3) - 10.0D0
          F(3) = X(3) + SIN(X(2)-2.0D0) + X(2)*X(2) - 7.0D0
          RETURN
          END SUBROUTINE
    !                                 User-supplied subroutine to
    !                                 compute Jacobian
          SUBROUTINE LSJAC (N, X, FJAC)
          INTEGER    N
          REAL       X(N), FJAC(N,N)
    !
    !
          FJAC(1,1) = 1.0D0 + EXP(X(1)-1.0D0)
          FJAC(1,2) = 2.0D0*(X(2)+X(3))
          FJAC(1,3) = 2.0D0*(X(2)+X(3))
          FJAC(2,1) = -EXP(X(2)-2.0D0)*(1.0D0/X(1)**2)
          FJAC(2,2) = EXP(X(2)-2.0D0)*(1.0D0/X(1))
          FJAC(2,3) = 2.0D0*X(3)
          FJAC(3,1) = 0.0D0
          FJAC(3,2) = COS(X(2)-2.0D0) + 2.0D0*X(2)
          FJAC(3,3) = 1.0D0
          RETURN
          END SUBROUTINE
      END PROGRAM

  5. #5
    Junior Member
    Join Date
    Oct 2016
    Location
    Chennai, India
    Posts
    5
    Quote Originally Posted by mecej4 View Post
    The compiler can detect mismatches for you if you help it by providing interfaces for arguments that are functions or subroutines. The following is a modified version of your code, with the two subroutines recast as CONTAINed subroutines. Please run your compiler on it, with options (if needed) to check interfaces.
    Thank you for that! Its new to me.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •