From efa5dcc2427831c5f3214236ae70c4c1b60c25bc Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Thu, 18 Nov 2021 15:16:54 +0100
Subject: [PATCH 01/11] cleanup tpc/berz TPSA i/o

---
 libs/ptc/src/Ci_tpsa.f90   | 13 +++++++------
 libs/ptc/src/c_dabnew.f90  | 22 +++++++++++-----------
 libs/ptc/src/cc_dabnew.f90 | 29 +++++++++++++++--------------
 3 files changed, 33 insertions(+), 31 deletions(-)

diff --git a/libs/ptc/src/Ci_tpsa.f90 b/libs/ptc/src/Ci_tpsa.f90
index e09122da0..813b2de49 100644
--- a/libs/ptc/src/Ci_tpsa.f90
+++ b/libs/ptc/src/Ci_tpsa.f90
@@ -18209,12 +18209,13 @@ subroutine c_normal(xyso3,n,dospin,no_used,rot,phase,nu_spin)
     ! but energy is constant. (Momentum compaction, phase slip etc.. falls from there)
  ! etienne
  
- if(c_skip_gofix) then
-  a1=1
-else
-    call  c_gofix(m1,a1) 
-endif 
-     m1=c_simil(a1,m1,-1)
+    if(c_skip_gofix) then
+      a1=1
+    else
+     call  c_gofix(m1,a1)
+    endif
+
+    m1=c_simil(a1,m1,-1)
  
     ! Does the the diagonalisation into a rotation
     call c_linear_a(m1,a2)  
diff --git a/libs/ptc/src/c_dabnew.f90 b/libs/ptc/src/c_dabnew.f90
index f286bcea3..86d42f96e 100644
--- a/libs/ptc/src/c_dabnew.f90
+++ b/libs/ptc/src/c_dabnew.f90
@@ -4469,7 +4469,7 @@ subroutine dapri(ina,iunit)
     if(inva.eq.0) then
        write(iunit,'(A)') '    I  VALUE  '
        do i = ipoa,ipoa+illa-1
-          write(iunit,'(I6,2X,G20.13)') i-ipoa, cc(i)
+          write(iunit,'(I6,2X,ES23.16)') i-ipoa, cc(i)
        enddo
     elseif(nomax.eq.1) then
        if(illa.ne.0) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
@@ -4483,8 +4483,8 @@ subroutine dapri(ina,iunit)
              j(i-1)=1
              ioa=1
           endif
-          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)
+          write(iunit,'(I6,2X,ES23.16,I5,4X,18(2i3,1X))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
+!          write(iunit,*) cc(ipoa+i-1)
        enddo
     else
        if(illa.ne.0) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
@@ -4497,9 +4497,9 @@ subroutine dapri(ina,iunit)
              if(abs(cc(ii)).gt.eps) then
                 !ETIENNE
                 iout = iout+1
-                write(iunit,'(I6,2X,G20.13,I5,4X,18(2i2,1X))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
+                write(iunit,'(I6,2X,ES23.16,I5,4X,18(2i3,1X))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
                 !ETIENNE
-                write(iunit,*) cc(ii)
+!                write(iunit,*) cc(ii)
              endif
              !ETIENNE
              !
@@ -4551,7 +4551,7 @@ subroutine dapri77(ina,iunit)
     else
         write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') "Properties",', NO =',inoa,', NV =',inva,', INA =',ina,&
          '*********************************************'
-    endif 
+    endif
    !
     if(illa.ne.0.and.longprint) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
     if(illa.eq.0.and.longprint) write(iunit,'(A)') '   ALL COMPONENTS ZERO '
@@ -4592,9 +4592,9 @@ subroutine dapri77(ina,iunit)
                    write(iunit,503) ioa,cc(ii),(j(i),i=1,inva)
                 endif
              endif
-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))
+501          format(' ', i3,1x,e23.16,1x,100(1x,i2))
+503          format(' ', i3,1x,e23.16,1x,100(1x,i2))
+502          format(' ', i5,1x,e23.16,1x,100(1x,i2))
           endif
           !ETIENNE
           !
@@ -4779,11 +4779,11 @@ subroutine darea(ina,iunit)
     !
 10  continue
     iin = iin + 1
-    read(iunit,'(I6,2X,G20.13,I5,4X,18(2i2,1X))') ii,c,io,(j(i),i=1,inva)
+    read(iunit,'(I6,2X,ES23.16,I5,4X,18(2i3,1X))') ii,c,io,(j(i),i=1,inva)
     !
     if(ii.eq.0) goto 20
     !ETIENNE
-    read(iunit,*) c
+!    read(iunit,*) c
     !ETIENNE
     if(ii.ne.iin) then
        iwarin = 1
diff --git a/libs/ptc/src/cc_dabnew.f90 b/libs/ptc/src/cc_dabnew.f90
index 606ce641f..abf491721 100644
--- a/libs/ptc/src/cc_dabnew.f90
+++ b/libs/ptc/src/cc_dabnew.f90
@@ -3958,11 +3958,11 @@ subroutine c_dapri(ina,iunit)
     if(inva.eq.0) then
        write(iunit,'(A)') '    I  VALUE  '
        do i = ipoa,ipoa+illa-1
-          write(iunit,'(I6,2X,G20.13)') i-ipoa, c_clean_complex(c_cc(i))
+          write(iunit,'(I6,2X,ES23.16)') i-ipoa, c_clean_complex(c_cc(i))
        enddo
     elseif(c_nomax.eq.1) then
-       if(illa.ne.0) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
-       if(illa.eq.0) write(iunit,'(A)') '   ALL COMPONENTS 0.0_dp '
+       if(illa.ne.0.and.longprint) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
+       if(illa.eq.0.and.longprint) write(iunit,'(A)') '   ALL COMPONENTS 0.0_dp '
        do i=1,illa
           do k=1,inva
              j(k)=0
@@ -3972,12 +3972,13 @@ subroutine c_dapri(ina,iunit)
              j(i-1)=1
              ioa=1
           endif
-          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))
+          write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,100(2i3,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))
        enddo
     else
