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----