Merge branch 'Python3' into new-test-server

CMakeLists.txt

@@ -445,6 +445,33 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
 
   # Additional options
   # -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4)
+
+
+###################################################################################################
+# PGI Compiler
+###################################################################################################
+elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI")
+
+  if (OPTIMIZATION STREQUAL "OFF")
+    set (OPTIMIZATION_FLAGS "-O0"       )
+  elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
+    set (OPTIMIZATION_FLAGS "-O2")
+  elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
+    set (OPTIMIZATION_FLAGS "-O3")
+  endif ()
+
+
+#------------------------------------------------------------------------------------------------
+# Fine tuning compilation options
+  set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess")
+  # preprocessor
+
+  set (STANDARD_CHECK "-Mallocatable=03")
+
+#------------------------------------------------------------------------------------------------
+# Runtime debugging
+  set (DEBUG_FLAGS "${DEBUG_FLAGS} -g")
+  # Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line
 else ()
   message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
 endif ()

VERSION

@@ -1 +1 @@
-v2.0.2-1674-g683dee82
+v2.0.2-1689-g1a471bcd

processing/post/vtk_addGridData.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python2.7
+#!/usr/bin/env python3
 # -*- coding: UTF-8 no BOM -*-
 
 import os,vtk

processing/post/vtk_addPointcloudData.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python2.7
+#!/usr/bin/env python3
 # -*- coding: UTF-8 no BOM -*-
 
 import os,vtk

processing/post/vtk_addRectilinearGridData.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python2.7
+#!/usr/bin/env python3
 # -*- coding: UTF-8 no BOM -*-
 
 import os,vtk

processing/post/vtk_pointcloud.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python2.7
+#!/usr/bin/env python3
 # -*- coding: UTF-8 no BOM -*-
 
 import os,sys,vtk

processing/post/vtk_rectilinearGrid.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python2.7
+#!/usr/bin/env python3
 # -*- coding: UTF-8 no BOM -*-
 
 import os,sys,vtk

src/C_routines.c

@@ -6,9 +6,11 @@
 #include <sys/stat.h>
 #include <stdio.h>
 #include <string.h>
+#include <signal.h>
 
 /* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */
 
+
 int isdirectory_c(const char *dir){
   struct stat statbuf;
   if(stat(dir, &statbuf) != 0)                                                                      /* error */
@@ -44,3 +46,11 @@ void gethostname_c(char hostname[], int *stat){
 int chdir_c(const char *dir){
   return chdir(dir);
 }
+
+void signalusr1_c(void (*handler)(int)){
+  signal(SIGUSR1, handler);
+}
+
+void signalusr2_c(void (*handler)(int)){
+  signal(SIGUSR2, handler);
+}

src/DAMASK_interface.f90

@@ -12,9 +12,9 @@
 module DAMASK_interface
  use prec, only: &
    pInt
-
  implicit none
  private
+ logical, public, protected :: SIGUSR1,SIGUSR2
  integer(pInt),       public, protected :: &
    interface_restartInc = 0_pInt                                                                    !< Increment at which calculation starts
  character(len=1024), public, protected :: &
@@ -42,6 +42,8 @@ contains
 subroutine DAMASK_interface_init()
  use, intrinsic :: &
    iso_fortran_env
+ use :: &
+   iso_c_binding
 #include <petsc/finclude/petscsys.h>
 #if defined(__GFORTRAN__) &&  __GNUC__ < 5
 ===================================================================================================
@@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
 
  use PETScSys
  use system_routines, only: &
+   signalusr1_C, &
+   signalusr2_C, &
    getHostName, &
    getCWD
 
@@ -229,6 +233,12 @@ subroutine DAMASK_interface_init()
  if (interface_restartInc > 0_pInt) &
    write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
 
+ call signalusr1_c(c_funloc(setSIGUSR1))
+ call signalusr2_c(c_funloc(setSIGUSR2))
+ SIGUSR1 = .false.
+ SIGUSR2 = .false.
+
+
 end subroutine DAMASK_interface_init
 
 
@@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b)
 
 end function makeRelativePath
 
+!--------------------------------------------------------------------------------------------------
+!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1
+!--------------------------------------------------------------------------------------------------
+subroutine setSIGUSR1(signal) bind(C)
+ use :: iso_c_binding
+   
+ implicit none
+ integer(C_INT), value :: signal
+ SIGUSR1 = .true.
+ 
+ write(6,*) 'received signal ',signal, 'set SIGUSR1'
+ 
+end subroutine setSIGUSR1
+ 
+ 
+!--------------------------------------------------------------------------------------------------
+!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2
+!--------------------------------------------------------------------------------------------------
+subroutine setSIGUSR2(signal) bind(C)
+ use :: iso_c_binding
+
+ implicit none
+ integer(C_INT), value :: signal
+ SIGUSR2 = .true.
+
+ write(6,*) 'received signal ',signal, 'set SIGUSR2'
+  
+end subroutine setSIGUSR2
+
 
 !--------------------------------------------------------------------------------------------------
 !> @brief taken from IO, check IO_stringValue for documentation 
@@ -469,11 +508,10 @@ pure function IIO_stringPos(string)
  do while (verify(string(right+1:),SEP)>0)
    left  = right + verify(string(right+1:),SEP)
    right = left + scan(string(left:),SEP) - 2
-   if ( string(left:left) == '#' ) exit
    IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
    IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
  enddo
 
 end function IIO_stringPos
 
-end module
+end module

src/FEM_utilities.f90

@@ -162,7 +162,6 @@ subroutine utilities_init()
 
  character(len=1024)                :: petsc_optionsPhysics
  integer(pInt)                      :: dimPlex
- integer(pInt)                      :: headerID = 205_pInt
  PetscInt,    allocatable           :: nEntities(:), nOutputCells(:), nOutputNodes(:)
  PetscInt                           :: dim
  PetscErrorCode                     :: ierr
@@ -213,13 +212,6 @@ subroutine utilities_init()
  nOutputCells(worldrank+1) = count(material_homog > 0_pInt)
  call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
  call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
- if (worldrank == 0_pInt) then
-   open(unit=headerID, file=trim(getSolverJobName())//'.header', &
-        form='FORMATTED', status='REPLACE')
-   write(headerID, '(a,i0)') 'dimension : ',   dimPlex                                             
-   write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes)
-   write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells)
- endif 
 
 end subroutine utilities_init
 