-       if(illa.ne.0) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
-       if(illa.eq.0) write(iunit,'(A)') '   ALL COMPONENTS 0.0_dp '
+       if(illa.ne.0.and.longprint) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
+       if(illa.eq.0.and.longprint) write(iunit,'(A)') '   ALL COMPONENTS 0.0_dp '
        do ioa = 0,inoa
           do ii=ipoa,ipoa+illa-1
              if(c_ieo(c_ia1(c_i_1(ii))+c_ia2(c_i_2(ii))).ne.ioa) goto 100
@@ -3992,9 +3993,9 @@ subroutine c_dapri(ina,iunit)
                 !ETIENNE
                 
                 iout = iout+1
-                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,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,100(2i3,1X))') iout,ccc,ioa,(j(iii),iii=1,c_nvmax)
                 !ETIENNE
-                write(iunit,*) c_cc(ii)
+!                write(iunit,*) c_cc(ii)
              endif
              !ETIENNE
              !
@@ -4119,9 +4120,9 @@ subroutine c_dapri77(ina,iunit)
                    write(iunit,503) ioa,ccc,(j(i),i=1,inva)
                 endif
              endif
-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))
+501          format(' ', i3,1x,e23.16,1x,e23.16,1x,100(1x,i2))
+503          format(' ', i3,1x,e23.16,1x,e23.16,1x,100(1x,i2))
+502          format(' ', i5,1x,e23.16,1x,e23.16,1x,100(1x,i2))
           endif
           !ETIENNE
           !
@@ -4310,12 +4311,12 @@ subroutine c_darea(ina,iunit)
     !
 10  continue
     iin = iin + 1
-!    read(iunit,'(I6,2X,G20.13,I5,4X,18(2i2,1X))') ii,c,io,(j(i),i=1,inva)
+!    read(iunit,'(I6,2X,ES23.16,I5,4X,100(2i3,1X))') ii,c,io,(j(i),i=1,inva)
     read(iunit,*) ii,c,io,(j(i),i=1,inva)
     !
     if(ii.eq.0) goto 20
     !ETIENNE
-    read(iunit,*) c
+!    read(iunit,*) c
     !ETIENNE
     if(ii.ne.iin) then
        iwarin = 1

From 583d76f264dd1db24f202aba7dd306e292bd0036 Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Fri, 19 Nov 2021 11:57:47 +0100
Subject: [PATCH 02/11] cleaning TPSA output

---
 libs/ptc/src/c_dabnew.f90  | 40 ++++++++++++++++++-------------------
 libs/ptc/src/cc_dabnew.f90 | 41 +++++++++++++++++++-------------------
 2 files changed, 40 insertions(+), 41 deletions(-)

diff --git a/libs/ptc/src/c_dabnew.f90 b/libs/ptc/src/c_dabnew.f90
index 86d42f96e..f180aaa0d 100644
--- a/libs/ptc/src/c_dabnew.f90
+++ b/libs/ptc/src/c_dabnew.f90
@@ -4472,8 +4472,8 @@ subroutine dapri(ina,iunit)
           write(iunit,'(I6,2X,ES23.16)') i-ipoa, cc(i)
        enddo
     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 '
+       if(illa.ne.0) write(iunit,'(A)') '     I   COEFFICIENT             ORDER   EXPONENTS'
+       if(illa.eq.0) write(iunit,'(A)') '         ALL COMPONENTS ZERO '
        do i=1,illa
           do k=1,inva
              j(k)=0
@@ -4483,12 +4483,12 @@ subroutine dapri(ina,iunit)
              j(i-1)=1
              ioa=1
           endif
