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

added error for to IO to substitute stop statement in kdtree2 

explicitly defined all functions in as either public or private in the modules to have a quick overview on all functions and parameters that are available
This commit is contained in:
Martin Diehl 2012-03-06 14:52:48 +00:00
parent 9b17015b5a
commit d00c3c9e19
6 changed files with 2464 additions and 2366 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
code/DAMASK_spectral_interface.f90
View File

@ -1,7 +1,7 @@
! Copyright 2011 Max-Planck-Institut für Eisenforschung GmbH ! Copyright 2011 Max-Planck-Institut für Eisenforschung GmbH
! !
! This file is part of DAMASK, ! This file is part of DAMASK,
! the Düsseldorf Advanced MAterial Simulation Kit. ! the Düsseldorf Advanced Material Simulation Kit.
! !
! DAMASK is free software: you can redistribute it and/or modify ! DAMASK is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by ! it under the terms of the GNU General Public License as published by
@ -16,39 +16,60 @@
! You should have received a copy of the GNU General Public License ! You should have received a copy of the GNU General Public License
! along with DAMASK. If not, see <http://www.gnu.org/licenses/>. ! along with DAMASK. If not, see <http://www.gnu.org/licenses/>.
! !
!############################################################## !--------------------------------------------------------------------------------------------------
!* $Id$ !* $Id$
!******************************************************************** !--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Interfacing between the spectral solver and the material subroutines provided
!! by DAMASK
!--------------------------------------------------------------------------------------------------
module DAMASK_interface
MODULE DAMASK_interface
implicit none implicit none
private
character(len=64), parameter, public :: FEsolver = 'Spectral' !> Keyword for spectral solver
character(len=5), parameter, public :: inputFileExtension = '.geom' !> File extension for geometry description
character(len=4), parameter, public :: logFileExtension = '.log' !> Dummy variable as the spectral solver has no log
character(len=1024), private :: geometryParameter, &
loadcaseParameter
character(len=64), parameter :: FEsolver = 'Spectral' public :: getSolverWorkingDirectoryName, &
character(len=5), parameter :: InputFileExtension = '.geom' getSolverJobName, &
character(len=4), parameter :: LogFileExtension = '.log' !until now, we don't have a log file. But IO.f90 requires it getLoadCase, &
character(len=1024) :: geometryParameter,loadcaseParameter getLoadCaseName, &
CONTAINS getModelName, &
DAMASK_interface_init
private :: rectifyPath, &
makeRelativePath, &
getPathSep
contains
!--------------------------------------------------------------------------------------------------
!> @brief Initializes the solver by interpreting the command line arguments. Also writes
!! information on computation on screen
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: pInt
!********************************************************************
! initialize interface module
!
!********************************************************************
subroutine DAMASK_interface_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: pInt
implicit none implicit none
character(len=1024) :: commandLine, & !> command line call as string
character(len=1024) commandLine, hostName, userName hostName, & !> name of computer
integer :: i, start = 0, length=0 userName !> name of user calling the executable
integer, dimension(8) :: date_and_time_values ! type default integer integer :: i, &
start = 0,&
length=0
integer, dimension(8) :: dateAndTime ! type default integer
call get_command(commandLine) call get_command(commandLine)
call DATE_AND_TIME(VALUES=date_and_time_values) call date_and_time(values = dateAndTime)
do i=1,len(commandLine) ! remove capitals do i = 1,len(commandLine) ! remove capitals
if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) commandLine(i:i) = & if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) &
achar(iachar(commandLine(i:i))+32) commandLine(i:i) = achar(iachar(commandLine(i:i))+32)
enddo enddo
if(index(commandLine,' -h ',.true.)>0 .or. index(commandLine,' --help ',.true.)>0) then ! search for ' -h ' or '--help' if(index(commandLine,' -h ',.true.) > 0 .or. index(commandLine,' --help ',.true.) > 0) then ! search for ' -h ' or '--help'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
print '(a)', '#############################################################' print '(a)', '#############################################################'
@ -146,12 +167,12 @@ subroutine DAMASK_interface_init()
write(6,*) '<<<+- DAMASK_spectral_interface init -+>>>' write(6,*) '<<<+- DAMASK_spectral_interface init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',date_and_time_values(3),'/',& write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
date_and_time_values(2),'/',& dateAndTime(2),'/',&
date_and_time_values(1) dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',date_and_time_values(5),':',& write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
date_and_time_values(6),':',& dateAndTime(6),':',&
date_and_time_values(7) dateAndTime(7)
write(6,*) 'Host Name: ', trim(hostName) write(6,*) 'Host Name: ', trim(hostName)
write(6,*) 'User Name: ', trim(userName) write(6,*) 'User Name: ', trim(userName)
write(6,*) 'Path Separator: ', getPathSep() write(6,*) 'Path Separator: ', getPathSep()
@ -160,17 +181,15 @@ subroutine DAMASK_interface_init()
write(6,*) 'Loadcase Parameter: ', trim(loadcaseParameter) write(6,*) 'Loadcase Parameter: ', trim(loadcaseParameter)
if (start/=3_pInt) write(6,*) 'Restart Parameter: ', trim(commandLine(start:start+length)) if (start/=3_pInt) write(6,*) 'Restart Parameter: ', trim(commandLine(start:start+length))
endsubroutine DAMASK_interface_init end subroutine DAMASK_interface_init
!******************************************************************** !--------------------------------------------------------------------------------------------------
! extract working directory from loadcase file !> @brief extract working directory from loadcase file possibly based on current working dir
! possibly based on current working dir !--------------------------------------------------------------------------------------------------
!********************************************************************
function getSolverWorkingDirectoryName() function getSolverWorkingDirectoryName()
implicit none implicit none
character(len=1024) :: cwd, getSolverWorkingDirectoryName
character(len=1024) cwd,getSolverWorkingDirectoryName
character :: pathSep character :: pathSep
pathSep = getPathSep() pathSep = getPathSep()
@ -184,33 +203,29 @@ function getSolverWorkingDirectoryName()
getSolverWorkingDirectoryName = rectifyPath(getSolverWorkingDirectoryName) getSolverWorkingDirectoryName = rectifyPath(getSolverWorkingDirectoryName)
endfunction getSolverWorkingDirectoryName end function getSolverWorkingDirectoryName
!********************************************************************
! basename of geometry file from command line arguments !--------------------------------------------------------------------------------------------------
! !> @brief basename of geometry file from command line arguments
!******************************************************************** !--------------------------------------------------------------------------------------------------
function getSolverJobName() character(len=1024) function getSolverJobName()
implicit none implicit none
character(1024) :: getSolverJobName
getSolverJobName = trim(getModelName())//'_'//trim(getLoadCase()) getSolverJobName = trim(getModelName())//'_'//trim(getLoadCase())
endfunction getSolverJobName end function getSolverJobName
!********************************************************************
! basename of geometry file from command line arguments !--------------------------------------------------------------------------------------------------
! !> @brief basename of geometry file from command line arguments
!******************************************************************** !--------------------------------------------------------------------------------------------------
function getModelName() character(len=1024) function getModelName()
use prec, only: pInt use prec, only: pInt
implicit none implicit none
character(len=1024) :: cwd
character(1024) getModelName, cwd
integer :: posExt,posSep integer :: posExt,posSep
character :: pathSep character :: pathSep
@ -231,17 +246,15 @@ function getModelName()
getModelName = makeRelativePath(getSolverWorkingDirectoryName(),& getModelName = makeRelativePath(getSolverWorkingDirectoryName(),&
getModelName) getModelName)
endfunction getModelName end function getModelName
!********************************************************************
! name of load case file exluding extension !--------------------------------------------------------------------------------------------------
! !> @brief name of load case file exluding extension
!******************************************************************** !--------------------------------------------------------------------------------------------------
function getLoadCase() character(len=1024) function getLoadCase()
implicit none implicit none
character(1024) :: getLoadCase
integer :: posExt,posSep integer :: posExt,posSep
character :: pathSep character :: pathSep
@ -249,21 +262,19 @@ function getLoadCase()
posExt = scan(loadcaseParameter,'.',back=.true.) posExt = scan(loadcaseParameter,'.',back=.true.)
posSep = scan(loadcaseParameter,pathSep,back=.true.) posSep = scan(loadcaseParameter,pathSep,back=.true.)
if (posExt <= posSep) posExt = len_trim(loadcaseParameter)+1 ! no extension present if (posExt <= posSep) posExt = len_trim(loadcaseParameter)+1 ! no extension present
getLoadCase = loadcaseParameter(posSep+1:posExt-1) ! name of load case file exluding extension getLoadCase = loadcaseParameter(posSep+1:posExt-1) ! name of load case file exluding extension
endfunction getLoadCase end function getLoadCase
!******************************************************************** !--------------------------------------------------------------------------------------------------
! relative path of loadcase from command line arguments !> @brief relative path of loadcase from command line arguments
! !--------------------------------------------------------------------------------------------------
!******************************************************************** character(len=1024) function getLoadcaseName()
function getLoadcaseName()
implicit none implicit none
character(len=1024) :: cwd
character(len=1024) :: getLoadcaseName,cwd
integer :: posExt = 0, posSep integer :: posExt = 0, posSep
character :: pathSep character :: pathSep
@ -272,8 +283,8 @@ function getLoadcaseName()
posExt = scan(getLoadcaseName,'.',back=.true.) posExt = scan(getLoadcaseName,'.',back=.true.)
posSep = scan(getLoadcaseName,pathSep,back=.true.) posSep = scan(getLoadcaseName,pathSep,back=.true.)
if (posExt <= posSep) getLoadcaseName = trim(getLoadcaseName)//('.load') ! no extension present if (posExt <= posSep) getLoadcaseName = trim(getLoadcaseName)//('.load') ! no extension present
if (scan(getLoadcaseName,pathSep) /= 1) then ! relative path given as command line argument if (scan(getLoadcaseName,pathSep) /= 1) then ! relative path given as command line argument
call getcwd(cwd) call getcwd(cwd)
getLoadcaseName = rectifyPath(trim(cwd)//pathSep//getLoadcaseName) getLoadcaseName = rectifyPath(trim(cwd)//pathSep//getLoadcaseName)
else else
@ -282,17 +293,15 @@ function getLoadcaseName()
getLoadcaseName = makeRelativePath(getSolverWorkingDirectoryName(),& getLoadcaseName = makeRelativePath(getSolverWorkingDirectoryName(),&
getLoadcaseName) getLoadcaseName)
endfunction getLoadcaseName end function getLoadcaseName
!******************************************************************** !--------------------------------------------------------------------------------------------------
! remove ../ and ./ from path !> @brief remove ../ and ./ from path
! !--------------------------------------------------------------------------------------------------
!********************************************************************
function rectifyPath(path) function rectifyPath(path)
implicit none implicit none
character(len=*) :: path character(len=*) :: path
character(len=len_trim(path)) :: rectifyPath character(len=len_trim(path)) :: rectifyPath
character :: pathSep character :: pathSep
@ -315,7 +324,7 @@ function rectifyPath(path)
do while (i > j) do while (i > j)
j = scan(rectifyPath(1:i-2),pathSep,back=.true.) j = scan(rectifyPath(1:i-2),pathSep,back=.true.)
rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j) rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j)
if (rectifyPath(j+1:j+1) == pathSep) then !search for '//' that appear in case of XXX/../../XXX if (rectifyPath(j+1:j+1) == pathSep) then !search for '//' that appear in case of XXX/../../XXX
k = len_trim(rectifyPath) k = len_trim(rectifyPath)
rectifyPath(j+1:k-1) = rectifyPath(j+2:k) rectifyPath(j+1:k-1) = rectifyPath(j+2:k)
rectifyPath(k:k) = ' ' rectifyPath(k:k) = ' '
@ -324,19 +333,16 @@ function rectifyPath(path)
enddo enddo
if(len_trim(rectifyPath) == 0) rectifyPath = pathSep if(len_trim(rectifyPath) == 0) rectifyPath = pathSep
end function rectifyPath end function rectifyPath
!******************************************************************** !--------------------------------------------------------------------------------------------------
! relative path from absolute a to absolute b !> @brief relative path from absolute a to absolute b
! !--------------------------------------------------------------------------------------------------
!******************************************************************** character(len=1024) function makeRelativePath(a,b)
function makeRelativePath(a,b)
implicit none implicit none
character (len=*) :: a,b character (len=*) :: a,b
character (len=1024) :: makeRelativePath
character :: pathSep character :: pathSep
integer :: i,posLastCommonSlash,remainingSlashes !no pInt integer :: i,posLastCommonSlash,remainingSlashes !no pInt
@ -353,18 +359,18 @@ function makeRelativePath(a,b)
enddo enddo
makeRelativePath = repeat('..'//pathSep,remainingSlashes)//b(posLastCommonSlash+1:len_trim(b)) makeRelativePath = repeat('..'//pathSep,remainingSlashes)//b(posLastCommonSlash+1:len_trim(b))
endfunction makeRelativePath end function makeRelativePath
!******************************************************************** !--------------------------------------------------------------------------------------------------
! counting / and \ in $PATH System variable !> @brief counting / and \ in $PATH System variable the character occuring more often is assumed
! the character occuring more often is assumed to be the path separator !! to be the path separator
!******************************************************************** !--------------------------------------------------------------------------------------------------
function getPathSep() character function getPathSep()
use prec, only: pInt use prec, only: pInt
implicit none implicit none
character :: getPathSep
character(len=2048) path character(len=2048) path
integer(pInt) :: backslash = 0_pInt, slash = 0_pInt integer(pInt) :: backslash = 0_pInt, slash = 0_pInt
integer :: i integer :: i
@ -383,4 +389,4 @@ function getPathSep()
end function end function
END MODULE end module

1131
code/IO.f90
View File

File diff suppressed because it is too large Load Diff

25
code/Makefile
View File

@ -135,8 +135,7 @@ COMPILE_OPTIONS_ifort :=-fpp\
-warn ignore_loc\ -warn ignore_loc\
-warn alignments\ -warn alignments\
-warn unused\ -warn unused\
-warn errors\ -warn errors
-warn stderrors
endif endif
#-fpp: preprocessor #-fpp: preprocessor
@ -152,7 +151,7 @@ endif
# alignments: data that is not naturally aligned # alignments: data that is not naturally aligned
# unused: declared variables that are never used # unused: declared variables that are never used
# errors: warnings are changed to errors # errors: warnings are changed to errors
# stderrors: warnings about Fortran standard violations are changed to errors # stderrors: warnings about Fortran standard violations are changed to errors (STANDARD_CHECK)
# #
################################################################################################### ###################################################################################################
#MORE OPTIONS FOR DEBUGGING DURING COMPILING #MORE OPTIONS FOR DEBUGGING DURING COMPILING
@ -182,7 +181,8 @@ endif
################################################################################################### ###################################################################################################
ifeq "$(FASTBUILD)" "YES" ifeq "$(FASTBUILD)" "YES"
COMPILE_OPTIONS_gfortran :=-xf95-cpp-input COMPILE_OPTIONS_gfortran :=-xf95-cpp-input\
-fno-range-check
else else
COMPILE_OPTIONS_gfortran :=-xf95-cpp-input\ COMPILE_OPTIONS_gfortran :=-xf95-cpp-input\
-ffree-line-length-132\ -ffree-line-length-132\
@ -205,7 +205,8 @@ COMPILE_OPTIONS_gfortran :=-xf95-cpp-input\
-Wunsafe-loop-optimizations\ -Wunsafe-loop-optimizations\
-Wunused\ -Wunused\
-Wall\ -Wall\
-Wextra -Wextra\
-Wintrinsics-std
endif endif
#-xf95-cpp-input: preprocessor #-xf95-cpp-input: preprocessor
@ -231,20 +232,20 @@ endif
# -value: # -value:
# -parameter: find usused variables with "parameter" attribute # -parameter: find usused variables with "parameter" attribute
#-Wextra: #-Wextra:
#-Wintrinsics-std: warnings because of "flush" is not longer in the standard, but still an intrinsic fuction of the compilers:
################################################################################################### ###################################################################################################
#OPTIONS FOR GFORTRAN 4.6 #OPTIONS FOR GFORTRAN 4.6
#-Wsuggest-attribute=const: #-Wsuggest-attribute=const:
#-Wsuggest-attribute=noreturn: #-Wsuggest-attribute=noreturn:
#-Wsuggest-attribute=pure: #-Wsuggest-attribute=pure:
#-Wreal-q-constant: Warn about real-literal-constants with 'q' exponent-letter #-Wreal-q-constant: Warn about real-literal-constants with 'q' exponent-letter
#
#MORE OPTIONS FOR DEBUGGING DURING COMPILING #MORE OPTIONS FOR DEBUGGING DURING COMPILING
#-Wline-truncation: too many warnings because we have comments beyond character 132 #-Wline-truncation: too many warnings because we have comments beyond character 132
#-Wintrinsic-std: warnings because of "flush" is not longer in the standard, but still an intrinsic fuction of the compilers: #-Warray-temporarieswarnings: because we have many temporary arrays (performance issue?):
#-Warray-temporarieswarnings: #-Wimplicit-interface:
# because we have many temporary arrays (performance issue?): #-pedantic-errors:
#-Wimplicit-interface #-fmodule-private:
#-pedantic-errors
#-fmodule-private
# #
#OPTIONS FOR DEGUBBING DURING RUNTIME #OPTIONS FOR DEGUBBING DURING RUNTIME
#-fcheck-bounds: check if an array index is too small (<1) or too large! #-fcheck-bounds: check if an array index is too small (<1) or too large!
@ -264,7 +265,7 @@ COMPILED_FILES = prec.o DAMASK_spectral_interface.o IO.o numerics.o debug.o math
homogenization_RGC.o homogenization_isostrain.o homogenization.o CPFEM.o crystallite.o homogenization_RGC.o homogenization_isostrain.o homogenization.o CPFEM.o crystallite.o
DAMASK_spectral.exe: DAMASK_spectral.o DAMASK_spectral.exe: DAMASK_spectral.o
$(PREFIX) $(COMPILERNAME) $(OPENMP_FLAG_$(F90))$(OPTIMIZATION_$(MAXOPTI)_$(F90)) $(STANDARD_CHECK_$(F90)) \ $(PREFIX) $(COMPILERNAME) $(OPENMP_FLAG_$(F90)) $(OPTIMIZATION_$(MAXOPTI)_$(F90)) $(STANDARD_CHECK_$(F90)) \
-o DAMASK_spectral.exe DAMASK_spectral.o \ -o DAMASK_spectral.exe DAMASK_spectral.o \
$(COMPILED_FILES) $(LIB_DIRS) $(LIBRARIES) $(SUFFIX) $(COMPILED_FILES) $(LIB_DIRS) $(LIBRARIES) $(SUFFIX)

3343
code/kdtree2.f90
View File

File diff suppressed because it is too large Load Diff

65
code/prec.f90
View File

@ -19,54 +19,57 @@
!############################################################## !##############################################################
!* $Id$ !* $Id$
!############################################################## !##############################################################
MODULE prec module prec
!############################################################## !##############################################################
implicit none implicit none
private
! *** Precision of real and integer variables *** ! *** Precision of real and integer variables ***
integer, parameter, public :: pReal = selected_real_kind(15,300) ! 15 significant digits, up to 1e+-300 integer, parameter, public :: pReal = selected_real_kind(15,300) ! 15 significant digits, up to 1e+-300
integer, parameter, public :: pInt = selected_int_kind(9) ! up to +- 1e9 integer, parameter, public :: pInt = selected_int_kind(9) ! up to +- 1e9
integer, parameter, public :: pLongInt = 8 ! should be 64bit integer, parameter, public :: pLongInt = 8 ! should be 64bit
real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal
real(pReal), parameter, public :: tol_gravityNodePos = 1.0e-100_pReal real(pReal), parameter, public :: tol_gravityNodePos = 1.0e-100_pReal
! NaN is precision dependent ! NaN is precision dependent
! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html ! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html
! copy can be found in documentation/Code/Fortran ! copy can be found in documentation/Code/Fortran
#ifdef __INTEL_COMPILER #ifdef __INTEL_COMPILER
#if __INTEL_COMPILER<1200 #if __INTEL_COMPILER<1200
real(pReal), parameter, public :: DAMASK_NaN = Z'7FF0000000000001' real(pReal), parameter, public :: DAMASK_NaN = Z'7FF0000000000001'
#else #else
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal) real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal)
#endif #endif
#else #else
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal) real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF0000000000001', pReal)
#endif #endif
type :: p_vec
real(pReal), dimension(:), pointer :: p
end type p_vec
CONTAINS type, public :: p_vec
real(pReal), dimension(:), pointer :: p
end type p_vec
public :: prec_init
contains
subroutine prec_init subroutine prec_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
implicit none
implicit none
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
write(6,*) '<<<+- prec init -+>>>' write(6,*) '<<<+- prec init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a,i3)') ' Bytes for pReal: ',pReal write(6,'(a,i3)') ' Bytes for pReal: ',pReal
write(6,'(a,i3)') ' Bytes for pInt: ',pInt write(6,'(a,i3)') ' Bytes for pInt: ',pInt
write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt
write(6,'(a,e10.3)') ' NaN: ',DAMASK_NAN write(6,'(a,e10.3)') ' NaN: ',DAMASK_NAN
write(6,'(a,l3)') ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN write(6,'(a,l3)') ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN
if (DAMASK_NaN == DAMASK_NaN) call quit(9000) if (DAMASK_NaN == DAMASK_NaN) call quit(9000)
write(6,*) write(6,*)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
end subroutine end subroutine prec_init
END MODULE prec end module prec

