fix build with gcc 10 10/21510/4
Clément DAVID [Mon, 22 Jun 2020 13:28:54 +0000 (15:28 +0200)]
 * some Fortran 77 code had rank mismatch on functions arguments
 * TCL threads/locks were declared twice

Change-Id: Ic863aa94e397d27b4a5d20f96a4b2fe482b770aa

12 files changed:
scilab/modules/cacsd/src/fortran/optml2.f
scilab/modules/optimization/src/fortran/fprf2.f
scilab/modules/optimization/src/fortran/n1fc1.f
scilab/modules/optimization/src/fortran/n1fc1a.f
scilab/modules/optimization/src/fortran/n1qn1a.f
scilab/modules/optimization/src/fortran/nlis2.f
scilab/modules/special_functions/src/fortran/dbesig.f
scilab/modules/special_functions/src/fortran/dbesjg.f
scilab/modules/special_functions/src/fortran/dbesyg.f
scilab/modules/tclsci/src/c/InitTclTk.c
scilab/modules/tclsci/src/c/TCL_Command.c
scilab/modules/tclsci/src/c/TCL_Command.h

index bc2ba84..0db3648 100644 (file)
@@ -169,7 +169,8 @@ C
 C
         call feq(neq,t,q,w(lqdot))
         dnorm0 = dnrm2(nq,w(lqdot),1)
-        if (info .gt. 1) call outl2(31,nq,nbout,q,dnorm0,t,tout)
+        xx(1) = dnorm0
+        if (info .gt. 1) call outl2(31,nq,nbout,q,xx,t,tout)
 C
 C     -- test pour degre1 -----------
         if (nall1.gt.0 .and. nq.eq.1 .and. nbout.gt.0) return
index 0979c0c..6a3086c 100644 (file)
@@ -354,7 +354,8 @@ C
       w12s = 0.d0
       l = jc(k0)
       if (l .ne. 1) nc = nc - 1
-      if (iprint.gt.6) call n1fc1o(io,32,k0,l,i3,i4,i5,y(k0),ps1,ps2,d4)
+      d3(1) = ps2
+      if (iprint.gt.6) call n1fc1o(io,32,k0,l,i3,i4,i5,y(k0),ps1,d3,d4)
       if (k0 .gt. nv) goto 400
       k1 = k0 - 1
       do 620 k = k0,nv
@@ -398,6 +399,7 @@ C
  940  continue
       u = u1
       if (iprint .le. 5) return
-      call n1fc1o(io,34,nc,nv,i3,i4,jc,s2,sp,u1,d4)
+      d3(1) = u1
+      call n1fc1o(io,34,nc,nv,i3,i4,jc,s2,sp,d3,d4)
       return
       end
index 1f063d2..ee0aa63 100644 (file)
@@ -53,7 +53,8 @@ C
       niz = 2 * (memax+1)
       nrz = nq + n*memax - 1
       ndz = nw2 + memax
-      if (iprint.gt.0) call n1fc1o(io,2,n,memax,niz,nrz,ndz,d1,d2,d3,d4)
+      i5(1) = ndz
+      if (iprint.gt.0) call n1fc1o(io,2,n,memax,niz,nrz,i5,d1,d2,d3,d4)
       do 110 i = 1,niz
  110  iz(i) = 0
       do 120 i = 1,nrz
index 5c8d3ea..9284b1d 100644 (file)
@@ -60,7 +60,7 @@ C cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      &          xga(*), y(*), w1(*), w2(*)
       dimension q(*), al(memax), aps(memax), anc(memax), poids(memax)
       real rzs(*)
-      dimension i5(1), d3(1), d4(1)
+      dimension i5(1), d2(1), d3(1), d4(1)
 C
 C         initialisations
 C
@@ -152,7 +152,9 @@ C         calcul de la precision
         if (j .gt. 0) z = z + xga(k)*poids(j)
  270  continue
       epsm = dmin1(eps,z)
-      if(iprint.ge.2) call n1fc1o(io,8,iter,nsim,i3,i4,i5,fn,epsm,s2,d4)
+      d2(1) = epsm
+      d3(1) = s2
+      if(iprint.ge.2) call n1fc1o(io,8,iter,nsim,i3,i4,i5,fn,d2,d3,d4)
       if (epsm .gt. eps0) goto 280
       mode = 1
       if (iprint .gt. 0) call n1fc1o(io,9,i1,i2,i3,i4,i5,d1,d2,d3,d4)
@@ -169,7 +171,10 @@ C                 suite des iterations
 C                    impressions
 C
  300  if (iprint .gt. 3) call n1fc1o(io,10,i1,i2,i3,i4,i5,d1,d2,d3,d4)