-          write(iunit,'(I6,2X,ES23.16,I5,4X,18(2i3,1X))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
-!          write(iunit,*) cc(ipoa+i-1)
+          write(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
+! LD      write(iunit,*) cc(ipoa+i-1)
        enddo
     else
-       if(illa.ne.0) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
-       if(illa.eq.0) write(iunit,'(A)') '   ALL COMPONENTS ZERO '
+       if(illa.ne.0) write(iunit,'(A)') '     I   COEFFICIENT             ORDER   EXPONENTS'
+       if(illa.eq.0) write(iunit,'(A)') '         ALL COMPONENTS ZERO '
        do ioa = 0,inoa
           do ii=ipoa,ipoa+illa-1
              if(ieo(ia1(i_1(ii))+ia2(i_2(ii))).ne.ioa) goto 100
@@ -4497,9 +4497,9 @@ subroutine dapri(ina,iunit)
              if(abs(cc(ii)).gt.eps) then
                 !ETIENNE
                 iout = iout+1
-                write(iunit,'(I6,2X,ES23.16,I5,4X,18(2i3,1X))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
+                write(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
                 !ETIENNE
-!                write(iunit,*) cc(ii)
+! LD             write(iunit,*) cc(ii)
              endif
              !ETIENNE
              !
@@ -4549,16 +4549,16 @@ subroutine dapri77(ina,iunit)
        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') daname(ina),', NO =',inoa,', NV =',inva,', INA =',ina,&
          '*********************************************'
     else
-        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') "Properties",', NO =',inoa,', NV =',inva,', INA =',ina,&
+       write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') "Properties",', NO =',inoa,', NV =',inva,', INA =',ina,&
          '*********************************************'
     endif
    !
-    if(illa.ne.0.and.longprint) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
-    if(illa.eq.0.and.longprint) write(iunit,'(A)') '   ALL COMPONENTS ZERO '
+    if(illa.ne.0.and.longprint) write(iunit,'(A)') '     I   COEFFICIENT             ORDER   EXPONENTS'
+    if(illa.eq.0.and.longprint) write(iunit,'(A)') '         ALL COMPONENTS ZERO '
     !
-    c10='      NO ='
-    k10='      NV ='
-    if(longprint)write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
+!LD c10='      NO ='
+!LD k10='      NV ='
+!LD if(longprint)write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
     iout = 0
     !
     !      DO 100 IOA = 0,INOA
@@ -4592,9 +4592,9 @@ subroutine dapri77(ina,iunit)
                    write(iunit,503) ioa,cc(ii),(j(i),i=1,inva)
                 endif
              endif
-501          format(' ', i3,1x,e23.16,1x,100(1x,i2))
-503          format(' ', i3,1x,e23.16,1x,100(1x,i2))
-502          format(' ', i5,1x,e23.16,1x,100(1x,i2))
+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))
           endif
           !ETIENNE
           !
@@ -4606,7 +4606,7 @@ subroutine dapri77(ina,iunit)
        j(i)=0
     enddo
     if(iout.eq.0) iout=1
-if(longprint) write(iunit,502) -iout,zero,(j(i),i=1,inva)
+!LD if(longprint) write(iunit,502) -iout,zero,(j(i),i=1,inva)
 if((.not.longprint).and.(.not.some)) write(iunit,*) 0," Real Polynomial is zero "
 !if(.not.longprint) write(iunit,*) " "
     !
@@ -4779,11 +4779,11 @@ subroutine darea(ina,iunit)
     !
 10  continue
     iin = iin + 1
-    read(iunit,'(I6,2X,ES23.16,I5,4X,18(2i3,1X))') ii,c,io,(j(i),i=1,inva)
+    read(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,i2))') ii,c,io,(j(i),i=1,inva)
     !
     if(ii.eq.0) goto 20
     !ETIENNE
-!    read(iunit,*) c
+!LD read(iunit,*) c
     !ETIENNE
     if(ii.ne.iin) then
        iwarin = 1
diff --git a/libs/ptc/src/cc_dabnew.f90 b/libs/ptc/src/cc_dabnew.f90
index abf491721..14725b344 100644
--- a/libs/ptc/src/cc_dabnew.f90
+++ b/libs/ptc/src/cc_dabnew.f90
@@ -3961,8 +3961,8 @@ subroutine c_dapri(ina,iunit)
           write(iunit,'(I6,2X,ES23.16)') i-ipoa, c_clean_complex(c_cc(i))
        enddo
     elseif(c_nomax.eq.1) then
-       if(illa.ne.0.and.longprint) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
-       if(illa.eq.0.and.longprint) write(iunit,'(A)') '   ALL COMPONENTS 0.0_dp '
+       if(illa.ne.0) write(iunit,'(A)') '     I   COEFFICIENT                                     ORDER   EXPONENTS'
+       if(illa.eq.0) write(iunit,'(A)') '         ALL COMPONENTS 0.0_dp '
        do i=1,illa
           do k=1,inva
              j(k)=0
@@ -3972,13 +3972,13 @@ subroutine c_dapri(ina,iunit)
              j(i-1)=1
              ioa=1
           endif
-          write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,100(2i3,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))
+          write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,3X,18(1X,I2))') iout, &
+                     c_clean_complex(c_cc(ipoa+i-1)),ioa,(j(iii),iii=1,c_nvmax)
+! LD          write(iunit,*) c_clean_complex(c_cc(ipoa+i-1))
        enddo
     else
-       if(illa.ne.0.and.longprint) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
-       if(illa.eq.0.and.longprint) write(iunit,'(A)') '   ALL COMPONENTS 0.0_dp '
+       if(illa.ne.0) write(iunit,'(A)') '     I   COEFFICIENT                                     ORDER   EXPONENTS'
+       if(illa.eq.0) write(iunit,'(A)') '         ALL COMPONENTS 0.0_dp '
        do ioa = 0,inoa
           do ii=ipoa,ipoa+illa-1
              if(c_ieo(c_ia1(c_i_1(ii))+c_ia2(c_i_2(ii))).ne.ioa) goto 100
@@ -3993,9 +3993,9 @@ subroutine c_dapri(ina,iunit)
                 !ETIENNE
                 
                 iout = iout+1
-                write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,4X,100(2i3,1X))') iout,ccc,ioa,(j(iii),iii=1,c_nvmax)
+                write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,3X,18(1X,I2))') iout,ccc,ioa,(j(iii),iii=1,c_nvmax)
                 !ETIENNE
-!                write(iunit,*) c_cc(ii)
+! LD                write(iunit,*) c_cc(ii)
              endif
              !ETIENNE
              !
@@ -4061,21 +4061,20 @@ subroutine c_dapri77(ina,iunit)
     ilma = c_idalm(ina)
     illa = c_idall(ina)
     !
-
     if(longprint) then
        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') c_daname(ina),', NO =',inoa,', NV =',inva,', INA =',ina,&
          '*********************************************'
     else