src/compilation_info.f90

@@ -1,9 +1,13 @@
+! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
 #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
   write(6,*) 'Compiled with ', compiler_version()
   write(6,*) 'With options  ', compiler_options()
-#else
+#elif defined(__INTEL_COMPILER)
   write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,&
                                                      ', build date ', __INTEL_COMPILER_BUILD_DATE
+#elif defined(__PGI)
+  write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,&
+                                                               '.', __PGIC_MINOR__
 #endif
 write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
 write(6,*)

src/math.f90

@@ -118,6 +118,9 @@ module math
 !---------------------------------------------------------------------------------------------------
 
  public :: &
+#if defined(__PGI)
+   norm2, &
+#endif
    math_init, &
    math_qsort, &
    math_expand, &
@@ -351,20 +354,38 @@ end subroutine math_check
 
 !--------------------------------------------------------------------------------------------------
 !> @brief Quicksort algorithm for two-dimensional integer arrays
-! Sorting is done with respect to array(1,:)
+! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it.
-! and keeps array(2:N,:) linked to it.
+! default: sort=1
 !--------------------------------------------------------------------------------------------------
-recursive subroutine math_qsort(a, istart, iend)
+recursive subroutine math_qsort(a, istart, iend, sortDim)
 
  implicit none
  integer(pInt), dimension(:,:), intent(inout) :: a
- integer(pInt), intent(in) :: istart,iend
+ integer(pInt), intent(in),optional :: istart,iend, sortDim
- integer(pInt) :: ipivot
+ integer(pInt) :: ipivot,s,e,d
-
+ 
- if (istart < iend) then
+ if(present(istart)) then
-   ipivot = qsort_partition(a,istart, iend)
+   s = istart
-   call math_qsort(a, istart, ipivot-1_pInt)
+ else
-   call math_qsort(a, ipivot+1_pInt, iend)
+   s = lbound(a,2)
+ endif
+ 
+ if(present(iend)) then
+   e = iend
+ else
+   e = ubound(a,2)
+ endif
+ 
+  if(present(sortDim)) then
+   d = sortDim
+ else
+   d = 1
+ endif
+  
+ if (s < e) then
+   ipivot = qsort_partition(a,s, e, d)
+   call math_qsort(a, s, ipivot-1_pInt, d)
+   call math_qsort(a, ipivot+1_pInt, e, d)
  endif
 
 !--------------------------------------------------------------------------------------------------
@@ -373,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend)
  !-------------------------------------------------------------------------------------------------
  !> @brief Partitioning required for quicksort
  !-------------------------------------------------------------------------------------------------
- integer(pInt) function qsort_partition(a, istart, iend)
+ integer(pInt) function qsort_partition(a, istart, iend, sort)
  
    implicit none
    integer(pInt), dimension(:,:), intent(inout) :: a
-   integer(pInt), intent(in) :: istart,iend
+   integer(pInt),                 intent(in)    :: istart,iend,sort
-   integer(pInt) :: i,j,k,tmp
+   integer(pInt), dimension(size(a,1))          :: tmp
+   integer(pInt) :: i,j
   
    do
