[Go to BBS]
All articles in a thread
Subjectftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No22
Date: 2005/10/28(Fri) 16:12:42
ContributorAkio Morita
ftnchekを用いた、syntax checkで判明している引数不足な呼び出し

Active file中で発生している呼び出し不整合(Invoked argc < Defined argc)
定義				呼び出しもと
doelem@doelem.f			toplvl.f
termes@termes.f
mkmachinef@initdainterface.f
pasex@pasex.f			mccor.f
msolv1@msolv1.f			msolv.f
chkflst@pfalloc.f
itfmessageexp@itfmessage.f
tfconvstr@tfconvstr.f		tffile.f,pstati.f,preadstr.f,preadmon.f,petune.f
tthin@tquad.f			tquads.f,tstrad.f
tthine@tthine.f			tturne.f
ttstat@ttstat.f			track.f
undulator@undulator.f		tturn.f

Obsolete file中の非互換関数
tfreev@itfaloc1.f
tvset@itfaloc1.f
tfearray@tfearray1.f

SubjectRe: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No23
Date: 2005/10/31(Mon) 12:26:24
ContributorAkio Morita
> doelem@doelem.f
> termes@termes.f
> mkmachinef@initdainterface.f
> pasex@pasex.f
への修正
pasexの呼び出しもと mccor.fの修正は怪しいが
``Orbit Correction commands will be removed soon''
らしいので、問題ない?(Ref. mcmess@tffsa.f)

----PATCH----
Index: src/tfvars.f
===================================================================
--- src/tfvars.f	(revision 363)
+++ src/tfvars.f	(working copy)
@@ -89,7 +89,7 @@
             if(ierrorprint .ne. 0)then
               call tfaddmessage(irtc,' ',2,6)
             endif