-        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') "Properties",', NO =',inoa,', NV =',inva,', INA =',ina,&
+        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') c_daname(ina),', NO =',inoa,', NV =',inva,', INA =',ina,&
          '*********************************************'
     endif
     !
-    if(illa.ne.0.and.longprint) write(iunit,'(A)') '    I  COEFFICIENT          ORDER   EXPONENTS'
-    if(illa.eq.0.and.longprint) write(iunit,'(A)') '   ALL COMPONENTS 0.0_dp '
+    if(illa.ne.0.and.longprint) write(iunit,'(A)') '     I   COEFFICIENT                                     ORDER   EXPONENTS'
+    if(illa.eq.0.and.longprint) write(iunit,'(A)') '         ALL COMPONENTS 0.0_dp '
     !
-    c10='      NO ='
-    k10='      NV ='
-    if(longprint)write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
+!    c10='      NO ='
+!    k10='      NV ='
+!    if(longprint)write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
     iout = 0
     !
     !      DO 100 IOA = 0,INOA
@@ -4120,9 +4119,9 @@ subroutine c_dapri77(ina,iunit)
                    write(iunit,503) ioa,ccc,(j(i),i=1,inva)
                 endif
              endif
-501          format(' ', i3,1x,e23.16,1x,e23.16,1x,100(1x,i2))
-503          format(' ', i3,1x,e23.16,1x,e23.16,1x,100(1x,i2))
-502          format(' ', i5,1x,e23.16,1x,e23.16,1x,100(1x,i2))
+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))
           endif
           !ETIENNE
           !
@@ -4134,7 +4133,7 @@ subroutine c_dapri77(ina,iunit)
        j(i)=0
     enddo
     if(iout.eq.0) iout=1
-if(longprint) write(iunit,502) -iout,0.0_dp,0.0_dp,(j(i),i=1,inva)
+!if(longprint) 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) write(6,*) " "
     !
@@ -4311,7 +4310,7 @@ subroutine c_darea(ina,iunit)
     !
 10  continue
     iin = iin + 1
