223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

fixed string handling and enabled compilation (unfortunately, gfortran needs exceptions)

This commit is contained in:
Martin Diehl 2016-03-21 21:09:45 +01:00
parent ca5ed22d66
commit d3579d78fd
3 changed files with 26 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
code/Makefile
View File

@ -628,13 +628,27 @@ DAMASK_interface.o: spectral_interface.f90 \
prec.o prec.o
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -o DAMASK_interface.o $(SUFFIX) $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $(INTERFACENAME) -o DAMASK_interface.o $(SUFFIX)
ifeq "$(F90)" "gfortran"
prec.o: prec.f90 \ prec.o: prec.f90 \
system_routines.o system_routines.o
$(PREFIX) $(COMPILERNAME) $(COMPILE) -c prec.f90 -fno-range-check -fall-intrinsics -fno-fast-math $(SUFFIX)
# fno-range-check: Disable range checking on results of simplification of constant expressions during compilation
# --> allows the definition of DAMASK_NaN
#-fall-intrinsics: all intrinsic procedures (including the GNU-specific extensions) are accepted. -Wintrinsics-std will be ignored
# and no user-defined procedure with the same name as any intrinsic will be called except when it is explicitly declared external
# --> allows the use of 'isnan'
#-fno-fast-math:
# --> otherwise, when setting -ffast-math, isnan always evaluates to false (I would call it a bug)
else
C_routines.o: C_routines.c prec.o: prec.f90 \
system_routines.o
endif
system_routines.o: system_routines.f90 \ system_routines.o: system_routines.f90 \
C_routines.o C_routines.o
C_routines.o: C_routines.c
%.o : %.f90 %.o : %.f90

12
code/spectral_interface.f90
View File

@ -233,20 +233,20 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA
pathSep = getPathSep() pathSep = getPathSep()
if (len(workingDirectoryArg)>0) then ! got working directory as input wdGiven: if (len(workingDirectoryArg)>0) then
if (workingDirectoryArg(1:1) == pathSep) then ! absolute path given as command line argument if (workingDirectoryArg(1:1) == pathSep) then ! absolute path given as command line argument
storeWorkingDirectory = workingDirectoryArg storeWorkingDirectory = workingDirectoryArg
else else
error = getCWD2(cwd) ! relative path given as command line argument error = getCWD2(cwd) ! relative path given as command line argument
storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg
endif endif
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory)))/= pathSep) &
/= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep ! if path seperator is not given, append it
if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists
write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist'
call quit(1_pInt) call quit(1_pInt)
endif endif
else ! using path to geometry file as working dir else wdGiven
if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument
storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.))
else else
@ -254,7 +254,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA
storeWorkingDirectory = trim(cwd)//pathSep//& storeWorkingDirectory = trim(cwd)//pathSep//&
geometryArg(1:scan(geometryArg,pathSep,back=.true.)) geometryArg(1:scan(geometryArg,pathSep,back=.true.))
endif endif
endif endif wdGiven
storeWorkingDirectory = rectifyPath(storeWorkingDirectory) storeWorkingDirectory = rectifyPath(storeWorkingDirectory)
end function storeWorkingDirectory end function storeWorkingDirectory
@ -264,8 +264,6 @@ end function storeWorkingDirectory
!> @brief simply returns the private string workingDir !> @brief simply returns the private string workingDir
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=1024) function getSolverWorkingDirectoryName() character(len=1024) function getSolverWorkingDirectoryName()
use system_routines, only: &
getCWD2
implicit none implicit none
getSolverWorkingDirectoryName = workingDirectory getSolverWorkingDirectoryName = workingDirectory

6
code/system_routines.f90
View File

@ -50,11 +50,13 @@ contains
C_NULL_CHAR C_NULL_CHAR
implicit none implicit none
character(len=1024), intent(out) :: str character(len=*), intent(out) :: str
character(len=1024) :: strFixedLength
integer(C_INT) :: stat integer(C_INT) :: stat
str = repeat(C_NULL_CHAR,1024) str = repeat(C_NULL_CHAR,1024)
call getCurrentWorkDir_C(str,stat) call getCurrentWorkDir_C(strFixedLength,stat)
str = strFixedLength(1:scan(strFixedLength,C_NULL_CHAR,.True.)-1)
getCWD2=merge(.True.,.False.,stat /= 0_C_INT) getCWD2=merge(.True.,.False.,stat /= 0_C_INT)
end function getCWD2 end function getCWD2