-            call termes(6,'Error in VariableRange '//
+            call termes(6,'Error in VariableRange ',
      $           pname(k)(1:lenw(pname(k)))//' '//key(1:lenw(key)))
             do j=i,nvar
               call tfsetlist(ntfoper,mtfnull,0.d0,iax,j)
Index: src/tffsa.f
===================================================================
--- src/tffsa.f	(revision 363)
+++ src/tffsa.f	(working copy)
@@ -1035,9 +1035,8 @@
         go to 12
       elseif(abbrev(word,'COR_RECT','_')) then
         call mcmess(lfno)
-        call mccor(word,ilist(1,ilattp+1),rlist(iftwis),rlist(ifgamm),
-     $       ilist(1,ifmult),
-     $       ilist(1,ifmast),kfit,ifitp,
+        call mccor(word,ilist(1,ilattp+1),rlist(ifpos),rlist(iftwis),
+     $       rlist(ifgamm),ilist(1,ifmult),ilist(1,ifmast),kfit,ifitp,
      1       mfitp,fitval,nfc,rlist(itstr),rlist(itestr),nster,
      1       rlist(itmon),rlist(itemon),nmon,newcor,lfno)
         go to 12
Index: src/doelem.f
===================================================================
--- src/doelem.f	(revision 363)
+++ src/doelem.f	(working copy)
@@ -1,7 +1,5 @@
-      subroutine doelem(elmcd,dummy)
+      subroutine doelem(elmcd)
       implicit none
-      integer elmcd
-      real*8 dummy
 c
       include 'inc/MACCBK.inc'
       include 'inc/MACFUN.inc'
@@ -10,6 +8,7 @@
       include 'inc/MACTTYP.inc'
       include 'inc/MACCODE.inc'
       include 'inc/MACKW.inc'
+      integer*4 elmcd
       character*(MAXSTR) token,wtoken*(*)
       integer slen,ival,ttype,hsrchz,slen2,ttype2,idx
       real*8 rval
Index: src/mccor.f
===================================================================
--- src/mccor.f	(revision 363)
+++ src/mccor.f	(working copy)
@@ -1,4 +1,4 @@
-      subroutine mccor(word,latt,twiss,gammab,mult,master,kfit,ifitp,
+      subroutine mccor(word,latt,pos,twiss,gammab,mult,master,kfit,ifitp,
      $     mfitp,fitval,nfc,istr,estr,nstr,imon,emon,nmon,newcor,lfno)
 c -**** Main routine for orbit correction ****--------------------------
 c  Note
@@ -23,7 +23,7 @@
       logical stab,cod,dsp,normal,xplane,yplane,both,bump,minusi,micado,
      1        cond,zsum,exist,exec,coup,operate
       logical corc(nkey),corcn(nkey),corca(nobj),method(nobj,nmeth)
-      dimension latt(2,nlat),twiss(nlat,-ndim:ndim,ntwissfun),
+      dimension latt(2,nlat),pos(nlat),twiss(nlat,-ndim:ndim,ntwissfun),
      $     gammab(nlat),mult(nlat),master(nlat)
       dimension dp1(-ndim:ndim)
       dimension istr(nstra,4),imon(nmona,4),emon(*),estr(*)
@@ -373,9 +373,9 @@
 c     z                   istr,istr(1,2),estr,nstr,imon,
 c     z                   nmon,corc,lfno)
               else
-                call pasex(word,latt,twiss,mult,
-     $               gammab,istr,estr,nstr,imon,emon,
-     $               nmon,lstack,lfno)
+                call pasex(word,latt,pos,twiss,mult,master,
+     $               gammab,' ',' ',istr,estr,nstr,imon,emon,nmon,
+     $               lfno)
               endif 
               exit
             endif
Index: src/initdainterface.f
===================================================================
--- src/initdainterface.f	(revision 363)
+++ src/initdainterface.f	(working copy)
@@ -16,9 +16,9 @@
         return
       endif
       if(itastk(1,isp) .eq. ntfreal)then     !Check the type of arg
-        call mkmachinef
         nord=vstk(ivstkoffset+isp)
         nvar=6
+        call mkmachinef(nord)
         call initda(nord,lvec)     !If real, vstk(ivstkoffset+isp1+i)has
 c                                  !the i-th value.
         itx=ntfoper                !Type of return value of function.
----PATCH----

SubjectRe^2: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No24
Date: 2005/10/31(Mon) 14:30:59
ContributorAkio Morita
もうすこし、まじめに直したパッチ
前の奴は、mccor.fで72桁を越えるというenbugが...

  Fix proto-type of yyerror()
	src/yylex.f

  Fix API mismatch of undularor() invoke
   Remove unused `iturn' argument
   Rename argument name `work' to `pz'
	src/undulator.f

  Fix API mismatch of mkmachinef() invoke
	src/initdainterface.f

  Fix API mismatch of termes() invoke
	src/tfvars.f

  Redirect API call prmmap@malloc.f/prmmap.f(obsolete) to pr_mem_map@pfalloc.f
	src/ActLie.f
	src/ActTra.f
	src/doACT.f
	src/dolist.f

  Fix API mismatch of doelem() invoke
   Remove `dummy' argument
   Fix argument type(Integer -> Integer*4)
	src/doelem.f

  Fix API mismatch of pasex() invoke
   mccor() API is changed to obtain pos argument for pasex
	src/mccor.f
	src/tffsa.f
----PATCH----
Index: src/undulator.f
===================================================================
--- src/undulator.f	(revision 382)
+++ src/undulator.f	(revision 390)
@@ -1,5 +1,5 @@
 C   18/01/93 303061342  MEMBER NAME  UNDULATOR *.FORT     M  E2FORT
-        subroutine undulator(np,x,px,y,py,z,g,dv,work,ulist,iturn)
+        subroutine undulator(np,x,px,y,py,z,g,dv,pz,ulist)
 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 c                                                                 c
 c  Undulator tracking subroutine.                                 c
@@ -14,7 +14,7 @@
 c      implicit none
       parameter (nsli=1,npole=2,len=3,i_F0=4,i_G0=5,i_dph=6,
      &   i_Kz=7,i_Kx=8,i_Ky=9,i_Qx=10,i_Qy=11,lambda=12,i_ds=13)
-      real*8 x(np),px(np),y(np),py(np),z(np),g(np),dv(np),work(np)
+      real*8 x(np),px(np),y(np),py(np),z(np),g(np),dv(np),pz(np)
       real*8 ulist(*)
       real*8 sinkz,sinkzp
       real*8 kx1,kx2,kx3,kx4,ff,gg,fx,fy,gx,gy,dpds
Index: src/tfvars.f
===================================================================
--- src/tfvars.f	(revision 382)
+++ src/tfvars.f	(revision 390)
@@ -89,7 +89,7 @@
             if(ierrorprint .ne. 0)then
               call tfaddmessage(irtc,' ',2,6)
             endif
-            call termes(6,'Error in VariableRange '//
+            call termes(6,'Error in VariableRange ',
      $           pname(k)(1:lenw(pname(k)))//' '//key(1:lenw(key)))
             do j=i,nvar
               call tfsetlist(ntfoper,mtfnull,0.d0,iax,j)
Index: src/yylex.f
===================================================================
--- src/yylex.f	(revision 382)
+++ src/yylex.f	(revision 390)
@@ -99,7 +99,10 @@
       return
       end
 c
-      subroutine yyerror()
+      subroutine yyerror(msg)
+      implicit none
+      character*(*) msg
+      write (*,*) 'LALR(1) parser: ', msg
       return
       end
 c
Index: src/ActTra.f
===================================================================
--- src/ActTra.f	(revision 382)
+++ src/ActTra.f	(revision 390)
@@ -211,7 +211,7 @@
 c     print *,np,nt,p0,charge,mass,sync,ex,ey,sigs,sige
 c     
 c.....construct initial value list.
-c     call prmmap
+c     call pr_mem_map
 c     if(igetgl('$COD$',idummy) .ne. 0)then
 c     call  twis(pexln,idxtws,.true.)
 c     endif
Index: src/tffsa.f
===================================================================
--- src/tffsa.f	(revision 382)
+++ src/tffsa.f	(revision 390)
@@ -1035,9 +1035,8 @@
         go to 12
       elseif(abbrev(word,'COR_RECT','_')) then
         call mcmess(lfno)
-        call mccor(word,ilist(1,ilattp+1),rlist(iftwis),rlist(ifgamm),
-     $       ilist(1,ifmult),
-     $       ilist(1,ifmast),kfit,ifitp,
+        call mccor(word,ilist(1,ilattp+1),rlist(ifpos),rlist(iftwis),
+     $       rlist(ifgamm),ilist(1,ifmult),ilist(1,ifmast),kfit,ifitp,
      1       mfitp,fitval,nfc,rlist(itstr),rlist(itestr),nster,
      1       rlist(itmon),rlist(itemon),nmon,newcor,lfno)
         go to 12
Index: src/doelem.f
===================================================================
--- src/doelem.f	(revision 382)
+++ src/doelem.f	(revision 390)
@@ -1,7 +1,5 @@
-      subroutine doelem(elmcd,dummy)
+      subroutine doelem(elmcd)
       implicit none
-      integer elmcd
-      real*8 dummy
 c
       include 'inc/MACCBK.inc'
       include 'inc/MACFUN.inc'
@@ -10,6 +8,7 @@
       include 'inc/MACTTYP.inc'
       include 'inc/MACCODE.inc'
       include 'inc/MACKW.inc'
+      integer*4 elmcd
       character*(MAXSTR) token,wtoken*(*)
       integer slen,ival,ttype,hsrchz,slen2,ttype2,idx
       real*8 rval
Index: src/ActLie.f
===================================================================
--- src/ActLie.f	(revision 382)
+++ src/ActLie.f	(revision 390)
@@ -24,9 +24,9 @@
      &       'Expanding '//pname(nidx)//' now.',0,0)
         call expnln(nidx)
       endif
-      call prmmap
+      call pr_mem_map
 c     call prexln(nidx,'            ')
       call AAALIE(nidx)
-      call prmmap
+      call pr_mem_map
       return
       end
Index: src/doACT.f
===================================================================
--- src/doACT.f	(revision 382)
+++ src/doACT.f	(revision 390)
@@ -93,7 +93,7 @@
                   call errmsg('doact'//pname(cmdidx)(2:),
      &                 ' break memory area.',0,0)
 c     stop 9999
-                  call prmmap
+                  call pr_mem_map
                endif
                ilist(1,membas)=memuse
                call freeme(membas+memuse,restme-memuse)
Index: src/mccor.f
===================================================================
--- src/mccor.f	(revision 382)
+++ src/mccor.f	(revision 390)
@@ -1,5 +1,7 @@
-      subroutine mccor(word,latt,twiss,gammab,mult,master,kfit,ifitp,
-     $     mfitp,fitval,nfc,istr,estr,nstr,imon,emon,nmon,newcor,lfno)
+      subroutine mccor(word,latt,pos,twiss,
+     $     gammab,mult,master,kfit,ifitp,
+     $     mfitp,fitval,nfc,istr,estr,nstr,
+     $     imon,emon,nmon,newcor,lfno)
 c -**** Main routine for orbit correction ****--------------------------
 c  Note
 c   . Subroutines for correction use the array TWISS as a buffer area:
@@ -23,7 +25,7 @@
       logical stab,cod,dsp,normal,xplane,yplane,both,bump,minusi,micado,
      1        cond,zsum,exist,exec,coup,operate
       logical corc(nkey),corcn(nkey),corca(nobj),method(nobj,nmeth)
-      dimension latt(2,nlat),twiss(nlat,-ndim:ndim,ntwissfun),
+      dimension latt(2,nlat),pos(nlat),twiss(nlat,-ndim:ndim,ntwissfun),
      $     gammab(nlat),mult(nlat),master(nlat)
       dimension dp1(-ndim:ndim)
       dimension istr(nstra,4),imon(nmona,4),emon(*),estr(*)
@@ -373,9 +375,9 @@
 c     z                   istr,istr(1,2),estr,nstr,imon,
 c     z                   nmon,corc,lfno)
               else
-                call pasex(word,latt,twiss,mult,
-     $               gammab,istr,estr,nstr,imon,emon,
-     $               nmon,lstack,lfno)
+                call pasex(word,latt,pos,twiss,mult,master,
+     $               gammab,' ',' ',istr,estr,nstr,imon,emon,nmon,
+     $               lfno)
               endif 
               exit
             endif
Index: src/dolist.f
===================================================================
--- src/dolist.f	(revision 382)
+++ src/dolist.f	(revision 390)
@@ -131,7 +131,7 @@
      $     '(1H ,''used Hash table='',I5,''/'',I5)')
      $     used, HTMAX
       if (Lmem) then
-         call prmmap
+         call pr_mem_map
       endif
       return
       end
Index: src/initdainterface.f
===================================================================
--- src/initdainterface.f	(revision 382)
+++ src/initdainterface.f	(revision 390)
@@ -16,9 +16,9 @@
         return
       endif
       if(itastk(1,isp) .eq. ntfreal)then     !Check the type of arg
-        call mkmachinef
         nord=vstk(ivstkoffset+isp)
         nvar=6
+        call mkmachinef(nord)
         call initda(nord,lvec)     !If real, vstk(ivstkoffset+isp1+i)has
 c                                  !the i-th value.
         itx=ntfoper                !Type of return value of function.
----PATCH----

SubjectRe^3: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No25
Date: 2005/10/31(Mon) 14:41:04
ContributorAkio Morita
まだ、修正が用意されて無いもの
`argc of Invoke > Define > 0'のケースに関しては、「syntax的には問題ない」
との主張もあるが、次の理由から修正の必要があると思う
* 必要の無いものを stackに積む時間と stack depthが無駄(performance)
* code上で、引数が整合しない理由が明らかでない(debugの妨げになる)
* 意図して渡したものを受け取らないAPI設計はおかしい(semantics)

Subprogram varying number of arguments(argc of Define > Invoke)
itfmessageexp@itfmessage.f	tfsetlistr@tfeval1.f
tfconvstr@tfconvstr.f		tffile@tffile.f
				preadstr@preadstr.f, pstati@pstati.f
				preadmon@preadmon.f, petune@petune.f
msolv1@msolv1.f			msolv@msolv.f
tthin@tquad.f			tquads@tquads.f, tstrad@tstrad.f
tthine@tthine.f			tturne1@tturne.f
trad@trad.f			tquads@tquads.f
ttstat@ttstat.f			tracka@tracka.f

Subprogram varying number of arguments(argc of Invoke > Define > 0)
qtwiss@qtwiss.f			tfltr1@tfltr1.f
pfrmat@pasex.f			pasex2@pasex.f, pasex3@pasex.f
tftmat@tftmat.f			qins@qins.f
qgettr@qgettr.f			tfltr1@tfltr1.f

SubjectRe^4: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No27
Date: 2005/10/31(Mon) 18:20:41
ContributorAkio Morita
tthin@tquad.f			tquads@tquads.f, tstrad@tstrad.f
tthine@tthine.f			tturne1@tturne.f
trad@trad.f			tquads@tquads.f
ttstat@ttstat.f			tracka@tracka.f
用のパッチ
自信が無いのでだれか査読して!

----PATCH----
Index: src/tquad.f
===================================================================
--- src/tquad.f	(revision 363)
+++ src/tquad.f	(working copy)
@@ -7,8 +7,8 @@
       integer*4 ndiv,np,l
       real*8 x(np),px(np),y(np),py(np),z(np),dv(np),g(np),pz(np)
       if(al .le. 0.d0)then
-        call tthin(np,x,px,y,py,z,g,dv,pz,
-     1             4,l,0.d0,ak,dx,dy,theta,cost,sint, 1.d0,.false.)
+        call tthin(np,x,px,y,py,z,g,dv,pz,4,l,0.d0,ak,
+     $             dx,dy,theta,cost,sint, 1.d0,.false.)
         return
       elseif(ak .eq. 0.d0)then
         call tdrift(np,x,px,y,py,z,g,dv,pz,al,
Index: src/tturne.f
===================================================================
--- src/tturne.f	(revision 376)
+++ src/tturne.f	(working copy)
@@ -274,7 +274,7 @@
      $       rlist(lp+13),rlist(lp+14) .eq. 0.d0,ld)
         go to 1010
  1600   call tthine(trans,cod,beam,beamr,lele,al,rlist(lp+2),
-     1             rlist(lp+5),rlist(lp+6),rlist(lp+4),ld)
+     1             rlist(lp+5),rlist(lp+6),rlist(lp+4),.false.,ld)
         go to 1010
  3000   call tsole(trans,cod,beam,beamr,latt,l,ke,sol,
      1       twiss,size,gammab,iatr,iacod,iabmi,ndim,plot)
Index: src/tracka.f
===================================================================
--- src/tracka.f	(revision 363)
+++ src/tracka.f	(working copy)
@@ -35,8 +35,8 @@
       if(trpt)then
         call ttinit(latt,x,px,y,py,z,g,dv,pz)
         call ttstat(np0,x,px,y,py,z,g,dv,pz,
-     1              'Entrance',sa,ss,es,.true.,
-     1              outfl)
+     1              'Entrance',sa,ss,es,
+     $              .false.,.true.,outfl)
       else
         call tinip(np,x,px,y,py,z,g,dv,pz,emx,emz,codin,cmplot)
       endif
@@ -210,7 +210,8 @@
       enddo
 1010  if(trpt .and. outfl .gt. 0)then
         call ttstat(np,x,px,y,py,z,g,dv,pz,
-     1              'Exit',sa,ss,es,.true.,outfl)
+     1              'Exit',sa,ss,es,
+     $              .false.,.true.,outfl)
       else
         lfnplt=nint(rgetgl1('PHSPLOTS'))
         if(lfnplt .gt. 0)then