-!    read(iunit,'(I6,2X,ES23.16,I5,4X,100(2i3,1X))') ii,c,io,(j(i),i=1,inva)
+!    read(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') ii,c,io,(j(i),i=1,inva)
     read(iunit,*) ii,c,io,(j(i),i=1,inva)
     !
     if(ii.eq.0) goto 20

From feb7eed584f5141190249936055db77601be4a8c Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Fri, 19 Nov 2021 14:42:05 +0100
Subject: [PATCH 03/11] cleanup TPSA I/O, add madxprint flag for backward
 compatibility with default set to new format

---
 libs/ptc/src/a_scratch_size.f90 |  1 +
 libs/ptc/src/c_dabnew.f90       | 20 +++++++++++---------
 libs/ptc/src/cc_dabnew.f90      | 24 ++++++++++++------------
 3 files changed, 24 insertions(+), 21 deletions(-)

diff --git a/libs/ptc/src/a_scratch_size.f90 b/libs/ptc/src/a_scratch_size.f90
index 2120299d6..2c621d75c 100644
--- a/libs/ptc/src/a_scratch_size.f90
+++ b/libs/ptc/src/a_scratch_size.f90
@@ -89,6 +89,7 @@ module precision_constants
   !  real(dp),parameter:: A_dt = -0.142987272e0_dp    ! sateesh
   !  real(dp),parameter:: a_h3 =-4.183963e0_dp    ! sateesh
   logical(lp),  public :: longprint = my_true
+  logical(lp),  public :: madxprint = my_true
 
    real(dp) :: A_particle=A_ELECTRON
    real(dp),parameter::pmae=5.1099895000E-4_dp     ! NIST CODATA 2018
diff --git a/libs/ptc/src/c_dabnew.f90 b/libs/ptc/src/c_dabnew.f90
index f180aaa0d..86f65d3c7 100644
--- a/libs/ptc/src/c_dabnew.f90
+++ b/libs/ptc/src/c_dabnew.f90
@@ -4484,7 +4484,7 @@ subroutine dapri(ina,iunit)
              ioa=1
           endif
           write(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
-! LD      write(iunit,*) cc(ipoa+i-1)
+          if (.not.madxprint) write(iunit,*) cc(ipoa+i-1)
        enddo
     else
        if(illa.ne.0) write(iunit,'(A)') '     I   COEFFICIENT             ORDER   EXPONENTS'
@@ -4499,7 +4499,7 @@ subroutine dapri(ina,iunit)
                 iout = iout+1
                 write(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
                 !ETIENNE
-! LD             write(iunit,*) cc(ii)
+                if (.not.madxprint) write(iunit,*) cc(ii)
              endif
              !ETIENNE
              !
@@ -4556,9 +4556,11 @@ subroutine dapri77(ina,iunit)
     if(illa.ne.0.and.longprint) write(iunit,'(A)') '     I   COEFFICIENT             ORDER   EXPONENTS'
     if(illa.eq.0.and.longprint) write(iunit,'(A)') '         ALL COMPONENTS ZERO '
     !
-!LD c10='      NO ='
-!LD k10='      NV ='
-!LD if(longprint)write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
+    if (.not.madxprint) then
+       c10='      NO ='
+       k10='      NV ='
+       if(longprint)write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
+    endif
     iout = 0
     !
     !      DO 100 IOA = 0,INOA
@@ -4606,9 +4608,9 @@ subroutine dapri77(ina,iunit)
        j(i)=0
     enddo
     if(iout.eq.0) iout=1
-!LD if(longprint) write(iunit,502) -iout,zero,(j(i),i=1,inva)
-if((.not.longprint).and.(.not.some)) write(iunit,*) 0," Real Polynomial is zero "
-!if(.not.longprint) write(iunit,*) " "
+    if(longprint.and.(.not.madxprint)) write(iunit,502) -iout,zero,(j(i),i=1,inva)
+    if((.not.longprint).and.(.not.some)) write(iunit,*) 0," Real Polynomial is zero "
+    !if((.not.longprint).and.(.not.madxprint)) write(iunit,*) " "
     !
     return
       end subroutine dapri77
@@ -4783,7 +4785,7 @@ subroutine darea(ina,iunit)
     !
     if(ii.eq.0) goto 20
     !ETIENNE
-!LD read(iunit,*) c
+    if(.not.madxprint) read(iunit,*) c
     !ETIENNE
     if(ii.ne.iin) then
        iwarin = 1
diff --git a/libs/ptc/src/cc_dabnew.f90 b/libs/ptc/src/cc_dabnew.f90
index 14725b344..c3b4df590 100644
--- a/libs/ptc/src/cc_dabnew.f90
+++ b/libs/ptc/src/cc_dabnew.f90
@@ -3974,7 +3974,7 @@ subroutine c_dapri(ina,iunit)
           endif
           write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,3X,18(1X,I2))') iout, &
                      c_clean_complex(c_cc(ipoa+i-1)),ioa,(j(iii),iii=1,c_nvmax)
-! LD          write(iunit,*) c_clean_complex(c_cc(ipoa+i-1))
+          if (.not.madxprint) write(iunit,*) c_clean_complex(c_cc(ipoa+i-1))
        enddo
     else
        if(illa.ne.0) write(iunit,'(A)') '     I   COEFFICIENT                                     ORDER   EXPONENTS'
@@ -3989,13 +3989,11 @@ subroutine c_dapri(ina,iunit)
              if(abs(real(c_cc(ii)))> epsprint) a=c_cc(ii)
              if(abs(aimag(c_cc(ii)))> epsprint) b=aimag(c_cc(ii))
              ccc=a+(0.0_dp,1.0_dp)*b
-
                 !ETIENNE
-                
                 iout = iout+1
                 write(iunit,'(I6,2X,ES23.16,1x,ES23.16,I5,3X,18(1X,I2))') iout,ccc,ioa,(j(iii),iii=1,c_nvmax)
-                !ETIENNE
-! LD                write(iunit,*) c_cc(ii)
+                !ETIENNE + LD
+                if (.not.madxprint) write(iunit,*) c_cc(ii)
              endif
              !ETIENNE
              !
@@ -4065,16 +4063,18 @@ subroutine c_dapri77(ina,iunit)
        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') c_daname(ina),', NO =',inoa,', NV =',inva,', INA =',ina,&
          '*********************************************'
     else
-        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') c_daname(ina),', NO =',inoa,', NV =',inva,', INA =',ina,&
+        write(iunit,'(/1X,A10,A6,I5,A6,I5,A7,I5/1X,A/)') "Properties",', NO =',inoa,', NV =',inva,', INA =',ina,&
          '*********************************************'
     endif
     !
     if(illa.ne.0.and.longprint) write(iunit,'(A)') '     I   COEFFICIENT                                     ORDER   EXPONENTS'
     if(illa.eq.0.and.longprint) write(iunit,'(A)') '         ALL COMPONENTS 0.0_dp '
     !
-!    c10='      NO ='
-!    k10='      NV ='
-!    if(longprint)write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
+    if (.not.madxprint) then
+       c10='      NO ='
+       k10='      NV ='
+       if(longprint) write(iunit,'(A10,I6,A10,I6)') c10,inoa,k10,inva
+    endif
     iout = 0
     !
     !      DO 100 IOA = 0,INOA
@@ -4133,9 +4133,9 @@ subroutine c_dapri77(ina,iunit)
        j(i)=0
     enddo
     if(iout.eq.0) iout=1
-!if(longprint) write(iunit,502) -iout,0.0_dp,0.0_dp,(j(i),i=1,inva)
+    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) write(6,*) " "
+    !if((.not.longprint).and.(.not.madxprint)) write(iunit,*) " "
     !
     return
 longprint=long
@@ -4315,7 +4315,7 @@ subroutine c_darea(ina,iunit)
     !
     if(ii.eq.0) goto 20
     !ETIENNE
-!    read(iunit,*) c
+    if (.not.madxprint) read(iunit,*) c
     !ETIENNE
     if(ii.ne.iin) then
        iwarin = 1

From 40425c522c13a76c987cf3c357d299b5231451b0 Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Thu, 13 Jan 2022 17:06:57 +0100
Subject: [PATCH 04/11] add madprint option to ptc_setswitch to setup TPSA IO
 format, default false for backward compat.

---
 libs/ptc/src/a_scratch_size.f90 |  2 +-
 src/mad_dict.c                  |  3 ++-
 src/mad_extrn_f.h               |  1 +
 src/mad_ptc.c                   | 18 ++++++++++++++----
 src/madx_ptc_intstate.f90       | 14 ++++++++++++++
 src/wrap.f90                    |  7 +++++++
 6 files changed, 39 insertions(+), 6 deletions(-)

diff --git a/libs/ptc/src/a_scratch_size.f90 b/libs/ptc/src/a_scratch_size.f90
index 2c621d75c..3a6dc965e 100644
--- a/libs/ptc/src/a_scratch_size.f90
+++ b/libs/ptc/src/a_scratch_size.f90
@@ -89,7 +89,7 @@ module precision_constants
   !  real(dp),parameter:: A_dt = -0.142987272e0_dp    ! sateesh
   !  real(dp),parameter:: a_h3 =-4.183963e0_dp    ! sateesh
   logical(lp),  public :: longprint = my_true
-  logical(lp),  public :: madxprint = my_true
+  logical(lp),  public :: madxprint = my_false
 
    real(dp) :: A_particle=A_ELECTRON
    real(dp),parameter::pmae=5.1099895000E-4_dp     ! NIST CODATA 2018
diff --git a/src/mad_dict.c b/src/mad_dict.c
index 13f82deec..19f6ef88f 100644
--- a/src/mad_dict.c
+++ b/src/mad_dict.c
@@ -754,7 +754,8 @@ const char *const_command_def =
 " "
 "ptc_setswitch: ptc_setswitch none 0 0 "
 "debuglevel = [i,1], "/*sets the level of debugging printout 0 none, 4 everything */
-"mapdump    = [i, 0], " /*sets the level of map dump printout in all tracking codes 0: none, 1: order 0, 2: order 1 */
+"mapdump    = [i, 0], " /*ld: sets the level of map dump printout in all tracking codes 0: none, 1: order 0, 2: order 1 */
+"madprint   = [l, false, true], " /*ld: sets map dump printout format*/
 "seed       = [i, 123456789], "
 "maxacceleration = [l, true, true], " /*switch saying to set cavities phases so the reference orbit is always on the crest, i.e. gains max energy*/
 "exact_mis  = [l, false, true], "  /* switch to ensure exact misaligment treatment */
diff --git a/src/mad_extrn_f.h b/src/mad_extrn_f.h
index 6c3b899ad..f59458620 100644
--- a/src/mad_extrn_f.h
+++ b/src/mad_extrn_f.h
@@ -333,6 +333,7 @@ void w_ptc_script_(F_INTEGER scriptname);
 void w_ptc_setaccel_method_(F_INTEGER method);
 void w_ptc_setdebuglevel_(F_INTEGER level);
 void w_ptc_setmapdumplevel_(F_INTEGER level);
+void w_ptc_setmadprint_(F_INTEGER level);
 void w_ptc_setseed_(F_INTEGER level);
 void w_ptc_setstochastic_(F_INTEGER method);
 void w_ptc_setfieldcomp_(F_INTEGER fibreidx);
diff --git a/src/mad_ptc.c b/src/mad_ptc.c
index 696161927..a616d6dd0 100644
--- a/src/mad_ptc.c
+++ b/src/mad_ptc.c
@@ -857,12 +857,22 @@ pro_ptc_setswitch(struct in_cmd* cmd)
   }
 
   /*MAPDUMP LEVEL*/