-      if (iprint.gt.2) call n1fc1o(io,11,iter,nsim,nv,i4,i5,fn,eps,s2,u)
+      d2(1) = eps
+      d3(1) = s2
+      d4(1) = u
+      if (iprint.gt.2) call n1fc1o(io,11,iter,nsim,nv,i4,i5,fn,d2,d3,d4)
       if(iprint.ge.6) call n1fc1o(io,12,ntot,i2,i3,i4,i5,d1,d2,d3,poids)
 C                test de non-pivotage
       if (logic .ne. 3) goto 350
@@ -231,7 +236,9 @@ C              1ere iteration, ajustement de ap, diam et eta
       ajust = ro / roa
       if (logic .ne. 3) diam2 = diam2 * ajust * ajust
       if (logic .ne. 3) eta2 = eta2 / (ajust*ajust)
-      if(iprint.ge.2) call n1fc1o(io,18,i1,i2,i3,i4,i5,diam2,eta2,ap,d4)
+      d2(1) = eta2
+      d3(1) = ap
+      if(iprint.ge.2) call n1fc1o(io,18,i1,i2,i3,i4,i5,diam2,d2,d3,d4)
  390  mm = memax - 1
       if (logic .eq. 2) mm = memax - 2
       if (ntot .le. mm) goto 400
@@ -245,7 +252,9 @@ C
       if (iprint .ge. 2)
      &  call n1fc1o(io,19,iter,nsim,ntot,i4,i5,fn,d2,d3,d4)
 C
- 400  if(iprint.ge.5) call n1fc1o(io,20,logic,i2,i3,i4,i5,ro,tps,tnc,d4)
+      d2(1) = tps
+      d3(1) = tnc
+ 400  if(iprint.ge.5) call n1fc1o(io,20,logic,i2,i3,i4,i5,ro,d2,d3,d4)
       if (logic .eq. 3) goto 500
 C
 C                 iteration de descente
index ae53299..d80cf3d 100644 (file)
@@ -22,7 +22,7 @@ c
 *     just for output (the computing code is normally not modified).
 
       implicit double precision (a-h,o-z)
-      dimension x(n),g(n),scale(n),h(*),d(n),w(n),
+      dimension x(n),f(1),g(n),scale(n),h(*),d(n),w(n),
      1 xa(n),ga(n),xb(n),gb(n),izs(*),dzs(*)
       character bufstr*(4096)
       real rzs(*)
@@ -122,7 +122,7 @@ c                verification que la diagonale est positive
    90 k=k+np-i
 c                quelques initialisations
   100 dff=0.0d+0
-  110 fa=f
+  110 fa=f(1)
       isfv=1
       do 120 i=1,n
       xa(i)=x(i)
@@ -208,7 +208,8 @@ c              calcul de fonction-gradient
       indic=4
       call simul (indic,n,xb,fb,gb,izs,rzs,dzs)
 c     next line added by Serge to avoid Inf and Nan's (04/2007)
-      if (vfinite(1,fb).ne.1.and.vfinite(n,gb).ne.1) indic=-1
+      f(1) = fb
+      if (vfinite(1,f).ne.1.and.vfinite(n,gb).ne.1) indic=-1
 c              test sur indic
       if (indic.gt.0) goto 185
       if (indic.lt.0) goto 183
@@ -236,8 +237,8 @@ c              test sur indic
       goto 240
 c             stockage si c'est la plus petite valeur
   185 isfv=min(2,isfv)
-      if (fb.gt.f) go to 220
-      if (fb.lt.f) go to 200
+      if (fb.gt.f(1)) go to 220
+      if (fb.lt.f(1)) go to 200
       gl1=0.0d+0
       gl2=0.0d+0
       do 190 i=1,n
index a3d60e2..04c8c7a 100644 (file)
@@ -76,7 +76,9 @@ c
    30 if(t.lt.tmax) go to 40
       t=tmax
       logic=1
-   40 if(iprint.ge.4) call n1fc1o(io,36,i1,i2,i3,i4,i5,fpn,d2,tmin,tmax)
+      d3(1) = tmin
+      d4(1) = tmax
+   40 if(iprint.ge.4) call n1fc1o(io,36,i1,i2,i3,i4,i5,fpn,d2,d3,d4)
       do 50 i=1,n
    50 x(i)=xn(i)+t*d(i)
 c
@@ -129,7 +131,8 @@ c         test de descente (premiere inegalite pour un pas serieux)
   230 gd(i)=g(i)
       indicd=indic
       logic=0
