From 98528f9a89467cc17995af141b69a085cf57b80d Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Wed, 26 Jun 2013 19:19:00 +0000 Subject: [PATCH] added possibility for multi-level inclusion of files in *.config and loadcase files. include subfiles by stating {path/to/include} --- code/DAMASK_spectral_driver.f90 | 17 ++- code/DAMASK_spectral_utilities.f90 | 4 +- code/IO.f90 | 194 ++++++++++++++++++---------- code/constitutive_dislotwin.f90 | 18 +-- code/constitutive_j2.f90 | 23 ++-- code/constitutive_none.f90 | 15 ++- code/constitutive_nonlocal.f90 | 19 +-- code/constitutive_phenopowerlaw.f90 | 16 +-- code/constitutive_titanmod.f90 | 16 +-- code/crystallite.f90 | 17 +-- code/material.f90 | 102 ++++++++------- code/mesh.f90 | 24 ++-- code/numerics.f90 | 11 +- 13 files changed, 275 insertions(+), 201 deletions(-) diff --git a/code/DAMASK_spectral_driver.f90 b/code/DAMASK_spectral_driver.f90 index 79d2cef58..28832cdeb 100644 --- a/code/DAMASK_spectral_driver.f90 +++ b/code/DAMASK_spectral_driver.f90 @@ -40,6 +40,7 @@ program DAMASK_spectral_Driver getSolverJobName, & appendToOutFile use IO, only: & + IO_read, & IO_isBlank, & IO_open_file, & IO_stringPos, & @@ -111,7 +112,7 @@ program DAMASK_spectral_Driver N_t = 0_pInt, & !< # of time indicators found in load case file N_n = 0_pInt, & !< # of increment specifiers found in load case file N_def = 0_pInt !< # of rate of deformation specifiers found in load case file - character(len=1024) :: & + character(len=65536) :: & line !-------------------------------------------------------------------------------------------------- @@ -161,10 +162,11 @@ program DAMASK_spectral_Driver call IO_open_file(myUnit,trim(loadCaseFile)) rewind(myUnit) do - read(myUnit,'(a1024)',END = 100) line + line = IO_read(myUnit) + if (trim(line) == '#EOF#') exit if (IO_isBlank(line)) cycle ! skip empty lines positions = IO_stringPos(line,maxNchunks) - do i = 1_pInt, positions(1) ! reading compulsory parameters for loadcase + do i = 1_pInt, positions(1) ! reading compulsory parameters for loadcase select case (IO_lc(IO_stringValue(line,positions,i))) case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f') N_def = N_def + 1_pInt @@ -176,8 +178,8 @@ program DAMASK_spectral_Driver enddo ! count all identifiers to allocate memory and do sanity check enddo -100 if ((N_def /= N_n) .or. (N_n /= N_t)) & ! sanity check - call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase + if ((N_def /= N_n) .or. (N_n /= N_t)) & ! sanity check + call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase allocate (loadCases(N_n)) ! array of load cases loadCases%P%myType='p' @@ -185,7 +187,8 @@ program DAMASK_spectral_Driver ! reading the load case and assign values to the allocated data structure rewind(myUnit) do - read(myUnit,'(a1024)',END = 101) line + line = IO_read(myUnit) + if (trim(line) == '#EOF#') exit if (IO_isBlank(line)) cycle ! skip empty lines currentLoadCase = currentLoadCase + 1_pInt positions = IO_stringPos(line,maxNchunks) @@ -264,7 +267,7 @@ program DAMASK_spectral_Driver loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector) end select enddo; enddo -101 close(myUnit) + close(myUnit) !-------------------------------------------------------------------------------------------------- ! consistency checks and output of load case diff --git a/code/DAMASK_spectral_utilities.f90 b/code/DAMASK_spectral_utilities.f90 index 417991375..9358ad944 100644 --- a/code/DAMASK_spectral_utilities.f90 +++ b/code/DAMASK_spectral_utilities.f90 @@ -201,8 +201,8 @@ subroutine utilities_init() geomSize = mesh_spectral_getSize(fileUnit) close(fileUnit) - write(6,'(a,3(i12 ))') ' grid a b c: ', grid - write(6,'(a,3(f12.5))') ' size x y z: ', geomSize + write(6,'(a,3(i12 ))') ' grid a b c: ', grid + write(6,'(a,3(es12.5))') ' size x y z: ', geomSize !-------------------------------------------------------------------------------------------------- ! scale dimension to calculate either uncorrected, dimension-independent, or dimension- and reso- diff --git a/code/IO.f90 b/code/IO.f90 index 5419b47e1..a896c5689 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -34,6 +34,7 @@ module IO private public :: & IO_init, & + IO_read, & IO_checkAndRewind, & IO_open_file_stat, & IO_open_jobFile_stat, & @@ -108,9 +109,68 @@ subroutine IO_init end subroutine IO_init +!-------------------------------------------------------------------------------------------------- +!> @brief recursively reads a line from a file. +!> Recursion is triggered by "{path/to/inputfile}" in a line. +!-------------------------------------------------------------------------------------------------- +recursive function IO_read(myUnit) result(line) + + implicit none + integer(pInt), intent(in) :: myUnit + integer(pInt), dimension(10) :: unitOn = 0_pInt ! save the stack of recursive file units + integer(pInt) :: stack = 1_pInt ! current stack position + character(len=8192), dimension(10) :: pathOn = '' + character(len=512) :: path,input + integer(pInt) :: myStat + logical :: inUse + character(len=65536) :: line + + character(len=*), parameter :: sep = achar(47)//achar(92) ! forward and backward slash ("/", "\") + + unitOn(1) = myUnit + + read(unitOn(stack),'(a65536)',END=100) line + input = IO_getTag(line,'{','}') + +! --- normal case --- + if (input == '') return ! regular line + +! --- recursion case --- + if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached + + inquire(UNIT=unitOn(stack),NAME=path) ! path of current file + stack = stack+1_pInt + unitOn(stack) = unitOn(stack-1_pInt)+1_pInt ! assume next file unit to be free to use + pathOn(stack) = path(1:scan(path,sep,.true.))//input ! glue include to current file's dir + + do + inquire(UNIT=unitOn(stack),OPENED=inUse) + if (.not. inUse) exit + unitOn(stack) = unitOn(stack)+1_pInt ! test next fileunit + enddo + + open(unitOn(stack),status='old',iostat=myStat,file=pathOn(stack)) ! open included file + if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) + + line = IO_read(myUnit) + + return + +! --- end of file case --- +100 if (stack > 1_pInt) then ! can go back to former file + close(unitOn(stack)) + stack = stack-1_pInt + line = IO_read(myUnit) + else ! top-most file reached + line = '#EOF#' !< @ToDo should be made a module parameter + endif + +end function IO_read + + !-------------------------------------------------------------------------------------------------- !> @brief Checks if unit is opened for reading, if true rewinds. Otherwise stops with -!! error message 102 +!> error message 102 !-------------------------------------------------------------------------------------------------- subroutine IO_checkAndRewind(myUnit) @@ -125,6 +185,27 @@ implicit none end subroutine IO_checkAndRewind +!-------------------------------------------------------------------------------------------------- +!> @brief Open existing file to given unit path to file is relative to working directory +!-------------------------------------------------------------------------------------------------- +subroutine IO_open_file(myUnit,relPath) + use DAMASK_interface, only: & + getSolverWorkingDirectoryName + + implicit none + integer(pInt), intent(in) :: myUnit + character(len=*), intent(in) :: relPath + + integer(pInt) :: myStat + character(len=1024) :: path + + path = trim(getSolverWorkingDirectoryName())//relPath + open(myUnit,status='old',iostat=myStat,file=path) + if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) + +end subroutine IO_open_file + + !-------------------------------------------------------------------------------------------------- !> @brief Open existing file to given unit path to file is relative to working directory !-------------------------------------------------------------------------------------------------- @@ -146,49 +227,6 @@ logical function IO_open_file_stat(myUnit,relPath) end function IO_open_file_stat -!-------------------------------------------------------------------------------------------------- -!> @brief Open (write) file related to current job but with different extension to given unit -!-------------------------------------------------------------------------------------------------- -logical function IO_open_jobFile_stat(myUnit,newExt) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: newExt - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt - open(myUnit,status='old',iostat=myStat,file=path) - IO_open_jobFile_stat = (myStat == 0_pInt) - -end function IO_open_JobFile_stat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Open existing file to given unit path to file is relative to working directory -!-------------------------------------------------------------------------------------------------- -subroutine IO_open_file(myUnit,relPath) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName - - implicit none - integer(pInt), intent(in) :: myUnit - character(len=*), intent(in) :: relPath - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverWorkingDirectoryName())//relPath - open(myUnit,status='old',iostat=myStat,file=path) - if (myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=path) - -end subroutine IO_open_file - - !-------------------------------------------------------------------------------------------------- !> @brief Open (write) file related to current job but with different extension to given unit !-------------------------------------------------------------------------------------------------- @@ -212,6 +250,28 @@ subroutine IO_open_jobFile(myUnit,newExt) end subroutine IO_open_jobFile +!-------------------------------------------------------------------------------------------------- +!> @brief Open (write) file related to current job but with different extension to given unit +!-------------------------------------------------------------------------------------------------- +logical function IO_open_jobFile_stat(myUnit,newExt) + use DAMASK_interface, only: & + getSolverWorkingDirectoryName, & + getSolverJobName + + implicit none + integer(pInt), intent(in) :: myUnit + character(len=*), intent(in) :: newExt + + integer(pInt) :: myStat + character(len=1024) :: path + + path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//newExt + open(myUnit,status='old',iostat=myStat,file=path) + IO_open_jobFile_stat = (myStat == 0_pInt) + +end function IO_open_JobFile_stat + + #ifndef Spectral !-------------------------------------------------------------------------------------------------- !> @brief open FEM input file to given unit @@ -669,19 +729,19 @@ integer(pInt) function IO_countSections(myFile,part) IO_countSections = 0_pInt rewind(myFile) - do while (IO_getTag(line,'<','>') /= part) ! search for part - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myFile) enddo - do - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier IO_countSections = IO_countSections + 1_pInt enddo -100 end function IO_countSections +end function IO_countSections !-------------------------------------------------------------------------------------------------- @@ -709,12 +769,12 @@ function IO_countTagInPart(myFile,part,myTag,Nsections) section = 0_pInt rewind(myFile) - do while (IO_getTag(line,'<','>') /= part) ! search for part - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myFile) enddo - do - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier @@ -727,7 +787,7 @@ function IO_countTagInPart(myFile,part,myTag,Nsections) endif enddo -100 IO_countTagInPart = counter + IO_countTagInPart = counter end function IO_countTagInPart @@ -757,12 +817,12 @@ function IO_spotTagInPart(myFile,part,myTag,Nsections) line ='' rewind(myFile) - do while (IO_getTag(line,'<','>') /= part) ! search for part - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myFile) enddo - do - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier @@ -775,7 +835,7 @@ function IO_spotTagInPart(myFile,part,myTag,Nsections) endif enddo -100 end function IO_spotTagInPart + end function IO_spotTagInPart !-------------------------------------------------------------------------------------------------- @@ -800,12 +860,12 @@ logical function IO_globalTagInPart(myFile,part,myTag) line ='' rewind(myFile) - do while (IO_getTag(line,'<','>') /= part) ! search for part - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_getTag(line,'<','>') /= part) ! search for part + line = IO_read(myFile) enddo - do - read(myFile,'(a65536)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier @@ -818,7 +878,7 @@ logical function IO_globalTagInPart(myFile,part,myTag) endif enddo -100 end function IO_globalTagInPart +end function IO_globalTagInPart @@ -1140,7 +1200,7 @@ subroutine IO_skipChunks(myUnit,N) remainingChunks = N do while (remainingChunks > 0) - read(myUnit,'(A65536)',end=100) line + read(myUnit,'(a65536)',end=100) line myPos = IO_stringPos(line,maxNchunks) remainingChunks = remainingChunks - myPos(1) enddo @@ -1293,7 +1353,7 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN) do read(myUnit,'(A65536)',end=100) line myPos = IO_stringPos(line,maxNchunks) - if (myPos(1) < 1_pInt) then ! empty line + if (myPos(1) < 1_pInt) then ! empty line exit elseif (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name do i = 1_pInt, lookupMaxN ! loop over known set names @@ -1430,6 +1490,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) msg = 'could not read file:' case (103_pInt) msg = 'could not assemble input files' + case (104_pInt) + msg = '{input} recursion limit reached' !-------------------------------------------------------------------------------------------------- ! material error messages and related messages in mesh diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index 8b85e51d9..a14f2feb8 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -161,8 +161,8 @@ integer(pInt) :: section = 0_pInt, maxNinstance,mySize=0_pInt,myStructure,maxTot Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & Nchunks_SlipFamilies, Nchunks_TwinFamilies, & index_myFamily, index_otherFamily -character(len=64) tag -character(len=1024) :: line = '' ! to start initialized +character(len=65536) :: tag +character(len=65536) :: line = '' ! to start initialized write(6,'(/,a)') ' <<<+- constitutive_'//trim(constitutive_dislotwin_LABEL)//' init -+>>>' write(6,'(a)') ' $Id$' @@ -290,12 +290,12 @@ allocate(constitutive_dislotwin_sbSv(6,6,homogenization_maxNgrains,mesh_maxNips, !* Readout data from material.config file rewind(file) -do while (IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to - read(file,'(a1024)',END=100) line -enddo - -do ! read thru sections of phase part - read(file,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to + line = IO_read(file) + enddo + + do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(file) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') then ! next section @@ -449,7 +449,7 @@ do ! read thru sections of endif enddo -100 do i = 1_pInt,maxNinstance + do i = 1_pInt,maxNinstance constitutive_dislotwin_structure(i) = & lattice_initializeStructure(constitutive_dislotwin_structureName(i),constitutive_dislotwin_CoverA(i)) myStructure = constitutive_dislotwin_structure(i) diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index d069ff605..dbb826935 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -109,6 +109,7 @@ subroutine constitutive_j2_init(myFile) math_Mandel3333to66, & math_Voigt66to3333 use IO, only: & + IO_read, & IO_lc, & IO_getTag, & IO_isBlank, & @@ -131,8 +132,8 @@ subroutine constitutive_j2_init(myFile) integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions integer(pInt) :: section = 0_pInt, maxNinstance, i,o, mySize - character(len=64) :: tag - character(len=1024) :: line = '' ! to start initialized + character(len=65536) :: tag + character(len=65536) :: line = '' ! to start initialized write(6,'(/,a)') ' <<<+- constitutive_'//trim(constitutive_j2_LABEL)//' init -+>>>' write(6,'(a)') ' $Id$' @@ -192,23 +193,23 @@ subroutine constitutive_j2_init(myFile) rewind(myFile) - do while (IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to + line = IO_read(myFile) enddo - do ! read thru sections of phase part - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') then ! next section section = section + 1_pInt ! advance section counter cycle endif - if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - if (phase_plasticity(section) == constitutive_j2_LABEL) then ! one of my sections - i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase + if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + if (phase_plasticity(section) == constitutive_j2_LABEL) then ! one of my sections + i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase positions = IO_stringPos(line,maxNchunks) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) case ('plasticity','elasticity') cycle @@ -268,7 +269,7 @@ subroutine constitutive_j2_init(myFile) endif enddo -100 do i = 1_pInt,maxNinstance ! sanity checks + do i = 1_pInt,maxNinstance ! sanity checks if (constitutive_j2_structureName(i) == '') call IO_error(205_pInt,e=i) if (constitutive_j2_tau0(i) < 0.0_pReal) call IO_error(211_pInt,ext_msg='tau0 (' & //constitutive_j2_label//')') diff --git a/code/constitutive_none.f90 b/code/constitutive_none.f90 index 042d98d56..f1167ffa8 100644 --- a/code/constitutive_none.f90 +++ b/code/constitutive_none.f90 @@ -70,6 +70,7 @@ subroutine constitutive_none_init(myFile) math_Mandel3333to66, & math_Voigt66to3333 use IO, only: & + IO_read, & IO_lc, & IO_getTag, & IO_isBlank, & @@ -91,8 +92,8 @@ subroutine constitutive_none_init(myFile) integer(pInt), parameter :: MAXNCHUNKS = 7_pInt integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions integer(pInt) :: section = 0_pInt, maxNinstance, i - character(len=64) :: tag - character(len=1024) :: line = '' ! to start initialized + character(len=65536) :: tag + character(len=65536) :: line = '' ! to start initialized write(6,'(/,a)') ' <<<+- constitutive_'//trim(constitutive_none_LABEL)//' init -+>>>' write(6,'(a)') ' $Id$' @@ -118,12 +119,12 @@ subroutine constitutive_none_init(myFile) rewind(myFile) - do while (IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to + line = IO_read(myFile) enddo - do ! read thru sections of phase part - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') then ! next section @@ -165,7 +166,7 @@ subroutine constitutive_none_init(myFile) endif enddo -100 do i = 1_pInt,maxNinstance + do i = 1_pInt,maxNinstance if (constitutive_none_structureName(i) == '') call IO_error(205_pInt,e=i) enddo diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 803b77001..1f233a47d 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -226,7 +226,8 @@ use math, only: math_Mandel3333to66, & math_Voigt66to3333, & math_mul3x3, & math_transpose33 -use IO, only: IO_lc, & +use IO, only: IO_read, & + IO_lc, & IO_getTag, & IO_isBlank, & IO_stringPos, & @@ -275,8 +276,8 @@ integer(pInt) :: section = 0_pInt, & Nchunks_SlipSlip = 0_pInt, & Nchunks_SlipFamilies = 0_pInt, & mySize = 0_pInt ! to suppress warnings, safe as init is called only once -character(len=64) tag -character(len=1024) :: line = '' ! to start initialized +character(len=65536) tag +character(len=65536) :: line = '' ! to start initialized write(6,*) write(6,*) '<<<+- constitutive_',trim(CONSTITUTIVE_NONLOCAL_LABEL),' init -+>>>' @@ -419,12 +420,12 @@ nonSchmidCoeff = 0.0_pReal !*** readout data from material.config file rewind(myFile) -do while (IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to - read(myFile,'(a1024)',END=100) line +do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to + line = IO_read(myFile) enddo - -do ! read thru sections of phase part - read(myFile,'(a1024)',END=100) line + +do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') then ! next section @@ -591,7 +592,7 @@ do enddo -100 do i = 1_pInt,maxNinstance +do i = 1_pInt,maxNinstance constitutive_nonlocal_structure(i) = & lattice_initializeStructure(constitutive_nonlocal_structureName(i), CoverA(i)) ! our lattice structure is defined in the material.config file by the structureName (and the c/a ratio) diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 225a14dd0..624e2cd9e 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -136,8 +136,8 @@ subroutine constitutive_phenopowerlaw_init(myFile) Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & Nchunks_SlipFamilies, Nchunks_TwinFamilies, & mySize=0_pInt, myStructure, index_myFamily, index_otherFamily - character(len=64) :: tag - character(len=1024) :: line = '' ! to start initialized + character(len=65536) :: tag + character(len=65536) :: line = '' ! to start initialized write(6,'(/,a)') ' <<<+- constitutive_'//trim(constitutive_phenopowerlaw_LABEL)//' init -+>>>' write(6,'(a)') ' $Id$' @@ -240,12 +240,12 @@ subroutine constitutive_phenopowerlaw_init(myFile) rewind(myFile) - do while (IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to + line = IO_read(myFile) enddo - - do ! read thru sections of phase part - read(myFile,'(a1024)',END=100) line + + do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') then ! next section @@ -375,7 +375,7 @@ subroutine constitutive_phenopowerlaw_init(myFile) endif enddo -100 do i = 1_pInt,maxNinstance + do i = 1_pInt,maxNinstance constitutive_phenopowerlaw_structure(i) = lattice_initializeStructure(constitutive_phenopowerlaw_structureName(i), & ! get structure constitutive_phenopowerlaw_CoverA(i)) diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90 index 0463275be..f5d1b18b3 100644 --- a/code/constitutive_titanmod.f90 +++ b/code/constitutive_titanmod.f90 @@ -252,8 +252,8 @@ integer(pInt) :: section = 0_pInt,f,i,j,k,l,m,n,o,p,q,r,s,s1,s2,t,t1,t2,ns,nt,& Nchunks_SlipFamilies, Nchunks_TwinFamilies, & mySize,myStructure,maxTotalNslip,maxTotalNtwin integer :: maxNinstance !no pInt -character(len=64) :: tag -character(len=1024) :: line = '' ! to start initialized +character(len=65536) :: tag +character(len=65536) :: line = '' ! to start initialized write(6,'(/,a)') ' <<<+- constitutive_'//trim(constitutive_titanmod_LABEL)//' init -+>>>' write(6,'(a)') ' $Id$' @@ -415,12 +415,12 @@ allocate(constitutive_titanmod_interactionTwinTwin(lattice_maxNinteraction,maxNi !* Read data from material.config file rewind(file) -do while (IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to - read(file,'(a1024)',END=100) line +do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= 'phase') ! wind forward to + line = IO_read(file) enddo - - do ! read thru sections of phase part - read(file,'(a1024)',END=100) line + +do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(file) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') then ! next section @@ -628,7 +628,7 @@ enddo endif enddo -100 do i = 1_pInt,maxNinstance +do i = 1_pInt,maxNinstance constitutive_titanmod_structure(i) = & lattice_initializeStructure(constitutive_titanmod_structureName(i),constitutive_titanmod_CoverA(i)) myStructure = constitutive_titanmod_structure(i) diff --git a/code/crystallite.f90 b/code/crystallite.f90 index f4f315fcb..5818ad637 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -148,6 +148,7 @@ subroutine crystallite_init(Temperature) mesh_maxNips, & mesh_maxNipNeighbors use IO, only: & + IO_read, & IO_timeStamp, & IO_open_jobFile_stat, & IO_open_file, & @@ -198,8 +199,8 @@ subroutine crystallite_init(Temperature) mySize, & myPhase, & myMat - character(len=64) :: tag - character(len=1024) :: line + character(len=65536) :: tag + character(len=65536) :: line write(6,'(/,a)') ' <<<+- crystallite init -+>>>' write(6,'(a)') ' $Id$' @@ -270,13 +271,13 @@ subroutine crystallite_init(Temperature) endif line = '' section = 0_pInt - - do while (IO_lc(IO_getTag(line,'<','>')) /= material_partCrystallite) ! wind forward to - read(myFile,'(a1024)',END=100) line + + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= material_partCrystallite) ! wind forward to + line = IO_read(myFile) enddo - do ! read through sections of phase part - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'[',']') /= '') then ! next section @@ -294,7 +295,7 @@ subroutine crystallite_init(Temperature) endif enddo -100 close(myFile) + close(myFile) do i = 1_pInt,material_Ncrystallite do j = 1_pInt,crystallite_Noutput(i) diff --git a/code/material.f90 b/code/material.f90 index a0e5def1f..4519ec5ff 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -35,13 +35,13 @@ module material implicit none private character(len=64), parameter, public :: & - material_CONFIGFILE = 'material.config', & !< generic name for material configuration file - material_LOCALFILEEXT = 'materialConfig' !< extension of solver job name depending material configuration file + MATERIAL_configFile = 'material.config', & !< generic name for material configuration file + MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file character(len=32), parameter, public :: & - material_PARTHOMOGENIZATION = 'homogenization', & !< keyword for homogenization part - material_PARTCRYSTALLITE = 'crystallite', & !< keyword for crystallite part - material_PARTPHASE = 'phase' !< keyword for phase part + MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part + MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part + MATERIAL_partPhase = 'phase' !< keyword for phase part character(len=64), dimension(:), allocatable, public, protected :: & phase_elasticity, & !< elasticity of each phase @@ -83,8 +83,8 @@ module material character(len=32), parameter, private :: & - material_PARTMICROSTRUCTURE = 'microstructure', & !< keyword for microstructure part - material_PARTTEXTURE = 'texture' !< keyword for texture part + MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part + MATERIAL_partTexture = 'texture' !< keyword for texture part character(len=64), dimension(:), allocatable, private :: & microstructure_name, & !< name of each microstructure @@ -236,6 +236,7 @@ end subroutine material_init !-------------------------------------------------------------------------------------------------- subroutine material_parseHomogenization(myFile,myPart) use IO, only: & + IO_read, & IO_globalTagInPart, & IO_countSections, & IO_error, & @@ -257,9 +258,9 @@ subroutine material_parseHomogenization(myFile,myPart) integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt) Nsections, section, s - character(len=64) :: tag - character(len=1024) :: line - logical :: echo + character(len=65536) :: tag + character(len=65536) :: line + logical :: echo echo = IO_globalTagInPart(myFile,myPart,'/echo/') @@ -281,13 +282,13 @@ subroutine material_parseHomogenization(myFile,myPart) line = '' section = 0_pInt - do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart + line = IO_read(myFile) enddo if (echo) write(6,'(/,a)') trim(line) ! echo part header - do - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (echo) write(6,*) trim(line) ! echo back read lines @@ -311,7 +312,7 @@ subroutine material_parseHomogenization(myFile,myPart) endif enddo -100 homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) + homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) end subroutine material_parseHomogenization @@ -333,9 +334,9 @@ subroutine material_parseMicrostructure(myFile,myPart) integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions integer(pInt) :: Nsections, section, constituent, e, i - character(len=64) :: tag - character(len=1024) :: line - logical :: echo + character(len=65536) :: tag + character(len=65536) :: line + logical :: echo echo = IO_globalTagInPart(myFile,myPart,'/echo/') @@ -367,13 +368,13 @@ subroutine material_parseMicrostructure(myFile,myPart) section = 0_pInt ! - " - constituent = 0_pInt ! - " - - do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart + line = IO_read(myFile) enddo if (echo) write(6,'(/,a)') trim(line) ! echo part header - do - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (echo) write(6,*) trim(line) ! echo back read lines @@ -405,7 +406,7 @@ subroutine material_parseMicrostructure(myFile,myPart) endif enddo -100 end subroutine material_parseMicrostructure +end subroutine material_parseMicrostructure !-------------------------------------------------------------------------------------------------- @@ -413,6 +414,7 @@ subroutine material_parseMicrostructure(myFile,myPart) !-------------------------------------------------------------------------------------------------- subroutine material_parseCrystallite(myFile,myPart) use IO, only: & + IO_read, & IO_countSections, & IO_error, & IO_countTagInPart, & @@ -425,10 +427,10 @@ subroutine material_parseCrystallite(myFile,myPart) character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: myFile - integer(pInt) :: Nsections, & - section - character(len=1024) :: line - logical :: echo + integer(pInt) :: Nsections, & + section + character(len=65536) :: line + logical :: echo echo = IO_globalTagInPart(myFile,myPart,'/echo/') @@ -445,13 +447,13 @@ subroutine material_parseCrystallite(myFile,myPart) line = '' section = 0_pInt - do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart + line = IO_read(myFile) enddo if (echo) write(6,'(/,a)') trim(line) ! echo part header - do - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (echo) write(6,*) trim(line) ! echo back read lines @@ -461,7 +463,7 @@ subroutine material_parseCrystallite(myFile,myPart) endif enddo -100 end subroutine material_parseCrystallite +end subroutine material_parseCrystallite !-------------------------------------------------------------------------------------------------- @@ -469,6 +471,7 @@ subroutine material_parseCrystallite(myFile,myPart) !-------------------------------------------------------------------------------------------------- subroutine material_parsePhase(myFile,myPart) use IO, only: & + IO_read, & IO_globalTagInPart, & IO_countSections, & IO_error, & @@ -488,9 +491,9 @@ subroutine material_parsePhase(myFile,myPart) integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt) Nsections, section, s - character(len=64) :: tag - character(len=1024) :: line - logical :: echo + character(len=65536) :: tag + character(len=65536) :: line + logical :: echo echo = IO_globalTagInPart(myFile,myPart,'/echo/') @@ -513,13 +516,13 @@ subroutine material_parsePhase(myFile,myPart) line = '' section = 0_pInt - do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart + line = IO_read(myFile) enddo - if (echo) write(6,*) trim(line) ! echo part header + if (echo) write(6,'(/,a)') trim(line) ! echo part header - do - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (echo) write(6,'(/,a)') trim(line) ! echo back read lines @@ -547,7 +550,7 @@ subroutine material_parsePhase(myFile,myPart) endif enddo -100 end subroutine material_parsePhase +end subroutine material_parsePhase !-------------------------------------------------------------------------------------------------- @@ -555,6 +558,7 @@ subroutine material_parsePhase(myFile,myPart) !-------------------------------------------------------------------------------------------------- subroutine material_parseTexture(myFile,myPart) use IO, only: & + IO_read, & IO_globalTagInPart, & IO_countSections, & IO_error, & @@ -580,9 +584,9 @@ subroutine material_parseTexture(myFile,myPart) integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt) :: Nsections, section, gauss, fiber, j - character(len=64) :: tag - character(len=1024) :: line - logical :: echo + character(len=65536) :: tag + character(len=65536) :: line + logical :: echo echo = IO_globalTagInPart(myFile,myPart,'/echo/') @@ -614,13 +618,13 @@ subroutine material_parseTexture(myFile,myPart) gauss = 0_pInt ! - " - fiber = 0_pInt ! - " - - do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#' .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart + line = IO_read(myFile) enddo if (echo) write(6,'(/,a)') trim(line) ! echo part header - do - read(myFile,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') + line = IO_read(myFile) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (echo) write(6,'(a)') trim(line) ! echo back read lines @@ -725,7 +729,7 @@ subroutine material_parseTexture(myFile,myPart) endif enddo -100 end subroutine material_parseTexture +end subroutine material_parseTexture !-------------------------------------------------------------------------------------------------- diff --git a/code/mesh.f90 b/code/mesh.f90 index ac9c6cd45..62e8c791a 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -2026,9 +2026,9 @@ function mesh_deformedCoordsLinear(gDim,F,FavgIn) result(coords) !-------------------------------------------------------------------------------------------------- ! report if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Restore geometry using linear integration' - write(6,'(a,3(i12 ))') ' grid a b c: ', iRes - write(6,'(a,3(f12.5))') ' size x y z: ', gDim + write(6,'(a)') ' Restore geometry using linear integration' + write(6,'(a,3(i12 ))') ' grid a b c: ', iRes + write(6,'(a,3(es12.5))') ' size x y z: ', gDim endif !-------------------------------------------------------------------------------------------------- @@ -2166,9 +2166,9 @@ function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) result(coords) !-------------------------------------------------------------------------------------------------- ! report if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Restore geometry using FFT-based integration' - write(6,'(a,3(i12 ))') ' grid a b c: ', iRes - write(6,'(a,3(f12.5))') ' size x y z: ', gDim + write(6,'(a)') ' Restore geometry using FFT-based integration' + write(6,'(a,3(i12 ))') ' grid a b c: ', iRes + write(6,'(a,3(es12.5))') ' size x y z: ', gDim endif !-------------------------------------------------------------------------------------------------- @@ -2311,9 +2311,9 @@ function mesh_volumeMismatch(gDim,F,nodes) result(vMismatch) !-------------------------------------------------------------------------------------------------- ! report and check if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Calculating volume mismatch' - write(6,'(a,3(i12 ))') ' grid a b c: ', iRes - write(6,'(a,3(f12.5))') ' size x y z: ', gDim + write(6,'(a)') ' Calculating volume mismatch' + write(6,'(a,3(i12 ))') ' grid a b c: ', iRes + write(6,'(a,3(es12.5))') ' size x y z: ', gDim endif if (any([iRes/=size(nodes,2)-1_pInt,iRes/=size(nodes,3)-1_pInt,iRes/=size(nodes,4)-1_pInt]))& @@ -2383,9 +2383,9 @@ function mesh_shapeMismatch(gDim,F,nodes,centres) result(sMismatch) !-------------------------------------------------------------------------------------------------- ! report and check if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Calculating shape mismatch' - write(6,'(a,3(i12 ))') ' grid a b c: ', iRes - write(6,'(a,3(f12.5))') ' size x y z: ', gDim + write(6,'(a)') ' Calculating shape mismatch' + write(6,'(a,3(i12 ))') ' grid a b c: ', iRes + write(6,'(a,3(es12.5))') ' size x y z: ', gDim endif if(any([iRes/=size(nodes,2)-1_pInt,iRes/=size(nodes,3)-1_pInt,iRes/=size(nodes,4)-1_pInt]) .or.& diff --git a/code/numerics.f90 b/code/numerics.f90 index b0cb978f4..a58223b8a 100644 --- a/code/numerics.f90 +++ b/code/numerics.f90 @@ -126,6 +126,7 @@ contains subroutine numerics_init use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use IO, only: & + IO_read, & IO_error, & IO_open_file_stat, & IO_isBlank, & @@ -148,8 +149,8 @@ subroutine numerics_init maxNchunks = 2_pInt !$ integer :: gotDAMASK_NUM_THREADS = 1 integer(pInt), dimension(1+2*maxNchunks) :: positions - character(len=64) :: tag - character(len=1024) :: line + character(len=65536) :: tag + character(len=65536) :: line !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS write(6,'(/,a)') ' <<<+- numerics init -+>>>' @@ -172,8 +173,8 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! read variables from config file and overwrite default parameters if keyword is present line = '' - do - read(fileunit,'(a1024)',END=100) line + do while (trim(line) /= '#EOF#') ! read thru sections of phase part + line = IO_read(fileunit) if (IO_isBlank(line)) cycle ! skip empty lines positions = IO_stringPos(line,maxNchunks) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key @@ -329,7 +330,7 @@ subroutine numerics_init call IO_error(300_pInt,ext_msg=tag) endselect enddo - 100 close(fileunit) + close(fileunit) else fileExists write(6,'(a,/)') ' using standard values'