62
code/prec_single.f90
View File

@ -19,54 +19,58 @@
!############################################################## !##############################################################
!* $Id$ !* $Id$
!############################################################## !##############################################################
MODULE prec module prec
!############################################################## !##############################################################
implicit none implicit none
private
! *** Precision of real and integer variables *** ! *** Precision of real and integer variables ***
integer, parameter, public :: pReal = selected_real_kind(6,37) ! 6 significant digits, up to 1e+-37 integer, parameter, public :: pReal = selected_real_kind(6,37) ! 6 significant digits, up to 1e+-37
integer, parameter, public :: pInt = selected_int_kind(9) ! up to +- 1e9 integer, parameter, public :: pInt = selected_int_kind(9) ! up to +- 1e9
integer, parameter, public :: pLongInt = 4 ! should be 64bit integer, parameter, public :: pLongInt = 4 ! should be 64bit
real(pReal), parameter, public :: tol_math_check = 1.0e-5_pReal real(pReal), parameter, public :: tol_math_check = 1.0e-5_pReal
real(pReal), parameter, public :: tol_gravityNodePos = 1.0e-36_pReal real(pReal), parameter, public :: tol_gravityNodePos = 1.0e-36_pReal
! NaN is precision dependent ! NaN is precision dependent
! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html ! from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html
! copy can be found in documentation/Code/Fortran ! copy can be found in documentation/Code/Fortran
#ifdef __INTEL_COMPILER #ifdef __INTEL_COMPILER
#if __INTEL_COMPILER<1200 #if __INTEL_COMPILER<1200
real(pReal), parameter, public :: DAMASK_NaN = Z'Z'7F800001', pReal' real(pReal), parameter, public :: DAMASK_NaN = Z'Z'7F800001', pReal'
#else #else
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal) real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal)
#endif #endif
#else #else
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal) real(pReal), parameter, public :: DAMASK_NaN = real(Z'7F800001', pReal)
#endif #endif
type :: p_vec
real(pReal), dimension(:), pointer :: p
end type p_vec
CONTAINS type, public :: p_vec
real(pReal), dimension(:), pointer :: p
end type p_vec
public :: prec_init
contains
subroutine prec_init subroutine prec_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
implicit none
implicit none
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
write(6,*) '<<<+- prec_single init -+>>>' write(6,*) '<<<+- prec_single init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a,i3)') ' Bytes for pReal: ',pReal write(6,'(a,i3)') ' Bytes for pReal: ',pReal
write(6,'(a,i3)') ' Bytes for pInt: ',pInt write(6,'(a,i3)') ' Bytes for pInt: ',pInt
write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt
write(6,'(a,e10.3)') ' NaN: ',DAMASK_NAN write(6,'(a,e10.3)') ' NaN: ',DAMASK_NAN
write(6,'(a,l3)') ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN write(6,'(a,l3)') ' NaN /= NaN: ',DAMASK_NaN/=DAMASK_NaN
if (DAMASK_NaN == DAMASK_NaN) call quit(9000) if (DAMASK_NaN == DAMASK_NaN) call quit(9000)
write(6,*) write(6,*)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
end subroutine end subroutine prec_init
END MODULE prec end module prec