Index: src/tquads.f
===================================================================
--- src/tquads.f	(revision 363)
+++ src/tquads.f	(working copy)
@@ -20,8 +20,8 @@
         ilist(2,ifv+1)=italoc(2)-2
       endif
       if(al .le. 0.d0)then
-        call tthin(np,x,px,y,py,z,g,dv,pz,
-     1             4,0.d0,ak,dx,dy,theta,cost,sint, 1.d0,.false.)
+        call tthin(np,x,px,y,py,z,g,dv,pz,4,ld,0.d0,ak,
+     $             dx,dy,theta,cost,sint, 1.d0,.false.)
         return
       endif
       enarad=rad .and. radlvl .ne. 1.d0
@@ -66,7 +66,7 @@
       if(enarad)then
         b1=brho*ak/al
         call trad(np,x,px,y,py,g,dv,0.d0,
-     1       b1,0.d0,.5d0*al,1.d0)
+     1       b1,0.d0,0.d0,.5d0*al, 1.d0)
       endif
       if(ifv .eq. 0)then
         call tsolqu(np,x,px,y,py,z,g,dv,pz,al,ak,bz,0.d0,0.d0,eps0)
@@ -124,8 +124,7 @@
       endif
       if(enarad)then
         call trad(np,x,px,y,py,g,dv,0.d0,
-     1       b1,0.d0,
-     1       .5d0*al,-1.d0)
+     1       b1,0.d0,0.d0,.5d0*al,-1.d0)
       endif
       if(mfring .eq. 2 .or. mfring .eq. 3)then
         do 2120 i=1,np
