From 977d4b6c6e1a2cbfb518ea0632853343dc904d69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20DAVID?= Date: Mon, 22 Jun 2020 15:28:54 +0200 Subject: [PATCH] fix build with gcc 10 * some Fortran 77 code had rank mismatch on functions arguments * TCL threads/locks were declared twice Change-Id: Ic863aa94e397d27b4a5d20f96a4b2fe482b770aa --- scilab/modules/cacsd/src/fortran/optml2.f | 3 ++- .../modules/optimization/src/fortran/fprf2.f | 6 ++++-- .../modules/optimization/src/fortran/n1fc1.f | 3 ++- .../modules/optimization/src/fortran/n1fc1a.f | 19 ++++++++++++++----- .../modules/optimization/src/fortran/n1qn1a.f | 11 ++++++----- .../modules/optimization/src/fortran/nlis2.f | 10 +++++++--- .../special_functions/src/fortran/dbesig.f | 4 ++-- .../special_functions/src/fortran/dbesjg.f | 4 ++-- .../special_functions/src/fortran/dbesyg.f | 4 ++-- scilab/modules/tclsci/src/c/InitTclTk.c | 5 +++++ scilab/modules/tclsci/src/c/TCL_Command.c | 7 +++++++ scilab/modules/tclsci/src/c/TCL_Command.h | 7 ------- 12 files changed, 53 insertions(+), 30 deletions(-) diff --git a/scilab/modules/cacsd/src/fortran/optml2.f b/scilab/modules/cacsd/src/fortran/optml2.f index bc2ba84b49f..0db364821b5 100644 --- a/scilab/modules/cacsd/src/fortran/optml2.f +++ b/scilab/modules/cacsd/src/fortran/optml2.f @@ -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 diff --git a/scilab/modules/optimization/src/fortran/fprf2.f b/scilab/modules/optimization/src/fortran/fprf2.f index 0979c0cd370..6a3086cd244 100644 --- a/scilab/modules/optimization/src/fortran/fprf2.f +++ b/scilab/modules/optimization/src/fortran/fprf2.f @@ -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 diff --git a/scilab/modules/optimization/src/fortran/n1fc1.f b/scilab/modules/optimization/src/fortran/n1fc1.f index 1f063d2229e..ee0aa6319d1 100644 --- a/scilab/modules/optimization/src/fortran/n1fc1.f +++ b/scilab/modules/optimization/src/fortran/n1fc1.f @@ -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 diff --git a/scilab/modules/optimization/src/fortran/n1fc1a.f b/scilab/modules/optimization/src/fortran/n1fc1a.f index 5c8d3ea1d1b..9284b1d1abc 100644 --- a/scilab/modules/optimization/src/fortran/n1fc1a.f +++ b/scilab/modules/optimization/src/fortran/n1fc1a.f @@ -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 diff --git a/scilab/modules/optimization/src/fortran/n1qn1a.f b/scilab/modules/optimization/src/fortran/n1qn1a.f index ae53299942c..d80cf3d292d 100644 --- a/scilab/modules/optimization/src/fortran/n1qn1a.f +++ b/scilab/modules/optimization/src/fortran/n1qn1a.f @@ -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 diff --git a/scilab/modules/optimization/src/fortran/nlis2.f b/scilab/modules/optimization/src/fortran/nlis2.f index a3d60e28206..04c8c7a5ec2 100644 --- a/scilab/modules/optimization/src/fortran/nlis2.f +++ b/scilab/modules/optimization/src/fortran/nlis2.f @@ -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 diff --git a/scilab/modules/special_functions/src/fortran/dbesig.f b/scilab/modules/special_functions/src/fortran/dbesig.f index 215a4039e8d..c4d1e894ec6 100644 --- a/scilab/modules/special_functions/src/fortran/dbesig.f +++ b/scilab/modules/special_functions/src/fortran/dbesig.f @@ -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 diff --git a/scilab/modules/special_functions/src/fortran/dbesjg.f b/scilab/modules/special_functions/src/fortran/dbesjg.f index 8d21ee8e1a1..14610444c81 100644 --- a/scilab/modules/special_functions/src/fortran/dbesjg.f +++ b/scilab/modules/special_functions/src/fortran/dbesjg.f @@ -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 diff --git a/scilab/modules/special_functions/src/fortran/dbesyg.f b/scilab/modules/special_functions/src/fortran/dbesyg.f index a0f530d023a..2f840e42ac0 100644 --- a/scilab/modules/special_functions/src/fortran/dbesyg.f +++ b/scilab/modules/special_functions/src/fortran/dbesyg.f @@ -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 diff --git a/scilab/modules/tclsci/src/c/InitTclTk.c b/scilab/modules/tclsci/src/c/InitTclTk.c index 9709ca2fdec..f8485906736 100644 --- a/scilab/modules/tclsci/src/c/InitTclTk.c +++ b/scilab/modules/tclsci/src/c/InitTclTk.c @@ -38,7 +38,12 @@ #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) diff --git a/scilab/modules/tclsci/src/c/TCL_Command.c b/scilab/modules/tclsci/src/c/TCL_Command.c index 75ca7778d0a..62fa3430c19 100644 --- a/scilab/modules/tclsci/src/c/TCL_Command.c +++ b/scilab/modules/tclsci/src/c/TCL_Command.c @@ -27,6 +27,13 @@ #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 diff --git a/scilab/modules/tclsci/src/c/TCL_Command.h b/scilab/modules/tclsci/src/c/TCL_Command.h index abcc7df64bb..f2266ce9c52 100644 --- a/scilab/modules/tclsci/src/c/TCL_Command.h +++ b/scilab/modules/tclsci/src/c/TCL_Command.h @@ -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__ */ -- 2.25.4