-  ! find the first element on the right side less than or equal to the pivot point
+     ! find the first element on the right side less than or equal to the pivot point
      do j = iend, istart, -1_pInt
-       if (a(1,j) <= a(1,istart)) exit
+       if (a(sort,j) <= a(sort,istart)) exit
      enddo
-  ! find the first element on the left side greater than the pivot point
+     ! find the first element on the left side greater than the pivot point
      do i = istart, iend
-       if (a(1,i) > a(1,istart)) exit
+       if (a(sort,i) > a(sort,istart)) exit
      enddo
-     if (i < j) then ! if the indexes do not cross, exchange values
+     cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index
-       do k = 1_pInt, int(size(a,1_pInt), pInt)
+       tmp         = a(:,istart)
-         tmp = a(k,i)
+       a(:,istart) = a(:,j)
-         a(k,i) = a(k,j)
+       a(:,j)      = tmp
-         a(k,j) = tmp
-       enddo
-     else           ! if they do cross, exchange left value with pivot and return with the partition index
-       do k = 1_pInt, int(size(a,1_pInt), pInt)
-         tmp = a(k,istart)
-         a(k,istart) = a(k,j)
-         a(k,j) = tmp
-       enddo
        qsort_partition = j
        return
-     endif
+     else cross ! if they do not cross, exchange values
+       tmp    = a(:,i)
+       a(:,i) = a(:,j)
+       a(:,j) = tmp
+     endif cross
    enddo
  
  end function qsort_partition
@@ -2707,4 +2725,19 @@ real(pReal) pure elemental function math_clip(a, left, right)
 
 end function math_clip
 
+
+#if defined(__PGI)
+!--------------------------------------------------------------------------------------------------
+!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10
+!--------------------------------------------------------------------------------------------------
+real(pReal) pure function norm2(v)
+ 
+ implicit none
+ real(pReal), intent(in), dimension(3) :: v
+ 
+ norm2 = sqrt(sum(v**2))
+
+end function norm2
+#endif
+
 end module math

src/system_routines.f90

@@ -3,11 +3,17 @@
 !> @brief    provides wrappers to C routines
 !--------------------------------------------------------------------------------------------------
 module system_routines
- 
+ use, intrinsic :: ISO_C_Binding, only: &
+   C_INT, &
+   C_CHAR, &
+   C_NULL_CHAR
+
  implicit none
  private
  
  public :: &
+   signalusr1_C, &
+   signalusr2_C, &
    isDirectory, &
    getCWD, &
    getHostName, &
@@ -27,7 +33,7 @@ interface
    use, intrinsic :: ISO_C_Binding, only: &
      C_INT, &
      C_CHAR
-   character(kind=C_CHAR), dimension(1024), intent(out)  :: str                                     ! C string is an array
+   character(kind=C_CHAR), dimension(1024), intent(out) :: str                                      ! C string is an array
    integer(C_INT),intent(out)         :: stat
   end subroutine getCurrentWorkDir_C
 
@@ -35,7 +41,7 @@ interface
    use, intrinsic :: ISO_C_Binding, only: &
      C_INT, &
      C_CHAR
-   character(kind=C_CHAR), dimension(1024), intent(out)  :: str                                     ! C string is an array
+   character(kind=C_CHAR), dimension(1024), intent(out) :: str                                      ! C string is an array
    integer(C_INT),intent(out)         :: stat
   end subroutine getHostName_C
 
@@ -46,31 +52,38 @@ interface
    integer(C_INT) :: chdir_C
    character(kind=C_CHAR), dimension(1024), intent(in) :: path                                      ! C string is an array
  end function chdir_C
+ 
+ subroutine signalusr1_C(handler) bind(C)
+   use, intrinsic :: ISO_C_Binding, only: &
+     C_FUNPTR
+   type(C_FUNPTR), intent(in), value :: handler
+ end subroutine signalusr1_C
+ 
+  subroutine signalusr2_C(handler) bind(C)
+   use, intrinsic :: ISO_C_Binding, only: &
+     C_FUNPTR
+   type(C_FUNPTR), intent(in), value :: handler
+ end subroutine signalusr2_C
 
 end interface
 
-
 contains
 
 !--------------------------------------------------------------------------------------------------
 !> @brief figures out if a given path is a directory (and not an ordinary file)
 !--------------------------------------------------------------------------------------------------
 logical function isDirectory(path)
-  use, intrinsic :: ISO_C_Binding, only: &
-    C_INT, &
-    C_CHAR, &
-    C_NULL_CHAR
 
