extraneous error compiling in Gfortran

[zmth]

common lena,np,nps
np=2;nps=3; lena=0
i=1;i1=0 ; call jkz(i,i1)
end
recursive subroutine jkz(i9,ir)
common lena,np,nps
print*,"i9",i9," ir",ir
if (i9<nps+1) then ; if (i9<nps) then ; if (i9<nps-1) then ; do ii=0,min(np,2*np-ir)
m1=i9+1;m2=ir+ii;call jkz(m1,m2) ; enddo; else ; do ii=max(0,np-ir),min(np,2*np-ir)
m1=i9+1;m2=ir+ii;call jkz(m1,m2) ; enddo; endif ; else
if (nps<4) then ; lena=lena+1; print*,"lena",lena
endif ; endif ; endif ; end


Now this works ok but if just put add to both common statements ii that is

common lena,np,nps,ii

in both places

then it goes into an endless loop which ofcourse it should not because that should have NO effect whatsoever. Get the same compiling error when use the equivalent as a module with NO common statements. Is anyone else having this same error from the gfortran compiler ? i even tried after the common statement in the subroutine

; save ii

then get the ridicuolus bogus error message from the compiler: COMMON attribute confllicts with save in 'ii'

What about any other compilers anyone is using ? like Intel etc. I trust they don't have this error ?

 

[xwb]

If you have ii in the common block and use ii in the loop of a recursive subroutine, it will loop endlessly since it resets at the start of every loop and never reaches the end. There is no need to cram all you code into as few lines a possible - it hinders readability and can be quite difficult to debug, especially when you want to set breakpoints. Also, it is difficult to see where one statement ends and the other begins.

 

[zmth]

yea i thought perhaps it was resetting for some unknown reason but i would have thought since that was the only use of it and did not use it anywhere else the compiler would have known not to nnecessarily change its value. as far as cramming I did not think t was too many on one line. The alternative is very long linear listing and have to scroll down too far. Also how does one put program steps in In that special notation script look as that also makes it a little larger and easier to read. I wish i knew how to use
breakpoints. I also had a version which did not make use of common blocks but instead module with the same effective
use though and it did the same thing.

 

[xwb]

Is it a windows or linux based system - which compiler?

 

[xwb]

Sorry - just realized it was gfortran. If Linux, you can use ddd.

 

[zmth]

to xwb: too bad there is no easy way to reply in this forum automatic with quote. I am using windows 7 . What does the 'ddd' do?
Also I don't really see what prefacing a subroutine with recursive does in this case if the compler doen't do what it should do in that case - among other things from the code or anyway as a default it should save things for the next call to itself esp when it is in a loop because then it goes forwards and backs up and forward again and again if it is in a loop
such as many of my other recursive subroutines calls itself ...., for m:-L thru L.....call sub(ii-1,....)

 

[xwb]

ddd is a gui front end for gdb. If you are running cygwin, then you should be able to run ddd.

In the old days when fortran compilers didn't use stacks, you needed the word recursive to tell the compiler to reserve space for the return addresses. In the old days, very often the return was stored in a word above the subroutine definition. If it was recursive, then a different, more inefficient mechanism would be employed.

The compiler is working correctly - if you put ii into common and use ii as a loop counter, that is the code that the compiler will generate. It will loop forever. If you use save variables, the same thing will happen.

 

[zmth]

But when I use module instead of common it works correctly by saving n1,nps while with common it does not ! I thought
it would be same. So would it be correct to say with a 'recursive' subroutine, as seems i have painfully found thru much grief, save is automatic and one should NOT use save ? AS it always seemed to be doing the opposite of what expect otherwise. HOw does one get the printout in this forum within the ' code' box.

 

[xwb]

Code boxes.
[code]
Type in your code
[/code]

You can click on preview to see what it looks like before submitting.

 

[xwb]

In your original posting, you said it works correctly - it only doesn't work when you add ii to the common block. Does it work correctly if ii is a module level variable? You have

module level np, nps - works
common np, nps - works
common np, nps, ii - loops continuously because ii is reset at the start of each recursive call
module level np, nps, ii - I expect this to loop continuously too

 

[zmth]

There is no more problem with anything looping continuously anymore - never was in that last simple example anyway which was a different question/issue. I have been using module in the long drawn out problem which i have never posted in any depth which WAS looping continuously till I figured I was doing the opposite of what should. Problem before was I was using save in the recursive subroutine when I should not have - again mainly using module. It kept doing opposite of what i expected as thought the problem was it was NOT saving something when it was opposite problem. The example with that last common example is a different matter. That simple program example is not recursive and not looping anything as no loops in it and has not much if anything to do with the main issue. It was just that it was not printing out what was assigned in the main while thought it should. When i do what i thought was same in module it prints out the correct assigned values. Also in my first post I now see why putting in that unneccesary anyway common could cause the endless looping.

