2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
2013-09-18 19:37:55 +05:30
!> @brief input/output functions, partly depending on chosen solver
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2014-03-12 13:03:51 +05:30
module IO
2013-02-11 15:14:17 +05:30
use prec , only : &
pInt , &
pReal
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
implicit none
private
2013-09-18 19:37:55 +05:30
character ( len = 5 ) , parameter , public :: &
IO_EOF = '#EOF#' !< end of file string
2017-05-16 01:23:25 +05:30
character ( len = 207 ) , parameter , private :: &
IO_DIVIDER = '───────────────────' / / &
2017-05-01 07:18:06 +05:30
'───────────────────' / / &
2017-05-16 01:23:25 +05:30
'───────────────────' / / &
'────────────'
2013-02-11 15:14:17 +05:30
public :: &
IO_init , &
2013-06-27 00:49:00 +05:30
IO_read , &
2013-02-11 15:14:17 +05:30
IO_checkAndRewind , &
IO_open_file_stat , &
IO_open_jobFile_stat , &
IO_open_file , &
IO_open_jobFile , &
IO_write_jobFile , &
2013-09-18 19:37:55 +05:30
IO_write_jobRealFile , &
IO_write_jobIntFile , &
IO_read_realFile , &
IO_read_intFile , &
2013-02-11 15:14:17 +05:30
IO_hybridIA , &
IO_isBlank , &
IO_getTag , &
IO_countSections , &
IO_countTagInPart , &
IO_spotTagInPart , &
IO_globalTagInPart , &
IO_stringPos , &
IO_stringValue , &
IO_fixedStringValue , &
IO_floatValue , &
IO_fixedNoEFloatValue , &
IO_intValue , &
IO_fixedIntValue , &
IO_lc , &
IO_skipChunks , &
IO_extractValue , &
IO_countDataLines , &
2018-01-10 21:43:25 +05:30
IO_countNumericalDataLines , &
2013-02-11 15:14:17 +05:30
IO_countContinuousIntValues , &
IO_continuousIntValues , &
IO_error , &
IO_warning , &
2013-02-25 22:04:59 +05:30
IO_intOut , &
IO_timeStamp
2014-11-06 17:17:27 +05:30
#if defined(Marc4DAMASK) || defined(Abaqus)
2013-02-11 15:14:17 +05:30
public :: &
IO_open_inputFile , &
IO_open_logFile
2012-06-15 21:40:21 +05:30
#endif
2018-01-10 21:43:25 +05:30
#ifdef Abaqus
2013-02-11 15:14:17 +05:30
public :: &
IO_abaqus_hasNoPart
2012-06-15 21:40:21 +05:30
#endif
2013-02-11 15:14:17 +05:30
private :: &
IO_fixedFloatValue , &
2013-02-13 00:30:41 +05:30
IO_verifyFloatValue , &
2015-05-11 02:25:36 +05:30
IO_verifyIntValue
2018-01-10 21:43:25 +05:30
#ifdef Abaqus
2013-02-11 15:14:17 +05:30
private :: &
abaqus_assembleInputFile
2012-06-15 21:40:21 +05:30
#endif
2014-04-15 15:13:35 +05:30
2012-03-06 20:22:48 +05:30
contains
2007-03-20 19:25:22 +05:30
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief only outputs revision number
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2012-03-06 20:22:48 +05:30
subroutine IO_init
2018-02-02 17:06:09 +05:30
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
2017-10-05 20:05:34 +05:30
use , intrinsic :: iso_fortran_env , only : &
compiler_version , &
compiler_options
#endif
2018-01-10 21:43:25 +05:30
2014-10-10 18:38:34 +05:30
implicit none
2014-10-10 21:28:18 +05:30
2016-06-29 20:05:49 +05:30
write ( 6 , '(/,a)' ) ' <<<+- IO init -+>>>'
write ( 6 , '(a15,a)' ) ' Current time: ' , IO_timeStamp ( )
2012-02-01 00:48:55 +05:30
#include "compilation_info.f90"
2014-03-12 13:03:51 +05:30
2012-03-06 20:22:48 +05:30
end subroutine IO_init
2010-07-13 15:56:07 +05:30
2012-06-18 20:57:01 +05:30
2013-06-27 00:49:00 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief recursively reads a line from a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
2013-06-27 00:49:00 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
recursive function IO_read ( fileUnit , reset ) result ( line )
2018-01-10 21:43:25 +05:30
2013-06-27 00:49:00 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-12-11 22:19:20 +05:30
logical , intent ( in ) , optional :: reset
2013-09-18 19:37:55 +05:30
integer ( pInt ) , dimension ( 10 ) :: unitOn = 0_pInt ! save the stack of recursive file units
integer ( pInt ) :: stack = 1_pInt ! current stack position
2013-06-27 00:49:00 +05:30
character ( len = 8192 ) , dimension ( 10 ) :: pathOn = ''
character ( len = 512 ) :: path , input
integer ( pInt ) :: myStat
character ( len = 65536 ) :: line
2013-09-18 19:37:55 +05:30
character ( len = * ) , parameter :: SEP = achar ( 47 ) / / achar ( 92 ) ! forward and backward slash ("/", "\")
2013-06-27 00:49:00 +05:30
2013-12-11 22:19:20 +05:30
!--------------------------------------------------------------------------------------------------
! reset case
2014-05-21 15:33:57 +05:30
if ( present ( reset ) ) then ; if ( reset ) then ! do not short circuit here
2013-12-12 03:33:09 +05:30
do while ( stack > 1_pInt ) ! can go back to former file
2013-12-11 22:19:20 +05:30
close ( unitOn ( stack ) )
stack = stack - 1_pInt
enddo
return
endif ; endif
!--------------------------------------------------------------------------------------------------
! read from file
unitOn ( 1 ) = fileUnit
2013-06-27 00:49:00 +05:30
read ( unitOn ( stack ) , '(a65536)' , END = 100 ) line
2018-01-10 21:43:25 +05:30
2013-06-27 00:49:00 +05:30
input = IO_getTag ( line , '{' , '}' )
2013-12-11 22:19:20 +05:30
!--------------------------------------------------------------------------------------------------
! normal case
2013-09-18 19:37:55 +05:30
if ( input == '' ) return ! regular line
2016-08-20 10:44:18 +05:30
2013-12-11 22:19:20 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
! recursion case
2013-09-18 19:37:55 +05:30
if ( stack > = 10_pInt ) call IO_error ( 104_pInt , ext_msg = input ) ! recursion limit reached
2013-06-27 00:49:00 +05:30
2013-09-18 19:37:55 +05:30
inquire ( UNIT = unitOn ( stack ) , NAME = path ) ! path of current file
2013-06-27 00:49:00 +05:30
stack = stack + 1_pInt
2014-05-15 15:10:43 +05:30
if ( scan ( input , SEP ) == 1 ) then ! absolut path given (UNIX only)
pathOn ( stack ) = input
else
pathOn ( stack ) = path ( 1 : scan ( path , SEP , . true . ) ) / / input ! glue include to current file's dir
endif
2013-06-27 00:49:00 +05:30
2016-09-03 17:59:39 +05:30
open ( newunit = unitOn ( stack ) , iostat = myStat , file = pathOn ( stack ) , action = 'read' ) ! open included file
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = pathOn ( stack ) )
2013-06-27 00:49:00 +05:30
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2018-01-10 21:43:25 +05:30
2013-06-27 00:49:00 +05:30
return
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
!--------------------------------------------------------------------------------------------------
! end of file case
2013-09-18 19:37:55 +05:30
100 if ( stack > 1_pInt ) then ! can go back to former file
2013-06-27 00:49:00 +05:30
close ( unitOn ( stack ) )
stack = stack - 1_pInt
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2013-09-18 19:37:55 +05:30
else ! top-most file reached
line = IO_EOF
2013-06-27 00:49:00 +05:30
endif
2014-05-21 15:33:57 +05:30
2013-06-27 00:49:00 +05:30
end function IO_read
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with
!! error message
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_checkAndRewind ( fileUnit )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
implicit none
2013-12-11 22:19:20 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
logical :: fileOpened
character ( len = 15 ) :: fileRead
2018-01-10 21:43:25 +05:30
inquire ( unit = fileUnit , opened = fileOpened , read = fileRead )
2014-12-03 06:12:35 +05:30
if ( . not . fileOpened . or . trim ( fileRead ) / = 'YES' ) call IO_error ( 102_pInt )
2013-12-11 22:19:20 +05:30
rewind ( fileUnit )
2012-04-20 17:28:41 +05:30
end subroutine IO_checkAndRewind
2010-07-13 15:56:07 +05:30
2011-07-18 14:45:20 +05:30
2013-06-27 00:49:00 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens existing file for reading to given unit. Path to file is relative to working
2013-09-18 19:37:55 +05:30
!! directory
!> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return
!! value
2013-06-27 00:49:00 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_open_file ( fileUnit , relPath )
2013-06-27 00:49:00 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName
2018-01-10 21:43:25 +05:30
2013-06-27 00:49:00 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: relPath !< relative path from working directory
2013-06-27 00:49:00 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2018-01-10 21:43:25 +05:30
2013-06-27 00:49:00 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / relPath
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , iostat = myStat , file = path )
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2018-01-10 21:43:25 +05:30
2013-06-27 00:49:00 +05:30
end subroutine IO_open_file
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens existing file for reading to given unit. Path to file is relative to working
2013-09-18 19:37:55 +05:30
!! directory
!> @details Like IO_open_file, but error is handled via return value and not via call to IO_error
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
logical function IO_open_file_stat ( fileUnit , relPath )
2013-09-18 19:37:55 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: relPath !< relative path from working directory
2011-07-18 14:45:20 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / relPath
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , iostat = myStat , file = path )
2012-03-06 20:22:48 +05:30
IO_open_file_stat = ( myStat == 0_pInt )
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
end function IO_open_file_stat
2011-09-13 21:24:06 +05:30
2010-07-13 15:56:07 +05:30
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens existing file for reading to given unit. File is named after solver job name
!! plus given extension and located in current working directory
2013-09-18 19:37:55 +05:30
!> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return
!! value
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_open_jobFile ( fileUnit , ext )
2012-06-18 20:57:01 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName
2012-03-06 20:22:48 +05:30
2010-07-13 15:56:07 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: ext !< extension of file
2010-07-13 15:56:07 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( getSolverJobName ( ) ) / / '.' / / ext
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , iostat = myStat , file = path )
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2018-01-10 21:43:25 +05:30
2013-06-27 00:49:00 +05:30
end subroutine IO_open_jobFile
2012-02-13 23:11:27 +05:30
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens existing file for reading to given unit. File is named after solver job name
!! plus given extension and located in current working directory
!> @details Like IO_open_jobFile, but error is handled via return value and not via call to
2013-09-18 19:37:55 +05:30
!! IO_error
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
logical function IO_open_jobFile_stat ( fileUnit , ext )
2013-02-11 15:14:17 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName
2007-03-20 19:25:22 +05:30
2012-02-13 23:11:27 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: ext !< extension of file
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( getSolverJobName ( ) ) / / '.' / / ext
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , iostat = myStat , file = path )
2013-06-27 00:49:00 +05:30
IO_open_jobFile_stat = ( myStat == 0_pInt )
end function IO_open_JobFile_stat
2007-03-20 19:25:22 +05:30
2012-08-09 16:31:53 +05:30
2014-11-06 17:17:27 +05:30
#if defined(Marc4DAMASK) || defined(Abaqus)
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief opens FEM input file for reading located in current working directory to given unit
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_open_inputFile ( fileUnit , modelName )
2012-06-15 21:40:21 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName , &
inputFileExtension
2007-03-20 19:25:22 +05:30
2012-03-06 20:22:48 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: modelName !< model name, in case of restart not solver job name
2010-05-10 20:32:59 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2012-06-15 21:40:21 +05:30
#ifdef Abaqus
2013-02-13 16:26:50 +05:30
integer ( pInt ) :: fileType
2018-01-10 21:43:25 +05:30
2013-02-13 16:26:50 +05:30
fileType = 1_pInt ! assume .pes
2013-09-23 14:31:46 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( modelName ) / / inputFileExtension ( fileType ) ! attempt .pes, if it exists: it should be used
2013-12-11 22:19:20 +05:30
open ( fileUnit + 1 , status = 'old' , iostat = myStat , file = path )
2013-02-13 16:26:50 +05:30
if ( myStat / = 0_pInt ) then ! if .pes does not work / exist; use conventional extension, i.e.".inp"
fileType = 2_pInt
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( modelName ) / / inputFileExtension ( fileType )
2013-12-11 22:19:20 +05:30
open ( fileUnit + 1 , status = 'old' , iostat = myStat , file = path )
2013-02-04 13:59:58 +05:30
endif
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( modelName ) / / inputFileExtension ( fileType ) / / '_assembly'
2013-12-11 22:19:20 +05:30
open ( fileUnit , iostat = myStat , file = path )
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2013-12-13 03:59:40 +05:30
if ( . not . abaqus_assembleInputFile ( fileUnit , fileUnit + 1_pInt ) ) call IO_error ( 103_pInt ) ! strip comments and concatenate any "include"s
2018-01-10 21:43:25 +05:30
close ( fileUnit + 1_pInt )
2012-06-15 21:40:21 +05:30
#endif
2013-04-30 15:19:30 +05:30
#ifdef Marc4DAMASK
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( modelName ) / / inputFileExtension
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , iostat = myStat , file = path )
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2012-06-15 21:40:21 +05:30
#endif
2010-07-13 15:56:07 +05:30
2012-03-06 20:22:48 +05:30
end subroutine IO_open_inputFile
2007-03-20 19:25:22 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens existing FEM log file for reading to given unit. File is named after solver job
!! name and located in current working directory
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_open_logFile ( fileUnit )
2012-06-15 21:40:21 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName , &
LogFileExtension
2010-11-03 20:09:18 +05:30
2009-07-22 21:37:19 +05:30
implicit none
2013-12-11 22:19:20 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2009-07-22 21:37:19 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2011-08-02 15:44:16 +05:30
2012-03-06 20:22:48 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( getSolverJobName ( ) ) / / LogFileExtension
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , iostat = myStat , file = path )
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2011-08-02 15:44:16 +05:30
2012-03-06 20:22:48 +05:30
end subroutine IO_open_logFile
2012-06-15 21:40:21 +05:30
#endif
2012-02-13 23:11:27 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens ASCII file to given unit for writing. File is named after solver job name plus
2013-12-28 01:33:28 +05:30
!! given extension and located in current working directory
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_write_jobFile ( fileUnit , ext )
2013-09-18 19:37:55 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName
2018-01-10 21:43:25 +05:30
2012-02-13 23:11:27 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: ext !< extension of file
2012-02-13 23:11:27 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2012-02-13 23:11:27 +05:30
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( getSolverJobName ( ) ) / / '.' / / ext
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'replace' , iostat = myStat , file = path )
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
end subroutine IO_write_jobFile
2011-08-02 15:44:16 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is
2013-09-18 19:37:55 +05:30
!! named after solver job name plus given extension and located in current working directory
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_write_jobRealFile ( fileUnit , ext , recMultiplier )
2018-01-10 21:43:25 +05:30
use DAMASK_interface , only : &
2013-09-18 19:37:55 +05:30
getSolverWorkingDirectoryName , &
getSolverJobName
2018-01-10 21:43:25 +05:30
2010-11-03 20:09:18 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: ext !< extension of file
integer ( pInt ) , intent ( in ) , optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
2010-11-03 20:09:18 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2010-11-03 20:09:18 +05:30
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( getSolverJobName ( ) ) / / '.' / / ext
2010-11-03 20:09:18 +05:30
if ( present ( recMultiplier ) ) then
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'replace' , form = 'unformatted' , access = 'direct' , &
2012-03-06 20:22:48 +05:30
recl = pReal * recMultiplier , iostat = myStat , file = path )
2012-02-13 23:11:27 +05:30
else
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'replace' , form = 'unformatted' , access = 'direct' , &
2012-03-06 20:22:48 +05:30
recl = pReal , iostat = myStat , file = path )
2012-02-13 23:11:27 +05:30
endif
2012-04-24 22:29:38 +05:30
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
end subroutine IO_write_jobRealFile
2010-11-03 20:09:18 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is
2013-09-18 19:37:55 +05:30
!! named after solver job name plus given extension and located in current working directory
2012-08-16 17:27:15 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_write_jobIntFile ( fileUnit , ext , recMultiplier )
2013-02-11 15:14:17 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName
2018-01-10 21:43:25 +05:30
2012-08-16 17:27:15 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: ext !< extension of file
integer ( pInt ) , intent ( in ) , optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
2012-08-16 17:27:15 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( getSolverJobName ( ) ) / / '.' / / ext
2012-08-16 17:27:15 +05:30
if ( present ( recMultiplier ) ) then
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'replace' , form = 'unformatted' , access = 'direct' , &
2014-05-15 18:38:02 +05:30
recl = pInt * recMultiplier , iostat = myStat , file = path )
2012-08-16 17:27:15 +05:30
else
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'replace' , form = 'unformatted' , access = 'direct' , &
2014-05-15 18:38:02 +05:30
recl = pInt , iostat = myStat , file = path )
2012-08-16 17:27:15 +05:30
endif
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
end subroutine IO_write_jobIntFile
2012-08-16 17:27:15 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is
2013-09-18 19:37:55 +05:30
!! located in current working directory
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_read_realFile ( fileUnit , ext , modelName , recMultiplier )
2013-02-11 15:14:17 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName
2018-01-10 21:43:25 +05:30
2010-11-03 20:09:18 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2018-01-10 21:43:25 +05:30
character ( len = * ) , intent ( in ) :: ext , & !< extension of file
2013-09-18 19:37:55 +05:30
modelName !< model name, in case of restart not solver job name
integer ( pInt ) , intent ( in ) , optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
2010-11-03 20:09:18 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2010-11-03 20:09:18 +05:30
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( modelName ) / / '.' / / ext
2010-11-03 20:09:18 +05:30
if ( present ( recMultiplier ) ) then
2018-01-10 21:43:25 +05:30
open ( fileUnit , status = 'old' , form = 'unformatted' , access = 'direct' , &
2014-05-15 18:38:02 +05:30
recl = pReal * recMultiplier , iostat = myStat , file = path )
2012-02-13 23:11:27 +05:30
else
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , form = 'unformatted' , access = 'direct' , &
2014-05-15 18:38:02 +05:30
recl = pReal , iostat = myStat , file = path )
2012-02-13 23:11:27 +05:30
endif
2014-05-15 18:38:02 +05:30
if ( myStat / = 0_pInt ) call IO_error ( 100_pInt , el = myStat , ext_msg = path )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
end subroutine IO_read_realFile
2010-11-03 20:09:18 +05:30
2012-08-09 16:31:53 +05:30
2012-08-16 17:27:15 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is
2013-09-18 19:37:55 +05:30
!! located in current working directory
2012-08-16 17:27:15 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_read_intFile ( fileUnit , ext , modelName , recMultiplier )
2013-02-11 15:14:17 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName
2018-01-10 21:43:25 +05:30
2012-08-16 17:27:15 +05:30
implicit none
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file unit
2018-01-10 21:43:25 +05:30
character ( len = * ) , intent ( in ) :: ext , & !< extension of file
2013-09-18 19:37:55 +05:30
modelName !< model name, in case of restart not solver job name
integer ( pInt ) , intent ( in ) , optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one)
2012-08-16 17:27:15 +05:30
integer ( pInt ) :: myStat
character ( len = 1024 ) :: path
2013-09-18 19:37:55 +05:30
path = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( modelName ) / / '.' / / ext
2012-08-16 17:27:15 +05:30
if ( present ( recMultiplier ) ) then
2018-01-10 21:43:25 +05:30
open ( fileUnit , status = 'old' , form = 'unformatted' , access = 'direct' , &
2014-05-15 18:38:02 +05:30
recl = pInt * recMultiplier , iostat = myStat , file = path )
2012-08-16 17:27:15 +05:30
else
2013-12-11 22:19:20 +05:30
open ( fileUnit , status = 'old' , form = 'unformatted' , access = 'direct' , &
2014-05-15 18:38:02 +05:30
recl = pInt , iostat = myStat , file = path )
2012-08-16 17:27:15 +05:30
endif
if ( myStat / = 0 ) call IO_error ( 100_pInt , ext_msg = path )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
end subroutine IO_read_intFile
2012-08-16 17:27:15 +05:30
2012-06-15 21:40:21 +05:30
#ifdef Abaqus
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief check if the input file for Abaqus contains part info
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
logical function IO_abaqus_hasNoPart ( fileUnit )
2007-03-21 18:02:15 +05:30
implicit none
2013-12-11 22:19:20 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit
2012-03-06 20:22:48 +05:30
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-06-24 19:03:30 +05:30
character ( len = 65536 ) :: line
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
IO_abaqus_hasNoPart = . true .
2018-01-10 21:43:25 +05:30
2013-06-24 19:03:30 +05:30
610 FORMAT ( A65536 )
2013-12-11 22:19:20 +05:30
rewind ( fileUnit )
2012-03-06 20:22:48 +05:30
do
2013-12-11 22:19:20 +05:30
read ( fileUnit , 610 , END = 620 ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
if ( IO_lc ( IO_stringValue ( line , chunkPos , 1_pInt ) ) == '*part' ) then
2012-03-06 20:22:48 +05:30
IO_abaqus_hasNoPart = . false .
exit
endif
2009-06-15 18:41:21 +05:30
enddo
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
620 end function IO_abaqus_hasNoPart
2012-06-15 21:40:21 +05:30
#endif
2007-03-21 18:02:15 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief hybrid IA sampling of ODFfile
!--------------------------------------------------------------------------------------------------
2012-03-06 20:22:48 +05:30
function IO_hybridIA ( Nast , ODFfileName )
2015-04-26 16:37:39 +05:30
use prec , only : &
tol_math_check
2007-03-21 18:02:15 +05:30
implicit none
2015-08-28 13:08:48 +05:30
integer ( pInt ) , intent ( in ) :: Nast !< number of samples?
2013-09-18 19:37:55 +05:30
real ( pReal ) , dimension ( 3 , Nast ) :: IO_hybridIA
2015-08-28 13:08:48 +05:30
character ( len = * ) , intent ( in ) :: ODFfileName !< name of ODF file including total path
2018-01-10 21:43:25 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! math module is not available
2016-05-25 11:22:56 +05:30
real ( pReal ) , parameter :: PI = 3.141592653589793_pReal
2012-03-06 20:22:48 +05:30
real ( pReal ) , parameter :: INRAD = PI / 18 0.0_pReal
integer ( pInt ) :: i , j , bin , NnonZero , Nset , Nreps , reps , phi1 , Phi , phi2
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
integer ( pInt ) , dimension ( 3 ) :: steps !< number of steps in phi1, Phi, and phi2 direction
integer ( pInt ) , dimension ( 4 ) :: columns !< columns in linearODF file where eulerangles and density are located
integer ( pInt ) , dimension ( : ) , allocatable :: binSet
2012-03-06 20:22:48 +05:30
real ( pReal ) :: center , sum_dV_V , prob , dg_0 , C , lowerC , upperC , rnd
2015-04-26 16:37:39 +05:30
real ( pReal ) , dimension ( 2 , 3 ) :: limits !< starting and end values for eulerangles
real ( pReal ) , dimension ( 3 ) :: deltas , & !< angular step size in phi1, Phi, and phi2 direction
eulers !< euler angles when reading from file
2012-03-06 20:22:48 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable :: dV_V
2015-04-26 16:37:39 +05:30
character ( len = 65536 ) :: line , keyword
2015-04-11 15:58:10 +05:30
integer ( pInt ) :: headerLength
integer ( pInt ) , parameter :: FILEUNIT = 999_pInt
2015-04-26 16:37:39 +05:30
IO_hybridIA = 0.0_pReal ! initialize return value for case of error
2015-10-13 22:32:07 +05:30
write ( 6 , '(/,a,/)' , advance = 'no' ) ' Using linear ODF file: ' / / trim ( ODFfileName )
2012-11-07 15:01:46 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
! parse header of ODF file
2015-04-11 15:58:10 +05:30
call IO_open_file ( FILEUNIT , ODFfileName )
2015-04-26 16:37:39 +05:30
headerLength = 0_pInt
line = IO_read ( FILEUNIT )
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
keyword = IO_lc ( IO_StringValue ( line , chunkPos , 2_pInt , . true . ) )
2015-04-11 15:58:10 +05:30
if ( keyword ( 1 : 4 ) == 'head' ) then
2015-08-28 13:08:48 +05:30
headerLength = IO_intValue ( line , chunkPos , 1_pInt ) + 1_pInt
2007-03-21 18:02:15 +05:30
else
2015-04-11 15:58:10 +05:30
call IO_error ( error_ID = 156_pInt , ext_msg = 'no header found' )
2009-06-15 18:41:21 +05:30
endif
2015-04-11 15:58:10 +05:30
2015-04-26 16:37:39 +05:30
!--------------------------------------------------------------------------------------------------
! figure out columns containing data
do i = 1_pInt , headerLength - 1_pInt
line = IO_read ( FILEUNIT )
enddo
columns = 0_pInt
2018-01-10 21:43:25 +05:30
chunkPos = IO_stringPos ( line )
2015-08-28 13:08:48 +05:30
do i = 1_pInt , chunkPos ( 1 )
select case ( IO_lc ( IO_StringValue ( line , chunkPos , i , . true . ) ) )
2015-04-26 16:37:39 +05:30
case ( 'phi1' )
columns ( 1 ) = i
case ( 'phi' )
columns ( 2 ) = i
case ( 'phi2' )
columns ( 3 ) = i
case ( 'intensity' )
columns ( 4 ) = i
2015-04-11 15:58:10 +05:30
end select
enddo
2015-04-26 16:37:39 +05:30
if ( any ( columns < 1 ) ) call IO_error ( error_ID = 156_pInt , ext_msg = 'could not find expected header' )
!--------------------------------------------------------------------------------------------------
! determine limits, number of steps and step size
2015-10-13 22:32:07 +05:30
limits ( 1 , 1 : 3 ) = 72 1.0_pReal
limits ( 2 , 1 : 3 ) = - 1.0_pReal
2015-04-26 16:37:39 +05:30
steps = 0_pInt
line = IO_read ( FILEUNIT )
do while ( trim ( line ) / = IO_EOF )
2018-01-10 21:43:25 +05:30
chunkPos = IO_stringPos ( line )
2015-08-28 13:08:48 +05:30
eulers = [ IO_floatValue ( line , chunkPos , columns ( 1 ) ) , &
IO_floatValue ( line , chunkPos , columns ( 2 ) ) , &
IO_floatValue ( line , chunkPos , columns ( 3 ) ) ]
2015-04-26 16:37:39 +05:30
steps = steps + merge ( 1 , 0 , eulers > limits ( 2 , 1 : 3 ) )
limits ( 1 , 1 : 3 ) = min ( limits ( 1 , 1 : 3 ) , eulers )
limits ( 2 , 1 : 3 ) = max ( limits ( 2 , 1 : 3 ) , eulers )
line = IO_read ( FILEUNIT )
enddo
deltas = ( limits ( 2 , 1 : 3 ) - limits ( 1 , 1 : 3 ) ) / real ( steps - 1_pInt , pReal )
write ( 6 , '(/,a,/,3(2x,f12.4,1x))' , advance = 'no' ) ' Starting angles / ° = ' , limits ( 1 , 1 : 3 )
write ( 6 , '(/,a,/,3(2x,f12.4,1x))' , advance = 'no' ) ' Ending angles / ° = ' , limits ( 2 , 1 : 3 )
write ( 6 , '(/,a,/,3(2x,f12.4,1x))' , advance = 'no' ) ' Angular steps / ° = ' , deltas
if ( all ( abs ( limits ( 1 , 1 : 3 ) ) < tol_math_check ) ) then
write ( 6 , '(/,a,/)' , advance = 'no' ) ' assuming vertex centered data'
center = 0.0_pReal ! no need to shift
if ( any ( mod ( int ( limits ( 2 , 1 : 3 ) , pInt ) , 90 ) == 0 ) ) &
call IO_error ( error_ID = 156_pInt , ext_msg = 'linear ODF data repeated at right boundary' )
else
write ( 6 , '(/,a,/)' , advance = 'no' ) ' assuming cell centered data'
center = 0.5_pReal ! shift data by half of a bin
endif
2015-10-13 22:32:07 +05:30
limits = limits * INRAD
deltas = deltas * INRAD
2007-03-21 18:02:15 +05:30
2015-04-26 16:37:39 +05:30
!--------------------------------------------------------------------------------------------------
! read in data
2015-04-11 15:58:10 +05:30
allocate ( dV_V ( steps ( 3 ) , steps ( 2 ) , steps ( 1 ) ) , source = 0.0_pReal )
2007-03-21 18:02:15 +05:30
sum_dV_V = 0.0_pReal
dg_0 = deltas ( 1 ) * deltas ( 3 ) * 2.0_pReal * sin ( deltas ( 2 ) / 2.0_pReal )
NnonZero = 0_pInt
2015-04-26 16:37:39 +05:30
call IO_checkAndRewind ( FILEUNIT ) ! forward
do i = 1_pInt , headerLength
line = IO_read ( FILEUNIT )
enddo
2013-09-18 19:37:55 +05:30
do phi1 = 1_pInt , steps ( 1 ) ; do Phi = 1_pInt , steps ( 2 ) ; do phi2 = 1_pInt , steps ( 3 )
2015-04-26 16:37:39 +05:30
line = IO_read ( FILEUNIT )
2018-01-10 21:43:25 +05:30
chunkPos = IO_stringPos ( line )
2015-10-13 22:32:07 +05:30
eulers = [ IO_floatValue ( line , chunkPos , columns ( 1 ) ) , & ! read in again for consistency check only
2015-08-28 13:08:48 +05:30
IO_floatValue ( line , chunkPos , columns ( 2 ) ) , &
IO_floatValue ( line , chunkPos , columns ( 3 ) ) ] * INRAD
2015-10-13 22:32:07 +05:30
if ( any ( abs ( ( real ( [ phi1 , phi , phi2 ] , pReal ) - 1.0_pReal + center ) * deltas - eulers ) > tol_math_check ) ) & ! check if data is in expected order (phi2 fast) and correct for Fortran starting at 1
2015-04-26 16:37:39 +05:30
call IO_error ( error_ID = 156_pInt , ext_msg = 'linear ODF data not in expected order' )
2015-08-28 13:08:48 +05:30
prob = IO_floatValue ( line , chunkPos , columns ( 4 ) )
2013-09-18 19:37:55 +05:30
if ( prob > 0.0_pReal ) then
NnonZero = NnonZero + 1_pInt
sum_dV_V = sum_dV_V + prob
else
prob = 0.0_pReal
endif
2016-05-25 11:22:56 +05:30
dV_V ( phi2 , Phi , phi1 ) = prob * dg_0 * sin ( ( real ( Phi - 1_pInt , pReal ) + center ) * deltas ( 2 ) )
2018-01-10 21:43:25 +05:30
enddo ; enddo ; enddo
2015-04-11 15:58:10 +05:30
close ( FILEUNIT )
2013-02-11 15:14:17 +05:30
dV_V = dV_V / sum_dV_V ! normalize to 1
2018-01-10 21:43:25 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! now fix bounds
Nset = max ( Nast , NnonZero ) ! if less than non-zero voxel count requested, sample at least that much
2007-03-21 18:02:15 +05:30
lowerC = 0.0_pReal
upperC = real ( Nset , pReal )
2018-01-10 21:43:25 +05:30
2007-03-21 18:02:15 +05:30
do while ( hybridIA_reps ( dV_V , steps , upperC ) < Nset )
lowerC = upperC
upperC = upperC * 2.0_pReal
2009-06-15 18:41:21 +05:30
enddo
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! binary search for best C
2007-03-21 18:02:15 +05:30
do
C = ( upperC + lowerC ) / 2.0_pReal
Nreps = hybridIA_reps ( dV_V , steps , C )
if ( abs ( upperC - lowerC ) < upperC * 1.0e-14_pReal ) then
C = upperC
Nreps = hybridIA_reps ( dV_V , steps , C )
exit
elseif ( Nreps < Nset ) then
lowerC = C
elseif ( Nreps > Nset ) then
upperC = C
else
exit
2009-06-15 18:41:21 +05:30
endif
enddo
2009-08-13 18:51:22 +05:30
2007-03-21 18:02:15 +05:30
allocate ( binSet ( Nreps ) )
2013-02-11 15:14:17 +05:30
bin = 0_pInt ! bin counter
i = 1_pInt ! set counter
2013-09-19 20:58:55 +05:30
do phi1 = 1_pInt , steps ( 1 ) ; do Phi = 1_pInt , steps ( 2 ) ; do phi2 = 1_pInt , steps ( 3 )
reps = nint ( C * dV_V ( phi2 , Phi , phi1 ) , pInt )
binSet ( i : i + reps - 1 ) = bin
bin = bin + 1_pInt ! advance bin
i = i + reps ! advance set
enddo ; enddo ; enddo
2007-03-21 18:02:15 +05:30
2012-02-16 00:28:38 +05:30
do i = 1_pInt , Nast
2007-03-21 18:02:15 +05:30
if ( i < Nast ) then
call random_number ( rnd )
2016-05-25 11:22:56 +05:30
j = nint ( rnd * real ( Nreps - i , pReal ) + real ( i , pReal ) + 0.5_pReal , pInt )
2007-03-21 18:02:15 +05:30
else
j = i
2009-06-15 18:41:21 +05:30
endif
2007-03-21 18:02:15 +05:30
bin = binSet ( j )
2013-09-18 19:37:55 +05:30
IO_hybridIA ( 1 , i ) = deltas ( 1 ) * ( real ( mod ( bin / ( steps ( 3 ) * steps ( 2 ) ) , steps ( 1 ) ) , pReal ) + center ) ! phi1
IO_hybridIA ( 2 , i ) = deltas ( 2 ) * ( real ( mod ( bin / steps ( 3 ) , steps ( 2 ) ) , pReal ) + center ) ! Phi
IO_hybridIA ( 3 , i ) = deltas ( 3 ) * ( real ( mod ( bin , steps ( 3 ) ) , pReal ) + center ) ! phi2
2007-03-21 18:02:15 +05:30
binSet ( j ) = binSet ( i )
2009-06-15 18:41:21 +05:30
enddo
2018-01-10 21:43:25 +05:30
2015-05-11 02:25:36 +05:30
contains
!--------------------------------------------------------------------------------------------------
!> @brief counts hybrid IA repetitions
!--------------------------------------------------------------------------------------------------
integer ( pInt ) pure function hybridIA_reps ( dV_V , steps , C )
2018-01-10 21:43:25 +05:30
2015-05-11 02:25:36 +05:30
implicit none
2015-10-13 22:32:07 +05:30
integer ( pInt ) , intent ( in ) , dimension ( 3 ) :: steps !< number of bins in Euler space
2015-05-11 02:25:36 +05:30
real ( pReal ) , intent ( in ) , dimension ( steps ( 3 ) , steps ( 2 ) , steps ( 1 ) ) :: dV_V !< needs description
real ( pReal ) , intent ( in ) :: C !< needs description
2018-01-10 21:43:25 +05:30
2015-05-11 02:25:36 +05:30
integer ( pInt ) :: phi1 , Phi , phi2
2018-01-10 21:43:25 +05:30
2015-05-11 02:25:36 +05:30
hybridIA_reps = 0_pInt
do phi1 = 1_pInt , steps ( 1 ) ; do Phi = 1_pInt , steps ( 2 ) ; do phi2 = 1_pInt , steps ( 3 )
hybridIA_reps = hybridIA_reps + nint ( C * dV_V ( phi2 , Phi , phi1 ) , pInt )
enddo ; enddo ; enddo
2018-01-10 21:43:25 +05:30
2015-05-11 02:25:36 +05:30
end function hybridIA_reps
2007-03-21 18:02:15 +05:30
2012-03-06 20:22:48 +05:30
end function IO_hybridIA
2007-03-21 18:02:15 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief identifies strings without content
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
logical pure function IO_isBlank ( string )
2009-03-04 17:18:54 +05:30
implicit none
2013-12-13 03:59:40 +05:30
character ( len = * ) , intent ( in ) :: string !< string to check for content
2012-03-06 20:22:48 +05:30
2013-02-11 15:14:17 +05:30
character ( len = * ) , parameter :: blankChar = achar ( 32 ) / / achar ( 9 ) / / achar ( 10 ) / / achar ( 13 ) ! whitespaces
character ( len = * ) , parameter :: comment = achar ( 35 ) ! comment id '#'
2012-03-06 20:22:48 +05:30
2013-02-11 15:14:17 +05:30
integer :: posNonBlank , posComment ! no pInt
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
posNonBlank = verify ( string , blankChar )
posComment = scan ( string , comment )
2009-03-04 17:18:54 +05:30
IO_isBlank = posNonBlank == 0 . or . posNonBlank == posComment
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
end function IO_isBlank
2009-03-04 17:18:54 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief get tagged content of string
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
pure function IO_getTag ( string , openChar , closeChar )
2009-03-04 17:18:54 +05:30
implicit none
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: string !< string to check for tag
character ( len = len_trim ( string ) ) :: IO_getTag
2018-01-10 21:43:25 +05:30
character ( len = * ) , intent ( in ) :: openChar , & !< indicates beginning of tag
2013-09-18 19:37:55 +05:30
closeChar !< indicates end of tag
2012-03-06 20:22:48 +05:30
2013-09-18 19:37:55 +05:30
character ( len = * ) , parameter :: SEP = achar ( 32 ) / / achar ( 9 ) / / achar ( 10 ) / / achar ( 13 ) ! whitespaces
2009-03-04 17:18:54 +05:30
2013-02-11 15:14:17 +05:30
integer :: left , right ! no pInt
2009-03-04 17:18:54 +05:30
IO_getTag = ''
2013-09-18 19:37:55 +05:30
left = scan ( string , openChar )
right = scan ( string , closeChar )
2018-01-10 21:43:25 +05:30
2013-12-13 03:59:40 +05:30
if ( left == verify ( string , SEP ) . and . right > left ) & ! openChar is first and closeChar occurs
2013-09-18 19:37:55 +05:30
IO_getTag = string ( left + 1 : right - 1 )
2009-03-04 17:18:54 +05:30
2012-03-06 20:22:48 +05:30
end function IO_getTag
2009-03-04 17:18:54 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief count number of [sections] in <part> for given file handle
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
integer ( pInt ) function IO_countSections ( fileUnit , part )
2012-03-06 20:22:48 +05:30
2009-03-04 17:18:54 +05:30
implicit none
2018-01-10 21:43:25 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file handle
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: part !< part name in which sections are counted
2009-03-04 17:18:54 +05:30
2013-06-24 19:03:30 +05:30
character ( len = 65536 ) :: line
2009-03-04 17:18:54 +05:30
2012-03-09 20:52:52 +05:30
line = ''
2012-02-16 00:28:38 +05:30
IO_countSections = 0_pInt
2013-12-11 22:19:20 +05:30
rewind ( fileUnit )
2009-03-04 17:18:54 +05:30
2014-05-21 15:33:57 +05:30
do while ( trim ( line ) / = IO_EOF . and . IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = part ) ! search for part
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2009-03-04 17:18:54 +05:30
enddo
2013-09-18 19:37:55 +05:30
do while ( trim ( line ) / = IO_EOF )
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2013-02-11 15:14:17 +05:30
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
2014-05-21 15:33:57 +05:30
if ( IO_getTag ( line , '<' , '>' ) / = '' ) then ! stop at next part
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2018-01-10 21:43:25 +05:30
exit
2014-05-21 15:33:57 +05:30
endif
2013-02-11 15:14:17 +05:30
if ( IO_getTag ( line , '[' , ']' ) / = '' ) & ! found [section] identifier
2012-02-16 00:28:38 +05:30
IO_countSections = IO_countSections + 1_pInt
2009-03-04 17:18:54 +05:30
enddo
2013-06-27 00:49:00 +05:30
end function IO_countSections
2018-01-10 21:43:25 +05:30
2009-03-04 17:18:54 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief returns array of tag counts within <part> for at most N [sections]
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
function IO_countTagInPart ( fileUnit , part , tag , Nsections )
2009-03-04 17:18:54 +05:30
implicit none
2013-09-18 19:37:55 +05:30
integer ( pInt ) , intent ( in ) :: Nsections !< maximum number of sections in which tag is searched for
2012-03-06 20:22:48 +05:30
integer ( pInt ) , dimension ( Nsections ) :: IO_countTagInPart
2018-01-10 21:43:25 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file handle
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: part , & !< part in which tag is searched for
tag !< tag to search for
2009-03-04 17:18:54 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) , dimension ( Nsections ) :: counter
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2012-03-07 15:37:29 +05:30
integer ( pInt ) :: section
2013-09-18 19:37:55 +05:30
character ( len = 65536 ) :: line
2018-01-10 21:43:25 +05:30
2012-03-09 20:52:52 +05:30
line = ''
2012-03-06 20:22:48 +05:30
counter = 0_pInt
2012-03-07 15:37:29 +05:30
section = 0_pInt
2012-03-09 20:52:52 +05:30
2018-01-10 21:43:25 +05:30
rewind ( fileUnit )
2014-05-21 15:33:57 +05:30
do while ( trim ( line ) / = IO_EOF . and . IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = part ) ! search for part
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2009-03-04 17:18:54 +05:30
enddo
2013-09-18 19:37:55 +05:30
do while ( trim ( line ) / = IO_EOF )
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2013-02-11 15:14:17 +05:30
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
2014-05-21 15:33:57 +05:30
if ( IO_getTag ( line , '<' , '>' ) / = '' ) then ! stop at next part
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2018-01-10 21:43:25 +05:30
exit
2014-05-21 15:33:57 +05:30
endif
2013-09-18 19:37:55 +05:30
if ( IO_getTag ( line , '[' , ']' ) / = '' ) section = section + 1_pInt ! found [section] identifier
2009-03-04 17:18:54 +05:30
if ( section > 0 ) then
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
if ( tag == trim ( IO_lc ( IO_stringValue ( line , chunkPos , 1_pInt ) ) ) ) & ! match
2012-02-02 18:49:02 +05:30
counter ( section ) = counter ( section ) + 1_pInt
2018-01-10 21:43:25 +05:30
endif
2009-03-04 17:18:54 +05:30
enddo
2013-06-27 00:49:00 +05:30
IO_countTagInPart = counter
2009-03-04 17:18:54 +05:30
2012-03-06 20:22:48 +05:30
end function IO_countTagInPart
2009-03-04 17:18:54 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief returns array of tag presence within <part> for at most N [sections]
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
function IO_spotTagInPart ( fileUnit , part , tag , Nsections )
2009-04-03 16:00:18 +05:30
implicit none
2013-09-18 19:37:55 +05:30
integer ( pInt ) , intent ( in ) :: Nsections !< maximum number of sections in which tag is searched for
logical , dimension ( Nsections ) :: IO_spotTagInPart
2018-01-10 21:43:25 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file handle
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: part , & !< part in which tag is searched for
tag !< tag to search for
2012-03-06 20:22:48 +05:30
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: section
2013-09-18 19:37:55 +05:30
character ( len = 65536 ) :: line
2009-04-03 16:00:18 +05:30
2013-02-11 15:14:17 +05:30
IO_spotTagInPart = . false . ! assume to nowhere spot tag
2009-04-03 16:00:18 +05:30
section = 0_pInt
2017-04-14 04:31:42 +05:30
line = ''
2009-04-03 16:00:18 +05:30
2013-12-11 22:19:20 +05:30
rewind ( fileUnit )
2014-05-21 15:33:57 +05:30
do while ( trim ( line ) / = IO_EOF . and . IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = part ) ! search for part
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2009-04-03 16:00:18 +05:30
enddo
2013-09-18 19:37:55 +05:30
do while ( trim ( line ) / = IO_EOF )
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2013-02-11 15:14:17 +05:30
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
2014-05-21 15:33:57 +05:30
if ( IO_getTag ( line , '<' , '>' ) / = '' ) then ! stop at next part
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2018-01-10 21:43:25 +05:30
exit
2014-05-21 15:33:57 +05:30
endif
2013-09-18 19:37:55 +05:30
if ( IO_getTag ( line , '[' , ']' ) / = '' ) section = section + 1_pInt ! found [section] identifier
2012-02-16 00:28:38 +05:30
if ( section > 0_pInt ) then
2018-01-10 21:43:25 +05:30
chunkPos = IO_stringPos ( line )
2015-08-28 13:08:48 +05:30
if ( tag == trim ( IO_lc ( IO_stringValue ( line , chunkPos , 1_pInt ) ) ) ) & ! match
2009-04-03 16:00:18 +05:30
IO_spotTagInPart ( section ) = . true .
2013-09-18 19:37:55 +05:30
endif
2009-04-03 16:00:18 +05:30
enddo
2013-06-27 00:49:00 +05:30
end function IO_spotTagInPart
2012-03-06 20:22:48 +05:30
2013-02-11 15:14:17 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief return logical whether tag is present within <part> before any [sections]
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
logical function IO_globalTagInPart ( fileUnit , part , tag )
2012-06-26 15:54:54 +05:30
implicit none
2018-01-10 21:43:25 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file handle
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: part , & !< part in which tag is searched for
tag !< tag to search for
2012-06-26 15:54:54 +05:30
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2012-06-26 15:54:54 +05:30
integer ( pInt ) :: section
2013-09-18 19:37:55 +05:30
character ( len = 65536 ) :: line
2012-06-26 15:54:54 +05:30
2013-02-11 15:14:17 +05:30
IO_globalTagInPart = . false . ! assume to nowhere spot tag
2012-06-26 15:54:54 +05:30
section = 0_pInt
line = ''
2013-12-11 22:19:20 +05:30
rewind ( fileUnit )
2014-05-21 15:33:57 +05:30
do while ( trim ( line ) / = IO_EOF . and . IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = part ) ! search for part
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2012-06-26 15:54:54 +05:30
enddo
2013-09-18 19:37:55 +05:30
do while ( trim ( line ) / = IO_EOF )
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2013-02-11 15:14:17 +05:30
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
2014-05-21 15:33:57 +05:30
if ( IO_getTag ( line , '<' , '>' ) / = '' ) then ! stop at next part
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2018-01-10 21:43:25 +05:30
exit
2014-05-21 15:33:57 +05:30
endif
2013-09-18 19:37:55 +05:30
if ( IO_getTag ( line , '[' , ']' ) / = '' ) section = section + 1_pInt ! found [section] identifier
2012-06-26 15:54:54 +05:30
if ( section == 0_pInt ) then
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
if ( tag == trim ( IO_lc ( IO_stringValue ( line , chunkPos , 1_pInt ) ) ) ) & ! match
2012-06-26 15:54:54 +05:30
IO_globalTagInPart = . true .
2018-01-10 21:43:25 +05:30
endif
2012-06-26 15:54:54 +05:30
enddo
2013-06-27 00:49:00 +05:30
end function IO_globalTagInPart
2012-06-26 15:54:54 +05:30
2013-02-13 00:30:41 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief locates all space-separated chunks in given string and returns array containing number
2015-08-28 13:08:48 +05:30
!! them and the left/right position to be used by IO_xxxVal
!! Array size is dynamically adjusted to number of chunks found in string
2013-09-18 19:37:55 +05:30
!! IMPORTANT: first element contains number of chunks!
2013-02-13 00:30:41 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
pure function IO_stringPos ( string )
2007-03-20 19:25:22 +05:30
implicit none
2015-08-28 13:08:48 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: IO_stringPos
character ( len = * ) , intent ( in ) :: string !< string in which chunk positions are searched for
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
character ( len = * ) , parameter :: SEP = achar ( 44 ) / / achar ( 32 ) / / achar ( 9 ) / / achar ( 10 ) / / achar ( 13 ) ! comma and whitespaces
2013-02-06 22:11:09 +05:30
integer :: left , right ! no pInt (verify and scan return default integer)
2012-03-06 20:22:48 +05:30
2015-08-28 13:08:48 +05:30
allocate ( IO_stringPos ( 1 ) , source = 0_pInt )
2009-12-15 21:33:53 +05:30
right = 0
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
do while ( verify ( string ( right + 1 : ) , SEP ) > 0 )
left = right + verify ( string ( right + 1 : ) , SEP )
right = left + scan ( string ( left : ) , SEP ) - 2
2015-08-06 14:54:56 +05:30
if ( string ( left : left ) == '#' ) exit
2015-08-28 13:08:48 +05:30
IO_stringPos = [ IO_stringPos , int ( left , pInt ) , int ( right , pInt ) ]
2012-02-16 00:28:38 +05:30
IO_stringPos ( 1 ) = IO_stringPos ( 1 ) + 1_pInt
2009-06-15 18:41:21 +05:30
enddo
2009-12-15 21:33:53 +05:30
2012-03-06 20:22:48 +05:30
end function IO_stringPos
2007-03-20 19:25:22 +05:30
2015-08-13 20:24:34 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief reads string value at myChunk from string
2015-08-13 20:24:34 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
function IO_stringValue ( string , chunkPos , myChunk , silent )
2018-01-10 21:43:25 +05:30
2007-03-20 19:25:22 +05:30
implicit none
2015-08-28 13:08:48 +05:30
integer ( pInt ) , dimension ( : ) , intent ( in ) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer ( pInt ) , intent ( in ) :: myChunk !< position number of desired chunk
character ( len = * ) , intent ( in ) :: string !< raw input with known start and end of each chunk
character ( len = : ) , allocatable :: IO_stringValue
logical , optional , intent ( in ) :: silent !< switch to trigger verbosity
2013-09-18 19:37:55 +05:30
character ( len = 16 ) , parameter :: MYNAME = 'IO_stringValue: '
2013-02-08 21:25:53 +05:30
logical :: warn
2018-01-10 21:43:25 +05:30
2013-02-08 21:25:53 +05:30
if ( . not . present ( silent ) ) then
warn = . false .
else
warn = silent
endif
2018-01-10 21:43:25 +05:30
2013-02-08 21:25:53 +05:30
IO_stringValue = ''
2015-08-28 13:08:48 +05:30
valuePresent : if ( myChunk > chunkPos ( 1 ) . or . myChunk < 1_pInt ) then
if ( warn ) call IO_warning ( 201 , el = myChunk , ext_msg = MYNAME / / trim ( string ) )
else valuePresent
IO_stringValue = string ( chunkPos ( myChunk * 2 ) : chunkPos ( myChunk * 2 + 1 ) )
endif valuePresent
2007-03-20 19:25:22 +05:30
2012-03-06 20:22:48 +05:30
end function IO_stringValue
2007-03-20 19:25:22 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief reads string value at myChunk from fixed format string
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
pure function IO_fixedStringValue ( string , ends , myChunk )
2018-01-10 21:43:25 +05:30
2007-03-21 20:15:03 +05:30
implicit none
2015-08-28 13:08:48 +05:30
integer ( pInt ) , intent ( in ) :: myChunk !< position number of desired chunk
integer ( pInt ) , dimension ( : ) , intent ( in ) :: ends !< positions of end of each tag/chunk in given string
2018-01-10 21:43:25 +05:30
character ( len = ends ( myChunk + 1 ) - ends ( myChunk ) ) :: IO_fixedStringValue
2015-08-28 13:08:48 +05:30
character ( len = * ) , intent ( in ) :: string !< raw input with known ends of each chunk
2007-03-21 20:15:03 +05:30
2015-08-28 13:08:48 +05:30
IO_fixedStringValue = string ( ends ( myChunk ) + 1 : ends ( myChunk + 1 ) )
2007-03-21 20:15:03 +05:30
2012-03-06 20:22:48 +05:30
end function IO_fixedStringValue
2007-03-21 20:15:03 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief reads float value at myChunk from string
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
real ( pReal ) function IO_floatValue ( string , chunkPos , myChunk )
2013-02-06 22:11:09 +05:30
2007-03-20 19:25:22 +05:30
implicit none
2015-08-28 13:08:48 +05:30
integer ( pInt ) , dimension ( : ) , intent ( in ) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer ( pInt ) , intent ( in ) :: myChunk !< position number of desired chunk
character ( len = * ) , intent ( in ) :: string !< raw input with known start and end of each chunk
2013-09-18 19:37:55 +05:30
character ( len = 15 ) , parameter :: MYNAME = 'IO_floatValue: '
character ( len = 17 ) , parameter :: VALIDCHARACTERS = '0123456789eEdD.+-'
2007-03-20 19:25:22 +05:30
2013-02-06 22:11:09 +05:30
IO_floatValue = 0.0_pReal
2013-02-13 00:30:41 +05:30
2015-08-28 13:08:48 +05:30
valuePresent : if ( myChunk > chunkPos ( 1 ) . or . myChunk < 1_pInt ) then
call IO_warning ( 201 , el = myChunk , ext_msg = MYNAME / / trim ( string ) )
else valuePresent
2014-02-06 23:18:01 +05:30
IO_floatValue = &
2015-08-28 13:08:48 +05:30
IO_verifyFloatValue ( trim ( adjustl ( string ( chunkPos ( myChunk * 2 ) : chunkPos ( myChunk * 2 + 1 ) ) ) ) , &
2013-09-18 19:37:55 +05:30
VALIDCHARACTERS , MYNAME )
2015-08-28 13:08:48 +05:30
endif valuePresent
2007-03-20 19:25:22 +05:30
2012-03-06 20:22:48 +05:30
end function IO_floatValue
2007-03-20 19:25:22 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief reads float value at myChunk from fixed format string
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
real ( pReal ) function IO_fixedFloatValue ( string , ends , myChunk )
2018-01-10 21:43:25 +05:30
2007-03-21 20:15:03 +05:30
implicit none
2015-08-28 13:08:48 +05:30
character ( len = * ) , intent ( in ) :: string !< raw input with known ends of each chunk
integer ( pInt ) , intent ( in ) :: myChunk !< position number of desired chunk
integer ( pInt ) , dimension ( : ) , intent ( in ) :: ends !< positions of end of each tag/chunk in given string
2013-09-18 19:37:55 +05:30
character ( len = 20 ) , parameter :: MYNAME = 'IO_fixedFloatValue: '
character ( len = 17 ) , parameter :: VALIDCHARACTERS = '0123456789eEdD.+-'
2007-03-21 20:15:03 +05:30
2014-02-06 23:18:01 +05:30
IO_fixedFloatValue = &
2015-08-28 13:08:48 +05:30
IO_verifyFloatValue ( trim ( adjustl ( string ( ends ( myChunk ) + 1_pInt : ends ( myChunk + 1_pInt ) ) ) ) , &
2013-09-18 19:37:55 +05:30
VALIDCHARACTERS , MYNAME )
2007-03-21 20:15:03 +05:30
2012-03-06 20:22:48 +05:30
end function IO_fixedFloatValue
2007-03-21 20:15:03 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief reads float x.y+z value at myChunk from format string
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
real ( pReal ) function IO_fixedNoEFloatValue ( string , ends , myChunk )
2012-03-06 20:22:48 +05:30
2007-03-21 20:15:03 +05:30
implicit none
2015-08-28 13:08:48 +05:30
character ( len = * ) , intent ( in ) :: string !< raw input with known ends of each chunk
integer ( pInt ) , intent ( in ) :: myChunk !< position number of desired chunk
integer ( pInt ) , dimension ( : ) , intent ( in ) :: ends !< positions of end of each tag/chunk in given string
2013-09-18 19:37:55 +05:30
character ( len = 22 ) , parameter :: MYNAME = 'IO_fixedNoEFloatValue '
character ( len = 13 ) , parameter :: VALIDBASE = '0123456789.+-'
character ( len = 12 ) , parameter :: VALIDEXP = '0123456789+-'
2018-01-10 21:43:25 +05:30
2013-02-13 00:30:41 +05:30
real ( pReal ) :: base
integer ( pInt ) :: expon
integer :: pos_exp
2018-01-10 21:43:25 +05:30
2015-08-28 13:08:48 +05:30
pos_exp = scan ( string ( ends ( myChunk ) + 1 : ends ( myChunk + 1 ) ) , '+-' , back = . true . )
hasExponent : if ( pos_exp > 1 ) then
base = IO_verifyFloatValue ( trim ( adjustl ( string ( ends ( myChunk ) + 1_pInt : ends ( myChunk ) + pos_exp - 1_pInt ) ) ) , &
2013-09-18 19:37:55 +05:30
VALIDBASE , MYNAME / / '(base): ' )
2015-08-28 13:08:48 +05:30
expon = IO_verifyIntValue ( trim ( adjustl ( string ( ends ( myChunk ) + pos_exp : ends ( myChunk + 1_pInt ) ) ) ) , &
2014-02-06 23:18:01 +05:30
VALIDEXP , MYNAME / / '(exp): ' )
2015-08-28 13:08:48 +05:30
else hasExponent
base = IO_verifyFloatValue ( trim ( adjustl ( string ( ends ( myChunk ) + 1_pInt : ends ( myChunk + 1_pInt ) ) ) ) , &
2013-09-18 19:37:55 +05:30
VALIDBASE , MYNAME / / '(base): ' )
2013-02-13 00:30:41 +05:30
expon = 0_pInt
2015-08-28 13:08:48 +05:30
endif hasExponent
2013-02-13 00:30:41 +05:30
IO_fixedNoEFloatValue = base * 1 0.0_pReal ** real ( expon , pReal )
2007-03-21 20:15:03 +05:30
2012-03-06 20:22:48 +05:30
end function IO_fixedNoEFloatValue
2007-03-21 20:15:03 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief reads integer value at myChunk from string
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
integer ( pInt ) function IO_intValue ( string , chunkPos , myChunk )
2012-03-06 20:22:48 +05:30
2007-03-20 19:25:22 +05:30
implicit none
2015-08-28 13:08:48 +05:30
character ( len = * ) , intent ( in ) :: string !< raw input with known start and end of each chunk
integer ( pInt ) , intent ( in ) :: myChunk !< position number of desired chunk
integer ( pInt ) , dimension ( : ) , intent ( in ) :: chunkPos !< positions of start and end of each tag/chunk in given string
2013-09-18 19:37:55 +05:30
character ( len = 13 ) , parameter :: MYNAME = 'IO_intValue: '
character ( len = 12 ) , parameter :: VALIDCHARACTERS = '0123456789+-'
2007-03-20 19:25:22 +05:30
2013-02-13 21:17:00 +05:30
IO_intValue = 0_pInt
2013-02-13 00:30:41 +05:30
2015-08-28 13:08:48 +05:30
valuePresent : if ( myChunk > chunkPos ( 1 ) . or . myChunk < 1_pInt ) then
call IO_warning ( 201 , el = myChunk , ext_msg = MYNAME / / trim ( string ) )
else valuePresent
IO_intValue = IO_verifyIntValue ( trim ( adjustl ( string ( chunkPos ( myChunk * 2 ) : chunkPos ( myChunk * 2 + 1 ) ) ) ) , &
2013-09-18 19:37:55 +05:30
VALIDCHARACTERS , MYNAME )
2015-08-28 13:08:48 +05:30
endif valuePresent
2007-03-20 19:25:22 +05:30
2012-03-06 20:22:48 +05:30
end function IO_intValue
2007-03-20 19:25:22 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief reads integer value at myChunk from fixed format string
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
integer ( pInt ) function IO_fixedIntValue ( string , ends , myChunk )
2018-01-10 21:43:25 +05:30
2007-03-21 20:15:03 +05:30
implicit none
2015-08-28 13:08:48 +05:30
character ( len = * ) , intent ( in ) :: string !< raw input with known ends of each chunk
integer ( pInt ) , intent ( in ) :: myChunk !< position number of desired chunk
integer ( pInt ) , dimension ( : ) , intent ( in ) :: ends !< positions of end of each tag/chunk in given string
2013-09-18 19:37:55 +05:30
character ( len = 20 ) , parameter :: MYNAME = 'IO_fixedIntValue: '
character ( len = 12 ) , parameter :: VALIDCHARACTERS = '0123456789+-'
2007-03-21 20:15:03 +05:30
2015-08-28 13:08:48 +05:30
IO_fixedIntValue = IO_verifyIntValue ( trim ( adjustl ( string ( ends ( myChunk ) + 1_pInt : ends ( myChunk + 1_pInt ) ) ) ) , &
2014-02-06 23:18:01 +05:30
VALIDCHARACTERS , MYNAME )
2007-03-21 20:15:03 +05:30
2012-03-06 20:22:48 +05:30
end function IO_fixedIntValue
2007-03-21 20:15:03 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief changes characters in string to lower case
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
pure function IO_lc ( string )
2007-03-20 19:25:22 +05:30
implicit none
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: string !< string to convert
character ( len = len ( string ) ) :: IO_lc
character ( 26 ) , parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
2018-01-10 21:43:25 +05:30
character ( 26 ) , parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
2013-02-06 22:11:09 +05:30
integer :: i , n ! no pInt (len returns default integer)
2007-03-20 19:25:22 +05:30
2013-09-18 19:37:55 +05:30
IO_lc = string
do i = 1 , len ( string )
n = index ( UPPER , IO_lc ( i : i ) )
if ( n / = 0 ) IO_lc ( i : i ) = LOWER ( n : n )
2007-04-25 20:08:22 +05:30
enddo
2007-03-20 19:25:22 +05:30
2012-03-06 20:22:48 +05:30
end function IO_lc
2007-03-20 19:25:22 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief reads file to skip (at least) N chunks (may be over multiple lines)
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine IO_skipChunks ( fileUnit , N )
2009-04-03 12:34:31 +05:30
implicit none
2018-01-10 21:43:25 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit , & !< file handle
N !< minimum number of chunks to skip
2012-03-07 15:37:29 +05:30
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: remainingChunks
2013-06-24 19:03:30 +05:30
character ( len = 65536 ) :: line
2009-04-03 12:34:31 +05:30
2013-09-19 20:58:55 +05:30
line = ''
2009-04-03 12:34:31 +05:30
remainingChunks = N
2013-09-19 20:58:55 +05:30
2013-09-18 19:37:55 +05:30
do while ( trim ( line ) / = IO_EOF . and . remainingChunks > 0 )
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2015-08-28 13:08:48 +05:30
remainingChunks = remainingChunks - ( size ( IO_stringPos ( line ) ) - 1_pInt ) / 2_pInt
2009-06-15 18:41:21 +05:30
enddo
2013-09-18 19:37:55 +05:30
end subroutine IO_skipChunks
2009-04-03 12:34:31 +05:30
2009-10-12 21:31:49 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief extracts string value from key=value pair and check whether key matches
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
character ( len = 300 ) pure function IO_extractValue ( pair , key )
2018-01-10 21:43:25 +05:30
2009-10-12 21:31:49 +05:30
implicit none
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: pair , & !< key=value pair
key !< key to be expected
2012-03-07 15:37:29 +05:30
2013-09-18 19:37:55 +05:30
character ( len = * ) , parameter :: SEP = achar ( 61 ) ! '='
2009-10-12 21:31:49 +05:30
2015-08-28 13:08:48 +05:30
integer :: myChunk !< position number of desired chunk
2009-10-12 21:31:49 +05:30
IO_extractValue = ''
2015-08-28 13:08:48 +05:30
myChunk = scan ( pair , SEP )
2016-03-09 20:06:11 +05:30
if ( myChunk > 0 . and . pair ( : myChunk - 1 ) == key ) IO_extractValue = pair ( myChunk + 1 : ) ! extract value if key matches
2009-10-12 21:31:49 +05:30
2012-03-06 20:22:48 +05:30
end function IO_extractValue
2009-10-12 21:31:49 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief count lines containig data up to next *keyword
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
integer ( pInt ) function IO_countDataLines ( fileUnit )
2007-10-15 19:25:52 +05:30
implicit none
2018-01-10 21:43:25 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file handle
2007-10-15 19:25:52 +05:30
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-06-24 19:03:30 +05:30
character ( len = 65536 ) :: line , &
2012-03-06 20:22:48 +05:30
tmp
2007-10-15 19:25:52 +05:30
2012-02-16 00:28:38 +05:30
IO_countDataLines = 0_pInt
2013-09-19 20:58:55 +05:30
line = ''
2012-03-09 20:52:52 +05:30
2013-09-19 20:58:55 +05:30
do while ( trim ( line ) / = IO_EOF )
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
tmp = IO_lc ( IO_stringValue ( line , chunkPos , 1_pInt ) )
2013-02-11 15:14:17 +05:30
if ( tmp ( 1 : 1 ) == '*' . and . tmp ( 2 : 2 ) / = '*' ) then ! found keyword
2018-01-10 21:43:25 +05:30
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2009-10-12 21:31:49 +05:30
exit
2007-10-15 19:25:52 +05:30
else
2010-07-13 15:56:07 +05:30
if ( tmp ( 2 : 2 ) / = '*' ) IO_countDataLines = IO_countDataLines + 1_pInt
2007-10-15 19:25:52 +05:30
endif
enddo
2013-12-11 22:19:20 +05:30
backspace ( fileUnit )
2009-10-12 21:31:49 +05:30
2012-03-06 20:22:48 +05:30
end function IO_countDataLines
2009-10-12 21:31:49 +05:30
2018-01-10 21:43:25 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief count lines containig data up to next *keyword
!--------------------------------------------------------------------------------------------------
integer ( pInt ) function IO_countNumericalDataLines ( fileUnit )
implicit none
integer ( pInt ) , intent ( in ) :: fileUnit !< file handle
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
character ( len = 65536 ) :: line , &
tmp
IO_countNumericalDataLines = 0_pInt
line = ''
do while ( trim ( line ) / = IO_EOF )
line = IO_read ( fileUnit )
chunkPos = IO_stringPos ( line )
tmp = IO_lc ( IO_stringValue ( line , chunkPos , 1_pInt ) )
2018-02-02 19:36:13 +05:30
if ( verify ( trim ( tmp ) , "0123456789" ) / = 0 ) then ! found keyword
2018-01-10 21:43:25 +05:30
line = IO_read ( fileUnit , . true . ) ! reset IO_read
exit
else
IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt
endif
enddo
backspace ( fileUnit )
end function IO_countNumericalDataLines
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief count items in consecutive lines depending on lines
!> @details Marc: ints concatenated by "c" as last char or range of values a "to" b
!> Abaqus: triplet of start,stop,inc
2012-10-18 15:47:16 +05:30
!> Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
integer ( pInt ) function IO_countContinuousIntValues ( fileUnit )
2009-10-12 21:31:49 +05:30
2012-03-06 20:22:48 +05:30
implicit none
2013-12-11 22:19:20 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit
2018-01-10 21:43:25 +05:30
#ifdef Abaqus
2012-03-06 20:22:48 +05:30
integer ( pInt ) :: l , c
2012-06-15 21:40:21 +05:30
#endif
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2012-03-06 20:22:48 +05:30
character ( len = 65536 ) :: line
2009-10-12 21:31:49 +05:30
2012-04-11 22:54:50 +05:30
IO_countContinuousIntValues = 0_pInt
2013-09-19 20:58:55 +05:30
line = ''
2009-10-12 21:31:49 +05:30
2012-06-15 21:40:21 +05:30
#ifndef Abaqus
2013-09-18 19:37:55 +05:30
do while ( trim ( line ) / = IO_EOF )
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
if ( chunkPos ( 1 ) < 1_pInt ) then ! empty line
2018-01-10 21:43:25 +05:30
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2012-11-07 15:01:46 +05:30
exit
2015-08-28 13:08:48 +05:30
elseif ( IO_lc ( IO_stringValue ( line , chunkPos , 2_pInt ) ) == 'to' ) then ! found range indicator
2016-10-29 14:34:19 +05:30
IO_countContinuousIntValues = 1_pInt + abs ( IO_intValue ( line , chunkPos , 3_pInt ) &
- IO_intValue ( line , chunkPos , 1_pInt ) )
2018-01-10 21:43:25 +05:30
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2012-11-07 15:01:46 +05:30
exit ! only one single range indicator allowed
2015-08-28 13:08:48 +05:30
else if ( IO_lc ( IO_stringValue ( line , chunkPos , 2_pInt ) ) == 'of' ) then ! found multiple entries indicator
IO_countContinuousIntValues = IO_intValue ( line , chunkPos , 1_pInt )
2018-01-10 21:43:25 +05:30
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2012-11-07 15:01:46 +05:30
exit ! only one single multiplier allowed
2012-06-15 21:40:21 +05:30
else
2015-08-28 13:08:48 +05:30
IO_countContinuousIntValues = IO_countContinuousIntValues + chunkPos ( 1 ) - 1_pInt ! add line's count when assuming 'c'
if ( IO_lc ( IO_stringValue ( line , chunkPos , chunkPos ( 1 ) ) ) / = 'c' ) then ! line finished, read last value
2012-06-15 21:40:21 +05:30
IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt
2018-01-10 21:43:25 +05:30
line = IO_read ( fileUnit , . true . ) ! reset IO_read
2012-11-07 15:01:46 +05:30
exit ! data ended
2012-06-15 21:40:21 +05:30
endif
endif
enddo
#else
2013-12-11 22:19:20 +05:30
c = IO_countDataLines ( fileUnit )
2012-06-15 21:40:21 +05:30
do l = 1_pInt , c
2013-12-13 03:59:40 +05:30
backspace ( fileUnit ) ! ToDo: substitute by rewind?
2012-06-15 21:40:21 +05:30
enddo
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
l = 1_pInt
2013-12-13 03:59:40 +05:30
do while ( trim ( line ) / = IO_EOF . and . l < = c ) ! ToDo: is this correct
2013-09-18 19:37:55 +05:30
l = l + 1_pInt
2013-12-11 22:19:20 +05:30
line = IO_read ( fileUnit )
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
2013-02-11 15:14:17 +05:30
IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation
2015-08-28 13:08:48 +05:30
( IO_intValue ( line , chunkPos , 2_pInt ) - IO_intValue ( line , chunkPos , 1_pInt ) ) / &
max ( 1_pInt , IO_intValue ( line , chunkPos , 3_pInt ) )
2012-06-15 21:40:21 +05:30
enddo
#endif
2009-10-12 21:31:49 +05:30
2013-09-18 19:37:55 +05:30
end function IO_countContinuousIntValues
2007-10-15 19:25:52 +05:30
2009-10-12 21:31:49 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief return integer list corresponding to items in consecutive lines.
2013-07-08 21:18:13 +05:30
!! First integer in array is counter
2012-08-09 16:31:53 +05:30
!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set
2013-07-08 21:18:13 +05:30
!! Abaqus: triplet of start,stop,inc or named set
!! Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
function IO_continuousIntValues ( fileUnit , maxN , lookupName , lookupMap , lookupMaxN )
2007-04-25 20:08:22 +05:30
2012-03-06 20:22:48 +05:30
implicit none
integer ( pInt ) , intent ( in ) :: maxN
2012-04-11 22:54:50 +05:30
integer ( pInt ) , dimension ( 1 + maxN ) :: IO_continuousIntValues
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit , &
2012-03-06 20:22:48 +05:30
lookupMaxN
integer ( pInt ) , dimension ( : , : ) , intent ( in ) :: lookupMap
character ( len = 64 ) , dimension ( : ) , intent ( in ) :: lookupName
2016-10-29 14:34:19 +05:30
integer ( pInt ) :: i , first , last
2012-06-15 21:40:21 +05:30
#ifdef Abaqus
2016-10-29 14:34:19 +05:30
integer ( pInt ) :: j , l , c
2012-06-15 21:40:21 +05:30
#endif
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2012-01-12 22:31:24 +05:30
character ( len = 65536 ) line
2010-07-13 15:56:07 +05:30
logical rangeGeneration
2007-04-25 20:08:22 +05:30
2012-04-11 22:54:50 +05:30
IO_continuousIntValues = 0_pInt
2010-07-13 15:56:07 +05:30
rangeGeneration = . false .
2009-10-12 21:31:49 +05:30
2012-06-15 21:40:21 +05:30
#ifndef Abaqus
do
2013-12-11 22:19:20 +05:30
read ( fileUnit , '(A65536)' , end = 100 ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
if ( chunkPos ( 1 ) < 1_pInt ) then ! empty line
2012-11-07 15:01:46 +05:30
exit
2015-08-28 13:08:48 +05:30
elseif ( verify ( IO_stringValue ( line , chunkPos , 1_pInt ) , '0123456789' ) > 0 ) then ! a non-int, i.e. set name
2012-11-07 15:01:46 +05:30
do i = 1_pInt , lookupMaxN ! loop over known set names
2015-08-28 13:08:48 +05:30
if ( IO_stringValue ( line , chunkPos , 1_pInt ) == lookupName ( i ) ) then ! found matching name
2012-11-07 15:01:46 +05:30
IO_continuousIntValues = lookupMap ( : , i ) ! return resp. entity list
2012-04-11 22:54:50 +05:30
exit
2007-10-23 18:38:27 +05:30
endif
enddo
2012-06-15 21:40:21 +05:30
exit
2015-08-28 13:08:48 +05:30
else if ( chunkPos ( 1 ) > 2_pInt . and . IO_lc ( IO_stringValue ( line , chunkPos , 2_pInt ) ) == 'to' ) then ! found range indicator
2016-10-29 14:34:19 +05:30
first = IO_intValue ( line , chunkPos , 1_pInt )
last = IO_intValue ( line , chunkPos , 3_pInt )
2018-01-10 21:43:25 +05:30
do i = first , last , sign ( 1_pInt , last - first )
2012-06-15 21:40:21 +05:30
IO_continuousIntValues ( 1 ) = IO_continuousIntValues ( 1 ) + 1_pInt
IO_continuousIntValues ( 1 + IO_continuousIntValues ( 1 ) ) = i
2010-07-13 15:56:07 +05:30
enddo
2012-06-15 21:40:21 +05:30
exit
2015-08-28 13:08:48 +05:30
else if ( chunkPos ( 1 ) > 2_pInt . and . IO_lc ( IO_stringValue ( line , chunkPos , 2_pInt ) ) == 'of' ) then ! found multiple entries indicator
IO_continuousIntValues ( 1 ) = IO_intValue ( line , chunkPos , 1_pInt )
IO_continuousIntValues ( 2 : IO_continuousIntValues ( 1 ) + 1 ) = IO_intValue ( line , chunkPos , 3_pInt )
2012-06-15 21:40:21 +05:30
exit
else
2015-08-28 13:08:48 +05:30
do i = 1_pInt , chunkPos ( 1 ) - 1_pInt ! interpret up to second to last value
2012-06-15 21:40:21 +05:30
IO_continuousIntValues ( 1 ) = IO_continuousIntValues ( 1 ) + 1_pInt
2015-08-28 13:08:48 +05:30
IO_continuousIntValues ( 1 + IO_continuousIntValues ( 1 ) ) = IO_intValue ( line , chunkPos , i )
2007-04-25 20:08:22 +05:30
enddo
2015-08-28 13:08:48 +05:30
if ( IO_lc ( IO_stringValue ( line , chunkPos , chunkPos ( 1 ) ) ) / = 'c' ) then ! line finished, read last value
2012-06-15 21:40:21 +05:30
IO_continuousIntValues ( 1 ) = IO_continuousIntValues ( 1 ) + 1_pInt
2015-08-28 13:08:48 +05:30
IO_continuousIntValues ( 1 + IO_continuousIntValues ( 1 ) ) = IO_intValue ( line , chunkPos , chunkPos ( 1 ) )
2012-06-15 21:40:21 +05:30
exit
endif
endif
enddo
#else
2013-12-11 22:19:20 +05:30
c = IO_countDataLines ( fileUnit )
2012-06-15 21:40:21 +05:30
do l = 1_pInt , c
2013-12-11 22:19:20 +05:30
backspace ( fileUnit )
2012-06-15 21:40:21 +05:30
enddo
2018-01-10 21:43:25 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! check if the element values in the elset are auto generated
2013-12-11 22:19:20 +05:30
backspace ( fileUnit )
read ( fileUnit , '(A65536)' , end = 100 ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
do i = 1_pInt , chunkPos ( 1 )
if ( IO_lc ( IO_stringValue ( line , chunkPos , i ) ) == 'generate' ) rangeGeneration = . true .
2012-06-15 21:40:21 +05:30
enddo
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
do l = 1_pInt , c
2013-12-11 22:19:20 +05:30
read ( fileUnit , '(A65536)' , end = 100 ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
if ( verify ( IO_stringValue ( line , chunkPos , 1_pInt ) , '0123456789' ) > 0 ) then ! a non-int, i.e. set names follow on this line
2015-09-05 21:56:55 +05:30
do i = 1_pInt , chunkPos ( 1 ) ! loop over set names in line
2015-08-14 10:33:54 +05:30
do j = 1_pInt , lookupMaxN ! look through known set names
2015-08-28 13:08:48 +05:30
if ( IO_stringValue ( line , chunkPos , i ) == lookupName ( j ) ) then ! found matching name
2012-11-07 15:01:46 +05:30
first = 2_pInt + IO_continuousIntValues ( 1 ) ! where to start appending data
last = first + lookupMap ( 1 , j ) - 1_pInt ! up to where to append data
IO_continuousIntValues ( first : last ) = lookupMap ( 2 : 1 + lookupMap ( 1 , j ) , j ) ! add resp. entity list
IO_continuousIntValues ( 1 ) = IO_continuousIntValues ( 1 ) + lookupMap ( 1 , j ) ! count them
2012-06-15 21:40:21 +05:30
endif
enddo
enddo
2012-11-07 15:01:46 +05:30
else if ( rangeGeneration ) then ! range generation
2015-08-28 13:08:48 +05:30
do i = IO_intValue ( line , chunkPos , 1_pInt ) , &
IO_intValue ( line , chunkPos , 2_pInt ) , &
max ( 1_pInt , IO_intValue ( line , chunkPos , 3_pInt ) )
2012-06-15 21:40:21 +05:30
IO_continuousIntValues ( 1 ) = IO_continuousIntValues ( 1 ) + 1_pInt
IO_continuousIntValues ( 1 + IO_continuousIntValues ( 1 ) ) = i
enddo
2012-11-07 15:01:46 +05:30
else ! read individual elem nums
2015-09-05 21:56:55 +05:30
do i = 1_pInt , chunkPos ( 1 )
2012-06-15 21:40:21 +05:30
IO_continuousIntValues ( 1 ) = IO_continuousIntValues ( 1 ) + 1_pInt
2015-08-28 13:08:48 +05:30
IO_continuousIntValues ( 1 + IO_continuousIntValues ( 1 ) ) = IO_intValue ( line , chunkPos , i )
2012-06-15 21:40:21 +05:30
enddo
endif
enddo
#endif
2009-10-12 21:31:49 +05:30
2012-04-11 22:54:50 +05:30
100 end function IO_continuousIntValues
2007-04-25 20:08:22 +05:30
2012-11-07 15:01:46 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns format string for integer values without leading zeros
!--------------------------------------------------------------------------------------------------
2012-08-31 01:56:28 +05:30
pure function IO_intOut ( intToPrint )
2013-12-28 01:33:28 +05:30
2012-08-31 01:56:28 +05:30
implicit none
2015-08-14 10:33:54 +05:30
character ( len = 19 ) :: N_Digits ! maximum digits for 64 bit integer
character ( len = 40 ) :: IO_intOut
2012-08-31 01:56:28 +05:30
integer ( pInt ) , intent ( in ) :: intToPrint
2018-01-10 21:43:25 +05:30
2015-08-14 10:33:54 +05:30
write ( N_Digits , '(I19.19)' ) 1_pInt + int ( log10 ( real ( intToPrint ) ) , pInt )
2012-10-02 15:00:13 +05:30
IO_intOut = 'I' / / trim ( N_Digits ) / / '.' / / trim ( N_Digits )
2012-08-31 01:56:28 +05:30
end function IO_intOut
2012-10-02 15:00:13 +05:30
2013-02-25 22:04:59 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns time stamp
!--------------------------------------------------------------------------------------------------
function IO_timeStamp ( )
2013-12-28 01:33:28 +05:30
2013-02-25 22:04:59 +05:30
implicit none
character ( len = 10 ) :: IO_timeStamp
integer ( pInt ) , dimension ( 8 ) :: values
2018-01-10 21:43:25 +05:30
2013-02-25 22:04:59 +05:30
call DATE_AND_TIME ( VALUES = values )
write ( IO_timeStamp , '(i2.2,a1,i2.2,a1,i2.2)' ) values ( 5 ) , ':' , values ( 6 ) , ':' , values ( 7 )
end function IO_timeStamp
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief write error statements to standard out and terminate the Marc/spectral run with exit #9xxx
!> in ABAQUS either time step is reduced or execution terminated
!--------------------------------------------------------------------------------------------------
2017-05-16 01:23:25 +05:30
subroutine IO_error ( error_ID , el , ip , g , instance , ext_msg )
2013-12-28 01:33:28 +05:30
2007-03-20 19:25:22 +05:30
implicit none
2012-03-06 20:22:48 +05:30
integer ( pInt ) , intent ( in ) :: error_ID
2017-05-16 01:23:25 +05:30
integer ( pInt ) , optional , intent ( in ) :: el , ip , g , instance
2009-03-04 17:18:54 +05:30
character ( len = * ) , optional , intent ( in ) :: ext_msg
2018-01-10 21:43:25 +05:30
2013-12-28 01:33:28 +05:30
external :: quit
2012-03-06 20:22:48 +05:30
character ( len = 1024 ) :: msg
2013-01-10 03:49:32 +05:30
character ( len = 1024 ) :: formatString
2018-01-10 21:43:25 +05:30
2011-11-02 20:08:42 +05:30
select case ( error_ID )
2012-02-13 23:11:27 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! internal errors
2012-10-12 23:25:23 +05:30
case ( 0_pInt )
msg = 'internal check failed:'
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! file handling errors
2012-02-02 18:49:02 +05:30
case ( 100_pInt )
2012-02-13 23:11:27 +05:30
msg = 'could not open file:'
2012-02-02 18:49:02 +05:30
case ( 101_pInt )
2012-02-13 23:11:27 +05:30
msg = 'write error for file:'
2012-02-02 18:49:02 +05:30
case ( 102_pInt )
2012-02-13 23:11:27 +05:30
msg = 'could not read file:'
2012-02-02 18:49:02 +05:30
case ( 103_pInt )
2012-02-13 23:11:27 +05:30
msg = 'could not assemble input files'
2013-06-27 00:49:00 +05:30
case ( 104_pInt )
msg = '{input} recursion limit reached'
2013-12-12 22:39:59 +05:30
case ( 105_pInt )
msg = 'unknown output:'
2018-01-10 21:43:25 +05:30
2014-12-03 06:12:35 +05:30
!--------------------------------------------------------------------------------------------------
! lattice error messages
case ( 130_pInt )
msg = 'unknown lattice structure encountered'
case ( 131_pInt )
msg = 'hex lattice structure with invalid c/a ratio'
2015-06-11 13:53:27 +05:30
case ( 132_pInt )
msg = 'trans_lattice_structure not possible'
case ( 133_pInt )
msg = 'transformed hex lattice structure with invalid c/a ratio'
2014-12-03 06:12:35 +05:30
case ( 135_pInt )
msg = 'zero entry on stiffness diagonal'
2015-07-08 17:28:52 +05:30
case ( 136_pInt )
msg = 'zero entry on stiffness diagonal for transformed phase'
2014-12-03 06:12:35 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! material error messages and related messages in mesh
2012-02-02 18:49:02 +05:30
case ( 150_pInt )
2013-10-23 16:51:48 +05:30
msg = 'index out of bounds'
2012-02-13 23:11:27 +05:30
case ( 151_pInt )
2013-10-23 16:51:48 +05:30
msg = 'microstructure has no constituents'
2012-02-13 23:11:27 +05:30
case ( 153_pInt )
2011-08-02 15:44:16 +05:30
msg = 'sum of phase fractions differs from 1'
2012-02-13 23:11:27 +05:30
case ( 154_pInt )
msg = 'homogenization index out of bounds'
case ( 155_pInt )
msg = 'microstructure index out of bounds'
case ( 156_pInt )
msg = 'reading from ODF file'
2013-05-02 14:05:37 +05:30
case ( 157_pInt )
2013-07-24 16:39:39 +05:30
msg = 'illegal texture transformation specified'
2012-02-13 23:11:27 +05:30
case ( 160_pInt )
msg = 'no entries in config part'
2014-05-15 18:38:02 +05:30
case ( 165_pInt )
msg = 'homogenization configuration'
2012-02-13 23:11:27 +05:30
case ( 170_pInt )
msg = 'no homogenization specified via State Variable 2'
2012-02-02 18:49:02 +05:30
case ( 180_pInt )
2012-02-13 23:11:27 +05:30
msg = 'no microstructure specified via State Variable 3'
2013-04-10 15:08:40 +05:30
case ( 190_pInt )
msg = 'unknown element type:'
2012-02-13 23:11:27 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! plasticity error messages
2012-02-02 18:49:02 +05:30
case ( 200_pInt )
2018-01-10 21:43:25 +05:30
msg = 'unknown elasticity specified:'
2012-06-02 19:53:28 +05:30
case ( 201_pInt )
2013-11-27 13:34:05 +05:30
msg = 'unknown plasticity specified:'
2012-02-13 23:11:27 +05:30
2012-02-14 14:52:37 +05:30
case ( 210_pInt )
2012-07-17 23:06:24 +05:30
msg = 'unknown material parameter:'
2012-02-02 18:49:02 +05:30
case ( 211_pInt )
2012-07-17 23:06:24 +05:30
msg = 'material parameter out of bounds:'
2009-10-16 01:32:52 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
! numerics error messages
2012-02-13 23:11:27 +05:30
case ( 300_pInt )
msg = 'unknown numerics parameter:'
case ( 301_pInt )
msg = 'numerics parameter out of bounds:'
2018-01-10 21:43:25 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
! math errors
2012-02-13 23:11:27 +05:30
case ( 400_pInt )
msg = 'matrix inversion error'
case ( 401_pInt )
2017-09-15 00:55:22 +05:30
msg = 'math_check failed'
2012-02-13 23:11:27 +05:30
case ( 405_pInt )
2013-06-30 05:47:58 +05:30
msg = 'I_TO_HALTON-error: an input base BASE is <= 1'
2012-02-13 23:11:27 +05:30
case ( 406_pInt )
msg = 'Prime-error: N must be between 0 and PRIME_MAX'
2012-05-08 18:46:59 +05:30
case ( 407_pInt )
2012-06-02 19:53:28 +05:30
msg = 'Polar decomposition error'
2013-06-06 00:40:37 +05:30
case ( 409_pInt )
msg = 'math_check: R*v == q*v failed'
2015-12-15 01:34:59 +05:30
case ( 410_pInt )
msg = 'eigenvalues computation error'
2012-02-13 23:11:27 +05:30
2013-02-11 15:14:17 +05:30
!-------------------------------------------------------------------------------------------------
! homogenization errors
2012-02-13 23:11:27 +05:30
case ( 500_pInt )
msg = 'unknown homogenization specified'
2018-01-10 21:43:25 +05:30
2013-02-28 02:11:14 +05:30
!--------------------------------------------------------------------------------------------------
! user errors
case ( 600_pInt )
2013-04-16 22:37:27 +05:30
msg = 'Ping-Pong not possible when using non-DAMASK elements'
2013-02-28 02:11:14 +05:30
case ( 601_pInt )
2013-04-16 22:37:27 +05:30
msg = 'Ping-Pong needed when using non-local plasticity'
2013-10-16 18:08:00 +05:30
case ( 602_pInt )
2017-09-19 17:36:44 +05:30
msg = 'invalid selection for debug'
2012-02-13 23:11:27 +05:30
2013-02-11 15:14:17 +05:30
!-------------------------------------------------------------------------------------------------
! DAMASK_marc errors
2012-02-02 18:49:02 +05:30
case ( 700_pInt )
2012-02-13 23:11:27 +05:30
msg = 'invalid materialpoint result requested'
2017-10-04 20:48:06 +05:30
case ( 701_pInt )
msg = 'not supported input file format, use Marc 2016 or earlier'
2012-02-13 23:11:27 +05:30
2013-02-11 15:14:17 +05:30
!-------------------------------------------------------------------------------------------------
! errors related to spectral solver
2012-02-13 23:11:27 +05:30
case ( 809_pInt )
msg = 'initializing FFTW'
2015-07-09 19:08:21 +05:30
case ( 810_pInt )
msg = 'FFTW plan creation'
2012-02-13 23:11:27 +05:30
case ( 831_pInt )
msg = 'mask consistency violated in spectral loadcase'
case ( 832_pInt )
2015-07-09 19:08:21 +05:30
msg = 'ill-defined L (line partly defined) in spectral loadcase'
2012-02-13 23:11:27 +05:30
case ( 834_pInt )
msg = 'negative time increment in spectral loadcase'
case ( 835_pInt )
msg = 'non-positive increments in spectral loadcase'
case ( 836_pInt )
msg = 'non-positive result frequency in spectral loadcase'
case ( 837_pInt )
msg = 'incomplete loadcase'
case ( 838_pInt )
msg = 'mixed boundary conditions allow rotation'
2012-05-21 14:36:02 +05:30
case ( 841_pInt )
msg = 'missing header length info in spectral mesh'
2012-02-13 23:11:27 +05:30
case ( 842_pInt )
2012-05-21 14:36:02 +05:30
msg = 'homogenization in spectral mesh'
2012-02-13 23:11:27 +05:30
case ( 843_pInt )
2013-04-08 19:52:32 +05:30
msg = 'grid in spectral mesh'
2012-02-13 23:11:27 +05:30
case ( 844_pInt )
2013-04-08 19:52:32 +05:30
msg = 'size in spectral mesh'
2012-02-13 23:11:27 +05:30
case ( 845_pInt )
msg = 'incomplete information in spectral mesh header'
case ( 846_pInt )
msg = 'not a rotation defined for loadcase rotation'
case ( 847_pInt )
2013-01-10 03:49:32 +05:30
msg = 'update of gamma operator not possible when pre-calculated'
2012-02-13 23:11:27 +05:30
case ( 880_pInt )
msg = 'mismatch of microstructure count and a*b*c in geom file'
2012-08-29 00:49:47 +05:30
case ( 891_pInt )
msg = 'unknown solver type selected'
case ( 892_pInt )
msg = 'unknown filter type selected'
2015-12-15 01:34:59 +05:30
case ( 893_pInt )
msg = 'PETSc: SNES_DIVERGED_FNORM_NAN'
2016-03-27 00:25:44 +05:30
case ( 894_pInt )
msg = 'MPI error'
2018-01-10 21:43:25 +05:30
2013-02-11 15:14:17 +05:30
!-------------------------------------------------------------------------------------------------
! error messages related to parsing of Abaqus input file
2012-02-02 18:49:02 +05:30
case ( 900_pInt )
2013-01-10 03:49:32 +05:30
msg = 'improper definition of nodes in input file (Nnodes < 2)'
2012-02-02 18:49:02 +05:30
case ( 901_pInt )
2013-01-10 03:49:32 +05:30
msg = 'no elements defined in input file (Nelems = 0)'
2012-02-02 18:49:02 +05:30
case ( 902_pInt )
2013-01-10 03:49:32 +05:30
msg = 'no element sets defined in input file (No *Elset exists)'
2012-02-02 18:49:02 +05:30
case ( 903_pInt )
2013-01-10 03:49:32 +05:30
msg = 'no materials defined in input file (Look into section assigments)'
2012-02-02 18:49:02 +05:30
case ( 904_pInt )
2013-01-10 03:49:32 +05:30
msg = 'no elements could be assigned for Elset: '
2012-02-02 18:49:02 +05:30
case ( 905_pInt )
2013-01-10 03:49:32 +05:30
msg = 'error in mesh_abaqus_map_materials'
2012-02-02 18:49:02 +05:30
case ( 906_pInt )
2013-01-10 03:49:32 +05:30
msg = 'error in mesh_abaqus_count_cpElements'
2012-02-02 18:49:02 +05:30
case ( 907_pInt )
2013-01-10 03:49:32 +05:30
msg = 'size of mesh_mapFEtoCPelem in mesh_abaqus_map_elements'
2012-02-02 18:49:02 +05:30
case ( 908_pInt )
2013-01-10 03:49:32 +05:30
msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes'
2012-02-02 18:49:02 +05:30
case ( 909_pInt )
2018-01-10 21:43:25 +05:30
msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes'
2013-02-11 15:14:17 +05:30
!-------------------------------------------------------------------------------------------------
! general error messages
2012-02-13 23:11:27 +05:30
case ( 666_pInt )
msg = 'memory leak detected'
2007-03-20 19:25:22 +05:30
case default
2013-01-10 03:49:32 +05:30
msg = 'unknown error number...'
2012-02-13 23:11:27 +05:30
2007-03-20 19:25:22 +05:30
end select
2018-01-10 21:43:25 +05:30
2008-05-26 18:41:25 +05:30
!$OMP CRITICAL (write2out)
2017-05-16 01:23:25 +05:30
write ( 0 , '(/,a)' ) ' ┌' / / IO_DIVIDER / / '┐'
write ( 0 , '(a,24x,a,40x,a)' ) ' │' , 'error' , '│'
write ( 0 , '(a,24x,i3,42x,a)' ) ' │' , error_ID , '│'
write ( 0 , '(a)' ) ' ├' / / IO_DIVIDER / / '┤'
2017-05-01 07:18:06 +05:30
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a4,a' , max ( 1 , len ( trim ( msg ) ) ) , ',' , &
2017-05-16 01:23:25 +05:30
max ( 1 , 72 - len ( trim ( msg ) ) - 4 ) , 'x,a)'
write ( 0 , formatString ) '│ ' , trim ( msg ) , '│'
2013-01-10 03:49:32 +05:30
if ( present ( ext_msg ) ) then
2017-05-01 07:18:06 +05:30
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a4,a' , max ( 1 , len ( trim ( ext_msg ) ) ) , ',' , &
2017-05-16 01:23:25 +05:30
max ( 1 , 72 - len ( trim ( ext_msg ) ) - 4 ) , 'x,a)'
write ( 0 , formatString ) '│ ' , trim ( ext_msg ) , '│'
2009-03-04 17:18:54 +05:30
endif
2017-05-16 01:23:25 +05:30
if ( present ( el ) ) &
write ( 0 , '(a19,1x,i9,44x,a3)' ) ' │ at element ' , el , '│'
if ( present ( ip ) ) &
write ( 0 , '(a19,1x,i9,44x,a3)' ) ' │ at IP ' , ip , '│'
if ( present ( g ) ) &
write ( 0 , '(a19,1x,i9,44x,a3)' ) ' │ at constituent' , g , '│'
if ( present ( instance ) ) &
write ( 0 , '(a19,1x,i9,44x,a3)' ) ' │ at instance ' , instance , '│'
write ( 0 , '(a,69x,a)' ) ' │' , '│'
write ( 0 , '(a)' ) ' └' / / IO_DIVIDER / / '┘'
2017-02-13 03:29:14 +05:30
flush ( 0 )
2012-02-10 16:54:53 +05:30
call quit ( 9000_pInt + error_ID )
2010-02-18 15:42:45 +05:30
!$OMP END CRITICAL (write2out)
2009-01-20 00:40:58 +05:30
2012-03-06 20:22:48 +05:30
end subroutine IO_error
2007-03-20 19:25:22 +05:30
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief writes warning statement to standard out
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
subroutine IO_warning ( warning_ID , el , ip , g , ext_msg )
2009-03-31 14:51:57 +05:30
implicit none
2012-03-06 20:22:48 +05:30
integer ( pInt ) , intent ( in ) :: warning_ID
2013-09-18 19:37:55 +05:30
integer ( pInt ) , optional , intent ( in ) :: el , ip , g
2009-03-31 14:51:57 +05:30
character ( len = * ) , optional , intent ( in ) :: ext_msg
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
character ( len = 1024 ) :: msg
2013-01-10 03:49:32 +05:30
character ( len = 1024 ) :: formatString
2009-03-31 14:51:57 +05:30
2011-11-02 20:08:42 +05:30
select case ( warning_ID )
2014-12-03 06:12:35 +05:30
case ( 1_pInt )
msg = 'unknown key'
2012-02-02 18:49:02 +05:30
case ( 34_pInt )
2011-12-06 22:28:17 +05:30
msg = 'invalid restart increment given'
2012-02-02 18:49:02 +05:30
case ( 35_pInt )
2012-01-30 19:22:41 +05:30
msg = 'could not get $DAMASK_NUM_THREADS'
2012-06-15 21:40:21 +05:30
case ( 40_pInt )
2013-01-10 03:49:32 +05:30
msg = 'found spectral solver parameter'
2012-10-11 20:19:12 +05:30
case ( 42_pInt )
2013-01-10 03:49:32 +05:30
msg = 'parameter has no effect'
2014-06-18 14:40:16 +05:30
case ( 43_pInt )
msg = 'main diagonal of C66 close to zero'
2011-11-15 23:24:18 +05:30
case ( 47_pInt )
2013-01-10 03:49:32 +05:30
msg = 'no valid parameter for FFTW, using FFTW_PATIENT'
2013-09-12 20:17:09 +05:30
case ( 50_pInt )
2013-10-11 14:47:03 +05:30
msg = 'not all available slip system families are defined'
2013-09-12 20:17:09 +05:30
case ( 51_pInt )
2013-10-11 14:47:03 +05:30
msg = 'not all available twin system families are defined'
case ( 52_pInt )
msg = 'not all available parameters are defined'
2014-07-22 13:13:03 +05:30
case ( 53_pInt )
msg = 'not all available transformation system families are defined'
2011-11-02 20:08:42 +05:30
case ( 101_pInt )
2013-01-10 03:49:32 +05:30
msg = 'crystallite debugging off'
2013-02-06 22:11:09 +05:30
case ( 201_pInt )
msg = 'position not found when parsing line'
case ( 202_pInt )
msg = 'invalid character in string chunk'
case ( 203_pInt )
msg = 'interpretation of string chunk failed'
2011-11-02 20:08:42 +05:30
case ( 600_pInt )
2013-01-10 03:49:32 +05:30
msg = 'crystallite responds elastically'
2011-11-02 20:08:42 +05:30
case ( 601_pInt )
2013-01-10 03:49:32 +05:30
msg = 'stiffness close to zero'
2011-11-02 20:08:42 +05:30
case ( 650_pInt )
2013-01-10 03:49:32 +05:30
msg = 'polar decomposition failed'
2011-11-02 20:08:42 +05:30
case ( 700_pInt )
2013-01-10 03:49:32 +05:30
msg = 'unknown crystal symmetry'
2014-03-31 15:34:11 +05:30
case ( 850_pInt )
msg = 'max number of cut back exceeded, terminating'
2009-03-31 14:51:57 +05:30
case default
2013-01-10 03:49:32 +05:30
msg = 'unknown warning number'
2009-03-31 14:51:57 +05:30
end select
2018-01-10 21:43:25 +05:30
2009-03-31 14:51:57 +05:30
!$OMP CRITICAL (write2out)
2017-05-16 01:23:25 +05:30
write ( 6 , '(/,a)' ) ' ┌' / / IO_DIVIDER / / '┐'
write ( 6 , '(a,24x,a,38x,a)' ) ' │' , 'warning' , '│'
write ( 6 , '(a,24x,i3,42x,a)' ) ' │' , warning_ID , '│'
write ( 6 , '(a)' ) ' ├' / / IO_DIVIDER / / '┤'
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a4,a' , max ( 1 , len ( trim ( msg ) ) ) , ',' , &
max ( 1 , 72 - len ( trim ( msg ) ) - 4 ) , 'x,a)'
write ( 6 , formatString ) '│ ' , trim ( msg ) , '│'
2013-01-10 03:49:32 +05:30
if ( present ( ext_msg ) ) then
2017-05-16 01:23:25 +05:30
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a4,a' , max ( 1 , len ( trim ( ext_msg ) ) ) , ',' , &
max ( 1 , 72 - len ( trim ( ext_msg ) ) - 4 ) , 'x,a)'
write ( 6 , formatString ) '│ ' , trim ( ext_msg ) , '│'
2009-03-31 14:51:57 +05:30
endif
2017-05-16 01:23:25 +05:30
if ( present ( el ) ) &
write ( 6 , '(a19,1x,i9,44x,a3)' ) ' │ at element ' , el , '│'
if ( present ( ip ) ) &
write ( 6 , '(a19,1x,i9,44x,a3)' ) ' │ at IP ' , ip , '│'
if ( present ( g ) ) &
write ( 6 , '(a19,1x,i9,44x,a3)' ) ' │ at constituent' , g , '│'
write ( 6 , '(a,69x,a)' ) ' │' , '│'
write ( 6 , '(a)' ) ' └' / / IO_DIVIDER / / '┘'
2012-03-06 20:22:48 +05:30
flush ( 6 )
2010-04-06 12:17:15 +05:30
!$OMP END CRITICAL (write2out)
2009-03-31 14:51:57 +05:30
2012-03-06 20:22:48 +05:30
end subroutine IO_warning
2012-06-15 21:40:21 +05:30
2013-02-11 15:14:17 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
! internal helper functions
2013-02-11 15:14:17 +05:30
2013-09-18 19:37:55 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns verified integer value in given string
!--------------------------------------------------------------------------------------------------
integer ( pInt ) function IO_verifyIntValue ( string , validChars , myName )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
implicit none
2018-01-10 21:43:25 +05:30
character ( len = * ) , intent ( in ) :: string , & !< string for conversion to int value. Must not contain spaces!
2013-09-18 19:37:55 +05:30
validChars , & !< valid characters in string
myName !< name of caller function (for debugging)
integer ( pInt ) :: readStatus , invalidWhere
2014-02-06 23:18:01 +05:30
!character(len=len(trim(string))) :: trimmed does not work with ifort 14.0.1
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
IO_verifyIntValue = 0_pInt
2014-02-06 23:18:01 +05:30
invalidWhere = verify ( string , validChars )
2013-09-18 19:37:55 +05:30
if ( invalidWhere == 0_pInt ) then
2014-02-06 23:18:01 +05:30
read ( UNIT = string , iostat = readStatus , FMT = * ) IO_verifyIntValue ! no offending chars found
2018-02-02 19:36:13 +05:30
if ( readStatus / = 0_pInt ) & ! error during string to integer conversion
2015-09-10 15:56:09 +05:30
call IO_warning ( 203_pInt , ext_msg = myName / / '"' / / string / / '"' )
2013-09-18 19:37:55 +05:30
else
2015-09-10 15:56:09 +05:30
call IO_warning ( 202_pInt , ext_msg = myName / / '"' / / string / / '"' ) ! complain about offending characters
2014-02-06 23:18:01 +05:30
read ( UNIT = string ( 1_pInt : invalidWhere - 1_pInt ) , iostat = readStatus , FMT = * ) IO_verifyIntValue ! interpret remaining string
2018-02-02 19:36:13 +05:30
if ( readStatus / = 0_pInt ) & ! error during string to integer conversion
2015-09-10 15:56:09 +05:30
call IO_warning ( 203_pInt , ext_msg = myName / / '"' / / string ( 1_pInt : invalidWhere - 1_pInt ) / / '"' )
2013-09-18 19:37:55 +05:30
endif
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
end function IO_verifyIntValue
!--------------------------------------------------------------------------------------------------
!> @brief returns verified float value in given string
!--------------------------------------------------------------------------------------------------
real ( pReal ) function IO_verifyFloatValue ( string , validChars , myName )
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
implicit none
2018-01-10 21:43:25 +05:30
character ( len = * ) , intent ( in ) :: string , & !< string for conversion to int value. Must not contain spaces!
2013-09-18 19:37:55 +05:30
validChars , & !< valid characters in string
myName !< name of caller function (for debugging)
integer ( pInt ) :: readStatus , invalidWhere
2014-02-06 23:18:01 +05:30
!character(len=len(trim(string))) :: trimmed does not work with ifort 14.0.1
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
IO_verifyFloatValue = 0.0_pReal
2014-02-06 23:18:01 +05:30
invalidWhere = verify ( string , validChars )
2013-09-18 19:37:55 +05:30
if ( invalidWhere == 0_pInt ) then
2014-02-06 23:18:01 +05:30
read ( UNIT = string , iostat = readStatus , FMT = * ) IO_verifyFloatValue ! no offending chars found
2013-09-18 19:37:55 +05:30
if ( readStatus / = 0_pInt ) & ! error during string to float conversion
2015-09-10 15:56:09 +05:30
call IO_warning ( 203_pInt , ext_msg = myName / / '"' / / string / / '"' )
2013-09-18 19:37:55 +05:30
else
2015-09-10 15:56:09 +05:30
call IO_warning ( 202_pInt , ext_msg = myName / / '"' / / string / / '"' ) ! complain about offending characters
2014-02-06 23:18:01 +05:30
read ( UNIT = string ( 1_pInt : invalidWhere - 1_pInt ) , iostat = readStatus , FMT = * ) IO_verifyFloatValue ! interpret remaining string
2013-09-18 19:37:55 +05:30
if ( readStatus / = 0_pInt ) & ! error during string to float conversion
2015-09-10 15:56:09 +05:30
call IO_warning ( 203_pInt , ext_msg = myName / / '"' / / string ( 1_pInt : invalidWhere - 1_pInt ) / / '"' )
2013-09-18 19:37:55 +05:30
endif
2018-01-10 21:43:25 +05:30
2013-09-18 19:37:55 +05:30
end function IO_verifyFloatValue
2018-01-10 21:43:25 +05:30
#ifdef Abaqus
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief create a new input file for abaqus simulations by removing all comment lines and
2012-08-09 16:31:53 +05:30
!> including "include"s
!--------------------------------------------------------------------------------------------------
2012-03-06 20:22:48 +05:30
recursive function abaqus_assembleInputFile ( unit1 , unit2 ) result ( createSuccess )
2013-09-18 19:37:55 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName
2012-03-06 20:22:48 +05:30
implicit none
integer ( pInt ) , intent ( in ) :: unit1 , &
unit2
2018-01-10 21:43:25 +05:30
2012-03-07 15:37:29 +05:30
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-09-18 19:37:55 +05:30
character ( len = 65536 ) :: line , fname
2012-03-06 20:22:48 +05:30
logical :: createSuccess , fexist
do
2013-06-24 19:03:30 +05:30
read ( unit2 , '(A65536)' , END = 220 ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
2012-03-06 20:22:48 +05:30
2015-08-28 13:08:48 +05:30
if ( IO_lc ( IO_StringValue ( line , chunkPos , 1_pInt ) ) == '*include' ) then
2012-03-06 20:22:48 +05:30
fname = trim ( getSolverWorkingDirectoryName ( ) ) / / trim ( line ( 9 + scan ( line ( 9 : ) , '=' ) : ) )
inquire ( file = fname , exist = fexist )
if ( . not . ( fexist ) ) then
!$OMP CRITICAL (write2out)
write ( 6 , * ) 'ERROR: file does not exist error in abaqus_assembleInputFile'
write ( 6 , * ) 'filename: ' , trim ( fname )
!$OMP END CRITICAL (write2out)
createSuccess = . false .
return
endif
open ( unit2 + 1 , err = 200 , status = 'old' , file = fname )
if ( abaqus_assembleInputFile ( unit1 , unit2 + 1_pInt ) ) then
createSuccess = . true .
close ( unit2 + 1 )
else
createSuccess = . false .
return
endif
2012-05-15 20:29:26 +05:30
else if ( line ( 1 : 2 ) / = '**' . OR . line ( 1 : 8 ) == '**damask' ) then
2012-03-06 20:22:48 +05:30
write ( unit1 , '(A)' ) trim ( line )
endif
enddo
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
220 createSuccess = . true .
return
2018-01-10 21:43:25 +05:30
2012-03-06 20:22:48 +05:30
200 createSuccess = . false .
end function abaqus_assembleInputFile
2012-06-15 21:40:21 +05:30
#endif
2012-03-06 20:22:48 +05:30
end module IO