-  if ( name_list_pos("mapdump", nl) >=0 )
-  {
-    found = command_par_value2("mapdump", cmd->clone, &switchvalue);
+  found = command_par_value2("mapdump", cmd->clone, &switchvalue);
+  if (found) {
+    if (debuglevel > 0) printf("mapdump is found and its value is %f\n", switchvalue);
     int mapdump = (int)switchvalue;
     w_ptc_setmapdumplevel_(&mapdump);
-  }
+  } else
+    if (debuglevel > 0) printf("mapdump is not present (keeping current value)\n");
+
+  /*MADPRINT TPSA FORMAT*/
+  found = command_par_value2("madprint", cmd->clone, &switchvalue);
+  if (found) {
+    if (debuglevel > 0) printf("madprint is found and its value is %f\n", switchvalue);
+    int madprint = (int)switchvalue;
+    w_ptc_setmadprint_(&madprint);
+  } else
+    if (debuglevel > 0) printf("madprint is not present (keeping current value)\n");
 
   /*ACCELERATION SWITCH*/
   found = command_par_value_user2("maxacceleration", cmd->clone, &switchvalue);
diff --git a/src/madx_ptc_intstate.f90 b/src/madx_ptc_intstate.f90
index 5ee961866..8a0bd8be5 100644
--- a/src/madx_ptc_intstate.f90
+++ b/src/madx_ptc_intstate.f90
@@ -15,6 +15,7 @@ module madx_ptc_intstate_module
   public                            :: setenforce6D
   public                            :: ptc_setdebuglevel
   public                            :: ptc_setmapdumplevel
+  public                            :: ptc_setmadprint
   public                            :: ptc_setseed
   public                            :: ptc_setaccel_method
   public                            :: ptc_setexactmis
@@ -140,6 +141,19 @@ end subroutine ptc_setmapdumplevel
   !____________________________________________________________________________________________
 
 
+  subroutine ptc_setmadprint(level)
+    use precision_constants, only : madxprint ! LD:13.01.2022
+    implicit none
+    integer     :: level
+
+    if (level > 0) then
+        print *, "Setting madprint level to", level
+    end if
+    madxprint = level.ne.0
+
+  end subroutine ptc_setmadprint
+
+  !____________________________________________________________________________________________
   subroutine ptc_setseed(seed)
     USE gauss_dis
     implicit none
diff --git a/src/wrap.f90 b/src/wrap.f90
index 25bb9aee9..c40c0ba66 100644
--- a/src/wrap.f90
+++ b/src/wrap.f90
@@ -116,6 +116,13 @@ subroutine w_ptc_setmapdumplevel(level)
   call ptc_setmapdumplevel(level)
 end subroutine w_ptc_setmapdumplevel
 
