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