fix rank mismatch in tensor.f so gfortran 10 will still compile it

Changes

@@ -1,3 +1,6 @@
+- fix rank mismatch in tensor.f so gfortran 10 will still compile it
+
+0.07 2022-01-02
 - test stability and more build improvements
 
 0.06 2022-01-02

tensor.f

@@ -65,7 +65,7 @@ SUBROUTINE TENSOR(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
       INTEGER NR,N,ITNLIM,IPR,METHOD,GRDFLG,HESFLG,NDIGIT,MSG
       INTEGER ITNNO,IWRK(N)
       DOUBLE PRECISION X(N),TYPX(N),FSCALE,GRADTL,STEPTL,STEPMX
-      DOUBLE PRECISION XPLS(N),FPLS,GPLS(N),H(NR,N),WRK(NR,8)
+      DOUBLE PRECISION XPLS(N),FPLS,GPLS(N),H(NR,N),WRK(NR,8),FPLSA(1)
       EXTERNAL FCN,GRD,HSN
 C
 C   EQUIVALENCE WRK(N,1) = G(N)
@@ -76,9 +76,10 @@ SUBROUTINE TENSOR(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 C               WRK(N,7) = WK1(N)
 C               WRK(N,8) = WK2(N)
 C
+      FPLSA(1) = FPLS
       CALL OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
      Z         ITNLIM,STEPMX,IPR,METHOD,GRDFLG,HESFLG,NDIGIT,
-     Z         MSG,XPLS,FPLS,GPLS,H,ITNNO,
+     Z         MSG,XPLS,FPLSA,GPLS,H,ITNNO,
      Z         WRK(1,1),WRK(1,2),WRK(1,3),WRK(1,4),
      Z         WRK(1,6),WRK(1,7),WRK(1,8),IWRK)
       RETURN
@@ -188,10 +189,10 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 
       INTEGER NR,N,ITNLIM,IPR,METHOD,GRDFLG,HESFLG,NDIGIT,MSG
       INTEGER ITNNO,PIVOT(N),ICSCMX,I,ITRMCD,IRETCD,IMSG,NFCNT
-      DOUBLE PRECISION F,FP,GPLS(N),G(N),H(NR,N),S(N)
+      DOUBLE PRECISION F(1),FP,GPLS(N),G(N),H(NR,N),S(N)
       DOUBLE PRECISION D(N),WK1(N),TYPX(N),FSCALE,GRADTL,STEPTL
       DOUBLE PRECISION X(N),STEPMX,FINIT
-      DOUBLE PRECISION WK2(N),FPLS,XPLS(N),E(N)
+      DOUBLE PRECISION WK2(N),FPLS(1),XPLS(N),E(N)
       DOUBLE PRECISION DN(N),EPS,RNF,ANALTL,GNORM,TWONRM
       DOUBLE PRECISION ADDMAX,TEMP,ALPHA,BETA,GD,FN,DDOT
       DOUBLE PRECISION RGX,RSX
@@ -231,13 +232,13 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
       DO 20 I=1,N
         WK1(I)=X(I)*TYPX(I)
 20    CONTINUE
-      CALL FCN(N,WK1,F)
+      CALL FCN(N,WK1,F(1))
       NFCNT=NFCNT+1
       IF(GRDFLG .GE. 1)THEN
         CALL GRD(N,WK1,G)
         IF(GRDFLG .EQ. 1)THEN
           FSCALE=1D0
-          CALL GRDCHK(N,WK1,FCN,F,G,DN,TYPX,FSCALE,RNF,ANALTL,WK2,
+          CALL GRDCHK(N,WK1,FCN,F(1),G,DN,TYPX,FSCALE,RNF,ANALTL,WK2,
      Z                    MSG,IPR,NFCNT)
         END IF
       ELSE
@@ -251,25 +252,25 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 C
 C     PRINT OUT 1ST ITERATION?
       IF(MSG .GE. 1)THEN
-        WRITE(IPR,25)F
+        WRITE(IPR,25)F(1)
 25      FORMAT(' INITIAL FUNCTION VALUE F=',E20.13)
         WRITE(IPR,30)(G(I),I=1,N)
 30      FORMAT(' INITIAL GRADIENT G=',999E20.13)
       END IF
 C
 C     TEST WHETHER THE INITIAL GUESS SATISFIES THE STOPPING CRITERIA
       IF(GNORM .LE. GRADTL)THEN
-        FPLS=F
+        FPLS(1)=F(1)
         DO 40,I=1,N
            XPLS(I)=X(I)
            GPLS(I)=G(I)
 40      CONTINUE
-        CALL OPTSTP(N,XPLS,FPLS,GPLS,X,ITNNO,ICSCMX,
+        CALL OPTSTP(N,XPLS,FPLS(1),GPLS,X,ITNNO,ICSCMX,
      Z            ITRMCD,GRADTL,STEPTL,FSCALE,ITNLIM,IRETCD,
      Z            MXTAKE,IPR,MSG,RGX,RSX)   
         GO TO 350
       END IF
-      FINIT=F
+      FINIT=F(1)
 C
 C------------------------
 C     ITERATION 1 |
@@ -282,15 +283,15 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
         IF (GRDFLG .EQ. 1)  THEN
            CALL FSTOFD(NR,N,N,WK1,GRD,G,H,TYPX,RNF,WK2,3,NFCNT)
         ELSE
-           CALL SNDOFD(NR,N,WK1,FCN,F,H,TYPX,RNF,WK2,D,NFCNT)
+           CALL SNDOFD(NR,N,WK1,FCN,F(1),H,TYPX,RNF,WK2,D,NFCNT)
         END IF
       ELSE
         IF(HESFLG .EQ. 2)THEN
           CALL HSN(NR,N,WK1,H)
         ELSE
           IF(HESFLG .EQ. 1)THEN
 C           IN HESCHK GPLS,XPLS AND E ARE USED AS WORK SPACE
-            CALL HESCHK(NR,N,WK1,FCN,GRD,HSN,F,G,H,DN,TYPX,RNF,
+            CALL HESCHK(NR,N,WK1,FCN,GRD,HSN,F(1),G,H,DN,TYPX,RNF,
      Z                    ANALTL,GRDFLG,GPLS,XPLS,E,MSG,IPR,NFCNT)
           END IF
         END IF
@@ -311,7 +312,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 
 C
 C     APPLY LINESEARCH TO THE NEWTON STEP
-      CALL LNSRCH(NR,N,X,F,G,D,XPLS,FPLS,MXTAKE,IRETCD,STEPMX,
+      CALL LNSRCH(NR,N,X,F(1),G,D,XPLS,FPLS(1),MXTAKE,IRETCD,STEPMX,
      Z                STEPTL,TYPX,FCN,WK1,NFCNT)
 C
 C     UPDATE G
@@ -328,16 +329,16 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
       END IF
 C
 C     CHECK STOPPING CONDITIONS
-      CALL OPTSTP(N,XPLS,FPLS,GPLS,X,ITNNO,ICSCMX,
+      CALL OPTSTP(N,XPLS,FPLS(1),GPLS,X,ITNNO,ICSCMX,
      Z            ITRMCD,GRADTL,STEPTL,FSCALE,ITNLIM,IRETCD,
      Z            MXTAKE,IPR,MSG,RGX,RSX)   
 C
 C     IF ITRMCD > 0 THEN STOPPING CONDITIONS SATISFIED
       IF(ITRMCD .GT. 0)GO TO 350
 C
 C     UPDATE X,F AND S FOR TENSOR MODEL
-      FP=F
-      F=FPLS
+      FP=F(1)
+      F(1)=FPLS(1)
       DO 90 I=1,N
         TEMP=XPLS(I)
         S(I)=X(I)-TEMP
@@ -351,7 +352,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 103     FORMAT(' -----------    ITERATION ',I4,' ----------------')
           WRITE(IPR,104)(X(I),I=1,N)
 104     FORMAT(' X=',999E20.13)
-        WRITE(IPR,105)FPLS
+        WRITE(IPR,105)FPLS(1)
 105     FORMAT(' F(X)=',E20.13)
         WRITE(IPR,106)(GPLS(I),I=1,N)
 106     FORMAT(' G(X)=',999E20.13)
@@ -376,7 +377,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
         IF (GRDFLG .EQ. 1)  THEN
            CALL FSTOFD(NR,N,N,WK1,GRD,G,H,TYPX,RNF,WK2,3,NFCNT)
         ELSE
-           CALL SNDOFD(NR,N,WK1,FCN,F,H,TYPX,RNF,WK2,D,NFCNT)
+           CALL SNDOFD(NR,N,WK1,FCN,F(1),H,TYPX,RNF,WK2,D,NFCNT)
         END IF
       ELSE  
         CALL HSN(NR,N,WK1,H)
@@ -405,7 +406,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
       END IF
 C
 C     FORM TENSOR MODEL
-      CALL MKMDL(NR,N,F,FP,GPLS,G,S,H,ALPHA,BETA,WK1,D)
+      CALL MKMDL(NR,N,F(1),FP,GPLS,G,S,H,ALPHA,BETA,WK1,D)
 C
 C   SOLVE TENSOR MODEL AND COMPUTE NEWTON STEP
 C   ON INPUT : SH IS STORED IN WK1
@@ -433,20 +434,20 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
       CALL DCOPY(N,GPLS(1),1,G(1),1)
 C
 C     APPLY LINESEARCH TO TENSOR (OR NEWTON) STEP
-      CALL LNSRCH(NR,N,X,F,G,D,XPLS,FPLS,MXTAKE,IRETCD,STEPMX,
+      CALL LNSRCH(NR,N,X,F(1),G,D,XPLS,FPLS(1),MXTAKE,IRETCD,STEPMX,
      Z                STEPTL,TYPX,FCN,WK1,NFCNT)
 C
       IF(.NOT. NOMIN)THEN
 C       TENSOR STEP IS FOUND AND IN DESCENT DIRECTION, 
 C       APPLY LINESEARCH TO NEWTON STEP
 C       NEW NEWTON POINT IN WK2
-        CALL LNSRCH(NR,N,X,F,G,DN,WK2,FN,MXTAKE,IRETCD,STEPMX,
+        CALL LNSRCH(NR,N,X,F(1),G,DN,WK2,FN,MXTAKE,IRETCD,STEPMX,
      Z                STEPTL,TYPX,FCN,WK1,NFCNT)
 C
 C       COMPARE TENSOR STEP TO NEWTON STEP
 C       IF NEWTON STEP IS BETTER, SET NEXT ITERATE TO NEW NEWTON POINT
-        IF(FN .LT. FPLS)THEN
-          FPLS=FN
+        IF(FN .LT. FPLS(1))THEN
+          FPLS(1)=FN
           CALL DCOPY(N,DN(1),1,D(1),1)
           CALL DCOPY(N,WK2(1),1,XPLS(1),1)
         END IF
@@ -459,7 +460,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
       DO 330 I=1,N
          WK1(I)=XPLS(I)*TYPX(I)
 330   CONTINUE
-      CALL FCN(N,WK1,FPLS)
+      CALL FCN(N,WK1,FPLS(1))
       NFCNT=NFCNT+1
       IF(GRDFLG .GE. 1)THEN
         CALL GRD(N,WK1,GPLS)
@@ -469,7 +470,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 C
 C     CHECK STOPPING CONDITIONS
       IMSG=MSG
-      CALL OPTSTP(N,XPLS,FPLS,GPLS,X,ITNNO,ICSCMX,
+      CALL OPTSTP(N,XPLS,FPLS(1),GPLS,X,ITNNO,ICSCMX,
      Z            ITRMCD,GRADTL,STEPTL,FSCALE,ITNLIM,IRETCD,
      Z            MXTAKE,IPR,MSG,RGX,RSX)   
 C
@@ -487,7 +488,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 370     FORMAT(' FINAL X=',999E20.13)
         WRITE(IPR,380)(GPLS(I),I=1,N)
 380     FORMAT(' GRADIENT G=',999E20.13)
-        WRITE(IPR,390)FPLS,ITNNO
+        WRITE(IPR,390)FPLS(1),ITNNO
 390     FORMAT(' FUNCTION VALUE F(X)=',E20.13,
      Z         ' AT ITERATION ',I4) 
         IF (IMSG .GE. 3) THEN
@@ -502,7 +503,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
            IF (GRDFLG .EQ. 1)  THEN
               CALL FSTOFD(NR,N,N,XPLS,GRD,GPLS,H,TYPX,RNF,WK2,3,NFCNT)
            ELSE
-              CALL SNDOFD(NR,N,XPLS,FCN,FPLS,H,TYPX,RNF,WK2,D,NFCNT)
+              CALL SNDOFD(NR,N,XPLS,FCN,FPLS(1),H,TYPX,RNF,WK2,D,NFCNT)
            END IF
         ELSE  
           CALL HSN(NR,N,XPLS,H)
@@ -525,7 +526,7 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
 560     FORMAT(' -----------    ITERATION ',I4,' ----------------')
           WRITE(IPR,570)(X(I),I=1,N)
 570     FORMAT(' X=',999E20.13)
-        WRITE(IPR,580)FPLS
+        WRITE(IPR,580)FPLS(1)
 580     FORMAT(' F(X)=',E20.13)
         WRITE(IPR,590)(GPLS(I),I=1,N)
 590     FORMAT(' G(X)=',999E20.13)
@@ -538,8 +539,8 @@ SUBROUTINE OPT(NR,N,X,FCN,GRD,HSN,TYPX,FSCALE,GRADTL,STEPTL,
       ENDIF
 
 C     UPDATE F
-      FP=F
-      F=FPLS
+      FP=F(1)
+      F(1)=FPLS(1)
 C
 C     PERFORM NEXT ITERATION
       GO TO 200
@@ -701,8 +702,8 @@ SUBROUTINE GRDCHK(N,X,FCN,F,G,TYPSIZ,TYPX,FSCALE,RNF,
 C IPR          --> DEVICE TO WHICH TO SEND OUTPUT                       
 C IFN         <--> NUMBER OF FUNCTION EVALUATIONS
       INTEGER N,MSG,IPR,IFN,KER,I
-      DOUBLE PRECISION F,X(N),G(N),TYPX(N),FSCALE,ANALTL,RNF
-      DOUBLE PRECISION TYPSIZ(N),GS,WRK
+      DOUBLE PRECISION F(1),X(N),G(N),TYPX(N),FSCALE,ANALTL,RNF
+      DOUBLE PRECISION TYPSIZ(N),GS,WRK(1)
       DOUBLE PRECISION WRK1(N)                                                 
       EXTERNAL FCN                                                      
       INTRINSIC ABS,MAX
@@ -713,7 +714,7 @@ SUBROUTINE GRDCHK(N,X,FCN,F,G,TYPSIZ,TYPX,FSCALE,RNF,
       CALL FSTOFD(1,1,N,X,FCN,F,WRK1,TYPX,RNF,WRK,1,IFN)
       KER=0
       DO 5 I=1,N
-        GS=MAX(ABS(F),FSCALE)/MAX(ABS(X(I)),TYPSIZ(I))
+        GS=MAX(ABS(F(1)),FSCALE)/MAX(ABS(X(I)),TYPSIZ(I))
         IF(ABS(G(I)-WRK1(I)).GT.MAX(ABS(G(I)),GS)*ANALTL) KER=1
     5 CONTINUE
       IF(KER.EQ.0) GO TO 20

tn.f

@@ -1,7 +1,7 @@
       subroutine lmqn (ifail, n, x, f, g, w, lw, sfun,
      *            msglvl, maxit, maxfun, eta, stepmx, accrcy, xtol)
       implicit          double precision (a-h,o-z)
-      integer           msglvl, n, maxfun, ifail, lw
+      integer           msglvl, n, maxfun, ifail, lw, ipivot(1)
       double precision  x(n), g(n), w(lw), eta, xtol, stepmx, f, accrcy
 
 c
@@ -644,7 +644,7 @@ subroutine lmqnbc (ifail, n, x, f, g, w, lw, sfun, low, up,
 c
 150   f = oldf
       if (msglvl .ge. 1) call monit(n,x,
-     *     f,g,niter,nftotl,nfeval,ireset,ipivot)
+     *     f,g,niter,nftotl,nfeval,.true.,ipivot)
 c
 c set ifail
 c
@@ -681,13 +681,14 @@ subroutine lmqnbc (ifail, n, x, f, g, w, lw, sfun, low, up,
       end
 c
 c
-      subroutine monit(n,x,f,g,niter,nftotl,nfeval,ireset,ipivot)
+      subroutine monit(n,x,f,g,niter,nftotl,nfeval,lreset,ipivot)
 c
 c print results of current iteration
 c
       implicit         double precision (a-h,o-z)
       double precision x(n),f,g(n),gtg
       integer          ipivot(n)
+      logical          lreset
 c
       gtg = 0.d0
       do 10 i = 1,n