-  implicit none
+ implicit none
-  character(len=*), intent(in) :: path
+ character(len=*), intent(in) :: path
-  character(kind=C_CHAR), dimension(1024) :: strFixedLength
+ character(kind=C_CHAR), dimension(1024) :: strFixedLength                                         ! C string as array
-  integer :: i 
+ integer :: i 
 
-  strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
+ strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
-  do i=1,len(path)                                                                                  ! copy array components
+ do i=1,len(path)                                                                                   ! copy array components
-    strFixedLength(i)=path(i:i)
+   strFixedLength(i)=path(i:i)
-  enddo
+ enddo
-  isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
+ isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
 
 end function isDirectory
 
@@ -79,29 +92,25 @@ end function isDirectory
 !> @brief gets the current working directory
 !--------------------------------------------------------------------------------------------------
 character(len=1024) function getCWD()
-  use, intrinsic :: ISO_C_Binding, only: &
-    C_INT, &
-    C_CHAR, &
-    C_NULL_CHAR
 
-  implicit none
+ implicit none
-  character(kind=C_CHAR), dimension(1024) :: charArray                                              ! C string is an array
+ character(kind=C_CHAR), dimension(1024) :: charArray                                               ! C string is an array
-  integer(C_INT) :: stat
+ integer(C_INT) :: stat
-  integer :: i
+ integer :: i
 
-  call getCurrentWorkDir_C(charArray,stat)
+ call getCurrentWorkDir_C(charArray,stat)
-  if (stat /= 0_C_INT) then
+ if (stat /= 0_C_INT) then
-    getCWD = 'Error occured when getting currend working directory'
+   getCWD = 'Error occured when getting currend working directory'
-  else
+ else
-    getCWD = repeat('',len(getCWD))
+   getCWD = repeat('',len(getCWD))
-    arrayToString: do i=1,len(getCWD)
+   arrayToString: do i=1,len(getCWD)
-      if (charArray(i) /= C_NULL_CHAR) then
+     if (charArray(i) /= C_NULL_CHAR) then
-        getCWD(i:i)=charArray(i)
+       getCWD(i:i)=charArray(i)
-      else
+     else
-        exit
+       exit
-      endif
+     endif
-    enddo arrayToString
+   enddo arrayToString
-  endif
+ endif
 
 end function getCWD
 
@@ -110,51 +119,42 @@ end function getCWD
 !> @brief gets the current host name
 !--------------------------------------------------------------------------------------------------
 character(len=1024) function getHostName()
-  use, intrinsic :: ISO_C_Binding, only: &
+ implicit none
-    C_INT, &
+ character(kind=C_CHAR), dimension(1024) :: charArray                                              ! C string is an array
-    C_CHAR, &
+ integer(C_INT) :: stat
-    C_NULL_CHAR
+ integer :: i
 
-  implicit none
+ call getHostName_C(charArray,stat)
-  character(kind=C_CHAR), dimension(1024) :: charArray                                              ! C string is an array
+ if (stat /= 0_C_INT) then
-  integer(C_INT) :: stat
+   getHostName = 'Error occured when getting host name'
-  integer :: i
+ else
-
+   getHostName = repeat('',len(getHostName))
-  call getHostName_C(charArray,stat)
+   arrayToString: do i=1,len(getHostName)
-  if (stat /= 0_C_INT) then
+     if (charArray(i) /= C_NULL_CHAR) then
-    getHostName = 'Error occured when getting host name'
+       getHostName(i:i)=charArray(i)
-  else
+     else
-    getHostName = repeat('',len(getHostName))
+       exit
-    arrayToString: do i=1,len(getHostName)
+     endif
-      if (charArray(i) /= C_NULL_CHAR) then
+   enddo arrayToString
-        getHostName(i:i)=charArray(i)
+ endif
-      else
-        exit
-      endif
-    enddo arrayToString
-  endif
 
 end function getHostName
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief changes the current working directory
 !--------------------------------------------------------------------------------------------------
 logical function setCWD(path)
-  use, intrinsic :: ISO_C_Binding, only: &
+ implicit none
-    C_INT, &
+ character(len=*), intent(in) :: path
-    C_CHAR, &
+ character(kind=C_CHAR), dimension(1024) :: strFixedLength                                          ! C string is an array
-    C_NULL_CHAR
+ integer :: i
 
-  implicit none
+ strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
-  character(len=*), intent(in) :: path
+ do i=1,len(path)                                                                                   ! copy array components
-  character(kind=C_CHAR), dimension(1024) :: strFixedLength                                         ! C string is an array
+   strFixedLength(i)=path(i:i)
-  integer :: i
+ enddo
-
+ setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
-  strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
-  do i=1,len(path)                                                                                  ! copy array components
-    strFixedLength(i)=path(i:i)
-  enddo
-  setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
 
 end function setCWD