Skip to content

Commit

Permalink
keep format backward compatible
Browse files Browse the repository at this point in the history
  • Loading branch information
@ldeniau
ldeniau committed Jan 14, 2022
1 parent 493d02a commit 673b716
Show file tree
Hide file tree
Showing 2 changed files with 56 additions and 30 deletions.
42 changes: 29 additions & 13 deletions libs/ptc/src/c_dabnew.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4468,9 +4468,15 @@ subroutine dapri(ina,iunit)
ioa = 0
if(inva.eq.0) then
write(iunit,'(A)') ' I VALUE '
do i = ipoa,ipoa+illa-1
write(iunit,'(I6,2X,ES23.16)') i-ipoa, cc(i)
enddo
if (madxprint) then
do i = ipoa,ipoa+illa-1
write(iunit,'(I6,2X,ES23.16)') i-ipoa, cc(i)
enddo
else
do i = ipoa,ipoa+illa-1
write(iunit,'(I6,2X,G20.13)') i-ipoa, cc(i)
enddo
endif
elseif(nomax.eq.1) then
if(illa.ne.0) write(iunit,'(A)') ' I COEFFICIENT ORDER EXPONENTS'
if(illa.eq.0) write(iunit,'(A)') ' ALL COMPONENTS ZERO '
Expand All @@ -4483,8 +4489,12 @@ subroutine dapri(ina,iunit)
j(i-1)=1
ioa=1
endif
write(iunit,'(I6,2X,ES23.16,I5,4X,18(2I2,1X))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
if (.not.madxprint) write(iunit,*) cc(ipoa+i-1)
if (madxprint) then
write(iunit,'(I6,2X,ES23.16,I5,4X,18(2I2,1X))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
else
write(iunit,'(I6,2X,G20.13,I5,4X,18(2I2,1X))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
write(iunit,*) cc(ipoa+i-1)
endif
enddo
else
if(illa.ne.0) write(iunit,'(A)') ' I COEFFICIENT ORDER EXPONENTS'
Expand All @@ -4497,9 +4507,12 @@ subroutine dapri(ina,iunit)
if(abs(cc(ii)).gt.eps) then
!ETIENNE
iout = iout+1
write(iunit,'(I6,2X,ES23.16,I5,4X,18(2I2,1X))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
!ETIENNE
if (.not.madxprint) write(iunit,*) cc(ii)
if (madxprint) then
write(iunit,'(I6,2X,ES23.16,I5,4X,18(2I2,1X))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
else
write(iunit,'(I6,2X,G20.13,I5,4X,18(2I2,1X))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
write(iunit,*) cc(ii)
endif
endif
!ETIENNE
!
Expand Down Expand Up @@ -4594,9 +4607,9 @@ subroutine dapri77(ina,iunit)
write(iunit,503) ioa,cc(ii),(j(i),i=1,inva)
endif
endif
501 format(' ', i3,1x,es23.16,1x,100(1x,i2))
503 format(' ', i3,1x,es23.16,1x,100(1x,i2))
502 format(' ', i5,1x,es23.16,1x,100(1x,i2))
501 format(' ', i3,1x,g23.16,1x,100(1x,i2))
503 format(' ', i3,1x,g23.16,1x,100(1x,i2))
502 format(' ', i5,1x,g23.16,1x,100(1x,i2))
endif
!ETIENNE
!
Expand Down Expand Up @@ -4781,8 +4794,11 @@ subroutine darea(ina,iunit)
!
10 continue
iin = iin + 1
! read(iunit,'(I6,2X,G23.16,I5,4X,18(2I2,1X))') ii,c,io,(j(i),i=1,inva)
read(iunit,*) ii,c,io,(j(i),i=1,inva)
if (madxprint) then
read(iunit,'(I6,2X,ES23.16,I5,4X,18(2I2,1X))') ii,c,io,(j(i),i=1,inva)
else
read(iunit,'(I6,2X,G20.13,I5,4X,18(2I2,1X))') ii,c,io,(j(i),i=1,inva)
endif
!
if(ii.eq.0) goto 20
!ETIENNE
Expand Down
44 changes: 27 additions & 17 deletions libs/ptc/src/cc_dabnew.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3972,9 +3972,14 @@ subroutine c_dapri(ina,iunit)
j(i-1)=1
ioa=1
endif
write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,3X,18(1X,I2))') iout, &
if (madxprint) then
write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,18(2I2,1X))') iout, &
c_clean_complex(c_cc(ipoa+i-1)),ioa,(j(iii),iii=1,c_nvmax)
if (.not.madxprint) write(iunit,*) c_clean_complex(c_cc(ipoa+i-1))
else
write(iunit,'(I6,2X,G20.13,1x,G20.13,I5,4X,18(2i2,1X))') iout, &
c_clean_complex(c_cc(ipoa+i-1)),ioa,(j(iii),iii=1,c_nvmax)
write(iunit,*) c_clean_complex(c_cc(ipoa+i-1))
endif
enddo
else
if(illa.ne.0) write(iunit,'(A)') ' I COEFFICIENT ORDER EXPONENTS'
Expand All @@ -3991,9 +3996,12 @@ subroutine c_dapri(ina,iunit)
ccc=a+(0.0_dp,1.0_dp)*b
!ETIENNE
iout = iout+1
write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,18(2I2,1X))') iout,ccc,ioa,(j(iii),iii=1,c_nvmax)
!ETIENNE + LD
if (.not.madxprint) write(iunit,*) c_cc(ii)
if (madxprint) then
write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,18(2I2,1X))') iout, ccc,ioa,(j(iii),iii=1,c_nvmax)
else
write(iunit,'(I6,2X,G20.13,1x,G20.13,I5,4X,18(2i2,1X))') iout, ccc,ioa,(j(iii),iii=1,c_nvmax)
write(iunit,*) c_cc(ii)
endif
endif
!ETIENNE
!
Expand All @@ -4009,7 +4017,7 @@ subroutine c_dapri(ina,iunit)
end subroutine c_dapri

function c_clean_complex(c)
implicit none
implicit none
complex(dp) c_clean_complex,c
real(dp) cr,ci

Expand All @@ -4019,7 +4027,7 @@ function c_clean_complex(c)
if(abs(ci)<epsprint) ci=0
c_clean_complex=cr+i_*ci

end function c_clean_complex
end function c_clean_complex


subroutine c_dapri77(ina,iunit)
Expand Down Expand Up @@ -4094,7 +4102,7 @@ subroutine c_dapri77(ina,iunit)
if(abs(aimag(c_cc(ii)))> epsprint) then
b=aimag(c_cc(ii))
imprime=.true.
endif
endif
ccc=a+(0.0_dp,1.0_dp)*b
! ccc=c_cc(ii)
if(c_nomax.ne.1) then
Expand All @@ -4119,9 +4127,9 @@ subroutine c_dapri77(ina,iunit)
write(iunit,503) ioa,ccc,(j(i),i=1,inva)
endif
endif
501 format(' ', i3,1x,es23.16,1x,es23.16,1x,100(1x,i2))
503 format(' ', i3,1x,es23.16,1x,es23.16,1x,100(1x,i2))
502 format(' ', i5,1x,es23.16,1x,es23.16,1x,100(1x,i2))
501 format(' ', i3,1x,g23.16,1x,g23.16,1x,100(1x,i2))
503 format(' ', i3,1x,g23.16,1x,g23.16,1x,100(1x,i2))
502 format(' ', i5,1x,g23.16,1x,g23.16,1x,100(1x,i2))
endif
!ETIENNE
!
Expand All @@ -4135,7 +4143,7 @@ subroutine c_dapri77(ina,iunit)
if(iout.eq.0) iout=1
if(longprint.and.(.not.madxprint)) write(iunit,502) -iout,0.0_dp,0.0_dp,(j(i),i=1,inva)
if((.not.longprint).and.(.not.some)) write(iunit,*) " Complex Polynomial is zero "
!if((.not.longprint).and.(.not.madxprint)) write(iunit,*) " "
if((.not.longprint).and.(.not.madxprint)) write(6,*) " "
!
return
longprint=long
Expand Down Expand Up @@ -4263,7 +4271,7 @@ subroutine c_darea(ina,iunit)
integer,dimension(c_lnv)::j
complex(dp) c
character(10) c10

if((.not.C_STABLE_DA)) then
if(C_watch_user) then
write(6,*) "big problem in dabnew ", sqrt(crash)
Expand Down Expand Up @@ -4303,15 +4311,18 @@ subroutine c_darea(ina,iunit)
read(iunit,'(A10)') c10
read(iunit,'(A10)') c10
read(iunit,'(A10)') c10

!
!
iin = 0
!
10 continue
iin = iin + 1
! read(iunit,'(I6,2X,G23.16,I5,4X,18(2I2,1X))') ii,c,io,(j(i),i=1,inva)
read(iunit,*) ii,c,io,(j(i),i=1,inva)
if (madxprint) then
read(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,18(2I2,1X))') ii,c,io,(j(i),i=1,inva)
else
read(iunit,'(I6,2X,G20.13,1x,G20.13,I5,4X,18(2I2,1X))') ii,c,io,(j(i),i=1,inva)
endif
!
if(ii.eq.0) goto 20
!ETIENNE
Expand Down Expand Up @@ -4356,7 +4367,6 @@ subroutine c_darea(ina,iunit)
if(c_nomax.ne.1) call dapac(ina)
!
return

end subroutine c_darea
!FF
!
Expand Down

0 comments on commit 673b716

Please sign in to comment.