+subroutine w_ptc_setmadprint(level)
+  use madx_ptc_intstate_module
+  implicit none
+  integer level
+  call ptc_setmadprint(level)
+end subroutine w_ptc_setmadprint
+
 subroutine w_ptc_setseed(seed)
   use madx_ptc_intstate_module
   implicit none

From f9df3a23c0bf3c9af4085dd24a509e4b500660de Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Thu, 13 Jan 2022 17:41:02 +0100
Subject: [PATCH 05/11] remove extra output when NOT selected (was added for
 consistency with other PTC_SETSWITCH options)

---
 src/mad_ptc.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/mad_ptc.c b/src/mad_ptc.c
index bf3a805ca..19b95a932 100644
--- a/src/mad_ptc.c
+++ b/src/mad_ptc.c
@@ -862,8 +862,7 @@ pro_ptc_setswitch(struct in_cmd* cmd)
     if (debuglevel > 0) printf("mapdump is found and its value is %f\n", switchvalue);
     int mapdump = (int)switchvalue;
     w_ptc_setmapdumplevel_(&mapdump);
-  } else
-    if (debuglevel > 0) printf("mapdump is not present (keeping current value)\n");
+  }
 
   /*MADPRINT TPSA FORMAT*/
   found = command_par_value2("madprint", cmd->clone, &switchvalue);
@@ -871,8 +870,7 @@ pro_ptc_setswitch(struct in_cmd* cmd)
     if (debuglevel > 0) printf("madprint is found and its value is %f\n", switchvalue);
     int madprint = (int)switchvalue;
     w_ptc_setmadprint_(&madprint);
-  } else
-    if (debuglevel > 0) printf("madprint is not present (keeping current value)\n");
+  }
 
   /*ACCELERATION SWITCH*/
   found = command_par_value_user2("maxacceleration", cmd->clone, &switchvalue);

From 90d2e893ba8775f10ad7994d412d9b6d9420a1fb Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Thu, 13 Jan 2022 17:57:16 +0100
Subject: [PATCH 06/11] remove extra output when NOT selected (was added for
 consistency with other PTC_SETSWITCH options)

---
 src/mad_ptc.c | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/mad_ptc.c b/src/mad_ptc.c
index 19b95a932..3ede2518b 100644
--- a/src/mad_ptc.c
+++ b/src/mad_ptc.c
@@ -857,16 +857,16 @@ pro_ptc_setswitch(struct in_cmd* cmd)
   }
 
   /*MAPDUMP LEVEL*/