So far I have got the code here working correctly so far as it agrees with maxima and many tests. Have quite a bit more than this to go with more recursive subroutines to add and much more in the main. Mainly trying to copy what i have done in maxima so far as maxima is just way too slow for one and i can't get it to compile there in maxima either.

module inc
parameter (pi = 3.141592654)
logical*1 fl,fl1,fl2
integer*1 i,i1,i2,i3, ia,ic,ic1,ii,&
ir,inps,j,j1,j2,j3,k,l,m,&
m1,m2,mn,n,n1,n2,np,npmx,nps
integer*2 lena,lenb ;integer lenl,&
lenlisnp, lnpi
contains
subroutine binomrs(n,id,r)
integer*1 n,i,id,j
integer*2 lena; j=max(id,n-id)
if(j<=n) then ; r=1;do i=1,n-j
r=r*(n-i+1)/i
enddo; else r=0;endif;end
subroutine vc(j1,m1,j2,m2,j,rout)
integer*1:: i1(4),i1r(4)=0,i2(5),&
i2r(5)=0,ic1(4),ic2(5)
integer*1 i ,is ,j, j1, j2,m1,m2
integer*8 idnm,io,itmp,ivc
integer*16 i16
common /i16/ i16
rout=0;if (.not.(j<abs(j1-j2).or.&
j>j1+j2.or.j<abs(m1+m2))) then;ivc=0
do is=max(0,j-j2-m1), min(j1-m1,j-m1-m2)
itmp=(-1)**is;call fact(j1+m1+is,io)
itmp=itmp*io;call fact(j2+j-m1-is,io)
itmp=itmp*io;call fact(is,idnm)
call fact(j1-m1-is,io) ; idnm=idnm*io
call fact(j-m1-m2-is,io);idnm=idnm*io
call fact(j2-j+m1+is,io);idnm=idnm*io
ivc=ivc+itmp/idnm;enddo;if(ivc.ne.0) then
i1=(/j+j1-j2,j-j1+j2,j1+m1,j2+m2/);ic1=i1
i2=(/j1+j2-j,j1-m1,j2-m2,j+m1+m2,j-m1-m2/)
ic2=i2
do i=1,3;i1r(i)=maxloc(ic1,1)
ic1(i1r(i))=-1;i2r(i)=maxloc(ic2,1)
ic2(i2r(i))=-1
enddo;i2r(4)=maxloc(ic2,1);ic2(i2r(4))=-1

i16=1;is=j+j1+j2+1;call facnd(is,i2(i2r(1)))
do i=1,3;call facnd(i1(i1r(i)),i2(i2r(i+1)))
enddo
call facnd(maxval(ic1),maxval(ic2))
rout=(-1)**m1*sqrt(real(2*j+1)/i16)*ivc
endif;endif;end
subroutine fact(ii,io);integer*1 i,ii
integer*8 io
io=1;do i=2,ii;io=io*i;enddo;end
subroutine facnd(in,idn);integer*1 in,idn
integer*16 i16 common /i16/ i16
if(in>idn) then ; do i=idn+1,in;i16=i16*i
enddo
else if(idn>in) then
do i=in+1,idn;i16=i16/i;enddo;endif; end
end module inc
use inc integer*1,allocatable::ialis),km),&
lisal,,lisi),&
lisin),lisnp,,liss,,lo),ls)
integer*2,allocatable::lssa)
allocatable::lnl),rlisnp)

open (1, file="modinc395.t",&
status="old",position="rewind",&
action="read",iostat=ierror)
read(1,'(2(i3))') nps,npmx
print*,"nps,npmx",nps,npmx
close(1) ; open (1, file="modinc395.t",&
status="old",position="append",&
action="readwrite",iostat=ierror)
write(1,'("nps",(i2)," npmx",(i2))')nps,npmx
if(nps>2)then;inps=1;else;inps=0
endif;n1=2*nps-min(3,nps)
allocate(ialis(nps),km(nps),lisi(n1),&
lisin(nps),lo(nps),ls(n1),lssa(npmx+1))
lenl=0; fl=.false.;lenb=0 ;do np=0,npmx
i=1;i1=0; lena=0 ;call jkz(i,i1,liss,lisi)
lenl=lenl+lena ; lssa(np+1)=lena; enddo
allocate(lisal(n1,lenl)) ; fl=.true. ;ns=0
do np=0,npmx
lenb=lssa(np+1)
print*,"np",np," lenb",lenb," ns",ns
lena=0 ; i=1;i1=0
allocate(liss(n1,lenb)); liss,=0
lisi)=0
call jkz(i,i1,liss,lisi)
lisal,ns+1:ns+lenb)=liss,
ns=ns+lenb;deallocate(liss);enddo

