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
2012-02-10 16:54:53 +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
2014-03-12 13:03:51 +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 , &
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
#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
2012-06-15 21:40:21 +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
2012-06-18 20:57:01 +05:30
use , intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
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 )
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
2014-05-21 15:33:57 +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
!--------------------------------------------------------------------------------------------------
! 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 )
2013-06-27 00:49:00 +05:30
return
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 )
2012-04-20 17:28:41 +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
2014-12-03 06:12:35 +05:30
inquire ( unit = fileUnit , opened = fileOpened , read = fileRead )
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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief opens existing file for reading to given unit. Path to file is relative to working
!! 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
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
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 )
2013-06-27 00:49:00 +05:30
end subroutine IO_open_file
2012-06-18 20:57:01 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief opens existing file for reading to given unit. Path to file is relative to working
!! 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
2010-07-13 15:56:07 +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
2010-07-13 15:56:07 +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 )
2010-07-13 15:56:07 +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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +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_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 )
2012-02-13 23:11:27 +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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +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
!! 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
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 )
2012-02-13 23:11:27 +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
2013-12-11 22:19:20 +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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +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
!--------------------------------------------------------------------------------------------------
2013-12-28 01:33:28 +05:30
!> @brief opens ASCII file to given unit for writing. File is 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_jobFile ( fileUnit , ext )
2013-09-18 19:37:55 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName
2012-03-06 20:22:48 +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 )
2011-08-02 15:44:16 +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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is
!! 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 )
2013-09-18 19:37:55 +05:30
use DAMASK_interface , only : &
getSolverWorkingDirectoryName , &
getSolverJobName
2012-03-06 20:22:48 +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 )
2010-11-03 20:09:18 +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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is
!! 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
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 )
2012-08-16 17:27:15 +05:30
2013-09-18 19:37:55 +05:30
end subroutine IO_write_jobIntFile
2012-08-16 17:27:15 +05:30
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is
!! 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
2012-03-06 20:22:48 +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
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
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 * 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 )
2010-11-03 20:09:18 +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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is
!! 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
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
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
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 * 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 )
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
2007-03-21 18:02:15 +05:30
2012-03-06 20:22:48 +05:30
IO_abaqus_hasNoPart = . true .
2007-03-21 18:02:15 +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
2007-03-21 18:02:15 +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
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
!--------------------------------------------------------------------------------------------------
2015-04-11 15:58:10 +05:30
! parse header of ODF file
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
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
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 )
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
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 )
2015-08-28 13:08:48 +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 ) )
2013-09-18 19:37:55 +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
2007-03-21 18:02:15 +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 )
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
2015-05-11 02:25:36 +05:30
contains
!--------------------------------------------------------------------------------------------------
!> @brief counts hybrid IA repetitions
!--------------------------------------------------------------------------------------------------
integer ( pInt ) pure function hybridIA_reps ( dV_V , steps , C )
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
integer ( pInt ) :: phi1 , Phi , phi2
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
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
2009-03-04 17:18:54 +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
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
2012-03-06 20:22:48 +05:30
2013-09-18 19:37:55 +05:30
character ( len = * ) , intent ( in ) :: openChar , & !< indicates beginning of tag
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 )
2009-03-04 17:18:54 +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
2013-12-13 03:59:40 +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
exit
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
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
2013-12-13 03:59:40 +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
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
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-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
exit
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
2009-03-04 17:18:54 +05:30
endif
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
2013-12-13 03:59:40 +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
2012-03-09 20:52:52 +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
exit
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
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
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
2013-12-13 03:59:40 +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
exit
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 .
endif
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
!--------------------------------------------------------------------------------------------------
2015-08-28 13:08:48 +05:30
!> @brief locates all space-separated chunks in given string and returns array containing number
!! 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
2012-03-06 20:22:48 +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
2012-03-06 20:22:48 +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 )
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
if ( . not . present ( silent ) ) then
warn = . false .
else
warn = silent
endif
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 )
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
character ( len = ends ( myChunk + 1 ) - ends ( myChunk ) ) :: IO_fixedStringValue
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 )
2013-02-13 00:30:41 +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+-'
2013-02-13 00:30:41 +05:30
real ( pReal ) :: base
integer ( pInt ) :: expon
integer :: pos_exp
2013-02-06 22:11:09 +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 )
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'
character ( 26 ) , parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
2012-03-06 20:22:48 +05:30
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
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit , & !< file handle
2013-09-18 19:37:55 +05:30
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 )
2009-04-03 12:34:31 +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
2013-12-13 03:59:40 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit !< file handle
2012-03-06 20:22:48 +05:30
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
2014-05-21 15:33:57 +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
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
2012-03-06 20:22:48 +05:30
2012-06-15 21:40:21 +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
2014-05-21 15:33:57 +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
IO_countContinuousIntValues = 1_pInt + IO_intValue ( line , chunkPos , 3_pInt ) &
- IO_intValue ( line , chunkPos , 1_pInt )
2014-05-21 15:33:57 +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 )
2014-05-21 15:33:57 +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
2014-05-21 15:33:57 +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
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
!--------------------------------------------------------------------------------------------------
!> @brief return integer list corrsponding 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
2012-03-06 20:22:48 +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
2012-06-15 21:40:21 +05:30
integer ( pInt ) :: i
#ifdef Abaqus
integer ( pInt ) :: j , l , c , first , last
#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
do i = IO_intValue ( line , chunkPos , 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
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
2009-10-12 21:31:49 +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
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
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
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
!--------------------------------------------------------------------------------------------------
2013-09-18 19:37:55 +05:30
subroutine IO_error ( error_ID , el , ip , g , 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
2013-09-18 19:37:55 +05:30
integer ( pInt ) , optional , intent ( in ) :: el , ip , g
2009-03-04 17:18:54 +05:30
character ( len = * ) , optional , intent ( in ) :: ext_msg
2012-03-06 20:22:48 +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
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:'
2012-02-13 23:11:27 +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 )
2012-06-02 19:53:28 +05:30
msg = 'unknown elasticity specified:'
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
!--------------------------------------------------------------------------------------------------
! 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:'
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 )
2010-05-06 19:37:21 +05:30
msg = 'math_check: quat -> axisAngle -> quat failed'
2012-02-13 23:11:27 +05:30
case ( 402_pInt )
2010-05-06 19:37:21 +05:30
msg = 'math_check: quat -> R -> quat failed'
2012-02-13 23:11:27 +05:30
case ( 403_pInt )
2010-05-06 19:37:21 +05:30
msg = 'math_check: quat -> euler -> quat failed'
2012-02-13 23:11:27 +05:30
case ( 404_pInt )
2010-05-06 19:37:21 +05:30
msg = 'math_check: R -> euler -> R 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'
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 )
msg = 'invalid element/IP/component (grain) selected 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'
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'
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 )
2013-04-10 15:08:40 +05:30
msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes'
2010-07-13 15:56:07 +05:30
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
2009-01-20 00:40:58 +05:30
2008-05-26 18:41:25 +05:30
!$OMP CRITICAL (write2out)
2013-01-10 03:49:32 +05:30
write ( 6 , '(/,a)' ) ' +--------------------------------------------------------+'
write ( 6 , '(a)' ) ' + error +'
write ( 6 , '(a,i3,a)' ) ' + ' , error_ID , ' +'
write ( 6 , '(a)' ) ' + +'
2013-02-21 03:26:59 +05:30
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a2,a' , max ( 1 , len ( trim ( msg ) ) ) , ',' , &
max ( 1 , 60 - len ( trim ( msg ) ) - 5 ) , 'x,a)'
2013-01-10 03:49:32 +05:30
write ( 6 , formatString ) '+ ' , trim ( msg ) , '+'
if ( present ( ext_msg ) ) then
2013-02-21 03:26:59 +05:30
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a2,a' , max ( 1 , len ( trim ( ext_msg ) ) ) , ',' , &
max ( 1 , 60 - len ( trim ( ext_msg ) ) - 5 ) , 'x,a)'
2013-01-10 03:49:32 +05:30
write ( 6 , formatString ) '+ ' , trim ( ext_msg ) , '+'
endif
2013-09-18 19:37:55 +05:30
if ( present ( el ) ) then
if ( present ( ip ) ) then
2013-01-10 03:49:32 +05:30
if ( present ( g ) ) then
2013-09-18 19:37:55 +05:30
write ( 6 , '(a13,1x,i9,1x,a2,1x,i2,1x,a5,1x,i4,18x,a1)' ) ' + at element' , el , 'IP' , ip , 'grain' , g , '+'
2013-01-10 03:49:32 +05:30
else
2013-09-18 19:37:55 +05:30
write ( 6 , '(a13,1x,i9,1x,a2,1x,i2,29x,a1)' ) ' + at element' , el , 'IP' , ip , '+'
2013-01-10 03:49:32 +05:30
endif
2009-03-04 17:18:54 +05:30
else
2013-09-18 19:37:55 +05:30
write ( 6 , '(a13,1x,i9,35x,a1)' ) ' + at element' , el , '+'
2009-03-04 17:18:54 +05:30
endif
2013-09-18 19:37:55 +05:30
elseif ( present ( ip ) ) then ! now having the meaning of "instance"
write ( 6 , '(a15,1x,i9,33x,a1)' ) ' + for instance' , ip , '+'
2009-03-04 17:18:54 +05:30
endif
2013-01-10 03:49:32 +05:30
write ( 6 , '(a)' ) ' +--------------------------------------------------------+'
2012-03-06 20:22:48 +05:30
flush ( 6 )
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
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
!$OMP CRITICAL (write2out)
2013-01-10 03:49:32 +05:30
write ( 6 , '(/,a)' ) ' +--------------------------------------------------------+'
write ( 6 , '(a)' ) ' + warning +'
write ( 6 , '(a,i3,a)' ) ' + ' , warning_ID , ' +'
write ( 6 , '(a)' ) ' + +'
2013-02-21 03:26:59 +05:30
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a2,a' , max ( 1 , len ( trim ( msg ) ) ) , ',' , &
max ( 1 , 60 - len ( trim ( msg ) ) - 5 ) , 'x,a)'
2013-01-10 03:49:32 +05:30
write ( 6 , formatString ) '+ ' , trim ( msg ) , '+'
if ( present ( ext_msg ) ) then
2013-02-21 03:26:59 +05:30
write ( formatString , '(a,i6.6,a,i6.6,a)' ) '(1x,a2,a' , max ( 1 , len ( trim ( ext_msg ) ) ) , ',' , &
max ( 1 , 60 - len ( trim ( ext_msg ) ) - 5 ) , 'x,a)'
2013-01-10 03:49:32 +05:30
write ( 6 , formatString ) '+ ' , trim ( ext_msg ) , '+'
endif
2013-09-18 19:37:55 +05:30
if ( present ( el ) ) then
if ( present ( ip ) ) then
2010-11-04 23:48:01 +05:30
if ( present ( g ) ) then
2013-09-18 19:37:55 +05:30
write ( 6 , '(a13,1x,i9,1x,a2,1x,i2,1x,a5,1x,i4,18x,a1)' ) ' + at element' , el , 'IP' , ip , 'grain' , g , '+'
2010-11-04 23:48:01 +05:30
else
2013-09-18 19:37:55 +05:30
write ( 6 , '(a13,1x,i9,1x,a2,1x,i2,29x,a1)' ) ' + at element' , el , 'IP' , ip , '+'
2010-11-04 23:48:01 +05:30
endif
2009-03-31 14:51:57 +05:30
else
2013-09-18 19:37:55 +05:30
write ( 6 , '(a13,1x,i9,35x,a1)' ) ' + at element' , el , '+'
2009-03-31 14:51:57 +05:30
endif
endif
2013-01-10 03:49:32 +05:30
write ( 6 , '(a)' ) ' +--------------------------------------------------------+'
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
!--------------------------------------------------------------------------------------------------
! internal helper functions
2013-09-18 19:37:55 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns verified integer value in given string
!--------------------------------------------------------------------------------------------------
integer ( pInt ) function IO_verifyIntValue ( string , validChars , myName )
implicit none
2014-02-06 23:18:01 +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
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
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_verifyIntValue ! 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
end function IO_verifyIntValue
!--------------------------------------------------------------------------------------------------
!> @brief returns verified float value in given string
!--------------------------------------------------------------------------------------------------
real ( pReal ) function IO_verifyFloatValue ( string , validChars , myName )
implicit none
2014-02-06 23:18:01 +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
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
end function IO_verifyFloatValue
2012-06-15 21:40:21 +05:30
#ifdef Abaqus
2012-08-09 16:31:53 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief create a new input file for abaqus simulations by removing all comment lines and
!> 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
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
220 createSuccess = . true .
return
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