-      if(iprint.ge.4) call n1fc1o(io,40,i1,i2,i3,i4,i5,t,ffn,fp,d4)
+      d3(1) = fp
+      if(iprint.ge.4) call n1fc1o(io,40,i1,i2,i3,i4,i5,t,ffn,d3,d4)
       if(tg.ne.0.) go to 500
 c                tests pour un pas nul (si tg=0)
       if(fpd.lt.tesd) go to 500
@@ -141,7 +144,8 @@ c                tests pour un pas nul (si tg=0)
       go to 999
 c
 c                    descente
-  300 if(iprint.ge.4) call n1fc1o(io,41,i1,i2,i3,i4,i5,t,ffn,fp,d4)
+      d3(1) = fp
+  300 if(iprint.ge.4) call n1fc1o(io,41,i1,i2,i3,i4,i5,t,ffn,d3,d4)
 c
 c         test de derivee (deuxieme inegalite pour un pas serieux)
       if(fp.lt.tesd) go to 320
index 215a403..c4d1e89 100644 (file)
@@ -128,13 +128,13 @@ C         values
       if (na.lt.0) then
 c     .  element wise case x and alpha are supposed to have the same size
          do i=1,nx
-            call  dbesig (x(i), alpha(i),kode,1,y(i), nz, w1,ier)
+            call  dbesig (x(i), alpha(i),kode,1,y(i), nz, w,ier)
             ierr=max(ierr,ier)
          enddo
       elseif (na.eq.1) then
 c     .  element wise case x and alpha are supposed to have the same size
          do i=1,nx
-            call  dbesig (x(i), alpha(1),kode,1,y(i), nz, w1,ier)
+            call  dbesig (x(i), alpha(1),kode,1,y(i), nz, w,ier)
             ierr=max(ierr,ier)
          enddo
       else
index 8d21ee8..1461044 100644 (file)
@@ -141,13 +141,13 @@ C         values
       if (na.lt.0) then
 c     .  element wise case x and alpha are supposed to have the same size
          do i=1,nx
-            call  dbesjg (x(i), alpha(i),1,y(i), nz, w1,ier)
+            call  dbesjg (x(i), alpha(i),1,y(i), nz, w,ier)
             ierr=max(ierr,ier)
          enddo
       elseif (na.eq.1) then
 c     .  element wise case x and alpha are supposed to have the same size
          do i=1,nx
-            call  dbesjg (x(i), alpha(1),1,y(i), nz, w1,ier)
+            call  dbesjg (x(i), alpha(1),1,y(i), nz, w,ier)
             ierr=max(ierr,ier)
          enddo
       else
index a0f530d..2f840e4 100644 (file)
@@ -122,13 +122,13 @@ C         values
       if (na.lt.0) then
 c     .  element wise case x and alpha are supposed to have the same size
          do i=1,nx
-            call  dbesyg (abs(x(i)), alpha(i),1,y(i), nz, w1,ier)
+            call  dbesyg (abs(x(i)), alpha(i),1,y(i), nz, w,ier)
             ierr=max(ierr,ier)
          enddo
       elseif (na.eq.1) then
 c     .  element wise case x and alpha are supposed to have the same size
          do i=1,nx
-            call  dbesyg (abs(x(i)), alpha(1),1,y(i), nz, w1,ier)
+            call  dbesyg (abs(x(i)), alpha(1),1,y(i), nz, w,ier)
             ierr=max(ierr,ier)
          enddo
       else
index 9709ca2..f848590 100644 (file)
 #include "getshortpathname.h"
 /*--------------------------------------------------------------------------*/
 BOOL TK_Started = FALSE;
+/* The tclLoop thread Id, declared in TCL_Command.c
+in order to wait it ends when closing Scilab */
+extern __threadId TclThread;
 
+extern __threadSignal InterpReady;
+extern __threadSignalLock InterpReadyLock;
 /*--------------------------------------------------------------------------*/
 static char *GetSciPath(void);
 static void releaseTclInterpOnError(void)
index 75ca777..62fa343 100644 (file)
 #include "TCL_Command.h"
 #include "GlobalTclInterp.h"
 
+/* The tclLoop thread Id
+in order to wait it ends when closing Scilab */
+__threadId TclThread;
+
+__threadSignal InterpReady;
+__threadSignalLock InterpReadyLock;
+
 // Globla Tcl Slave Name
 char *                 TclSlave;
 // Global Tcl Command Buffer
index abcc7df..f2266ce 100644 (file)
@@ -83,11 +83,4 @@ int          getTclCommandReturn(void);
 */
 char           *getTclCommandResult(void);
 
-/* The tclLoop thread Id
-in order to wait it ends when closing Scilab */
-__threadId TclThread;
-
-__threadSignal InterpReady;
-__threadSignalLock InterpReadyLock;
-
 #endif /* !__TCL_COMMAND_H__ */