lenlisnp=1;allocate(lnl(2*lenl),&
rlisnp(lenlisnp),lisnp(nps,lenlisnp))
fl=.false.
lnl=0
lisin)=0;rin=1.;mn=0 ; ia=1+inps+n1
lnl(1)=1
do il=2,lenl; ls=lisal,il)
lenb=0; call wsd(ia,lisin,rin,mn,ls,&
lisnp,rlisnp)
lnl(2*il-1)=lenb
enddo
do i=1,2*lenl,2
enddo
lenlisnp=sum(lnl)
deallocate(lisnp,rlisnp)
allocate(lisnp(nps,lenlisnp),rlisnp(lenlisnp))
lisnp=0 ; rlisnp=0
lnpi=1 ; fl=.true.
rlisnp(1)=1
do il=2,lenl; ls=lisal,il)
lenb=0 ; call wsd(ia,lisin,rin,mn,ls,&
lisnp,rlisnp)
lnpi=lnpi+lnl(2*il-1)
enddo

deallocate(ialis,km,lisal,lisi,lisin,&
lisnp,lnl,lo,ls,lssa,rlisnp)
end

recursive subroutine wsd(ii,lisin,rin,&
mn,ls,lisnp,rlisnp)
use inc,only:fl,inps,j,l,lenb,lenl,&
lenlisnp,lnpi,n,n1,nps,npmx,vc
integer*1 i,ii,j1,j2,j3,lisin(nps),&
ls(n1),m,mn,ni,lisnp(nps,lenlisnp),&
lo(nps)
dimension rlisnp(lenlisnp)

if(ii.eq.nps+1) then;j1=ls(1)
j2=ls(2) ; ni=2
else
if(ii<n1+2) then
j1=ls(ii-1);endif ; j2=ls(ii+1-nps)
ni=ii+1-nps;endif
if(ii.eq.n1+2) then;j3=0;j1=j2
elseif(ii.eq.n1+1) then j3=ls(nps)*inps
else; j3=ls(ii);endif
do m=max(-j1,mn-j2),min(j1,mn+j2)
call vc(j1,m,j2,mn-m,j3,tt)
if(tt.ne.0) then ; lo=lisin;ro=rin
lo(ni)=mn-m; ro=ro*tt
if(ii>nps+1) then;i=ii-1
call wsd(i,lo,ro,m,ls,lisnp,rlisnp)
else;lo(1)=m ; lenb=lenb+1
if(fl) then ; write(1,*)" lnpi",lnpi
lisnp,lnpi+lenb)=lo
rlisnp(lnpi+lenb)=ro
endif ;endif;endif ; enddo
end subroutine

recursive subroutine jkz(ih,ir,liss,lisi)
use inc,only: fl,i3,ia,ic,ic1,j,j1,j2,&
n1,n2,np,npmx,nps,lena,lenb
integer*1:: i,i1,i2,i4,i5,ih,ii,ir,&
itm,m1,m2,liss(n1,lenb),lisi(n1)
if (ih<nps+1) then ; if (ih<nps) then
if (ih<nps-1) then
do ii=0,min(np,2*np-ir) ; lisi(ih)=ii
m1=ih+1;m2=ir+ii

call jkz(m1,m2,liss,lisi)
enddo;else; do ii=max(0,np-ir),&
min(np,2*np-ir)
lisi(ih)=ii m1=ih+1;m2=ir+ii

call jkz(m1,m2,liss,lisi) ; enddo
endif ; else ;lisi(nps)=2*np-ir
if (nps<4) then
lena=lena+1;if(fl) then
liss,lena)=lisi);endif
else;i2=ir+lisi(nps)-lisi(1)-lisi(2)
i1=nps+1

call jkz(i1,i2,liss,lisi)
endif ; endif ;else

itm=maxval(lisi(ih-nps+2:nps))
if(ih >nps+1) then;do i=max(2*itm-ir,&
abs(lisi(ih-1)-lisi(ih+1-nps))),&
min(ir,lisi(ih-1)+lisi(ih+1-nps))
lisi(ih)=i; if(ih<2*nps-3) then
i5=ir-lisi(ih+2-nps); i4=ih+1

call jkz(i4,i5,liss,lisi) ;else
lena=lena+1
if(fl) then
liss,lena)=lisi);endif
endif;enddo;else
do i=max(2*itm-ir,abs(lisi(2)-lisi(1))),&
min(ir,lisi(1)+lisi(2))
lisi(nps+1)=i ; if(ih<2*nps-3) then
ia=nps+2
call jkz(ia,ir-lisi(3),liss,lisi)
else
lena=lena+1;if(fl) then
liss,lena)=lisi) endif;endif;enddo
endif ;endif ; end

where file modinc395.t is simply for example
4 2

and will be appended as it is written to

 

[zmth]

Code boxes.

Type in your code

You can click on preview to see what it looks like before submitting.

But what it was before submitting and after were not same
Yes I now did that but it came out too squashed lines were very short horizontally and overun NOT as in preview