Merge branch 'Python3' into new-test-server
This commit is contained in:
Martin Diehl
commit
b4fd4afb15
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/env python2.7
|
||||
#!/usr/bin/env python3
|
||||
# -*- coding: UTF-8 no BOM -*-
|
||||
|
||||
import os,vtk
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/env python2.7
|
||||
#!/usr/bin/env python3
|
||||
# -*- coding: UTF-8 no BOM -*-
|
||||
|
||||
import os,vtk
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/env python2.7
|
||||
#!/usr/bin/env python3
|
||||
# -*- coding: UTF-8 no BOM -*-
|
||||
|
||||
import os,vtk
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/env python2.7
|
||||
#!/usr/bin/env python3
|
||||
# -*- coding: UTF-8 no BOM -*-
|
||||
|
||||
import os,sys,vtk
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/env python2.7
|
||||
#!/usr/bin/env python3
|
||||
# -*- coding: UTF-8 no BOM -*-
|
||||
|
||||
import os,sys,vtk
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
@ -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,7 +508,6 @@ 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -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,*)
|
||||
|
|
|
|||
91
src/math.f90
91
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,:)
|
||||
! and keeps array(2:N,:) linked to it.
|
||||
! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) 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) :: ipivot
|
||||
integer(pInt), intent(in),optional :: istart,iend, sortDim
|
||||
integer(pInt) :: ipivot,s,e,d
|
||||
|
||||
if (istart < iend) then
|
||||
ipivot = qsort_partition(a,istart, iend)
|
||||
call math_qsort(a, istart, ipivot-1_pInt)
|
||||
call math_qsort(a, ipivot+1_pInt, iend)
|
||||
if(present(istart)) then
|
||||
s = istart
|
||||
else
|
||||
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) :: i,j,k,tmp
|
||||
integer(pInt), intent(in) :: istart,iend,sort
|
||||
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
|
||||
do k = 1_pInt, int(size(a,1_pInt), pInt)
|
||||
tmp = a(k,i)
|
||||
a(k,i) = a(k,j)
|
||||
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
|
||||
cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index
|
||||
tmp = a(:,istart)
|
||||
a(:,istart) = a(:,j)
|
||||
a(:,j) = tmp
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
@ -47,8 +53,19 @@ interface
|
|||
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array
|
||||
end function chdir_C
|
||||
|
||||
end interface
|
||||
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
|
||||
|
||||
|
|
@ -56,21 +73,17 @@ 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
|
||||
character(len=*), intent(in) :: path
|
||||
character(kind=C_CHAR), dimension(1024) :: strFixedLength
|
||||
integer :: i
|
||||
implicit none
|
||||
character(len=*), intent(in) :: path
|
||||
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string as array
|
||||
integer :: i
|
||||
|
||||
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
|
||||
do i=1,len(path) ! copy array components
|
||||
strFixedLength(i)=path(i:i)
|
||||
enddo
|
||||
isDirectory=merge(.True.,.False.,isDirectory_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
|
||||
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
|
||||
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
|
||||
integer(C_INT) :: stat
|
||||
integer :: i
|
||||
implicit none
|
||||
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
|
||||
integer(C_INT) :: stat
|
||||
integer :: i
|
||||
|
||||
call getCurrentWorkDir_C(charArray,stat)
|
||||
if (stat /= 0_C_INT) then
|
||||
getCWD = 'Error occured when getting currend working directory'
|
||||
else
|
||||
getCWD = repeat('',len(getCWD))
|
||||
arrayToString: do i=1,len(getCWD)
|
||||
if (charArray(i) /= C_NULL_CHAR) then
|
||||
getCWD(i:i)=charArray(i)
|
||||
else
|
||||
exit
|
||||
endif
|
||||
enddo arrayToString
|
||||
endif
|
||||
call getCurrentWorkDir_C(charArray,stat)
|
||||
if (stat /= 0_C_INT) then
|
||||
getCWD = 'Error occured when getting currend working directory'
|
||||
else
|
||||
getCWD = repeat('',len(getCWD))
|
||||
arrayToString: do i=1,len(getCWD)
|
||||
if (charArray(i) /= C_NULL_CHAR) then
|
||||
getCWD(i:i)=charArray(i)
|
||||
else
|
||||
exit
|
||||
endif
|
||||
enddo arrayToString
|
||||
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: &
|
||||
C_INT, &
|
||||
C_CHAR, &
|
||||
C_NULL_CHAR
|
||||
implicit none
|
||||
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
|
||||
integer(C_INT) :: stat
|
||||
integer :: i
|
||||
|
||||
implicit none
|
||||
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
|
||||
integer(C_INT) :: stat
|
||||
integer :: i
|
||||
|
||||
call getHostName_C(charArray,stat)
|
||||
if (stat /= 0_C_INT) then
|
||||
getHostName = 'Error occured when getting host name'
|
||||
else
|
||||
getHostName = repeat('',len(getHostName))
|
||||
arrayToString: do i=1,len(getHostName)
|
||||
if (charArray(i) /= C_NULL_CHAR) then
|
||||
getHostName(i:i)=charArray(i)
|
||||
else
|
||||
exit
|
||||
endif
|
||||
enddo arrayToString
|
||||
endif
|
||||
call getHostName_C(charArray,stat)
|
||||
if (stat /= 0_C_INT) then
|
||||
getHostName = 'Error occured when getting host name'
|
||||
else
|
||||
getHostName = repeat('',len(getHostName))
|
||||
arrayToString: do i=1,len(getHostName)
|
||||
if (charArray(i) /= C_NULL_CHAR) then
|
||||
getHostName(i:i)=charArray(i)
|
||||
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: &
|
||||
C_INT, &
|
||||
C_CHAR, &
|
||||
C_NULL_CHAR
|
||||
implicit none
|
||||
character(len=*), intent(in) :: path
|
||||
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
|
||||
integer :: i
|
||||
|
||||
implicit none
|
||||
character(len=*), intent(in) :: path
|
||||
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
|
||||
integer :: i
|
||||
|
||||
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)
|
||||
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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue