Merge pull request #563 from piotrskowronski/master

Bug correction in sector_nmul_max, plus modifs needed for Intel 18.0.1 with gcc 7.3

Makefile_lib

@@ -22,18 +22,19 @@ ifeq ($(ONLINE),yes)
 LIBS += -Llib$(ARCH) -lSDDS1c -lSDDS1 -lrpnlib -lmdbmth -lmdblib -lgsl -lz
 endif
 
+# Libraries on Linux
+
+ifeq ($(OSTYPE),Linux)
+LIBS   += $(if $(call eq,$(ARCH),32),$(call libdir,/usr/lib),) -lpthread -lX11
+LDLIBS += -lstdc++ -lm
+endif
+
 # Garbage Collector
 
 ifeq ($(USEGC),yes)
 LIBS += -Llibs$/gc -lgc-$(OSNAME)$(ARCH)$(if $(findstring -intel,$@),-intel,-gnu)
 endif
 
-# Libraries on Linux
-
-ifeq ($(OSTYPE),Linux)
-LIBS   += $(if $(call eq,$(ARCH),32),$(call libdir,/usr/lib),) -lX11
-LDLIBS += -lstdc++ -lm
-endif
 
 # Libraries on MacOSX
 

libs/ptc/src/a_def_element_fibre_layout.inc

@@ -312,6 +312,26 @@ type info
    real(dp), pointer:: m(:,:)  => null()
 END type info
 
+TYPE INTEGRATION_NODE
+   INTEGER, POINTER :: pos_in_fibre => null(), CAS  => null()
+   INTEGER, POINTER ::  pos => null(),lost  => null()
+   real(dp), POINTER :: S(:)  => null()
+   real(dp), POINTER :: ds_ac  => null()
+   real(dp), POINTER :: ref(:)  => null()
+   real(dp), pointer :: ent(:,:),a(:)  => null()
+   real(dp), pointer :: exi(:,:),b(:)  => null()
+   real(dp), POINTER :: delta_rad_in  => null()
+   real(dp), POINTER :: delta_rad_out  => null()
+   INTEGER, POINTER :: TEAPOT_LIKE  => null()
+   TYPE (INTEGRATION_NODE), POINTER :: NEXT  => null()
+   TYPE (INTEGRATION_NODE), POINTER :: PREVIOUS  => null()
+   TYPE (NODE_LAYOUT), POINTER :: PARENT_NODE_LAYOUT  => null()
+   TYPE(FIBRE), POINTER :: PARENT_FIBRE  => null()
+   !   TYPE(EXTRA_WORK), POINTER :: WORK
+   TYPE(BEAM_BEAM_NODE), POINTER :: BB  => null()
+!   TYPE(tree_element), POINTER :: T
+END TYPE INTEGRATION_NODE
+
 TYPE FIBRE
    !  BELOW ARE THE DATA CARRIED BY THE NODE
    INTEGER,POINTER ::DIR => null()
@@ -340,6 +360,8 @@ TYPE FIBRE
 
 END TYPE FIBRE
 
+
+
 TYPE LAYOUT
    CHARACTER(120), POINTER ::  NAME  => null()! IDENTIFICATION
    INTEGER, POINTER ::  INDEX  => null()! IDENTIFICATION, CHARGE SIGN
@@ -384,25 +406,6 @@ TYPE MAD_UNIVERSE             ! THE MOTHER OF ALL STRUCTURES
 END TYPE MAD_UNIVERSE
 
 
-TYPE INTEGRATION_NODE
-   INTEGER, POINTER :: pos_in_fibre => null(), CAS  => null()
-   INTEGER, POINTER ::  pos => null(),lost  => null()
-   real(dp), POINTER :: S(:)  => null()
-   real(dp), POINTER :: ds_ac  => null()
-   real(dp), POINTER :: ref(:)  => null()
-   real(dp), pointer :: ent(:,:),a(:)  => null()
-   real(dp), pointer :: exi(:,:),b(:)  => null()
-   real(dp), POINTER :: delta_rad_in  => null()
-   real(dp), POINTER :: delta_rad_out  => null()
-   INTEGER, POINTER :: TEAPOT_LIKE  => null()
-   TYPE (INTEGRATION_NODE), POINTER :: NEXT  => null()
-   TYPE (INTEGRATION_NODE), POINTER :: PREVIOUS  => null()
-   TYPE (NODE_LAYOUT), POINTER :: PARENT_NODE_LAYOUT  => null()
-   TYPE(FIBRE), POINTER :: PARENT_FIBRE  => null()
-   !   TYPE(EXTRA_WORK), POINTER :: WORK
-   TYPE(BEAM_BEAM_NODE), POINTER :: BB  => null()
-!   TYPE(tree_element), POINTER :: T
-END TYPE INTEGRATION_NODE
 
 TYPE BEAM_LOCATION
    TYPE (INTEGRATION_NODE), POINTER :: NODE  => null()

