Conference Room SAD
[thread display] [new arrival display] [word search] [past log] [管理用]

Subject ： Re^2: ftnchekを用いた、syntax checkで判明している引数不足な呼び出し
Date： 2005/10/31(Mon) 14:30:59
Contributor： Akio 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----

- 関連一覧ツリー （Click ▼ to display all articles in a thread.）