Index: src/tstrad.f
===================================================================
--- src/tstrad.f	(revision 363)
+++ src/tstrad.f	(working copy)
@@ -12,7 +12,7 @@
      1     cosp1,sinp1,cosp2,sinp2
       if(al .le. 0.d0)then
         call tthin(np,x,px,y,py,z,g,dv,pz,2,l,al,-phib,
-     1             dx,dy,theta,cost,sint,.false.)
+     1             dx,dy,theta,cost,sint,1.d0,.false.)
         return
       elseif(phib .eq. 0.d0)then
         call tdrift(np,x,px,y,py,z,g,dv,pz,al,0.d0,0.d0,0.d0)
----PATCH----

SubjectRe^5: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No28
Date: 2005/11/01(Tue) 17:54:00
ContributorAkio Morita
LTR_ACK FFS level commandの実装に係わる src/tfltr1.fからの
qtwiss/qgettr()の誤った引数での呼び出し

qtwiss(), qgettr()関数から 1997/06/05に引数 dpが
取り除かれているが src/tfltr1.fが追従していない
これって、どうやって直すのが正しいのかな?
src/tfltr1.f側から dpを渡さないといけないのだが...

Ref.
SAD Mail 1992 (http://acc-physics.kek.jp/SAD/PastMails/sadmail92.html)
Usage: LTR_ACK nus_from nus_to nus_step
Date: 2000/07/11 - 13:31

SubjectRe^4: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No29
Date: 2005/11/01(Tue) 17:59:16
ContributorAkio Morita
src/msolv.fから msolv1への呼び出し時の引数列が
壊れているが、CVS repositoryを見た限り
import時点(Rev 1.1)で既に整合していない
executableにlinkされているが、呼び出している関数が
ないので Atticへ放りこむのが正解?

SubjectRe^4: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No30
Date: 2005/11/01(Tue) 18:02:17
ContributorAkio Morita
> > Subprogram varying number of arguments(argc of Define > Invoke)
> itfmessageexp@itfmessage.f	tfsetlistr@tfeval1.f
> tfconvstr@tfconvstr.f		tffile@tffile.f
> 				preadstr@preadstr.f, pstati@pstati.f
> 				preadmon@preadmon.f, petune@petune.f
たぶにこれで正しい
----PATCH----
Index: src/petune.f
===================================================================
--- src/petune.f	(revision 390)
+++ src/petune.f	(revision 393)
@@ -73,7 +73,7 @@
           write(word,'(''ftn'',i2.2)') lfni1
         elseif(itype.eq.101) then
           call cssetp(next)
-          word=tfconvstr(101,ia,x,nc)
+          word=tfconvstr(101,ia,x,nc,'*')
           if(word.eq.' ') then
             call permes('?Missing filename for BTUNE HISTORY','.',' ',
      $           lfno)
Index: src/tffile.f
===================================================================
--- src/tffile.f	(revision 390)
+++ src/tffile.f	(revision 393)
@@ -60,7 +60,7 @@
           lfopen(lfnp)=.false.
         elseif(itype .eq. ntfstring)then
           call cssetp(next)
-          word=tfconvstr(ntfstring,ia,x,nc)
+          word=tfconvstr(ntfstring,ia,x,nc,'*')
           do 8020 j=51,97
             do 8030 i=lfnb,lfnp
               if(j .eq. lfnstk(i))then
@@ -143,7 +143,7 @@
           lfno1=98
           close(lfno1)
           call cssetp(next)
-          word=tfconvstr(ntfstring,ia,x,nc)
+          word=tfconvstr(ntfstring,ia,x,nc,'*')
 c          write(*,*)'tffile-1 ',word(1:lnblnk(word))
           call texpfn(word)
 c          write(*,*)'tffile-2 ',word(1:lnblnk(word))
Index: src/preadmon.f
===================================================================
--- src/preadmon.f	(revision 390)
+++ src/preadmon.f	(revision 393)
@@ -22,7 +22,7 @@
         write(word,'(''ftn'',i2.2)') lfni1
       elseif(itype.eq.101) then
         call cssetp(next)
-        word=tfconvstr(101,ia,x,nc)
+        word=tfconvstr(101,ia,x,nc,'*')
         if(word.eq.' ') then
           call permes('?Missing filename for MONREAD','.',' ',lfno)
           call getwdl(word)
Index: src/tfeval1.f
===================================================================
--- src/tfeval1.f	(revision 390)
+++ src/tfeval1.f	(revision 393)
@@ -571,10 +571,10 @@
       include 'inc/TFCODE.inc'
       integer*4 it,ia,ia1,irtc,itx,iax,iv,
      $     iav,iad,itadattach,itfcopy,i,italoc,
-     $     itfmessage,itfcopy1,itfmessageexp
+     $     itfmessage,itfcopy1
       real*8 v,vx
       if(ia1 .le. 0)then
-        irtc=itfmessageexp(999,
+        irtc=itfmessage(999,
      $       'General::invset','"a strange object"')
         return
       endif
Index: src/mckick.f
===================================================================
--- src/mckick.f	(revision 390)
+++ src/mckick.f	(revision 393)
@@ -27,7 +27,7 @@
 c     elseif(itype.eq.101) then
 c       print *,itype
 c       call cssetp(next)
-c       word=tfconvstr(101,ia,x,nc)
+c       word=tfconvstr(101,ia,x,nc,'*')
 c       if(word.eq.' ') then
 c         call permes('?Missing element for KICK','.',' ',6)
 c         call getwdl(word)
Index: src/preadstr.f
===================================================================
--- src/preadstr.f	(revision 390)
+++ src/preadstr.f	(revision 393)
@@ -23,7 +23,7 @@
         write(word,'(''ftn'',i2.2)') lfni1
       elseif(itype.eq.101) then
         call cssetp(next)
-        word=tfconvstr(101,ia,x,nc)
+        word=tfconvstr(101,ia,x,nc,'*')
         if(word.eq.' ') then
           call permes('?Missing filename for MONREAD','.',' ',lfno)
           call getwdl(word)
Index: src/pstati.f
===================================================================
--- src/pstati.f	(revision 390)
+++ src/pstati.f	(revision 393)
@@ -69,7 +69,7 @@
               write(word,'(''ftn'',i2.2)') lfni1
             elseif(itype.eq.101) then
               call cssetp(next)
-              word=tfconvstr(101,ia,x,ncc)
+              word=tfconvstr(101,ia,x,ncc,'*')
               if(word.eq.' ') then
                 call permes('?Missing filename for SUM','.',' ',lfno)
                 call getwdl(word)
---PATCH---

SubjectRe: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Article No32
Date: 2005/11/07(Mon) 18:06:06
ContributorAkio Morita
一応、全部直して MAIN trunkにも backportした

src/pasex.f, tfltr1.fの修正に付いて
1997/06/05の `dp'引数削除に伴う API syntax brokenは直したが、
semantics brokenな状態のままなので関連する FFS level command
LTR_ACK, COR_RECT, BALSは、壊れたままだと思うので注意
(直しかたも分からん)