-  found = command_par_value2("mapdump", cmd->clone, &switchvalue);
-  if (found) {
+  if ( name_list_pos("mapdump", nl) >=0 ) {
+    found = command_par_value2("mapdump", cmd->clone, &switchvalue);
     if (debuglevel > 0) printf("mapdump is found and its value is %f\n", switchvalue);
     int mapdump = (int)switchvalue;
     w_ptc_setmapdumplevel_(&mapdump);
   }
 
   /*MADPRINT TPSA FORMAT*/
-  found = command_par_value2("madprint", cmd->clone, &switchvalue);
-  if (found) {
+  if ( name_list_pos("madprint", nl) >=0 ) {
+    found = command_par_value2("madprint", cmd->clone, &switchvalue);
     if (debuglevel > 0) printf("madprint is found and its value is %f\n", switchvalue);
     int madprint = (int)switchvalue;
     w_ptc_setmadprint_(&madprint);

From a32686303faadb2de621742f85a3a9c3b5c17037 Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Thu, 13 Jan 2022 19:03:44 +0100
Subject: [PATCH 07/11] check if this modify output (unexpected)

---
 src/mad_regex.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/mad_regex.c b/src/mad_regex.c
index fb462de4d..3d686346d 100644
--- a/src/mad_regex.c
+++ b/src/mad_regex.c
@@ -252,7 +252,8 @@ myregend(char* mypat, struct reg_token* start)
 {
   const char *rout_name = "myregend";
   struct reg_token *rp, *aux;
-  if (mypat != NULL) myfree(rout_name, mypat), mypat = NULL;
+  if (mypat != NULL) myfree(rout_name, mypat);
+  mypat = NULL;
   rp = start;
   while (rp != NULL)
   {

From 1b6a797d4262129d5a0c3010fa99c1fd5fd76147 Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Thu, 13 Jan 2022 19:23:45 +0100
Subject: [PATCH 08/11] reverse change, as expected, no impact on tests

---
 src/mad_regex.c | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/mad_regex.c b/src/mad_regex.c
index 3d686346d..fb462de4d 100644
--- a/src/mad_regex.c
+++ b/src/mad_regex.c
@@ -252,8 +252,7 @@ myregend(char* mypat, struct reg_token* start)
 {
   const char *rout_name = "myregend";
   struct reg_token *rp, *aux;
-  if (mypat != NULL) myfree(rout_name, mypat);
-  mypat = NULL;
+  if (mypat != NULL) myfree(rout_name, mypat), mypat = NULL;
   rp = start;
   while (rp != NULL)
   {

From a4064cac5a2ad22eefff4aa9b1e796e692c94a72 Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Fri, 14 Jan 2022 09:42:36 +0100
Subject: [PATCH 09/11] remove output with debuglevel

---
 src/mad_ptc.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/mad_ptc.c b/src/mad_ptc.c
index 3ede2518b..8dc357023 100644
--- a/src/mad_ptc.c
+++ b/src/mad_ptc.c
@@ -859,7 +859,7 @@ pro_ptc_setswitch(struct in_cmd* cmd)
   /*MAPDUMP LEVEL*/
   if ( name_list_pos("mapdump", nl) >=0 ) {
     found = command_par_value2("mapdump", cmd->clone, &switchvalue);
-    if (debuglevel > 0) printf("mapdump is found and its value is %f\n", switchvalue);
+    // if (debuglevel > 0) printf("mapdump is found and its value is %f\n", switchvalue);
     int mapdump = (int)switchvalue;
     w_ptc_setmapdumplevel_(&mapdump);
   }
@@ -867,7 +867,7 @@ pro_ptc_setswitch(struct in_cmd* cmd)
   /*MADPRINT TPSA FORMAT*/
   if ( name_list_pos("madprint", nl) >=0 ) {
     found = command_par_value2("madprint", cmd->clone, &switchvalue);
-    if (debuglevel > 0) printf("madprint is found and its value is %f\n", switchvalue);
+    // if (debuglevel > 0) printf("madprint is found and its value is %f\n", switchvalue);
     int madprint = (int)switchvalue;
     w_ptc_setmadprint_(&madprint);
   }

From 493d02a48740f4d73d71ce484fba7b4c8bfa68ab Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Fri, 14 Jan 2022 14:25:17 +0100
Subject: [PATCH 10/11] fix for TPSA IO backward compatibility

---
 Makefile_test              | 2 +-
 libs/ptc/src/c_dabnew.f90  | 7 ++++---
 libs/ptc/src/cc_dabnew.f90 | 4 ++--
 3 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/Makefile_test b/Makefile_test
index fc40cb57a..fb6c9f915 100644
--- a/Makefile_test
+++ b/Makefile_test
@@ -108,7 +108,7 @@ test-dynap \
 test-c6t-4 \
 test-match-6 test-match-7 \
 test-ptc-twiss-2 \
-test-ptc-twiss-old6 test-ptc-twiss-old7 \
+test-ptc-twiss-old7 \
 test-touschek test-touschek-2 \
 \
 $(call onlx64,$(user-cases),)
diff --git a/libs/ptc/src/c_dabnew.f90 b/libs/ptc/src/c_dabnew.f90
index 86f65d3c7..5d019b4a7 100644
--- a/libs/ptc/src/c_dabnew.f90
+++ b/libs/ptc/src/c_dabnew.f90
@@ -4483,7 +4483,7 @@ subroutine dapri(ina,iunit)
              j(i-1)=1
              ioa=1
           endif
-          write(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') iout,cc(ipoa+i-1),ioa,(j(iii),iii=1,nvmax)
+          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)
        enddo
     else
@@ -4497,7 +4497,7 @@ subroutine dapri(ina,iunit)
              if(abs(cc(ii)).gt.eps) then
                 !ETIENNE
                 iout = iout+1
-                write(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') iout,cc(ii),ioa,(j(iii),iii=1,nvmax)
+                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)
              endif
@@ -4781,7 +4781,8 @@ subroutine darea(ina,iunit)
     !
 10  continue
     iin = iin + 1
-    read(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,i2))') ii,c,io,(j(i),i=1,inva)
+!    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(ii.eq.0) goto 20
     !ETIENNE
diff --git a/libs/ptc/src/cc_dabnew.f90 b/libs/ptc/src/cc_dabnew.f90
index c3b4df590..65e444bf9 100644
--- a/libs/ptc/src/cc_dabnew.f90
+++ b/libs/ptc/src/cc_dabnew.f90
@@ -3991,7 +3991,7 @@ 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,3X,18(1X,I2))') iout,ccc,ioa,(j(iii),iii=1,c_nvmax)
+                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)
              endif
@@ -4310,7 +4310,7 @@ subroutine c_darea(ina,iunit)
     !
 10  continue
     iin = iin + 1
-!    read(iunit,'(I6,2X,ES23.16,I5,3X,18(1X,I2))') ii,c,io,(j(i),i=1,inva)
+!    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(ii.eq.0) goto 20

From 673b716818bd5c93a83726a2d067a1468d3a1ce3 Mon Sep 17 00:00:00 2001
From: Laurent Deniau <laurent.deniau@gmail.com>
Date: Fri, 14 Jan 2022 17:21:41 +0100
Subject: [PATCH 11/11] keep format backward compatible

---
 libs/ptc/src/c_dabnew.f90  | 42 +++++++++++++++++++++++++-----------
 libs/ptc/src/cc_dabnew.f90 | 44 +++++++++++++++++++++++---------------
 2 files changed, 56 insertions(+), 30 deletions(-)

diff --git a/libs/ptc/src/c_dabnew.f90 b/libs/ptc/src/c_dabnew.f90
index 5d019b4a7..b4a353718 100644
--- a/libs/ptc/src/c_dabnew.f90
+++ b/libs/ptc/src/c_dabnew.f90
@@ -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 '
@@ -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'
@@ -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
              !
@@ -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
           !
@@ -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
diff --git a/libs/ptc/src/cc_dabnew.f90 b/libs/ptc/src/cc_dabnew.f90
index 65e444bf9..ac33d4c62 100644
--- a/libs/ptc/src/cc_dabnew.f90
+++ b/libs/ptc/src/cc_dabnew.f90
@@ -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'
@@ -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
              !
@@ -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
 
@@ -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)
@@ -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
@@ -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
           !
@@ -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
@@ -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)
@@ -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
@@ -4356,7 +4367,6 @@ subroutine c_darea(ina,iunit)
     if(c_nomax.ne.1) call dapac(ina)
     !
     return
- 
   end subroutine c_darea
   !FF
   !