libs/ptc/src/h_definition.f90

@@ -280,9 +280,9 @@ module definition
 
   !@3 ---------------------------------------------</br>
   include "a_def_frame_patch_chart.inc"
-  include "a_def_all_kind.inc"
   include "a_def_sagan.inc"
   include "a_def_element_fibre_layout.inc"
+  include "a_def_all_kind.inc"
   !@3 ---------------------------------------------</br>
   type(fibre), pointer :: lost_fibre=>null()
   type(integration_node), pointer :: lost_node=>null()

src/madx_ptc_module.f90

@@ -3503,12 +3503,14 @@ function getmaxnmul()
     use twtrrfi, only: maxferr
     implicit none
     integer getmaxnmul 
-    integer i,j, maxnmul, code, n_ferr, max_n_ferr
+    integer i,j, maxnmul, maxk, code, n_ferr, max_n_ferr
     integer restart_sequ,advance_node,node_fd_errors
     integer n_norm, n_skew
-    REAL(dp) :: tmp_0123(0:3)
+    REAL(dp) :: tmp_0123(0:3), v
     REAL(dp) :: tmpmularr(0:maxferr), field(2,0:maxferr)
     real(kind(1d0)) node_value
+    character (len = 3), dimension(3) :: kns = (/'k1 ','k2 ','k3 ' /)
+    character (len = 4), dimension(3) :: kss = (/'k1s ','k2s ','k3s ' /)
 
     getmaxnmul = -1
 
@@ -3522,7 +3524,24 @@ function getmaxnmul()
         j = advance_node()  !returns 1 if OK, 0 otherhise
         cycle;
       endif 
+
+      maxk = 0
+      do i=3,1,-1
+        v = node_value(kns(i))
+        if (v .ne. zero ) then
+          maxk = i
+          exit
+        endif
 
+        v = node_value(kss(i))
+        if (v .ne. zero ) then
+          maxk = i
+          exit
+        endif
+
+      enddo
+
+
       call get_node_vector('knl ',n_norm,tmpmularr) 
       call get_node_vector('ksl ',n_skew,tmpmularr) 
 
@@ -3543,12 +3562,15 @@ function getmaxnmul()
       enddo
 
 
-      maxnmul = max(n_norm,n_skew)
-      maxnmul = max(n_ferr,maxnmul)
+      maxnmul = max(n_norm,n_skew)  ! max order between  knl and kns
+      maxnmul = max(maxk,  maxnmul) ! max between the above and defined with k1,k2,k3, k1s,k2s,k3s
+      maxnmul = max(n_ferr,maxnmul) ! max between the above and the errors
 
       if (maxnmul > getmaxnmul) getmaxnmul = maxnmul
-
-     ! print*, "j=",j," ", getmaxnmul, maxnmul, n_norm,n_skew,n_ferr
+      if (getdebug() > 2) then
+         print*, "j   getmaxnmul   maxnmul  maxk  n_norm  n_skew  n_ferr"
+         print*, j,getmaxnmul, maxnmul, maxk, n_norm,n_skew,n_ferr
+      endif
 
       j = advance_node()
 

tests/test-ptc-normal/test-ptc-normal.cfg

@@ -1,4 +1,4 @@
 1-7         *     skip         # head
 *           *     dig=100      # global
 208         1     rel=5e-11    # [YIL] machine length
-214         3     rel=1e-12
+215         3     rel=1e-12

tests/test-ptc-twiss-6D-ALS/test-ptc-twiss-6D-ALS.cfg

@@ -1,3 +1,3 @@
 1-7       *     skip         # head
 *         *     any abs=9e-14 rel=2e-16
-56        *     abs=3e-13    # machine length
+57        *     abs=3e-13    # machine length