diff --git a/code/DAMASK_run.py b/code/DAMASK_run.py deleted file mode 100755 index 6b90de98d..000000000 --- a/code/DAMASK_run.py +++ /dev/null @@ -1,80 +0,0 @@ -#!/usr/bin/env python -# -*- coding: UTF-8 no BOM -*- - -import numpy,os,damask,string,sys,subprocess,re -from optparse import OptionParser, Option - -# ----------------------------- -class extendableOption(Option): -# ----------------------------- -# used for definition of new option parser action 'extend', which enables to take multiple option arguments -# taken from online tutorial http://docs.python.org/library/optparse.html - - ACTIONS = Option.ACTIONS + ("extend",) - STORE_ACTIONS = Option.STORE_ACTIONS + ("extend",) - TYPED_ACTIONS = Option.TYPED_ACTIONS + ("extend",) - ALWAYS_TYPED_ACTIONS = Option.ALWAYS_TYPED_ACTIONS + ("extend",) - - def take_action(self, action, dest, opt, value, values, parser): - if action == "extend": - lvalue = value.split(",") - values.ensure_value(dest, []).extend(lvalue) - else: - Option.take_action(self, action, dest, opt, value, values, parser) - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- - -parser = OptionParser(option_class=extendableOption, usage='%prog options [file[s]]', description = """ -Add column(s) with derived values according to user defined arithmetic operation between column(s). -Columns can be specified either by label or index. - -Example: distance to IP coordinates -- "math.sqrt( #ip.x#**2 + #ip.y#**2 + #ip.z#**2 )" -""" + string.replace('$Id$','\n','\\n') -) - -parser.add_option('-l','--load', '--loadcase', dest='loadcase', type='string', \ - help='PathToLoadFile/NameOfLoadFile.load. "PathToLoadFile" will be the working directory.') -parser.add_option('-g','--geom', '--geometry', dest='geometry', type='string', \ - help='PathToGeomFile/NameOfGeomFile.load.') - -parser.set_defaults(loadcase= '') -parser.set_defaults(geometry= '') - -(options,filenames) = parser.parse_args() -start = 1 -exitCode=2 -print 'load case', options.loadcase -print 'geometry', options.geometry -res=numpy.array([32,32,32]) -while exitCode == 2: - print 'restart at ', start - proc=subprocess.Popen(executable='DAMASK_spectral',\ - args=['-l', '%s'%options.loadcase, '-g', '%s'%options.geometry, '--regrid', '%i'%start],\ - stderr=subprocess.PIPE,stdout=subprocess.PIPE, bufsize=1) - while proc.poll() is None: # while process is running - myLine = proc.stdout.readline() - if len(myLine)>1: print myLine[0:-1] # print output without extra newline - exitCode = proc.returncode - err = proc.stderr.readlines() - print '-------------------------------------------------------' - print 'error messages', err - print '-------------------------------------------------------' - if exitCode==2: - os.system('rm -rf %i'%start) - os.system('mkdir %i'%start) - os.system('cp * %i/.'%start) - for i in xrange(len(err)): - if re.search('restart at\s+\d+',err[i]): start=int(string.split(err[i])[2]) -#------------regridding---------------------------------------------- -#-------------------------------------------------------------------- - damask.core.prec.init() - damask.core.DAMASK_interface.init(options.loadcase,options.geometry) - damask.core.IO.init() - damask.core.numerics.init() - damask.core.debug.init() - damask.core.math.init() - damask.core.FEsolving.init() - damask.core.mesh.init(1,1) - damask.core.mesh.regrid(adaptive=True,resNewInput=res) diff --git a/code/DAMASK_spectral_driver.f90 b/code/DAMASK_spectral_driver.f90 index ebbfdeeac..111c56e3c 100644 --- a/code/DAMASK_spectral_driver.f90 +++ b/code/DAMASK_spectral_driver.f90 @@ -91,11 +91,8 @@ program DAMASK_spectral_Driver ! variables related to information from load case and geom file real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors - integer(pInt), parameter :: MAXNCHUNKS = (1_pInt + 9_pInt)*3_pInt + & ! deformation, rotation, and stress - (1_pInt + 1_pInt)*5_pInt + & ! time, (log)incs, temp, restartfrequency, and outputfrequency - 1_pInt, & ! dropguessing - FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature - integer(pInt), dimension(1_pInt + MAXNCHUNKS*2_pInt) :: positions ! this is longer than needed for geometry parsing + integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & N_t = 0_pInt, & !< # of time indicators found in load case file @@ -178,9 +175,9 @@ program DAMASK_spectral_Driver line = IO_read(FILEUNIT) if (trim(line) == IO_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 - select case (IO_lc(IO_stringValue(line,positions,i))) + chunkPos = IO_stringPos(line) + do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase + select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f') N_def = N_def + 1_pInt case('t','time','delta') @@ -188,7 +185,7 @@ program DAMASK_spectral_Driver case('n','incs','increments','steps','logincs','logincrements','logsteps') N_n = N_n + 1_pInt end select - enddo ! count all identifiers to allocate memory and do sanity check + enddo ! count all identifiers to allocate memory and do sanity check enddo if ((N_def /= N_n) .or. (N_n /= N_t)) & ! sanity check @@ -218,24 +215,24 @@ program DAMASK_spectral_Driver if (trim(line) == IO_EOF) exit if (IO_isBlank(line)) cycle ! skip empty lines currentLoadCase = currentLoadCase + 1_pInt - positions = IO_stringPos(line,MAXNCHUNKS) - do i = 1_pInt, positions(1) - select case (IO_lc(IO_stringValue(line,positions,i))) + chunkPos = IO_stringPos(line) + do i = 1_pInt, chunkPos(1) + select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix temp_valueVector = 0.0_pReal - if (IO_lc(IO_stringValue(line,positions,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot - IO_lc(IO_stringValue(line,positions,i)) == 'dotf') then + if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot + IO_lc(IO_stringValue(line,chunkPos,i)) == 'dotf') then loadCases(currentLoadCase)%deformation%myType = 'fdot' - else if (IO_lc(IO_stringValue(line,positions,i)) == 'f') then + else if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'f') then loadCases(currentLoadCase)%deformation%myType = 'f' else loadCases(currentLoadCase)%deformation%myType = 'l' endif do j = 1_pInt, 9_pInt - temp_maskVector(j) = IO_stringValue(line,positions,i+j) /= '*' ! true if not a * + temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a * enddo do j = 1_pInt,9_pInt - if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,positions,i+j) ! read value where applicable + if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation transpose(reshape(temp_maskVector,[ 3,3])) @@ -245,34 +242,34 @@ program DAMASK_spectral_Driver case('p','pk1','piolakirchhoff','stress', 's') temp_valueVector = 0.0_pReal do j = 1_pInt, 9_pInt - temp_maskVector(j) = IO_stringValue(line,positions,i+j) /= '*' ! true if not an asterisk + temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk enddo do j = 1_pInt,9_pInt - if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,positions,i+j) ! read value where applicable + if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo loadCases(currentLoadCase)%P%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) loadCases(currentLoadCase)%P%maskFloat = merge(ones,zeros,& loadCases(currentLoadCase)%P%maskLogical) loadCases(currentLoadCase)%P%values = math_plain9to33(temp_valueVector) case('t','time','delta') ! increment time - loadCases(currentLoadCase)%time = IO_floatValue(line,positions,i+1_pInt) + loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) case('n','incs','increments','steps') ! number of increments - loadCases(currentLoadCase)%incs = IO_intValue(line,positions,i+1_pInt) + loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) - loadCases(currentLoadCase)%incs = IO_intValue(line,positions,i+1_pInt) + loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) loadCases(currentLoadCase)%logscale = 1_pInt case('freq','frequency','outputfreq') ! frequency of result writings - loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,positions,i+1_pInt) + loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) case('r','restart','restartwrite') ! frequency of writing restart information loadCases(currentLoadCase)%restartfrequency = & - max(0_pInt,IO_intValue(line,positions,i+1_pInt)) + max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) case('guessreset','dropguessing') loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory case('euler') ! rotation of currentLoadCase given in euler angles temp_valueVector = 0.0_pReal l = 1_pInt ! assuming values given in degrees k = 1_pInt ! assuming keyword indicating degree/radians present - select case (IO_lc(IO_stringValue(line,positions,i+1_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt))) case('deg','degree') case('rad','radian') ! don't convert from degree to radian l = 0_pInt @@ -280,14 +277,14 @@ program DAMASK_spectral_Driver k = 0_pInt end select do j = 1_pInt, 3_pInt - temp_valueVector(j) = IO_floatValue(line,positions,i+k+j) + temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j) enddo if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad loadCases(currentLoadCase)%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix case('rotation','rot') ! assign values for the rotation of currentLoadCase matrix temp_valueVector = 0.0_pReal do j = 1_pInt, 9_pInt - temp_valueVector(j) = IO_floatValue(line,positions,i+j) + temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) enddo loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector) end select diff --git a/code/DAMASK_spectral_interface.f90 b/code/DAMASK_spectral_interface.f90 index 29973707f..2ba13cf3e 100644 --- a/code/DAMASK_spectral_interface.f90 +++ b/code/DAMASK_spectral_interface.f90 @@ -66,10 +66,8 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn) integer :: & i, & worldrank = 0 - integer, parameter :: & - MAXNCHUNKS = 128 !< DAMASK_spectral + (l,g,w,r)*2 + h - integer, dimension(1+ 2* MAXNCHUNKS) :: & - positions + integer, allocatable, dimension(:) :: & + chunkPos integer, dimension(8) :: & dateAndTime ! type default integer #ifdef PETSc @@ -102,9 +100,9 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn) commandLine = 'n/a' else if ( .not.( present(loadcaseParameterIn) .and. present(geometryParameterIn))) then ! none parameters given in function call, trying to get them from command line call get_command(commandLine) - positions = IIO_stringPos(commandLine,MAXNCHUNKS) - do i = 1, positions(1) - tag = IIO_lc(IIO_stringValue(commandLine,positions,i)) ! extract key + chunkPos = IIO_stringPos(commandLine) + do i = 1, chunkPos(1) + tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key select case(tag) case ('-h','--help') mainProcess2: if (worldrank == 0) then @@ -164,16 +162,16 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn) call quit(0_pInt) ! normal Termination endif mainProcess2 case ('-l', '--load', '--loadcase') - loadcaseArg = IIO_stringValue(commandLine,positions,i+1_pInt) + loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) case ('-g', '--geom', '--geometry') - geometryArg = IIO_stringValue(commandLine,positions,i+1_pInt) + geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') - workingDirArg = IIO_stringValue(commandLine,positions,i+1_pInt) + workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) case ('-r', '--rs', '--restart') - spectralRestartInc = IIO_IntValue(commandLine,positions,i+1_pInt) + spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) appendToOutFile = .true. case ('--rg', '--regrid') - spectralRestartInc = IIO_IntValue(commandLine,positions,i+1_pInt) + spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) appendToOutFile = .false. end select enddo @@ -477,38 +475,40 @@ end function getPathSep !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_stringValue for documentation !-------------------------------------------------------------------------------------------------- -pure function IIO_stringValue(line,positions,myPos) +pure function IIO_stringValue(string,chunkPos,myChunk) implicit none - integer(pInt), intent(in) :: positions(*), & - myPos - character(len=1+positions(myPos*2+1)-positions(myPos*2)) :: IIO_stringValue - character(len=*), intent(in) :: line + 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=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - if (positions(1) < myPos) then + + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then IIO_stringValue = '' - else - IIO_stringValue = line(positions(myPos*2):positions(myPos*2+1)) - endif + else valuePresent + IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) + endif valuePresent end function IIO_stringValue !-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_stringValue for documentation +!> @brief taken from IO, check IO_intValue for documentation !-------------------------------------------------------------------------------------------------- -integer(pInt) pure function IIO_intValue(line,positions,myPos) +integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk) + + implicit none + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer(pInt), intent(in) :: myChunk !< position number of desired sub string + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - implicit none - character(len=*), intent(in) :: line - integer(pInt), intent(in) :: positions(*), & - myPos - if (positions(1) < myPos) then + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then IIO_intValue = 0_pInt - else - read(UNIT=line(positions(myPos*2):positions(myPos*2+1)),ERR=100,FMT=*) IIO_intValue - endif + else valuePresent + read(UNIT=string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),ERR=100,FMT=*) IIO_intValue + endif valuePresent return 100 IIO_intValue = huge(1_pInt) @@ -518,20 +518,21 @@ end function IIO_intValue !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_lc for documentation !-------------------------------------------------------------------------------------------------- -pure function IIO_lc(line) +pure function IIO_lc(string) implicit none - character(26), parameter :: lower = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - character(len=*), intent(in) :: line - character(len=len(line)) :: IIO_lc + character(len=*), intent(in) :: string !< string to convert + character(len=len(string)) :: IIO_lc + + character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' + character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' integer :: i,n ! no pInt (len returns default integer) - IIO_lc = line - do i=1,len(line) - n = index(upper,IIO_lc(i:i)) - if (n/=0) IIO_lc(i:i) = lower(n:n) + IIO_lc = string + do i=1,len(string) + n = index(UPPER,IIO_lc(i:i)) + if (n/=0) IIO_lc(i:i) = LOWER(n:n) enddo end function IIO_lc @@ -540,29 +541,23 @@ end function IIO_lc !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_stringPos for documentation !-------------------------------------------------------------------------------------------------- -pure function IIO_stringPos(string,N) +pure function IIO_stringPos(string) implicit none - integer(pInt), intent(in) :: N !< maximum number of parts - integer(pInt), dimension(1_pInt+N*2_pInt) :: IIO_stringPos - character(len=*), intent(in) :: string !< string in which parts are searched for + integer(pInt), dimension(:), allocatable :: IIO_stringPos + character(len=*), intent(in) :: string !< string in which chunks are searched for character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces integer :: left, right ! no pInt (verify and scan return default integer) - - IIO_stringPos = -1_pInt - IIO_stringPos(1) = 0_pInt + allocate(IIO_stringPos(1), source=0_pInt) right = 0 do while (verify(string(right+1:),SEP)>0) left = right + verify(string(right+1:),SEP) right = left + scan(string(left:),SEP) - 2 if ( string(left:left) == '#' ) exit - if ( IIO_stringPos(1) 0_pInt - restartRead = iand(IO_intValue(line,positions,1_pInt),2_pInt) > 0_pInt + chunkPos = IO_stringPos(line) + restartWrite = iand(IO_intValue(line,chunkPos,1_pInt),1_pInt) > 0_pInt + restartRead = iand(IO_intValue(line,chunkPos,1_pInt),2_pInt) > 0_pInt case ('*restart') - do j=2_pInt,positions(1) - restartWrite = (IO_lc(IO_StringValue(line,positions,j)) == 'write') .or. restartWrite - restartRead = (IO_lc(IO_StringValue(line,positions,j)) == 'read') .or. restartRead + do j=2_pInt,chunkPos(1) + restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite + restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead enddo if(restartWrite) then - do j=2_pInt,positions(1) - restartWrite = (IO_lc(IO_StringValue(line,positions,j)) /= 'frequency=0') .and. restartWrite + do j=2_pInt,chunkPos(1) + restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite enddo endif end select @@ -146,23 +144,23 @@ subroutine FE_init rewind(FILEUNIT) do read (FILEUNIT,'(a1024)',END=200) line - positions = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,positions,1_pInt)) == 'restart' .and. & - IO_lc(IO_stringValue(line,positions,2_pInt)) == 'file' .and. & - IO_lc(IO_stringValue(line,positions,3_pInt)) == 'job' .and. & - IO_lc(IO_stringValue(line,positions,4_pInt)) == 'id' ) & - modelName = IO_StringValue(line,positions,6_pInt) + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'restart' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,3_pInt)) == 'job' .and. & + IO_lc(IO_stringValue(line,chunkPos,4_pInt)) == 'id' ) & + modelName = IO_StringValue(line,chunkPos,6_pInt) enddo #else call IO_open_inputFile(FILEUNIT,modelName) rewind(FILEUNIT) do read (FILEUNIT,'(a1024)',END=200) line - positions = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,positions,1_pInt))=='*heading') then + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))=='*heading') then read (FILEUNIT,'(a1024)',END=200) line - positions = IO_stringPos(line,MAXNCHUNKS) - modelName = IO_StringValue(line,positions,1_pInt) + chunkPos = IO_stringPos(line) + modelName = IO_StringValue(line,chunkPos,1_pInt) endif enddo #endif diff --git a/code/IO.f90 b/code/IO.f90 index 5d417c758..0e494fbdd 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -56,7 +56,6 @@ module IO IO_spotTagInPart, & IO_globalTagInPart, & IO_stringPos, & - IO_stringPos2, & IO_stringValue, & IO_fixedStringValue ,& IO_floatValue, & @@ -538,8 +537,7 @@ logical function IO_abaqus_hasNoPart(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line IO_abaqus_hasNoPart = .true. @@ -548,8 +546,8 @@ logical function IO_abaqus_hasNoPart(fileUnit) rewind(fileUnit) do read(fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if (IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) then + chunkPos = IO_stringPos(line) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then IO_abaqus_hasNoPart = .false. exit endif @@ -566,9 +564,9 @@ function IO_hybridIA(Nast,ODFfileName) tol_math_check implicit none - integer(pInt), intent(in) :: Nast !< number of samples? + integer(pInt), intent(in) :: Nast !< number of samples? real(pReal), dimension(3,Nast) :: IO_hybridIA - character(len=*), intent(in) :: ODFfileName !< name of ODF file including total path + character(len=*), intent(in) :: ODFfileName !< name of ODF file including total path !-------------------------------------------------------------------------------------------------- ! math module is not available @@ -576,10 +574,10 @@ function IO_hybridIA(Nast,ODFfileName) real(pReal), parameter :: INRAD = PI/180.0_pReal integer(pInt) :: i,j,bin,NnonZero,Nset,Nreps,reps,phi1,Phi,phi2 - integer(pInt), dimension(1_pInt + 7_pInt*2_pInt) :: positions - 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 + 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 real(pReal) :: center,sum_dV_V,prob,dg_0,C,lowerC,upperC,rnd 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 @@ -597,10 +595,10 @@ function IO_hybridIA(Nast,ODFfileName) call IO_open_file(FILEUNIT,ODFfileName) headerLength = 0_pInt line=IO_read(FILEUNIT) - positions = IO_stringPos(line,7_pInt) - keyword = IO_lc(IO_StringValue(line,positions,2_pInt,.true.)) + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,positions,1_pInt) + 1_pInt + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt else call IO_error(error_ID=156_pInt, ext_msg='no header found') endif @@ -611,9 +609,9 @@ function IO_hybridIA(Nast,ODFfileName) line=IO_read(FILEUNIT) enddo columns = 0_pInt - positions = IO_stringPos(line,7_pInt) - do i = 1_pInt, positions(1) - select case ( IO_lc(IO_StringValue(line,positions,i,.true.)) ) + chunkPos = IO_stringPos(line) + do i = 1_pInt, chunkPos(1) + select case ( IO_lc(IO_StringValue(line,chunkPos,i,.true.)) ) case ('phi1') columns(1) = i case ('phi') @@ -635,10 +633,10 @@ function IO_hybridIA(Nast,ODFfileName) line=IO_read(FILEUNIT) do while (trim(line) /= IO_EOF) - positions = IO_stringPos(line,7_pInt) - eulers=[IO_floatValue(line,positions,columns(1)),& - IO_floatValue(line,positions,columns(2)),& - IO_floatValue(line,positions,columns(3))] + chunkPos = IO_stringPos(line) + eulers=[IO_floatValue(line,chunkPos,columns(1)),& + IO_floatValue(line,chunkPos,columns(2)),& + IO_floatValue(line,chunkPos,columns(3))] 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) @@ -679,14 +677,14 @@ function IO_hybridIA(Nast,ODFfileName) do phi1=1_pInt,steps(1); do Phi=1_pInt,steps(2); do phi2=1_pInt,steps(3) line=IO_read(FILEUNIT) - positions = IO_stringPos(line,7_pInt) - eulers=[IO_floatValue(line,positions,columns(1)),& ! read in again for consistency check only - IO_floatValue(line,positions,columns(2)),& - IO_floatValue(line,positions,columns(3))]*INRAD + chunkPos = IO_stringPos(line) + eulers=[IO_floatValue(line,chunkPos,columns(1)),& ! read in again for consistency check only + IO_floatValue(line,chunkPos,columns(2)),& + IO_floatValue(line,chunkPos,columns(3))]*INRAD 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) call IO_error(error_ID = 156_pInt, ext_msg='linear ODF data not in expected order') - prob = IO_floatValue(line,positions,columns(4)) + prob = IO_floatValue(line,chunkPos,columns(4)) if (prob > 0.0_pReal) then NnonZero = NnonZero+1_pInt sum_dV_V = sum_dV_V+prob @@ -865,10 +863,9 @@ function IO_countTagInPart(fileUnit,part,tag,Nsections) character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt integer(pInt), dimension(Nsections) :: counter - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: section character(len=65536) :: line @@ -890,8 +887,8 @@ function IO_countTagInPart(fileUnit,part,tag,Nsections) endif if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0) then - positions = IO_stringPos(line,MAXNCHUNKS) - if (tag == trim(IO_lc(IO_stringValue(line,positions,1_pInt)))) & ! match + chunkPos = IO_stringPos(line) + if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match counter(section) = counter(section) + 1_pInt endif enddo @@ -913,9 +910,8 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: section character(len=65536) :: line @@ -937,8 +933,8 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) endif if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - if (tag == trim(IO_lc(IO_stringValue(line,positions,1_pInt)))) & ! matsch ! match + chunkPos = IO_stringPos(line) + if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match IO_spotTagInPart(section) = .true. endif enddo @@ -956,9 +952,8 @@ logical function IO_globalTagInPart(fileUnit,part,tag) character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: section character(len=65536) :: line @@ -980,8 +975,8 @@ logical function IO_globalTagInPart(fileUnit,part,tag) endif if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section == 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - if (tag == trim(IO_lc(IO_stringValue(line,positions,1_pInt)))) & ! match + chunkPos = IO_stringPos(line) + if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match IO_globalTagInPart = .true. endif enddo @@ -990,33 +985,28 @@ end function IO_globalTagInPart !-------------------------------------------------------------------------------------------------- -!> @brief locates at most N space-separated parts in string and returns array containing number of -!! parts in string and the left/right positions of at most N to be used by IO_xxxVal +!> @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 !! IMPORTANT: first element contains number of chunks! !-------------------------------------------------------------------------------------------------- -pure function IO_stringPos(string,N) +pure function IO_stringPos(string) implicit none - integer(pInt), intent(in) :: N !< maximum number of parts - integer(pInt), dimension(1_pInt+N*2_pInt) :: IO_stringPos - character(len=*), intent(in) :: string !< string in which parts are searched for + integer(pInt), dimension(:), allocatable :: IO_stringPos + character(len=*), intent(in) :: string !< string in which chunk positions are searched for character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces integer :: left, right ! no pInt (verify and scan return default integer) - - IO_stringPos = -1_pInt - IO_stringPos(1) = 0_pInt + allocate(IO_stringPos(1), source=0_pInt) right = 0 do while (verify(string(right+1:),SEP)>0) left = right + verify(string(right+1:),SEP) right = left + scan(string(left:),SEP) - 2 if ( string(left:left) == '#' ) exit - if ( IO_stringPos(1) @brief locates at all space-separated parts in string and returns array containing number of -!! parts in string and the left/right positions to be used by IO_xxxVal -!! Array size is dynamically adjusted to number of chunks found in string -!! IMPORTANT: first element contains number of chunks! +!> @brief reads string value at myChunk from string !-------------------------------------------------------------------------------------------------- -pure function IO_stringPos2(string) - - implicit none - integer(pInt), dimension(:), allocatable :: IO_stringPos2 - character(len=*), intent(in) :: string !< string in which parts are searched for - - character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces - integer :: left, right ! no pInt (verify and scan return default integer) - - allocate(IO_stringPos2(1), source=0_pInt) - right = 0 - - do while (verify(string(right+1:),SEP)>0) - left = right + verify(string(right+1:),SEP) - right = left + scan(string(left:),SEP) - 2 - if ( string(left:left) == '#' ) exit - IO_stringPos2 = [IO_stringPos2,int(left, pInt), int(right, pInt)] - IO_stringPos2(1) = IO_stringPos2(1)+1_pInt - enddo - -end function IO_stringPos2 - - -!-------------------------------------------------------------------------------------------------- -!> @brief reads string value at myPos from string -!-------------------------------------------------------------------------------------------------- -function IO_stringValue(string,positions,myPos,silent) +function IO_stringValue(string,chunkPos,myChunk,silent) implicit none - integer(pInt), dimension(:), intent(in) :: positions !< positions of tags in string - integer(pInt), intent(in) :: myPos !< position of desired sub string - character(len=1+positions(myPos*2+1)-positions(myPos*2)) :: IO_stringValue - character(len=*), intent(in) :: string !< raw input with known positions - logical, optional,intent(in) :: silent !< switch to trigger verbosity + 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 character(len=16), parameter :: MYNAME = 'IO_stringValue: ' logical :: warn @@ -1074,84 +1036,84 @@ function IO_stringValue(string,positions,myPos,silent) endif IO_stringValue = '' - if (myPos > positions(1) .or. myPos < 1_pInt) then ! trying to access non-present value - if (warn) call IO_warning(201,el=myPos,ext_msg=MYNAME//trim(string)) - else - IO_stringValue = string(positions(myPos*2):positions(myPos*2+1)) - endif + 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 end function IO_stringValue !-------------------------------------------------------------------------------------------------- -!> @brief reads string value at myPos from fixed format string +!> @brief reads string value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- -pure function IO_fixedStringValue (string,ends,myPos) +pure function IO_fixedStringValue (string,ends,myChunk) implicit none - integer(pInt), intent(in) :: myPos !< position of desired sub string - integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string - character(len=ends(myPos+1)-ends(myPos)) :: IO_fixedStringValue - character(len=*), intent(in) :: string !< raw input with known ends + 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 - IO_fixedStringValue = string(ends(myPos)+1:ends(myPos+1)) + IO_fixedStringValue = string(ends(myChunk)+1:ends(myChunk+1)) end function IO_fixedStringValue !-------------------------------------------------------------------------------------------------- -!> @brief reads float value at myPos from string +!> @brief reads float value at myChunk from string !-------------------------------------------------------------------------------------------------- -real(pReal) function IO_floatValue (string,positions,myPos) +real(pReal) function IO_floatValue (string,chunkPos,myChunk) implicit none - integer(pInt), dimension(:), intent(in) :: positions !< positions of tags in string - integer(pInt), intent(in) :: myPos !< position of desired sub string - character(len=*), intent(in) :: string !< raw input with known positions + 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=15), parameter :: MYNAME = 'IO_floatValue: ' character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' IO_floatValue = 0.0_pReal - if (myPos > positions(1) .or. myPos < 1_pInt) then ! trying to access non-present value - call IO_warning(201,el=myPos,ext_msg=MYNAME//trim(string)) - else + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) + else valuePresent IO_floatValue = & - IO_verifyFloatValue(trim(adjustl(string(positions(myPos*2):positions(myPos*2+1)))),& + IO_verifyFloatValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& VALIDCHARACTERS,MYNAME) - endif + endif valuePresent end function IO_floatValue !-------------------------------------------------------------------------------------------------- -!> @brief reads float value at myPos from fixed format string +!> @brief reads float value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedFloatValue (string,ends,myPos) +real(pReal) function IO_fixedFloatValue (string,ends,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends - integer(pInt), intent(in) :: myPos !< position of desired sub string - integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + 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 character(len=20), parameter :: MYNAME = 'IO_fixedFloatValue: ' character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' IO_fixedFloatValue = & - IO_verifyFloatValue(trim(adjustl(string(ends(myPos)+1_pInt:ends(myPos+1_pInt)))),& + IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& VALIDCHARACTERS,MYNAME) end function IO_fixedFloatValue !-------------------------------------------------------------------------------------------------- -!> @brief reads float x.y+z value at myPos from format string +!> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedNoEFloatValue (string,ends,myPos) +real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends - integer(pInt), intent(in) :: myPos !< position of desired sub string - integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + 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 character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' character(len=13), parameter :: VALIDBASE = '0123456789.+-' character(len=12), parameter :: VALIDEXP = '0123456789+-' @@ -1160,59 +1122,59 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myPos) integer(pInt) :: expon integer :: pos_exp - pos_exp = scan(string(ends(myPos)+1:ends(myPos+1)),'+-',back=.true.) - if (pos_exp > 1) then - base = IO_verifyFloatValue(trim(adjustl(string(ends(myPos)+1_pInt:ends(myPos)+pos_exp-1_pInt))),& + 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))),& VALIDBASE,MYNAME//'(base): ') - expon = IO_verifyIntValue(trim(adjustl(string(ends(myPos)+pos_exp:ends(myPos+1_pInt)))),& + expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1_pInt)))),& VALIDEXP,MYNAME//'(exp): ') - else - base = IO_verifyFloatValue(trim(adjustl(string(ends(myPos)+1_pInt:ends(myPos+1_pInt)))),& + else hasExponent + base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& VALIDBASE,MYNAME//'(base): ') expon = 0_pInt - endif + endif hasExponent IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal) end function IO_fixedNoEFloatValue !-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myPos from string +!> @brief reads integer value at myChunk from string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_intValue(string,ends,myPos) +integer(pInt) function IO_intValue(string,chunkPos,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends - integer(pInt), intent(in) :: myPos !< position of desired sub string - integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + 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 character(len=13), parameter :: MYNAME = 'IO_intValue: ' character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' IO_intValue = 0_pInt - if (myPos > ends(1) .or. myPos < 1_pInt) then ! trying to access non-present value - call IO_warning(201,el=myPos,ext_msg=MYNAME//trim(string)) - else - IO_intValue = IO_verifyIntValue(trim(adjustl(string(ends(myPos*2):ends(myPos*2+1)))),& + 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)))),& VALIDCHARACTERS,MYNAME) - endif + endif valuePresent end function IO_intValue !-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myPos from fixed format string +!> @brief reads integer value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_fixedIntValue(string,ends,myPos) +integer(pInt) function IO_fixedIntValue(string,ends,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends - integer(pInt), intent(in) :: myPos !< position of desired sub string - integer(pInt), dimension(:), intent(in) :: ends !< positions of ends in string + 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 character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myPos)+1_pInt:ends(myPos+1_pInt)))),& + IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& VALIDCHARACTERS,MYNAME) end function IO_fixedIntValue @@ -1250,10 +1212,7 @@ subroutine IO_skipChunks(fileUnit,N) integer(pInt), intent(in) :: fileUnit, & !< file handle N !< minimum number of chunks to skip - integer(pInt), parameter :: MAXNCHUNKS = 64_pInt - integer(pInt) :: remainingChunks - integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos character(len=65536) :: line line = '' @@ -1261,8 +1220,7 @@ subroutine IO_skipChunks(fileUnit,N) do while (trim(line) /= IO_EOF .and. remainingChunks > 0) line = IO_read(fileUnit) - myPos = IO_stringPos(line,MAXNCHUNKS) - remainingChunks = remainingChunks - myPos(1) + remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt enddo end subroutine IO_skipChunks @@ -1278,13 +1236,13 @@ character(len=300) pure function IO_extractValue(pair,key) character(len=*), parameter :: SEP = achar(61) ! '=' - integer :: myPos ! no pInt (scan returns default integer) + integer :: myChunk !< position number of desired chunk IO_extractValue = '' - myPos = scan(pair,SEP) - if (myPos > 0 .and. pair(:myPos-1) == key(:myPos-1)) & ! key matches expected key - IO_extractValue = pair(myPos+1:) ! extract value + myChunk = scan(pair,SEP) + if (myChunk > 0 .and. pair(:myChunk-1) == key(:myChunk-1)) & + IO_extractValue = pair(myChunk+1:) ! extract value if key matches end function IO_extractValue @@ -1297,9 +1255,8 @@ integer(pInt) function IO_countDataLines(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit !< file handle - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line, & tmp @@ -1308,8 +1265,8 @@ integer(pInt) function IO_countDataLines(fileUnit) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) - myPos = IO_stringPos(line,MAXNCHUNKS) - tmp = IO_lc(IO_stringValue(line,myPos,1_pInt)) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword line = IO_read(fileUnit, .true.) ! reset IO_read exit @@ -1333,11 +1290,10 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 8192_pInt #ifdef Abaqus integer(pInt) :: l,c #endif - integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line IO_countContinuousIntValues = 0_pInt @@ -1346,22 +1302,22 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) #ifndef Abaqus do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) - myPos = IO_stringPos(line,MAXNCHUNKS) - if (myPos(1) < 1_pInt) then ! empty line + chunkPos = IO_stringPos(line) + if (chunkPos(1) < 1_pInt) then ! empty line line = IO_read(fileUnit, .true.) ! reset IO_read exit - elseif (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator - IO_countContinuousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) & - - IO_intValue(line,myPos,1_pInt) + 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) line = IO_read(fileUnit, .true.) ! reset IO_read exit ! only one single range indicator allowed - else if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_countContinuousIntValues = IO_intValue(line,myPos,1_pInt) + else if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator + IO_countContinuousIntValues = IO_intValue(line,chunkPos,1_pInt) line = IO_read(fileUnit, .true.) ! reset IO_read exit ! only one single multiplier allowed else - IO_countContinuousIntValues = IO_countContinuousIntValues+myPos(1)-1_pInt ! add line's count when assuming 'c' - if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value + 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 IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt line = IO_read(fileUnit, .true.) ! reset IO_read exit ! data ended @@ -1378,10 +1334,10 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct l = l + 1_pInt line = IO_read(fileUnit) - myPos = IO_stringPos(line,MAXNCHUNKS) + chunkPos = IO_stringPos(line) IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation - (IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/& - max(1_pInt,IO_intValue(line,myPos,3_pInt)) + (IO_intValue(line,chunkPos,2_pInt)-IO_intValue(line,chunkPos,1_pInt))/& + max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) enddo #endif @@ -1405,13 +1361,12 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) lookupMaxN integer(pInt), dimension(:,:), intent(in) :: lookupMap character(len=64), dimension(:), intent(in) :: lookupName - integer(pInt), parameter :: MAXNCHUNKS = 8192_pInt integer(pInt) :: i #ifdef Abaqus integer(pInt) :: j,l,c,first,last #endif - integer(pInt), dimension(1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) line logical rangeGeneration @@ -1421,35 +1376,35 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) #ifndef Abaqus do read(fileUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if (myPos(1) < 1_pInt) then ! empty line + chunkPos = IO_stringPos(line) + if (chunkPos(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 + elseif (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name do i = 1_pInt, lookupMaxN ! loop over known set names - if (IO_stringValue(line,myPos,1_pInt) == lookupName(i)) then ! found matching name + if (IO_stringValue(line,chunkPos,1_pInt) == lookupName(i)) then ! found matching name IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list exit endif enddo exit - else if (myPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator - do i = IO_intValue(line,myPos,1_pInt),IO_intValue(line,myPos,3_pInt) + 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) IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo exit - else if (myPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_continuousIntValues(1) = IO_intValue(line,myPos,1_pInt) - IO_continuousIntValues(2:IO_continuousIntValues(1)+1) = IO_intValue(line,myPos,3_pInt) + 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) exit else - do i = 1_pInt,myPos(1)-1_pInt ! interpret up to second to last value + do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,i) + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) enddo - if ( IO_lc(IO_stringValue(line,myPos,myPos(1))) /= 'c' ) then ! line finished, read last value + if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,myPos(1)) + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1)) exit endif endif @@ -1464,18 +1419,18 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) ! check if the element values in the elset are auto generated backspace(fileUnit) read(fileUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,MAXNCHUNKS) - do i = 1_pInt,myPos(1) - if (IO_lc(IO_stringValue(line,myPos,i)) == 'generate') rangeGeneration = .true. + chunkPos = IO_stringPos(line) + do i = 1_pInt,chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. enddo do l = 1_pInt,c read(fileUnit,'(A65536)',end=100) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if (verify(IO_stringValue(line,myPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line - do i = 1_pInt,myPos(1) ! loop over set names in line + 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 + do i = 1_pInt,myChunk(1) ! loop over set names in line do j = 1_pInt,lookupMaxN ! look through known set names - if (IO_stringValue(line,myPos,i) == lookupName(j)) then ! found matching name + if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name 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 @@ -1484,14 +1439,16 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) enddo enddo else if (rangeGeneration) then ! range generation - do i = IO_intValue(line,myPos,1_pInt),IO_intValue(line,myPos,2_pInt),max(1_pInt,IO_intValue(line,myPos,3_pInt)) + do i = IO_intValue(line,chunkPos,1_pInt),& + IO_intValue(line,chunkPos,2_pInt),& + max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo else ! read individual elem nums - do i = 1_pInt,myPos(1) + do i = 1_pInt,myChunk(1) IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,myPos,i) + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) enddo endif enddo @@ -1646,15 +1603,11 @@ subroutine IO_error(error_ID,el,ip,g,ext_msg) case (406_pInt) msg = 'Prime-error: N must be between 0 and PRIME_MAX' case (407_pInt) - msg = 'Dimension in nearest neighbor search wrong' - case (408_pInt) msg = 'Polar decomposition error' case (409_pInt) msg = 'math_check: R*v == q*v failed' case (450_pInt) msg = 'unknown symmetry type specified' - case (460_pInt) - msg = 'kdtree2 error' !------------------------------------------------------------------------------------------------- ! homogenization errors @@ -1948,18 +1901,17 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) integer(pInt), intent(in) :: unit1, & unit2 - integer(pInt), parameter :: MAXNCHUNKS = 6_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line,fname logical :: createSuccess,fexist do read(unit2,'(A65536)',END=220) line - positions = IO_stringPos(line,MAXNCHUNKS) + chunkPos = IO_stringPos(line) - if (IO_lc(IO_StringValue(line,positions,1_pInt))=='*include') then + if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):)) inquire(file=fname, exist=fexist) if (.not.(fexist)) then diff --git a/code/crystallite.f90 b/code/crystallite.f90 index f6594545c..ac34f7569 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -184,10 +184,9 @@ subroutine crystallite_init implicit none integer(pInt), parameter :: & - FILEUNIT = 200_pInt, & - MAXNCHUNKS = 2_pInt + FILEUNIT = 200_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & g, & !< grain number i, & !< integration point number @@ -299,12 +298,12 @@ subroutine crystallite_init cycle ! skip to next line endif if (section > 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') output = output + 1_pInt - crystallite_output(output,section) = IO_lc(IO_stringValue(line,positions,2_pInt)) + crystallite_output(output,section) = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) select case(crystallite_output(output,section)) case ('phase') crystallite_outputID(output,section) = phase_ID @@ -351,7 +350,7 @@ subroutine crystallite_init case ('neighboringelement') crystallite_outputID(output,section) = neighboringelement_ID case default - call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' (Crystallite)') + call IO_error(105_pInt,ext_msg=IO_stringValue(line,chunkPos,2_pInt)//' (Crystallite)') end select end select endif diff --git a/code/damage_local.f90 b/code/damage_local.f90 index 0126c33b3..a4bef8f0e 100644 --- a/code/damage_local.f90 +++ b/code/damage_local.f90 @@ -76,8 +76,7 @@ subroutine damage_local_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,homog,instance,o integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -123,16 +122,16 @@ subroutine damage_local_init(fileUnit) if (homog > 0_pInt ) then; if (damage_type(homog) == DAMAGE_local_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = damage_typeInstance(homog) ! which instance of my damage is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('damage') damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1_pInt damage_local_outputID(damage_local_Noutput(instance),instance) = damage_ID damage_local_output(damage_local_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select end select diff --git a/code/damage_nonlocal.f90 b/code/damage_nonlocal.f90 index 9e3032f52..84c95bc52 100644 --- a/code/damage_nonlocal.f90 +++ b/code/damage_nonlocal.f90 @@ -81,8 +81,7 @@ subroutine damage_nonlocal_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -125,19 +124,19 @@ subroutine damage_nonlocal_init(fileUnit) cycle ! skip to next line endif - if (section > 0_pInt ) then; if (damage_type(section) == DAMAGE_nonlocal_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + if (section > 0_pInt ) then; if (damage_type(section) == DAMAGE_nonlocal_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = damage_typeInstance(section) ! which instance of my damage is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + instance = damage_typeInstance(section) ! which instance of my damage is present homog + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('damage') damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1_pInt damage_nonlocal_outputID(damage_nonlocal_Noutput(instance),instance) = damage_ID damage_nonlocal_output(damage_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select end select diff --git a/code/damask.core.pyf b/code/damask.core.pyf index ab0a3e3ad..e6396ee1d 100644 --- a/code/damask.core.pyf +++ b/code/damask.core.pyf @@ -45,37 +45,6 @@ python module core ! in subroutine math_init end subroutine math_init - function math_nearestNeighbor(querySet,domainSet) ! in :math:math.f90 - ! input variables - real*8, dimension(:,:), intent(in) :: querySet - real*8, dimension(:,:), intent(in) :: domainSet - ! function definition - integer, dimension(size(querySet,2)), depend(querySet) :: math_nearestNeighbor - end function math_nearestNeighbor - - function math_periodicNearestNeighbor(geomdim,Favg,querySet,domainSet) ! in :math:math.f90 - ! input variables - real*8, dimension(3), intent(in) :: geomdim - real*8, dimension(3,3), intent(in) :: Favg - real*8, dimension(:,:), intent(in) :: querySet - real*8, dimension(:,:), intent(in) :: domainSet - integer, dimension(size(querySet,2)), depend(querySet) :: math_periodicNearestNeighbor - ! depending on input - real*8, dimension(size(domainSet,1),(3_pInt**size(domainSet,1))*size(domainSet,2)), depend(domainSet) :: domainSetLarge - end function math_periodicNearestNeighbor - - function math_periodicNearestNeighborDistances(geomdim,Favg,querySet,domainSet,Ndist) ! in :math:math.f90 - ! input variables - real*8, dimension(3), intent(in) :: geomdim - real*8, dimension(3,3), intent(in) :: Favg - integer, intent(in) :: Ndist - real*8, dimension(:,:), intent(in) :: querySet - real*8, dimension(:,:), intent(in) :: domainSet - real*8, dimension(Ndist,size(querySet,2)), depend(Ndist,querySet) :: math_periodicNearestNeighborDistances - ! depending on input - real*8, dimension(size(domainSet,1),(3_pInt**size(domainSet,1))*size(domainSet,2)), depend(domainSet) :: domainSetLarge - end function math_periodicNearestNeighborDistances - function math_tensorAvg(field) ! in :math:math.f90 ! input variables real*8 dimension(:,:,:,:,:), intent(in), :: field @@ -95,13 +64,6 @@ python module core ! in integer, parameter :: ip = 1 integer, parameter :: element = 1 end subroutine mesh_init - - function mesh_regrid(adaptive,resNewInput,minRes) ! in :mesh:mesh.f90 - logical, intent(in) :: adaptive - integer, dimension(3) :: mesh_regrid - integer, dimension(3), intent(in), optional :: resNewInput = -1 - integer, dimension(3), intent(in), optional :: minRes = -1 - end function mesh_regrid function mesh_nodesAroundCentres(gDim,Favg,centres) ! in :mesh:mesh.f90 real*8, dimension(:,:,:,:), intent(in) :: centres diff --git a/code/debug.f90 b/code/debug.f90 index abb7753dc..7701ba675 100644 --- a/code/debug.f90 +++ b/code/debug.f90 @@ -124,12 +124,10 @@ subroutine debug_init implicit none integer(pInt), parameter :: FILEUNIT = 300_pInt - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt integer(pInt) :: i, what - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions - character(len=65536) :: tag - character(len=65536) :: line + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: tag, line mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- debug init -+>>>' @@ -171,15 +169,15 @@ subroutine debug_init do while (trim(line) /= IO_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 + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('element','e','el') - debug_e = IO_intValue(line,positions,2_pInt) + debug_e = IO_intValue(line,chunkPos,2_pInt) case ('integrationpoint','i','ip') - debug_i = IO_intValue(line,positions,2_pInt) + debug_i = IO_intValue(line,chunkPos,2_pInt) case ('grain','g','gr') - debug_g = IO_intValue(line,positions,2_pInt) + debug_g = IO_intValue(line,chunkPos,2_pInt) end select what = 0_pInt @@ -216,8 +214,8 @@ subroutine debug_init what = debug_MAXNTYPE + 2_pInt end select if (what /= 0) then - do i = 2_pInt, positions(1) - select case(IO_lc(IO_stringValue(line,positions,i))) + do i = 2_pInt, chunkPos(1) + select case(IO_lc(IO_stringValue(line,chunkPos,i))) case('basic') debug_level(what) = ior(debug_level(what), debug_LEVELBASIC) case('extensive') diff --git a/code/homogenization_RGC.f90 b/code/homogenization_RGC.f90 index 8344f97ec..2170ce7a3 100644 --- a/code/homogenization_RGC.f90 +++ b/code/homogenization_RGC.f90 @@ -103,8 +103,7 @@ subroutine homogenization_RGC_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration - integer(pInt), parameter :: MAXNCHUNKS = 4_pInt - integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer :: & homog, & NofMyHomog, & @@ -162,76 +161,76 @@ subroutine homogenization_RGC_init(fileUnit) if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran if (homogenization_type(section) == HOMOGENIZATION_RGC_ID) then ! one of my sections i = homogenization_typeInstance(section) ! which instance of my type is present homogenization - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case('constitutivework') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = constitutivework_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('penaltyenergy') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = penaltyenergy_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('volumediscrepancy') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = volumediscrepancy_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('averagerelaxrate') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = averagerelaxrate_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('maximumrelaxrate') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = maximumrelaxrate_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('magnitudemismatch') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = magnitudemismatch_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('ipcoords') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = ipcoords_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('avgdefgrad','avgf') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgdefgrad_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('avgp','avgfirstpiola','avg1stpiola') homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgfirstpiola_ID homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('clustersize') - homogenization_RGC_Ngrains(1,i) = IO_intValue(line,positions,2_pInt) - homogenization_RGC_Ngrains(2,i) = IO_intValue(line,positions,3_pInt) - homogenization_RGC_Ngrains(3,i) = IO_intValue(line,positions,4_pInt) + homogenization_RGC_Ngrains(1,i) = IO_intValue(line,chunkPos,2_pInt) + homogenization_RGC_Ngrains(2,i) = IO_intValue(line,chunkPos,3_pInt) + homogenization_RGC_Ngrains(3,i) = IO_intValue(line,chunkPos,4_pInt) if (homogenization_Ngrains(section) /= product(homogenization_RGC_Ngrains(1:3,i))) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_RGC_label//')') case ('scalingparameter') - homogenization_RGC_xiAlpha(i) = IO_floatValue(line,positions,2_pInt) + homogenization_RGC_xiAlpha(i) = IO_floatValue(line,chunkPos,2_pInt) case ('overproportionality') - homogenization_RGC_ciAlpha(i) = IO_floatValue(line,positions,2_pInt) + homogenization_RGC_ciAlpha(i) = IO_floatValue(line,chunkPos,2_pInt) case ('grainsize') - homogenization_RGC_dAlpha(1,i) = IO_floatValue(line,positions,2_pInt) - homogenization_RGC_dAlpha(2,i) = IO_floatValue(line,positions,3_pInt) - homogenization_RGC_dAlpha(3,i) = IO_floatValue(line,positions,4_pInt) + homogenization_RGC_dAlpha(1,i) = IO_floatValue(line,chunkPos,2_pInt) + homogenization_RGC_dAlpha(2,i) = IO_floatValue(line,chunkPos,3_pInt) + homogenization_RGC_dAlpha(3,i) = IO_floatValue(line,chunkPos,4_pInt) case ('clusterorientation') - homogenization_RGC_angles(1,i) = IO_floatValue(line,positions,2_pInt) - homogenization_RGC_angles(2,i) = IO_floatValue(line,positions,3_pInt) - homogenization_RGC_angles(3,i) = IO_floatValue(line,positions,4_pInt) + homogenization_RGC_angles(1,i) = IO_floatValue(line,chunkPos,2_pInt) + homogenization_RGC_angles(2,i) = IO_floatValue(line,chunkPos,3_pInt) + homogenization_RGC_angles(3,i) = IO_floatValue(line,chunkPos,4_pInt) end select endif diff --git a/code/homogenization_isostrain.f90 b/code/homogenization_isostrain.f90 index c1d44c0a5..91b08f3ca 100644 --- a/code/homogenization_isostrain.f90 +++ b/code/homogenization_isostrain.f90 @@ -65,8 +65,7 @@ subroutine homogenization_isostrain_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & section = 0_pInt, i, mySize, o integer :: & @@ -121,37 +120,37 @@ subroutine homogenization_isostrain_init(fileUnit) if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran if (homogenization_type(section) == HOMOGENIZATION_ISOSTRAIN_ID) then ! one of my sections i = homogenization_typeInstance(section) ! which instance of my type is present homogenization - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case('nconstituents','ngrains') homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = nconstituents_ID homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('ipcoords') homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = ipcoords_ID homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('avgdefgrad','avgf') homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgdefgrad_ID homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case('avgp','avgfirstpiola','avg1stpiola') homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgfirstpiola_ID homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('nconstituents','ngrains') - homogenization_isostrain_Ngrains(i) = IO_intValue(line,positions,2_pInt) + homogenization_isostrain_Ngrains(i) = IO_intValue(line,chunkPos,2_pInt) case ('mapping') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('parallel','sum') homogenization_isostrain_mapping(i) = parallel_ID case ('average','mean','avg') diff --git a/code/hydrogenflux_cahnhilliard.f90 b/code/hydrogenflux_cahnhilliard.f90 index 757bac45d..1fd44b587 100644 --- a/code/hydrogenflux_cahnhilliard.f90 +++ b/code/hydrogenflux_cahnhilliard.f90 @@ -88,8 +88,7 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -135,16 +134,16 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) if (section > 0_pInt ) then; if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = hydrogenflux_typeInstance(section) ! which instance of my hydrogenflux is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('hydrogenconc') hydrogenflux_cahnhilliard_Noutput(instance) = hydrogenflux_cahnhilliard_Noutput(instance) + 1_pInt hydrogenflux_cahnhilliard_outputID(hydrogenflux_cahnhilliard_Noutput(instance),instance) = hydrogenConc_ID hydrogenflux_cahnhilliard_output(hydrogenflux_cahnhilliard_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select end select diff --git a/code/kinematics_cleavage_opening.f90 b/code/kinematics_cleavage_opening.f90 index bc4c0c661..04e770a57 100644 --- a/code/kinematics_cleavage_opening.f90 +++ b/code/kinematics_cleavage_opening.f90 @@ -88,8 +88,7 @@ subroutine kinematics_cleavage_opening_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,kinematics integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j character(len=65536) :: & @@ -150,29 +149,29 @@ subroutine kinematics_cleavage_opening_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = kinematics_cleavage_opening_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('anisobrittle_sdot0') - kinematics_cleavage_opening_sdot_0(instance) = IO_floatValue(line,positions,2_pInt) + kinematics_cleavage_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisobrittle_ratesensitivity') - kinematics_cleavage_opening_N(instance) = IO_floatValue(line,positions,2_pInt) + kinematics_cleavage_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('ncleavage') ! - Nchunks_CleavageFamilies = positions(1) - 1_pInt + Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_Ncleavage(j,instance) = IO_intValue(line,positions,1_pInt+j) + kinematics_cleavage_opening_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('anisobrittle_criticaldisplacement') do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_critDisp(j,instance) = IO_floatValue(line,positions,1_pInt+j) + kinematics_cleavage_opening_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('anisobrittle_criticalload') do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_critLoad(j,instance) = IO_floatValue(line,positions,1_pInt+j) + kinematics_cleavage_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo end select diff --git a/code/kinematics_hydrogen_strain.f90 b/code/kinematics_hydrogen_strain.f90 index 6ee6b6124..32d886952 100644 --- a/code/kinematics_hydrogen_strain.f90 +++ b/code/kinematics_hydrogen_strain.f90 @@ -75,8 +75,7 @@ subroutine kinematics_hydrogen_strain_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,kinematics character(len=65536) :: & tag = '', & @@ -131,11 +130,11 @@ subroutine kinematics_hydrogen_strain_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_hydrogen_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = kinematics_hydrogen_strain_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('hydrogen_strain_coeff') - kinematics_hydrogen_strain_coeff(instance) = IO_floatValue(line,positions,2_pInt) + kinematics_hydrogen_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/kinematics_slipplane_opening.f90 b/code/kinematics_slipplane_opening.f90 index 59de2708b..2cc6dfabc 100644 --- a/code/kinematics_slipplane_opening.f90 +++ b/code/kinematics_slipplane_opening.f90 @@ -88,8 +88,7 @@ subroutine kinematics_slipplane_opening_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,kinematics integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j character(len=65536) :: & @@ -150,29 +149,29 @@ subroutine kinematics_slipplane_opening_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = kinematics_slipplane_opening_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('nslip') ! - Nchunks_SlipFamilies = positions(1) - 1_pInt + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + kinematics_slipplane_opening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('anisoductile_sdot0') - kinematics_slipplane_opening_sdot_0(instance) = IO_floatValue(line,positions,2_pInt) + kinematics_slipplane_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalplasticstrain') do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_critPlasticStrain(j,instance) = IO_floatValue(line,positions,1_pInt+j) + kinematics_slipplane_opening_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('anisoductile_ratesensitivity') - kinematics_slipplane_opening_N(instance) = IO_floatValue(line,positions,2_pInt) + kinematics_slipplane_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalload') do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_critLoad(j,instance) = IO_floatValue(line,positions,1_pInt+j) + kinematics_slipplane_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo end select diff --git a/code/kinematics_thermal_expansion.f90 b/code/kinematics_thermal_expansion.f90 index 49adf17fd..9133da733 100644 --- a/code/kinematics_thermal_expansion.f90 +++ b/code/kinematics_thermal_expansion.f90 @@ -75,8 +75,7 @@ subroutine kinematics_thermal_expansion_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,kinematics character(len=65536) :: & tag = '', & @@ -131,11 +130,11 @@ subroutine kinematics_thermal_expansion_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_thermal_expansion_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = kinematics_thermal_expansion_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key... + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key... select case(tag) ! case ('(output)') -! output = IO_lc(IO_stringValue(line,positions,2_pInt)) ! ...and corresponding output +! output = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) ! ...and corresponding output ! select case(output) ! case ('thermalexpansionrate') ! kinematics_thermal_expansion_Noutput(instance) = kinematics_thermal_expansion_Noutput(instance) + 1_pInt diff --git a/code/kinematics_vacancy_strain.f90 b/code/kinematics_vacancy_strain.f90 index e0de4532d..1ec2a4dea 100644 --- a/code/kinematics_vacancy_strain.f90 +++ b/code/kinematics_vacancy_strain.f90 @@ -75,8 +75,7 @@ subroutine kinematics_vacancy_strain_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,kinematics character(len=65536) :: & tag = '', & @@ -131,11 +130,11 @@ subroutine kinematics_vacancy_strain_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_vacancy_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = kinematics_vacancy_strain_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('vacancy_strain_coeff') - kinematics_vacancy_strain_coeff(instance) = IO_floatValue(line,positions,2_pInt) + kinematics_vacancy_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/lattice.f90 b/code/lattice.f90 index 87b95754c..db2ed8c4b 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -1186,10 +1186,8 @@ subroutine lattice_init IO_open_file,& IO_open_jobFile_stat, & IO_countSections, & - IO_countTagInPart, & IO_error, & IO_timeStamp, & - IO_stringPos, & IO_EOF, & IO_read, & IO_lc, & @@ -1215,8 +1213,7 @@ subroutine lattice_init character(len=65536) :: & tag = '', & line = '' - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: section = 0_pInt,i real(pReal), dimension(:), allocatable :: & CoverA, & !!!!!!< c/a ratio for low symmetry type lattice @@ -1410,11 +1407,11 @@ subroutine lattice_init section = section + 1_pInt endif if (section > 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,positions,2_pInt)))) + select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) case('iso','isotropic') lattice_structure(section) = LATTICE_iso_ID case('fcc') @@ -1428,133 +1425,133 @@ subroutine lattice_init case('ort','orthorhombic') lattice_structure(section) = LATTICE_ort_ID case default - call IO_error(130_pInt,ext_msg=trim(IO_lc(IO_stringValue(line,positions,2_pInt)))) + call IO_error(130_pInt,ext_msg=trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) end select case('trans_lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,positions,2_pInt)))) + select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) case('bcc') trans_lattice_structure(section) = LATTICE_bcc_ID case('hex','hexagonal','hcp') trans_lattice_structure(section) = LATTICE_hex_ID end select case ('c11') - lattice_C66(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c12') - lattice_C66(1,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c13') - lattice_C66(1,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c22') - lattice_C66(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c23') - lattice_C66(2,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c33') - lattice_C66(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c44') - lattice_C66(4,4,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c55') - lattice_C66(5,5,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c66') - lattice_C66(6,6,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c11_trans') - lattice_trans_C66(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c12_trans') - lattice_trans_C66(1,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c13_trans') - lattice_trans_C66(1,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c22_trans') - lattice_trans_C66(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c23_trans') - lattice_trans_C66(2,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c33_trans') - lattice_trans_C66(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c44_trans') - lattice_trans_C66(4,4,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c55_trans') - lattice_trans_C66(5,5,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) case ('c66_trans') - lattice_trans_C66(6,6,section) = IO_floatValue(line,positions,2_pInt) + lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) case ('covera_ratio','c/a_ratio','c/a') - CoverA(section) = IO_floatValue(line,positions,2_pInt) + CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) case ('c/a_trans','c/a_martensite','c/a_mart') - CoverA_trans(section) = IO_floatValue(line,positions,2_pInt) + CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) case ('a_fcc') - a_fcc(section) = IO_floatValue(line,positions,2_pInt) + a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) case ('a_bcc') - a_bcc(section) = IO_floatValue(line,positions,2_pInt) + a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) case ('thermal_conductivity11') - lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('thermal_conductivity22') - lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('thermal_conductivity33') - lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('thermal_expansion11') - lattice_thermalExpansion33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_thermalExpansion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('thermal_expansion22') - lattice_thermalExpansion33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_thermalExpansion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('thermal_expansion33') - lattice_thermalExpansion33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_thermalExpansion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('specific_heat') - lattice_specificHeat(section) = IO_floatValue(line,positions,2_pInt) + lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyformationenergy') - lattice_vacancyFormationEnergy(section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancysurfaceenergy') - lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyvolume') - lattice_vacancyVol(section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenformationenergy') - lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogensurfaceenergy') - lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenvolume') - lattice_hydrogenVol(section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) case ('mass_density') - lattice_massDensity(section) = IO_floatValue(line,positions,2_pInt) + lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) case ('reference_temperature') - lattice_referenceTemperature(section) = IO_floatValue(line,positions,2_pInt) + lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) case ('damage_diffusion11') - lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('damage_diffusion22') - lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('damage_diffusion33') - lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('damage_mobility') - lattice_DamageMobility(section) = IO_floatValue(line,positions,2_pInt) + lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyflux_diffusion11') - lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyflux_diffusion22') - lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyflux_diffusion33') - lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyflux_mobility11') - lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyflux_mobility22') - lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyflux_mobility33') - lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('porosity_diffusion11') - lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('porosity_diffusion22') - lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('porosity_diffusion33') - lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('porosity_mobility') - lattice_PorosityMobility(section) = IO_floatValue(line,positions,2_pInt) + lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenflux_diffusion11') - lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenflux_diffusion22') - lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenflux_diffusion33') - lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenflux_mobility11') - lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenflux_mobility22') - lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenflux_mobility33') - lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) case ('vacancy_eqcv') - lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,positions,2_pInt) + lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogen_eqch') - lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,positions,2_pInt) + lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) end select endif enddo diff --git a/code/libs.f90 b/code/libs.f90 index b050bb7d4..7c109cab6 100644 --- a/code/libs.f90 +++ b/code/libs.f90 @@ -8,9 +8,6 @@ module libs !nothing in here end module libs -#if defined(Spectral) || defined(FEM) -#include "../lib/kdtree2.f90" -#endif #include "../lib/IR_Precision.f90" #include "../lib/Lib_Base64.f90" #include "../lib/Lib_VTK_IO.f90" diff --git a/code/material.f90 b/code/material.f90 index 21850208e..bebfc27e7 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -561,9 +561,8 @@ subroutine material_parseHomogenization(fileUnit,myPart) character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Nsections, section, s, p character(len=65536) :: & tag, line @@ -620,11 +619,11 @@ subroutine material_parseHomogenization(fileUnit,myPart) homogenization_name(section) = IO_getTag(line,'[',']') endif if (section > 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('type') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case(HOMOGENIZATION_NONE_label) homogenization_type(section) = HOMOGENIZATION_NONE_ID homogenization_Ngrains(section) = 1_pInt @@ -633,12 +632,12 @@ subroutine material_parseHomogenization(fileUnit,myPart) case(HOMOGENIZATION_RGC_label) homogenization_type(section) = HOMOGENIZATION_RGC_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select homogenization_typeInstance(section) = & count(homogenization_type==homogenization_type(section)) ! count instances case ('thermal') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case(THERMAL_isothermal_label) thermal_type(section) = THERMAL_isothermal_ID case(THERMAL_adiabatic_label) @@ -646,11 +645,11 @@ subroutine material_parseHomogenization(fileUnit,myPart) case(THERMAL_conduction_label) thermal_type(section) = THERMAL_conduction_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select case ('damage') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case(DAMAGE_NONE_label) damage_type(section) = DAMAGE_none_ID case(DAMAGE_LOCAL_label) @@ -658,11 +657,11 @@ subroutine material_parseHomogenization(fileUnit,myPart) case(DAMAGE_NONLOCAL_label) damage_type(section) = DAMAGE_nonlocal_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select case ('vacancyflux') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case(VACANCYFLUX_isoconc_label) vacancyflux_type(section) = VACANCYFLUX_isoconc_ID case(VACANCYFLUX_isochempot_label) @@ -670,46 +669,46 @@ subroutine material_parseHomogenization(fileUnit,myPart) case(VACANCYFLUX_cahnhilliard_label) vacancyflux_type(section) = VACANCYFLUX_cahnhilliard_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select case ('porosity') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case(POROSITY_NONE_label) porosity_type(section) = POROSITY_none_ID case(POROSITY_phasefield_label) porosity_type(section) = POROSITY_phasefield_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select case ('hydrogenflux') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case(HYDROGENFLUX_isoconc_label) hydrogenflux_type(section) = HYDROGENFLUX_isoconc_ID case(HYDROGENFLUX_cahnhilliard_label) hydrogenflux_type(section) = HYDROGENFLUX_cahnhilliard_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select case ('nconstituents','ngrains') - homogenization_Ngrains(section) = IO_intValue(line,positions,2_pInt) + homogenization_Ngrains(section) = IO_intValue(line,chunkPos,2_pInt) case ('initialtemperature','initialt') - thermal_initialT(section) = IO_floatValue(line,positions,2_pInt) + thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) case ('initialdamage') - damage_initialPhi(section) = IO_floatValue(line,positions,2_pInt) + damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) case ('initialvacancyconc','initialcv') - vacancyflux_initialCv(section) = IO_floatValue(line,positions,2_pInt) + vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) case ('initialporosity') - porosity_initialPhi(section) = IO_floatValue(line,positions,2_pInt) + porosity_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) case ('initialhydrogenconc','initialch') - hydrogenflux_initialCh(section) = IO_floatValue(line,positions,2_pInt) + hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) end select endif @@ -742,9 +741,8 @@ subroutine material_parseMicrostructure(fileUnit,myPart) character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Nsections, section, constituent, e, i character(len=65536) :: & tag, line @@ -799,22 +797,22 @@ subroutine material_parseMicrostructure(fileUnit,myPart) microstructure_name(section) = IO_getTag(line,'[',']') endif if (section > 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('crystallite') - microstructure_crystallite(section) = IO_intValue(line,positions,2_pInt) + microstructure_crystallite(section) = IO_intValue(line,chunkPos,2_pInt) case ('(constituent)') constituent = constituent + 1_pInt do i=2_pInt,6_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,positions,i)) + tag = IO_lc(IO_stringValue(line,chunkPos,i)) select case (tag) case('phase') - microstructure_phase(constituent,section) = IO_intValue(line,positions,i+1_pInt) + microstructure_phase(constituent,section) = IO_intValue(line,chunkPos,i+1_pInt) case('texture') - microstructure_texture(constituent,section) = IO_intValue(line,positions,i+1_pInt) + microstructure_texture(constituent,section) = IO_intValue(line,chunkPos,i+1_pInt) case('fraction') - microstructure_fraction(constituent,section) = IO_floatValue(line,positions,i+1_pInt) + microstructure_fraction(constituent,section) = IO_floatValue(line,chunkPos,i+1_pInt) end select enddo end select @@ -906,9 +904,8 @@ subroutine material_parsePhase(fileUnit,myPart) character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Nsections, section, sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536) :: & tag,line @@ -966,18 +963,18 @@ subroutine material_parsePhase(fileUnit,myPart) phase_name(section) = IO_getTag(line,'[',']') endif if (section > 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('elasticity') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case (ELASTICITY_HOOKE_label) phase_elasticity(section) = ELASTICITY_HOOKE_ID case default - call IO_error(200_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(200_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select case ('plasticity') - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case (PLASTICITY_NONE_label) phase_plasticity(section) = PLASTICITY_NONE_ID case (PLASTICITY_J2_label) @@ -995,11 +992,11 @@ subroutine material_parsePhase(fileUnit,myPart) case (PLASTICITY_NONLOCAL_label) phase_plasticity(section) = PLASTICITY_NONLOCAL_ID case default - call IO_error(201_pInt,ext_msg=trim(IO_stringValue(line,positions,2_pInt))) + call IO_error(201_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select case ('(source)') sourceCtr = sourceCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case (SOURCE_thermal_dissipation_label) phase_source(sourceCtr,section) = SOURCE_thermal_dissipation_ID case (SOURCE_thermal_externalheat_label) @@ -1021,7 +1018,7 @@ subroutine material_parsePhase(fileUnit,myPart) end select case ('(kinematics)') kinematicsCtr = kinematicsCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case (KINEMATICS_cleavage_opening_label) phase_kinematics(kinematicsCtr,section) = KINEMATICS_cleavage_opening_ID case (KINEMATICS_slipplane_opening_label) @@ -1035,7 +1032,7 @@ subroutine material_parsePhase(fileUnit,myPart) end select case ('(stiffness_degradation)') stiffDegradationCtr = stiffDegradationCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,positions,2_pInt))) + select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case (STIFFNESS_DEGRADATION_damage_label) phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_damage_ID case (STIFFNESS_DEGRADATION_porosity_label) @@ -1081,9 +1078,8 @@ subroutine material_parseTexture(fileUnit,myPart) character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 13_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Nsections, section, gauss, fiber, j character(len=65536) :: tag character(len=65536) :: line @@ -1136,13 +1132,13 @@ subroutine material_parseTexture(fileUnit,myPart) texture_name(section) = IO_getTag(line,'[',']') endif if (section > 0_pInt) then - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key textureType: select case(tag) case ('axes', 'rotation') textureType do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries - tag = IO_lc(IO_stringValue(line,positions,j+1_pInt)) + tag = IO_lc(IO_stringValue(line,chunkPos,j+1_pInt)) select case (tag) case('x', '+x') texture_transformation(j,1:3,section) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis @@ -1162,10 +1158,10 @@ subroutine material_parseTexture(fileUnit,myPart) enddo case ('hybridia') textureType - texture_ODFfile(section) = IO_stringValue(line,positions,2_pInt) + texture_ODFfile(section) = IO_stringValue(line,chunkPos,2_pInt) case ('symmetry') textureType - tag = IO_lc(IO_stringValue(line,positions,2_pInt)) + tag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) select case (tag) case('orthotropic') texture_symmetry(section) = 4_pInt @@ -1179,50 +1175,50 @@ subroutine material_parseTexture(fileUnit,myPart) gauss = gauss + 1_pInt texture_Gauss(1:3,gauss,section) = math_sampleRandomOri() do j = 2_pInt,4_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,positions,j)) + tag = IO_lc(IO_stringValue(line,chunkPos,j)) select case (tag) case('scatter') - texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,j+1_pInt) + texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo case ('(gauss)') textureType gauss = gauss + 1_pInt do j = 2_pInt,10_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,positions,j)) + tag = IO_lc(IO_stringValue(line,chunkPos,j)) select case (tag) case('phi1') - texture_Gauss(1,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Gauss(1,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('phi') - texture_Gauss(2,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Gauss(2,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('phi2') - texture_Gauss(3,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Gauss(3,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('scatter') - texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,j+1_pInt) + texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo case ('(fiber)') textureType fiber = fiber + 1_pInt do j = 2_pInt,12_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,positions,j)) + tag = IO_lc(IO_stringValue(line,chunkPos,j)) select case (tag) case('alpha1') - texture_Fiber(1,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Fiber(1,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('alpha2') - texture_Fiber(2,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Fiber(2,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('beta1') - texture_Fiber(3,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Fiber(3,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('beta2') - texture_Fiber(4,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Fiber(4,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('scatter') - texture_Fiber(5,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad + texture_Fiber(5,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('fraction') - texture_Fiber(6,fiber,section) = IO_floatValue(line,positions,j+1_pInt) + texture_Fiber(6,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo diff --git a/code/math.f90 b/code/math.f90 index d71fb348f..e21f3c83c 100644 --- a/code/math.f90 +++ b/code/math.f90 @@ -178,10 +178,7 @@ module math fftw_execute_dft_r2c, & fftw_execute_dft_c2r, & fftw_destroy_plan, & - math_tensorAvg, & - math_periodicNearestNeighbor, & - math_nearestNeighbor, & - math_periodicNearestNeighborDistances + math_tensorAvg #endif private :: & math_partition, & @@ -2721,148 +2718,6 @@ pure function math_rotate_forward3333(tensor,rot_tensor) end function math_rotate_forward3333 -#ifdef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief Obtain the nearest neighbor from periodic domainSet at points in querySet -!-------------------------------------------------------------------------------------------------- -function math_periodicNearestNeighbor(geomdim, Favg, querySet, domainSet) - use kdtree2_module - use IO, only: & - IO_error - - implicit none - real(pReal), dimension(3,3), intent(in) :: Favg - real(pReal), dimension(3), intent(in) :: geomdim - real(pReal), dimension(:,:), intent(in) :: querySet - real(pReal), dimension(:,:), intent(in) :: domainSet - integer(pInt), dimension(size(querySet,2)) :: math_periodicNearestNeighbor - real(pReal), dimension(size(domainSet,1),(3_pInt**size(domainSet,1))*size(domainSet,2)) :: & - domainSetLarge - - integer(pInt) :: i,j, l,m,n, spatialDim - type(kdtree2), pointer :: tree - type(kdtree2_result), dimension(1) :: Results - - if (size(querySet,1) /= size(domainSet,1)) call IO_error(407_pInt,ext_msg='query set') - spatialDim = size(querySet,1) - - i = 0_pInt - if(spatialDim == 2_pInt) then - do j = 1_pInt, size(domainSet,2) - do l = -1_pInt, 1_pInt; do m = -1_pInt, 1_pInt - i = i + 1_pInt - domainSetLarge(1:2,i) = domainSet(1:2,j) +matmul(Favg(1:2,1:2),real([l,m],pReal)*geomdim(1:2)) - enddo; enddo - enddo - else - do j = 1_pInt, size(domainSet,2) - do l = -1_pInt, 1_pInt; do m = -1_pInt, 1_pInt; do n = -1_pInt, 1_pInt - i = i + 1_pInt - domainSetLarge(1:3,i) = domainSet(1:3,j) + math_mul33x3(Favg,real([l,m,n],pReal)*geomdim) - enddo; enddo; enddo - enddo - endif - - tree => kdtree2_create(domainSetLarge,sort=.true.,rearrange=.true.) - - do j = 1_pInt, size(querySet,2) - call kdtree2_n_nearest(tp=tree, qv=querySet(1:spatialDim,j),nn=1_pInt, results = Results) - math_periodicNearestNeighbor(j) = Results(1)%idx - enddo - math_periodicNearestNeighbor = math_periodicNearestNeighbor -1_pInt ! let them run from 0 to domainPoints -1 - -end function math_periodicNearestNeighbor - - -!-------------------------------------------------------------------------------------------------- -!> @brief Obtain the nearest neighbor from domainSet at points in querySet -!-------------------------------------------------------------------------------------------------- -function math_nearestNeighbor(querySet, domainSet) - use kdtree2_module - use IO, only: & - IO_error - - implicit none - real(pReal), dimension(:,:), intent(in) :: querySet - real(pReal), dimension(:,:), intent(in) :: domainSet - integer(pInt), dimension(size(querySet,2)) :: math_nearestNeighbor - - integer(pInt) :: j, spatialDim - type(kdtree2), pointer :: tree - type(kdtree2_result), dimension(1) :: Results - - if (size(querySet,1) /= size(domainSet,1)) call IO_error(407_pInt,ext_msg='query set') - spatialDim = size(querySet,1) - - tree => kdtree2_create(domainSet,sort=.true.,rearrange=.true.) - - do j = 1_pInt, size(querySet,2) - call kdtree2_n_nearest(tp=tree, qv=querySet(1:spatialDim,j),nn=1_pInt, results = Results) - math_nearestNeighbor(j) = Results(1)%idx - enddo - math_nearestNeighbor = math_nearestNeighbor -1_pInt ! let them run from 0 to domainPoints -1 - -end function math_nearestNeighbor - - -!-------------------------------------------------------------------------------------------------- -!> @brief Obtain the distances to the next N nearest neighbors from domainSet at points in querySet -!-------------------------------------------------------------------------------------------------- -function math_periodicNearestNeighborDistances(geomdim, Favg, querySet, domainSet, Ndist) result(distances) - use kdtree2_module - use IO, only: & - IO_error - - implicit none - real(pReal), dimension(3), intent(in) :: geomdim - real(pReal), dimension(3,3), intent(in) :: Favg - integer(pInt), intent(in) :: Ndist - real(pReal), dimension(:,:), intent(in) :: querySet - real(pReal), dimension(:,:), intent(in) :: domainSet - ! output variable - real(pReal), dimension(Ndist,size(querySet,2)) :: distances - - real(pReal), dimension(size(domainSet,1),(3_pInt**size(domainSet,1))*size(domainSet,2)) & - :: domainSetLarge - - integer(pInt) :: i,j, l,m,n, spatialDim - type(kdtree2), pointer :: tree - type(kdtree2_result), dimension(:), allocatable :: Results - - allocate(Results(Ndist)) - if (size(querySet,1) /= size(domainSet,1)) call IO_error(407_pInt,ext_msg='query set') - spatialDim = size(querySet,1) - - i = 0_pInt - if(spatialDim == 2_pInt) then - do j = 1_pInt, size(domainSet,2) - do l = -1_pInt, 1_pInt; do m = -1_pInt, 1_pInt - i = i + 1_pInt - domainSetLarge(1:2,i) = domainSet(1:2,j) +matmul(Favg(1:2,1:2),real([l,m],pReal)*geomdim(1:2)) - enddo; enddo - enddo - else - do j = 1_pInt, size(domainSet,2) - do l = -1_pInt, 1_pInt; do m = -1_pInt, 1_pInt; do n = -1_pInt, 1_pInt - i = i + 1_pInt - domainSetLarge(1:3,i) = domainSet(1:3,j) + math_mul33x3(Favg,real([l,m,n],pReal)*geomdim) - enddo; enddo; enddo - enddo - endif - - tree => kdtree2_create(domainSetLarge,sort=.true.,rearrange=.true.) - - do j = 1_pInt, size(querySet,2) - call kdtree2_n_nearest(tp=tree, qv=querySet(1:spatialDim,j),nn=Ndist, results = Results) - distances(1:Ndist,j) = sqrt(Results(1:Ndist)%dis) - enddo - - deallocate(Results) - -end function math_periodicNearestNeighborDistances -#endif - - !-------------------------------------------------------------------------------------------------- !> @brief calculate average of tensor field !-------------------------------------------------------------------------------------------------- diff --git a/code/mesh.f90 b/code/mesh.f90 index e2510fcfd..949b96df3 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -421,7 +421,6 @@ module mesh public :: & mesh_spectral_getGrid, & mesh_spectral_getSize, & - mesh_regrid, & mesh_nodesAroundCentres, & mesh_deformedCoordsFFT, & mesh_volumeMismatch, & @@ -1042,7 +1041,7 @@ function mesh_spectral_getGrid(fileUnit) use IO, only: & IO_checkAndRewind, & IO_open_file, & - IO_stringPos2, & + IO_stringPos, & IO_lc, & IO_stringValue, & IO_intValue, & @@ -1054,7 +1053,7 @@ function mesh_spectral_getGrid(fileUnit) implicit none integer(pInt), dimension(3) :: mesh_spectral_getGrid integer(pInt), intent(in), optional :: fileUnit - integer(pInt), dimension(:), allocatable :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & @@ -1073,28 +1072,28 @@ function mesh_spectral_getGrid(fileUnit) call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line - positions = IO_stringPos2(line) - keyword = IO_lc(IO_StringValue(line,positions,2_pInt,.true.)) + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,positions,1_pInt) + 1_pInt + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt else call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') endif rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - positions = IO_stringPos2(line) - select case ( IO_lc(IO_StringValue(line,positions,1_pInt,.true.)) ) + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) case ('grid') gotGrid = .true. do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,positions,j))) + select case (IO_lc(IO_stringValue(line,chunkPos,j))) case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,positions,j+1_pInt) + mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,positions,j+1_pInt) + mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,positions,j+1_pInt) + mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) end select enddo end select @@ -1118,7 +1117,7 @@ function mesh_spectral_getSize(fileUnit) use IO, only: & IO_checkAndRewind, & IO_open_file, & - IO_stringPos2, & + IO_stringPos, & IO_lc, & IO_stringValue, & IO_intValue, & @@ -1130,7 +1129,7 @@ function mesh_spectral_getSize(fileUnit) implicit none real(pReal), dimension(3) :: mesh_spectral_getSize integer(pInt), intent(in), optional :: fileUnit - integer(pInt), dimension(:), allocatable :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & keyword @@ -1148,28 +1147,28 @@ function mesh_spectral_getSize(fileUnit) call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line - positions = IO_stringPos2(line) - keyword = IO_lc(IO_StringValue(line,positions,2_pInt,.true.)) + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,positions,1_pInt) + 1_pInt + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt else call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') endif rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - positions = IO_stringPos2(line) - select case ( IO_lc(IO_StringValue(line,positions,1,.true.)) ) + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) case ('size') gotSize = .true. do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,positions,j))) + select case (IO_lc(IO_stringValue(line,chunkPos,j))) case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,positions,j+1_pInt) + mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,positions,j+1_pInt) + mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,positions,j+1_pInt) + mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo end select @@ -1193,7 +1192,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) use IO, only: & IO_checkAndRewind, & IO_open_file, & - IO_stringPos2, & + IO_stringPos, & IO_lc, & IO_stringValue, & IO_intValue, & @@ -1203,7 +1202,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) implicit none integer(pInt), intent(in), optional :: fileUnit - integer(pInt), dimension(:), allocatable :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & keyword @@ -1221,21 +1220,21 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line - positions = IO_stringPos2(line) - keyword = IO_lc(IO_StringValue(line,positions,2_pInt,.true.)) + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,positions,1_pInt) + 1_pInt + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt else call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') endif rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - positions = IO_stringPos2(line) - select case ( IO_lc(IO_StringValue(line,positions,1,.true.)) ) + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) case ('homogenization') gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,positions,2_pInt) + mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) end select enddo @@ -1346,7 +1345,7 @@ subroutine mesh_spectral_build_elements(fileUnit) IO_checkAndRewind, & IO_lc, & IO_stringValue, & - IO_stringPos2, & + IO_stringPos, & IO_error, & IO_continuousIntValues, & IO_intValue, & @@ -1355,8 +1354,7 @@ subroutine mesh_spectral_build_elements(fileUnit) implicit none integer(pInt), intent(in) :: & fileUnit - integer(pInt), dimension(1_pInt+7_pInt*2_pInt) :: & - myPos + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & e, i, & headerLength = 0_pInt, & @@ -1381,10 +1379,10 @@ subroutine mesh_spectral_build_elements(fileUnit) ! get header length call IO_checkAndRewind(fileUnit) read(fileUnit,'(a65536)') line - myPos = IO_stringPos2(line) - keyword = IO_lc(IO_StringValue(line,myPos,2_pInt,.true.)) + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,myPos,1_pInt) + 1_pInt + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt else call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') endif @@ -1509,435 +1507,6 @@ subroutine mesh_spectral_build_ipNeighborhood(fileUnit) end subroutine mesh_spectral_build_ipNeighborhood -!-------------------------------------------------------------------------------------------------- -!> @brief Performes a regridding from saved restart information -!-------------------------------------------------------------------------------------------------- -function mesh_regrid(adaptive,resNewInput,minRes) - use prec, only: & - pInt, & - pReal - use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & - getSolverJobName, & - GeometryFile - use IO, only: & - IO_open_file, & - IO_read_realFile ,& - IO_read_intFile ,& - IO_write_jobRealFile, & - IO_write_jobIntFile, & - IO_write_jobFile, & - IO_error - use numerics, only: & - spectral_solver - use math, only: & - math_periodicNearestNeighbor, & - math_mul33x3 - - implicit none - logical, intent(in) :: adaptive ! if true, choose adaptive grid based on resNewInput, otherwise keep it constant - integer(pInt), dimension(3), optional, intent(in) :: resNewInput ! f2py cannot handle optional arguments correctly (they are always present) - integer(pInt), dimension(3), optional, intent(in) :: minRes - integer(pInt), dimension(3) :: mesh_regrid, ratio, grid - integer(pInt), parameter :: FILEUNIT = 777_pInt - integer(pInt), dimension(3,2) :: possibleResNew - integer(pInt):: maxsize, i, j, k, ielem, NpointsNew, spatialDim, Nelems - integer(pInt), dimension(3) :: resNew - integer(pInt), dimension(:), allocatable :: indices - real(pReal) :: wgt - real(pReal), dimension(3) :: geomSizeNew, geomSize - real(pReal), dimension(3,3) :: Favg, Favg_LastInc - real(pReal), dimension(:,:), allocatable :: & - coordinates, coordinatesNew - real(pReal), dimension(:,:,:), allocatable :: & - stateHomog - real(pReal), dimension (:,:,:,:), allocatable :: & - spectralF9, spectralF9New, & - Tstar, TstarNew, & - stateConst - real(pReal), dimension(:,:,:,:,:), allocatable :: & - F, FNew, & - Fp, FpNew, & - Lp, LpNew, & - dcsdE, dcsdENew, & - F_lastIncNew - real(pReal), dimension (:,:,:,:,:,:,:), allocatable :: & - dPdF, dPdFNew - character(len=1024):: formatString, N_Digits - integer(pInt), dimension(:,:), allocatable :: & - sizeStateHomog - integer(pInt), dimension(:,:,:), allocatable :: & - material_phase, material_phaseNew, & - sizeStateConst - - call IO_open_file(FILEUNIT,trim(geometryFile)) - grid = mesh_spectral_getGrid(FILEUNIT) - geomSize = mesh_spectral_getsize(FILEUNIT) - close(FILEUNIT) - - Nelems = product(grid) - wgt = 1.0_pReal/real(Nelems,pReal) - - write(6,'(a)') 'Regridding geometry' - if (adaptive) then - write(6,'(a)') 'adaptive resolution determination' - if (present(minRes)) then - if (all(minRes /= -1_pInt)) & !the f2py way to tell it is present - write(6,'(a,3(i12))') ' given minimum resolution ', minRes - endif - if (present(resNewInput)) then - if (any (resNewInput<1)) call IO_error(890_pInt, ext_msg = 'resNewInput') !the f2py way to tell it is not present - write(6,'(a,3(i12))') ' target resolution ', resNewInput - else - call IO_error(890_pInt, ext_msg = 'resNewInput') - endif - endif - - allocate(coordinates(3,Nelems)) - - -!-------------------------------------------------------------------------------------------------- -! read in deformation gradient to calculate coordinates, shape depend of selected solver - select case(spectral_solver) - case('basicpetsc','al','polarization') - allocate(spectralF9(9,grid(1),grid(2),grid(3))) - call IO_read_realFile(FILEUNIT,'F',trim(getSolverJobName()),size(spectralF9)) - read (FILEUNIT,rec=1) spectralF9 - close (FILEUNIT) - Favg = reshape(sum(sum(sum(spectralF9,dim=4),dim=3),dim=2) * wgt, [3,3]) - coordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(spectralF9, & - [3,3,grid(1),grid(2),grid(3)])),[3,mesh_NcpElems]) - end select - -!-------------------------------------------------------------------------------------------------- -! sanity check 2D/3D case - if (grid(3)== 1_pInt) then - spatialDim = 2_pInt - if (present (minRes)) then - if (minRes(1) > 0_pInt .or. minRes(2) > 0_pInt) then - if (minRes(3) /= 1_pInt .or. & - mod(minRes(1),2_pInt) /= 0_pInt .or. & - mod(minRes(2),2_pInt) /= 0_pInt) call IO_error(890_pInt, ext_msg = '2D minRes') ! as f2py has problems with present, use pyf file for initialization to -1 - endif; endif - else - spatialDim = 3_pInt - if (present (minRes)) then - if (any(minRes > 0_pInt)) then - if (mod(minRes(1),2_pInt) /= 0_pInt .or. & - mod(minRes(2),2_pInt) /= 0_pInt .or. & - mod(minRes(3),2_pInt) /= 0_pInt) call IO_error(890_pInt, ext_msg = '3D minRes') ! as f2py has problems with present, use pyf file for initialization to -1 - endif; endif - endif - -!-------------------------------------------------------------------------------------------------- -! Automatic detection based on current geom - geomSizeNew = math_mul33x3(Favg,geomSize) - if (adaptive) then - ratio = floor(real(resNewInput,pReal) * (geomSizeNew/geomSize), pInt) - - possibleResNew = 1_pInt - do i = 1_pInt, spatialDim - if (mod(ratio(i),2) == 0_pInt) then - possibleResNew(i,1:2) = [ratio(i),ratio(i) + 2_pInt] - else - possibleResNew(i,1:2) = [ratio(i)-1_pInt, ratio(i) + 1_pInt] - endif - if (.not.present(minRes)) then ! calling from fortran, optional argument not given - possibleResNew = possibleResNew - else ! optional argument is there - if (any(minRes<1_pInt)) then - possibleResNew = possibleResNew ! f2py calling, but without specification (or choosing invalid values), standard from pyf = -1 - else ! given useful values - forall(k = 1_pInt:3_pInt, j = 1_pInt:3_pInt) & - possibleResNew(j,k) = max(possibleResNew(j,k), minRes(j)) - endif - endif - enddo - - k = huge(1_pInt) - do i = 0_pInt, 2_pInt**spatialDim - 1 - j = abs( possibleResNew(1,iand(i,1_pInt)/1_pInt + 1_pInt) & - * possibleResNew(2,iand(i,2_pInt)/2_pInt + 1_pInt) & - * possibleResNew(3,iand(i,4_pInt)/4_pInt + 1_pInt) & - - resNewInput(1)*resNewInput(2)*resNewInput(3)) - - if (j < k) then - k = j - resNew =[ possibleResNew(1,iand(i,1_pInt)/1_pInt + 1_pInt), & - possibleResNew(2,iand(i,2_pInt)/2_pInt + 1_pInt), & - possibleResNew(3,iand(i,4_pInt)/4_pInt + 1_pInt) ] - endif - enddo - else - resNew = grid - endif - - mesh_regrid = resNew - NpointsNew = product(resNew) - -!-------------------------------------------------------------------------------------------------- -! Calculate regular new coordinates - allocate(coordinatesNew(3,NpointsNew)) - ielem = 0_pInt - do k=1_pInt,resNew(3); do j=1_pInt, resNew(2); do i=1_pInt, resNew(1) - ielem = ielem + 1_pInt - coordinatesNew(1:3,ielem) = math_mul33x3(Favg, geomSize/real(resNew,pReal)*real([i,j,k],pReal) & - - geomSize/real(2_pInt*resNew,pReal)) - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! Nearest neighbour search - allocate(indices(NpointsNew)) - indices = math_periodicNearestNeighbor(geomSize, Favg, coordinatesNew, coordinates) - deallocate(coordinates) - -!-------------------------------------------------------------------------------------------------- -! write out indices periodic - write(N_Digits, '(I16.16)') 1_pInt + int(log10(real(maxval(indices),pReal))) - N_Digits = adjustl(N_Digits) - formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)' - - call IO_write_jobFile(FILEUNIT,'IDX') ! make it a general open-write file - write(FILEUNIT, '(A)') '1 header' - write(FILEUNIT, '(A)') 'Numbered indices as per the large set' - do i = 1_pInt, NpointsNew - write(FILEUNIT,trim(formatString),advance='no') indices(i), ' ' - if(mod(i,resNew(1)) == 0_pInt) write(FILEUNIT,'(A)') '' - enddo - close(FILEUNIT) - - -!-------------------------------------------------------------------------------------------------- -! calculate and write out indices non periodic - do i = 1_pInt, NpointsNew - indices(i) = indices(i) / 3_pInt**spatialDim +1_pInt ! +1 b'coz index count starts from '0' - enddo - write(N_Digits, '(I16.16)') 1_pInt + int(log10(real(maxval(indices),pReal))) - N_Digits = adjustl(N_Digits) - formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)' - - call IO_write_jobFile(FILEUNIT,'idx') ! make it a general open-write file - write(FILEUNIT, '(A)') '1 header' - write(FILEUNIT, '(A)') 'Numbered indices as per the small set' - do i = 1_pInt, NpointsNew - write(FILEUNIT,trim(formatString),advance='no') indices(i), ' ' - if(mod(i,resNew(1)) == 0_pInt) write(FILEUNIT,'(A)') '' - enddo - close(FILEUNIT) - -!-------------------------------------------------------------------------------------------------- -! write out new geom file - write(N_Digits, '(I16.16)') 1_pInt+int(log10(real(maxval(mesh_element(4,1:mesh_NcpElems)),pReal)),pInt) - N_Digits = adjustl(N_Digits) - formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)' - open(FILEUNIT,file=trim(getSolverWorkingDirectoryName())//trim(GeometryFile),status='REPLACE') - write(FILEUNIT, '(A)') '3 header' - write(FILEUNIT, '(3(A, I8))') 'grid a ', resNew(1), ' b ', resNew(2), ' c ', resNew(3) - write(FILEUNIT, '(3(A, g17.10))') 'size x ', geomSize(1), ' y ', geomSize(2), ' z ', geomSize(3) - write(FILEUNIT, '(A)') 'homogenization 1' - do i = 1_pInt, NpointsNew - write(FILEUNIT,trim(formatString),advance='no') mesh_element(4,indices(i)), ' ' - if(mod(i,resNew(1)) == 0_pInt) write(FILEUNIT,'(A)') '' - enddo - close(FILEUNIT) - -!-------------------------------------------------------------------------------------------------- -! set F to average values - select case(spectral_solver) - case('basicpetsc','al','polarization') - allocate(spectralF9New(9,resNew(1),resNew(2),resNew(3))) - spectralF9New = spread(spread(spread(reshape(Favg,[9]),2,resNew(1)),3,resNew(2)),4,resNew(3)) - call IO_write_jobRealFile(FILEUNIT,'F',size(spectralF9New)) - write (FILEUNIT,rec=1) spectralF9New - close (FILEUNIT) - end select - -!--------------------------------------------------------------------------------- - allocate(F_lastIncNew(3,3,resNew(1),resNew(2),resNew(3))) - - call IO_read_realFile(FILEUNIT,'F_aim_lastInc', & - trim(getSolverJobName()),size(Favg_LastInc)) - read (FILEUNIT,rec=1) Favg_LastInc - close (FILEUNIT) - - F_lastIncNew = spread(spread(spread(Favg_LastInc,3,resNew(1)),4,resNew(2)),5,resNew(3)) - - call IO_write_jobRealFile(FILEUNIT,'convergedSpectralDefgrad_lastInc',size(F_LastIncNew)) - write (FILEUNIT,rec=1) F_LastIncNew - close (FILEUNIT) - - deallocate(F_lastIncNew) - -! relocating data of material subroutine --------------------------------------------------------- - allocate(material_phase (1,1, mesh_NcpElems)) - allocate(material_phaseNew (1,1, NpointsNew)) - call IO_read_intFile(FILEUNIT,'recordedPhase',trim(getSolverJobName()),size(material_phase)) - read (FILEUNIT,rec=1) material_phase - close (FILEUNIT) - do i = 1, NpointsNew - material_phaseNew(1,1,i) = material_phase(1,1,indices(i)) - enddo - do i = 1, mesh_NcpElems - if (all(material_phaseNew(1,1,:) /= material_phase(1,1,i))) then - write(6,*) 'mismatch in regridding' - write(6,*) material_phase(1,1,i), 'not found in material_phaseNew' - endif - enddo - call IO_write_jobIntFile(FILEUNIT,'recordedPhase',size(material_phaseNew)) - write (FILEUNIT,rec=1) material_phaseNew - close (FILEUNIT) - deallocate(material_phase) - deallocate(material_phaseNew) -!--------------------------------------------------------------------------- - allocate(F (3,3,1,1, mesh_NcpElems)) - allocate(FNew (3,3,1,1, NpointsNew)) - call IO_read_realFile(FILEUNIT,'convergedF',trim(getSolverJobName()),size(F)) - read (FILEUNIT,rec=1) F - close (FILEUNIT) - do i = 1, NpointsNew - FNew(1:3,1:3,1,1,i) = F(1:3,1:3,1,1,indices(i)) - enddo - - call IO_write_jobRealFile(FILEUNIT,'convergedF',size(FNew)) - write (FILEUNIT,rec=1) FNew - close (FILEUNIT) - deallocate(F) - deallocate(FNew) -!--------------------------------------------------------------------- - allocate(Fp (3,3,1,1,mesh_NcpElems)) - allocate(FpNew (3,3,1,1,NpointsNew)) - call IO_read_realFile(FILEUNIT,'convergedFp',trim(getSolverJobName()),size(Fp)) - read (FILEUNIT,rec=1) Fp - close (FILEUNIT) - do i = 1, NpointsNew - FpNew(1:3,1:3,1,1,i) = Fp(1:3,1:3,1,1,indices(i)) - enddo - - call IO_write_jobRealFile(FILEUNIT,'convergedFp',size(FpNew)) - write (FILEUNIT,rec=1) FpNew - close (FILEUNIT) - deallocate(Fp) - deallocate(FpNew) -!------------------------------------------------------------------------ - allocate(Lp (3,3,1,1,mesh_NcpElems)) - allocate(LpNew (3,3,1,1,NpointsNew)) - call IO_read_realFile(FILEUNIT,'convergedLp',trim(getSolverJobName()),size(Lp)) - read (FILEUNIT,rec=1) Lp - close (FILEUNIT) - do i = 1, NpointsNew - LpNew(1:3,1:3,1,1,i) = Lp(1:3,1:3,1,1,indices(i)) - enddo - call IO_write_jobRealFile(FILEUNIT,'convergedLp',size(LpNew)) - write (FILEUNIT,rec=1) LpNew - close (FILEUNIT) - deallocate(Lp) - deallocate(LpNew) -!---------------------------------------------------------------------------- - allocate(dcsdE (6,6,1,1,mesh_NcpElems)) - allocate(dcsdENew (6,6,1,1,NpointsNew)) - call IO_read_realFile(FILEUNIT,'convergeddcsdE',trim(getSolverJobName()),size(dcsdE)) - read (FILEUNIT,rec=1) dcsdE - close (FILEUNIT) - do i = 1, NpointsNew - dcsdENew(1:6,1:6,1,1,i) = dcsdE(1:6,1:6,1,1,indices(i)) - enddo - call IO_write_jobRealFile(FILEUNIT,'convergeddcsdE',size(dcsdENew)) - write (FILEUNIT,rec=1) dcsdENew - close (FILEUNIT) - deallocate(dcsdE) - deallocate(dcsdENew) -!--------------------------------------------------------------------------- - allocate(dPdF (3,3,3,3,1,1,mesh_NcpElems)) - allocate(dPdFNew (3,3,3,3,1,1,NpointsNew)) - call IO_read_realFile(FILEUNIT,'convergeddPdF',trim(getSolverJobName()),size(dPdF)) - read (FILEUNIT,rec=1) dPdF - close (FILEUNIT) - do i = 1, NpointsNew - dPdFNew(1:3,1:3,1:3,1:3,1,1,i) = dPdF(1:3,1:3,1:3,1:3,1,1,indices(i)) - enddo - call IO_write_jobRealFile(FILEUNIT,'convergeddPdF',size(dPdFNew)) - write (FILEUNIT,rec=1) dPdFNew - close (FILEUNIT) - deallocate(dPdF) - deallocate(dPdFNew) -!--------------------------------------------------------------------------- - allocate(Tstar (6,1,1,mesh_NcpElems)) - allocate(TstarNew (6,1,1,NpointsNew)) - call IO_read_realFile(FILEUNIT,'convergedTstar',trim(getSolverJobName()),size(Tstar)) - read (FILEUNIT,rec=1) Tstar - close (FILEUNIT) - do i = 1, NpointsNew - TstarNew(1:6,1,1,i) = Tstar(1:6,1,1,indices(i)) - enddo - call IO_write_jobRealFile(FILEUNIT,'convergedTstar',size(TstarNew)) - write (FILEUNIT,rec=1) TstarNew - close (FILEUNIT) - deallocate(Tstar) - deallocate(TstarNew) - -! for the state, we first have to know the size---------------------------------------------------- - allocate(sizeStateConst(1,1,mesh_NcpElems)) - call IO_read_intFile(FILEUNIT,'sizeStateConst',trim(getSolverJobName()),size(sizeStateConst)) - read (FILEUNIT,rec=1) sizeStateConst - close (FILEUNIT) - maxsize = maxval(sizeStateConst(1,1,1:mesh_NcpElems)) - allocate(StateConst (1,1,mesh_NcpElems,maxsize)) - - call IO_read_realFile(FILEUNIT,'convergedStateConst',trim(getSolverJobName())) - k = 0_pInt - do i =1, mesh_NcpElems - do j = 1,sizeStateConst(1,1,i) - k = k+1_pInt - read(FILEUNIT,rec=k) StateConst(1,1,i,j) - enddo - enddo - close(FILEUNIT) - call IO_write_jobRealFile(FILEUNIT,'convergedStateConst') - k = 0_pInt - do i = 1,NpointsNew - do j = 1,sizeStateConst(1,1,indices(i)) - k=k+1_pInt - write(FILEUNIT,rec=k) StateConst(1,1,indices(i),j) - enddo - enddo - close (FILEUNIT) - deallocate(sizeStateConst) - deallocate(StateConst) -!---------------------------------------------------------------------------- - allocate(sizeStateHomog(1,mesh_NcpElems)) - call IO_read_intFile(FILEUNIT,'sizeStateHomog',trim(getSolverJobName()),size(sizeStateHomog)) - read (FILEUNIT,rec=1) sizeStateHomog - close (FILEUNIT) - maxsize = maxval(sizeStateHomog(1,1:mesh_NcpElems)) - allocate(stateHomog (1,mesh_NcpElems,maxsize)) - - call IO_read_realFile(FILEUNIT,'convergedStateHomog',trim(getSolverJobName())) - k = 0_pInt - do i =1, mesh_NcpElems - do j = 1,sizeStateHomog(1,i) - k = k+1_pInt - read(FILEUNIT,rec=k) stateHomog(1,i,j) - enddo - enddo - close(FILEUNIT) - call IO_write_jobRealFile(FILEUNIT,'convergedStateHomog') - k = 0_pInt - do i = 1,NpointsNew - do j = 1,sizeStateHomog(1,indices(i)) - k=k+1_pInt - write(FILEUNIT,rec=k) stateHomog(1,indices(i),j) - enddo - enddo - close (FILEUNIT) - deallocate(sizeStateHomog) - deallocate(stateHomog) - - deallocate(indices) - write(6,*) 'finished regridding' - -end function mesh_regrid - - !-------------------------------------------------------------------------------------------------- !> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) !-------------------------------------------------------------------------------------------------- @@ -2367,8 +1936,7 @@ subroutine mesh_marc_get_tableStyles(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 6_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line initialcondTableStyle = 0_pInt @@ -2379,11 +1947,11 @@ subroutine mesh_marc_get_tableStyles(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) + chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'table' .and. myPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,myPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,myPos,5_pInt) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then + initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) + hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) exit endif enddo @@ -2405,8 +1973,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 4_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line mesh_Nnodes = 0_pInt @@ -2417,14 +1984,14 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) + chunkPos = IO_stringPos(line) - if ( IO_lc(IO_StringValue(line,myPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,myPos,3_pInt) - if ( IO_lc(IO_StringValue(line,myPos,1_pInt)) == 'coordinates') then + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - mesh_Nnodes = IO_IntValue (line,myPos,2_pInt) + chunkPos = IO_stringPos(line) + mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) exit ! assumes that "coordinates" comes later in file endif enddo @@ -2446,8 +2013,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line mesh_NelemSets = 0_pInt @@ -2458,10 +2024,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) + chunkPos = IO_stringPos(line) - if ( IO_lc(IO_StringValue(line,myPos,1_pInt)) == 'define' .and. & - IO_lc(IO_StringValue(line,myPos,2_pInt)) == 'element' ) then + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then mesh_NelemSets = mesh_NelemSets + 1_pInt mesh_maxNelemInSet = max(mesh_maxNelemInSet, & IO_countContinuousIntValues(fileUnit)) @@ -2486,8 +2052,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 4_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: elemSet = 0_pInt @@ -2499,11 +2064,11 @@ subroutine mesh_marc_map_elementSets(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=640) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if( (IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'define' ) .and. & - (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'element' ) ) then + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then elemSet = elemSet+1_pInt - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,myPos,4_pInt)) + mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) mesh_mapElemSet(:,elemSet) = & IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) endif @@ -2525,8 +2090,7 @@ subroutine mesh_marc_count_cpElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i character(len=300):: line @@ -2537,9 +2101,9 @@ subroutine mesh_marc_count_cpElements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) + chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'hypoelastic') then + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines read (fileUnit,610,END=620) line enddo @@ -2566,8 +2130,7 @@ subroutine mesh_marc_map_elements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts @@ -2580,8 +2143,8 @@ subroutine mesh_marc_map_elements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=660) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'hypoelastic' ) then + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines read (fileUnit,610,END=660) line enddo @@ -2615,8 +2178,7 @@ subroutine mesh_marc_map_nodes(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line integer(pInt), dimension (mesh_Nnodes) :: node_count @@ -2631,8 +2193,8 @@ subroutine mesh_marc_map_nodes(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=650) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'coordinates' ) then + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then read (fileUnit,610,END=650) line ! skip crap line do i = 1_pInt,mesh_Nnodes read (fileUnit,610,END=650) line @@ -2665,8 +2227,7 @@ subroutine mesh_marc_build_nodes(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), parameter :: MAXNCHUNKS = 1_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,j,m @@ -2678,8 +2239,8 @@ subroutine mesh_marc_build_nodes(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=670) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'coordinates' ) then + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then read (fileUnit,610,END=670) line ! skip crap line do i=1_pInt,mesh_Nnodes read (fileUnit,610,END=670) line @@ -2713,8 +2274,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,t,g,e,c @@ -2727,22 +2287,22 @@ subroutine mesh_marc_count_cpSizes(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=630) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'connectivity' ) then + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then read (fileUnit,610,END=630) line ! Garbage line do i=1_pInt,mesh_Nelems ! read all elements read (fileUnit,610,END=630) line - myPos = IO_stringPos(line,MAXNCHUNKS) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,myPos,1_pInt)) + chunkPos = IO_stringPos(line) ! limit to id and type + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,myPos,2_pInt)) + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) g = FE_geomtype(t) c = FE_celltype(g) mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(myPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line endif enddo exit @@ -2769,8 +2329,7 @@ subroutine mesh_marc_build_elements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 66_pInt ! limit to 64 nodes max (plus ID, type) - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts @@ -2783,30 +2342,30 @@ subroutine mesh_marc_build_elements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos(1:1+2*1) = IO_stringPos(line,1_pInt) - if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'connectivity' ) then + chunkPos(1:1+2*1) = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then read (fileUnit,610,END=620) line ! garbage line do i = 1_pInt,mesh_Nelems read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - e = mesh_FEasCP('elem',IO_intValue(line,myPos,1_pInt)) + chunkPos = IO_stringPos(line) + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = IO_IntValue (line,myPos,1_pInt) ! FE id - t = FE_mapElemtype(IO_StringValue(line,myPos,2_pInt)) ! elem type + mesh_element(1,e) = IO_IntValue (line,chunkPos,1_pInt) ! FE id + t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type mesh_element(2,e) = t nNodesAlreadyRead = 0_pInt - do j = 1_pInt,myPos(1)-2_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,myPos,j+2_pInt)) ! CP ids of nodes + do j = 1_pInt,chunkPos(1)-2_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes enddo - nNodesAlreadyRead = myPos(1) - 2_pInt + nNodesAlreadyRead = chunkPos(1) - 2_pInt do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - do j = 1_pInt,myPos(1) + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,myPos,j)) ! CP ids of nodes + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes enddo - nNodesAlreadyRead = nNodesAlreadyRead + myPos(1) + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) enddo endif enddo @@ -2817,17 +2376,17 @@ subroutine mesh_marc_build_elements(fileUnit) 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" read (fileUnit,610,END=620) line do - myPos(1:1+2*2) = IO_stringPos(line,2_pInt) - if( (IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'initial') .and. & - (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'state') ) then + chunkPos(1:1+2*2) = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style read (fileUnit,610,END=630) line ! read line with index of state var - myPos(1:1+2*1) = IO_stringPos(line,1_pInt) - sv = IO_IntValue(line,myPos,1_pInt) ! figure state variable index + chunkPos(1:1+2*1) = IO_stringPos(line) + sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest read (fileUnit,610,END=620) line ! read line with value of state var - myPos(1:1+2*1) = IO_stringPos(line,1_pInt) - do while (scan(IO_stringValue(line,myPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? + chunkPos(1:1+2*1) = IO_stringPos(line) + do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index if (initialcondTableStyle == 2_pInt) then @@ -2842,7 +2401,7 @@ subroutine mesh_marc_build_elements(fileUnit) enddo if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style read (fileUnit,610,END=630) line - myPos(1:1+2*1) = IO_stringPos(line,1_pInt) + chunkPos(1:1+2*1) = IO_stringPos(line) enddo endif else @@ -2869,8 +2428,7 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line logical :: inPart @@ -2883,26 +2441,26 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. if (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,myPos,1_pInt))) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) case('*node') if( & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'response' & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & ) & mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) case('*element') if( & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'response' & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & ) then mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) endif @@ -2930,8 +2488,7 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line logical :: inPart @@ -2944,12 +2501,12 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*elset' ) & + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & mesh_NelemSets = mesh_NelemSets + 1_pInt enddo @@ -2974,8 +2531,7 @@ subroutine mesh_abaqus_count_materials(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line logical inPart @@ -2987,14 +2543,14 @@ subroutine mesh_abaqus_count_materials(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,myPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,myPos,2_pInt)) == 'section' ) & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & mesh_Nmaterials = mesh_Nmaterials + 1_pInt enddo @@ -3020,8 +2576,7 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 4_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: elemSet = 0_pInt,i logical :: inPart = .false. @@ -3035,14 +2590,14 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=640) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*elset' ) then + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then elemSet = elemSet + 1_pInt - mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,myPos,2_pInt)),'elset')) + mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& mesh_mapElemSet,elemSet-1_pInt) endif @@ -3071,8 +2626,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 20_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line integer(pInt) :: i,c = 0_pInt @@ -3087,23 +2641,23 @@ subroutine mesh_abaqus_map_materials(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,myPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,myPos,2_pInt)) == 'section' ) then + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then elemSetName = '' materialName = '' - do i = 3_pInt,myPos(1_pInt) - if (IO_extractValue(IO_lc(IO_stringValue(line,myPos,i)),'elset') /= '') & - elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,myPos,i)),'elset')) - if (IO_extractValue(IO_lc(IO_stringValue(line,myPos,i)),'material') /= '') & - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,myPos,i)),'material')) + do i = 3_pInt,chunkPos(1_pInt) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & + elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) enddo if (elemSetName /= '' .and. materialName /= '') then @@ -3136,8 +2690,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line integer(pInt) :: i,k logical :: materialFound = .false. @@ -3150,13 +2703,13 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - select case ( IO_lc(IO_stringValue(line,myPos,1_pInt)) ) + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,myPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if (IO_lc(IO_StringValue(line,myPos,2_pInt)) == 'material' .and. materialFound) then + if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then do i = 1_pInt,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet @@ -3192,8 +2745,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) ::i,j,k,cpElem = 0_pInt logical :: materialFound = .false. @@ -3206,13 +2758,13 @@ subroutine mesh_abaqus_map_elements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=660) line - myPos = IO_stringPos(line,MAXNCHUNKS) - select case ( IO_lc(IO_stringValue(line,myPos,1_pInt)) ) + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,myPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'material' .and. materialFound) then + if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then do i = 1_pInt,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet @@ -3256,8 +2808,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line integer(pInt) :: i,c,cpNode = 0_pInt @@ -3270,17 +2821,17 @@ subroutine mesh_abaqus_map_nodes(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=650) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & ) then c = IO_countDataLines(fileUnit) do i = 1_pInt,c @@ -3288,9 +2839,9 @@ subroutine mesh_abaqus_map_nodes(fileUnit) enddo do i = 1_pInt,c read (fileUnit,610,END=650) line - myPos = IO_stringPos(line,MAXNCHUNKS) + chunkPos = IO_stringPos(line) cpNode = cpNode + 1_pInt - mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,myPos,1_pInt) + mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode enddo endif @@ -3320,8 +2871,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 4_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,j,m,c logical :: inPart @@ -3335,17 +2885,17 @@ subroutine mesh_abaqus_build_nodes(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=670) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & ) then c = IO_countDataLines(fileUnit) ! how many nodes are defined here? do i = 1_pInt,c @@ -3353,10 +2903,10 @@ subroutine mesh_abaqus_build_nodes(fileUnit) enddo do i = 1_pInt,c read (fileUnit,610,END=670) line - myPos = IO_stringPos(line,MAXNCHUNKS) - m = mesh_FEasCP('node',IO_intValue(line,myPos,1_pInt)) + chunkPos = IO_stringPos(line) + m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,myPos,j+1_pInt) + mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) enddo enddo endif @@ -3386,8 +2936,7 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 2_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,c,t,g logical :: inPart @@ -3403,18 +2952,18 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,myPos,2_pInt)),'type')) ! remember elem type + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type g = FE_geomtype(t) c = FE_celltype(g) mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) @@ -3446,8 +2995,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 65_pInt - integer(pInt), dimension (1_pInt+2_pInt*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead logical inPart,materialFound @@ -3462,42 +3010,42 @@ subroutine mesh_abaqus_build_elements(fileUnit) rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos(1:1+2*2) = IO_stringPos(line,2_pInt) - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'part' ) inPart = .false. + chunkPos(1:1+2*2) = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,myPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,myPos,2_pInt)) /= 'response' ) & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,myPos,2_pInt)),'type')) ! remember elem type + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type c = IO_countDataLines(fileUnit) do i = 1_pInt,c backspace(fileUnit) enddo do i = 1_pInt,c read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) ! limit to 64 nodes max - e = mesh_FEasCP('elem',IO_intValue(line,myPos,1_pInt)) + chunkPos = IO_stringPos(line) ! limit to 64 nodes max + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = IO_intValue(line,myPos,1_pInt) ! FE id + mesh_element(1,e) = IO_intValue(line,chunkPos,1_pInt) ! FE id mesh_element(2,e) = t ! elem type nNodesAlreadyRead = 0_pInt - do j = 1_pInt,myPos(1)-1_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,myPos,1_pInt+j)) ! put CP ids of nodes to position 5: + do j = 1_pInt,chunkPos(1)-1_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: enddo - nNodesAlreadyRead = myPos(1) - 1_pInt + nNodesAlreadyRead = chunkPos(1) - 1_pInt do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - do j = 1_pInt,myPos(1) + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,myPos,j)) ! CP ids of nodes + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes enddo - nNodesAlreadyRead = nNodesAlreadyRead + myPos(1) + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) enddo endif enddo @@ -3510,18 +3058,18 @@ subroutine mesh_abaqus_build_elements(fileUnit) materialFound = .false. do read (fileUnit,610,END=630) line - myPos = IO_stringPos(line,MAXNCHUNKS) - select case ( IO_lc(IO_StringValue(line,myPos,1_pInt))) + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,myPos,2_pInt)),'name')) ! extract name=value + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value materialFound = materialName /= '' ! valid name? case('*user') - if ( IO_lc(IO_StringValue(line,myPos,2_pInt)) == 'material' .and. & + if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & materialFound ) then read (fileUnit,610,END=630) line ! read homogenization and microstructure - myPos(1:1+2*2) = IO_stringPos(line,2_pInt) - homog = nint(IO_floatValue(line,myPos,1_pInt),pInt) - micro = nint(IO_floatValue(line,myPos,2_pInt),pInt) + chunkPos(1:1+2*2) = IO_stringPos(line) + homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) + micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) do i = 1_pInt,mesh_Nmaterials ! look thru material names if (materialName == mesh_nameMaterial(i)) then ! found one elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet @@ -3561,8 +3109,7 @@ use IO, only: & integer(pInt), intent(in) :: fileUnit #ifndef Spectral - integer(pInt), parameter :: MAXNCHUNKS = 5_pInt - integer(pInt), dimension (1+2*MAXNCHUNKS) :: myPos + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) chunk, Nchunks character(len=300) :: line, damaskOption, v character(len=300) :: keyword @@ -3582,14 +3129,14 @@ use IO, only: & rewind(fileUnit) do read (fileUnit,610,END=620) line - myPos = IO_stringPos(line,MAXNCHUNKS) - Nchunks = myPos(1) - if (IO_lc(IO_stringValue(line,myPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,myPos,2_pInt)) + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) select case(damaskOption) case('periodic') ! damask Option that allows to specify periodic fluxes do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,myPos,chunk)) ! chunk matches keyvalues x,y, or z? + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' diff --git a/code/numerics.f90 b/code/numerics.f90 index b8bdaf094..98c0b5160 100644 --- a/code/numerics.f90 +++ b/code/numerics.f90 @@ -221,11 +221,10 @@ subroutine numerics_init implicit none !$ include "omp_lib.h" ! use the not F90 standard conforming include file to prevent crashes with some versions of MSC.Marc #endif - integer(pInt), parameter :: FILEUNIT = 300_pInt ,& - MAXNCHUNKS = 2_pInt + integer(pInt), parameter :: FILEUNIT = 300_pInt !$ integer :: gotDAMASK_NUM_THREADS = 1 integer :: i, ierr ! no pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: & tag ,& line @@ -273,183 +272,184 @@ subroutine numerics_init if(line(i:i) == '=') line(i:i) = ' ' ! also allow keyword = value version enddo if (IO_isBlank(line)) cycle ! skip empty lines - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) case ('relevantstrain') - relevantStrain = IO_floatValue(line,positions,2_pInt) + relevantStrain = IO_floatValue(line,chunkPos,2_pInt) case ('defgradtolerance') - defgradTolerance = IO_floatValue(line,positions,2_pInt) + defgradTolerance = IO_floatValue(line,chunkPos,2_pInt) case ('ijacostiffness') - iJacoStiffness = IO_intValue(line,positions,2_pInt) + iJacoStiffness = IO_intValue(line,chunkPos,2_pInt) case ('ijacolpresiduum') - iJacoLpresiduum = IO_intValue(line,positions,2_pInt) + iJacoLpresiduum = IO_intValue(line,chunkPos,2_pInt) case ('pert_fg') - pert_Fg = IO_floatValue(line,positions,2_pInt) + pert_Fg = IO_floatValue(line,chunkPos,2_pInt) case ('pert_method') - pert_method = IO_intValue(line,positions,2_pInt) + pert_method = IO_intValue(line,chunkPos,2_pInt) case ('nhomog') - nHomog = IO_intValue(line,positions,2_pInt) + nHomog = IO_intValue(line,chunkPos,2_pInt) case ('nmpstate') - nMPstate = IO_intValue(line,positions,2_pInt) + nMPstate = IO_intValue(line,chunkPos,2_pInt) case ('ncryst') - nCryst = IO_intValue(line,positions,2_pInt) + nCryst = IO_intValue(line,chunkPos,2_pInt) case ('nstate') - nState = IO_intValue(line,positions,2_pInt) + nState = IO_intValue(line,chunkPos,2_pInt) case ('nstress') - nStress = IO_intValue(line,positions,2_pInt) + nStress = IO_intValue(line,chunkPos,2_pInt) case ('substepmincryst') - subStepMinCryst = IO_floatValue(line,positions,2_pInt) + subStepMinCryst = IO_floatValue(line,chunkPos,2_pInt) case ('substepsizecryst') - subStepSizeCryst = IO_floatValue(line,positions,2_pInt) + subStepSizeCryst = IO_floatValue(line,chunkPos,2_pInt) case ('stepincreasecryst') - stepIncreaseCryst = IO_floatValue(line,positions,2_pInt) + stepIncreaseCryst = IO_floatValue(line,chunkPos,2_pInt) case ('substepminhomog') - subStepMinHomog = IO_floatValue(line,positions,2_pInt) + subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt) case ('substepsizehomog') - subStepSizeHomog = IO_floatValue(line,positions,2_pInt) + subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt) case ('stepincreasehomog') - stepIncreaseHomog = IO_floatValue(line,positions,2_pInt) + stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt) case ('rtol_crystallitestate') - rTol_crystalliteState = IO_floatValue(line,positions,2_pInt) + rTol_crystalliteState = IO_floatValue(line,chunkPos,2_pInt) case ('rtol_crystallitestress') - rTol_crystalliteStress = IO_floatValue(line,positions,2_pInt) + rTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt) case ('atol_crystallitestress') - aTol_crystalliteStress = IO_floatValue(line,positions,2_pInt) + aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt) case ('integrator') - numerics_integrator(1) = IO_intValue(line,positions,2_pInt) + numerics_integrator(1) = IO_intValue(line,chunkPos,2_pInt) case ('integratorstiffness') - numerics_integrator(2) = IO_intValue(line,positions,2_pInt) + numerics_integrator(2) = IO_intValue(line,chunkPos,2_pInt) case ('analyticjaco') - analyticJaco = IO_intValue(line,positions,2_pInt) > 0_pInt + analyticJaco = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('usepingpong') - usepingpong = IO_intValue(line,positions,2_pInt) > 0_pInt + usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('timesyncing') - numerics_timeSyncing = IO_intValue(line,positions,2_pInt) > 0_pInt + numerics_timeSyncing = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('unitlength') - numerics_unitlength = IO_floatValue(line,positions,2_pInt) + numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt) !-------------------------------------------------------------------------------------------------- ! RGC parameters case ('atol_rgc') - absTol_RGC = IO_floatValue(line,positions,2_pInt) + absTol_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('rtol_rgc') - relTol_RGC = IO_floatValue(line,positions,2_pInt) + relTol_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('amax_rgc') - absMax_RGC = IO_floatValue(line,positions,2_pInt) + absMax_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('rmax_rgc') - relMax_RGC = IO_floatValue(line,positions,2_pInt) + relMax_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('perturbpenalty_rgc') - pPert_RGC = IO_floatValue(line,positions,2_pInt) + pPert_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('relevantmismatch_rgc') - xSmoo_RGC = IO_floatValue(line,positions,2_pInt) + xSmoo_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('viscositypower_rgc') - viscPower_RGC = IO_floatValue(line,positions,2_pInt) + viscPower_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('viscositymodulus_rgc') - viscModus_RGC = IO_floatValue(line,positions,2_pInt) + viscModus_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('refrelaxationrate_rgc') - refRelaxRate_RGC = IO_floatValue(line,positions,2_pInt) + refRelaxRate_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('maxrelaxation_rgc') - maxdRelax_RGC = IO_floatValue(line,positions,2_pInt) + maxdRelax_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('maxvoldiscrepancy_rgc') - maxVolDiscr_RGC = IO_floatValue(line,positions,2_pInt) + maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('voldiscrepancymod_rgc') - volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt) + volDiscrMod_RGC = IO_floatValue(line,chunkPos,2_pInt) case ('discrepancypower_rgc') - volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt) + volDiscrPow_RGC = IO_floatValue(line,chunkPos,2_pInt) !-------------------------------------------------------------------------------------------------- ! random seeding parameter case ('fixed_seed') - fixedSeed = IO_intValue(line,positions,2_pInt) + fixedSeed = IO_intValue(line,chunkPos,2_pInt) !-------------------------------------------------------------------------------------------------- ! gradient parameter case ('charlength') - charLength = IO_floatValue(line,positions,2_pInt) + charLength = IO_floatValue(line,chunkPos,2_pInt) case ('residualstiffness') - residualStiffness = IO_floatValue(line,positions,2_pInt) + residualStiffness = IO_floatValue(line,chunkPos,2_pInt) !-------------------------------------------------------------------------------------------------- ! field parameters case ('err_struct_tolabs') - err_struct_tolAbs = IO_floatValue(line,positions,2_pInt) + err_struct_tolAbs = IO_floatValue(line,chunkPos,2_pInt) case ('err_struct_tolrel') - err_struct_tolRel = IO_floatValue(line,positions,2_pInt) + err_struct_tolRel = IO_floatValue(line,chunkPos,2_pInt) case ('err_thermal_tolabs') - err_thermal_tolabs = IO_floatValue(line,positions,2_pInt) + err_thermal_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('err_thermal_tolrel') - err_thermal_tolrel = IO_floatValue(line,positions,2_pInt) + err_thermal_tolrel = IO_floatValue(line,chunkPos,2_pInt) case ('err_damage_tolabs') - err_damage_tolabs = IO_floatValue(line,positions,2_pInt) + err_damage_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('err_damage_tolrel') - err_damage_tolrel = IO_floatValue(line,positions,2_pInt) + err_damage_tolrel = IO_floatValue(line,chunkPos,2_pInt) case ('err_vacancyflux_tolabs') - err_vacancyflux_tolabs = IO_floatValue(line,positions,2_pInt) + err_vacancyflux_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('err_vacancyflux_tolrel') - err_vacancyflux_tolrel = IO_floatValue(line,positions,2_pInt) + err_vacancyflux_tolrel = IO_floatValue(line,chunkPos,2_pInt) case ('err_porosity_tolabs') - err_porosity_tolabs = IO_floatValue(line,positions,2_pInt) + err_porosity_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('err_porosity_tolrel') - err_porosity_tolrel = IO_floatValue(line,positions,2_pInt) + err_porosity_tolrel = IO_floatValue(line,chunkPos,2_pInt) case ('err_hydrogenflux_tolabs') - err_hydrogenflux_tolabs = IO_floatValue(line,positions,2_pInt) + err_hydrogenflux_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('err_hydrogenflux_tolrel') - err_hydrogenflux_tolrel = IO_floatValue(line,positions,2_pInt) + err_hydrogenflux_tolrel = IO_floatValue(line,chunkPos,2_pInt) case ('vacancyboundpenalty') - vacancyBoundPenalty = IO_floatValue(line,positions,2_pInt) + vacancyBoundPenalty = IO_floatValue(line,chunkPos,2_pInt) case ('hydrogenboundpenalty') - hydrogenBoundPenalty = IO_floatValue(line,positions,2_pInt) + hydrogenBoundPenalty = IO_floatValue(line,chunkPos,2_pInt) case ('itmax') - itmax = IO_intValue(line,positions,2_pInt) + itmax = IO_intValue(line,chunkPos,2_pInt) case ('itmin') - itmin = IO_intValue(line,positions,2_pInt) + itmin = IO_intValue(line,chunkPos,2_pInt) case ('maxcutback') - maxCutBack = IO_intValue(line,positions,2_pInt) + maxCutBack = IO_intValue(line,chunkPos,2_pInt) case ('maxstaggerediter') - stagItMax = IO_intValue(line,positions,2_pInt) + stagItMax = IO_intValue(line,chunkPos,2_pInt) case ('vacancypolyorder') - vacancyPolyOrder = IO_intValue(line,positions,2_pInt) + vacancyPolyOrder = IO_intValue(line,chunkPos,2_pInt) case ('hydrogenpolyorder') - hydrogenPolyOrder = IO_intValue(line,positions,2_pInt) + hydrogenPolyOrder = IO_intValue(line,chunkPos,2_pInt) !-------------------------------------------------------------------------------------------------- ! spectral parameters #ifdef Spectral case ('err_div_tolabs') - err_div_tolAbs = IO_floatValue(line,positions,2_pInt) + err_div_tolAbs = IO_floatValue(line,chunkPos,2_pInt) case ('err_div_tolrel') - err_div_tolRel = IO_floatValue(line,positions,2_pInt) + err_div_tolRel = IO_floatValue(line,chunkPos,2_pInt) case ('err_stress_tolrel') - err_stress_tolrel = IO_floatValue(line,positions,2_pInt) + err_stress_tolrel = IO_floatValue(line,chunkPos,2_pInt) case ('err_stress_tolabs') - err_stress_tolabs = IO_floatValue(line,positions,2_pInt) + err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('continuecalculation') - continueCalculation = IO_intValue(line,positions,2_pInt) + continueCalculation = IO_intValue(line,chunkPos,2_pInt) case ('memory_efficient') - memory_efficient = IO_intValue(line,positions,2_pInt) > 0_pInt + memory_efficient = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('fftw_timelimit') - fftw_timelimit = IO_floatValue(line,positions,2_pInt) + fftw_timelimit = IO_floatValue(line,chunkPos,2_pInt) case ('fftw_plan_mode') - fftw_plan_mode = IO_lc(IO_stringValue(line,positions,2_pInt)) + fftw_plan_mode = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('spectralfilter','myfilter') - spectral_filter = IO_lc(IO_stringValue(line,positions,2_pInt)) + spectral_filter = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('divergence_correction') - divergence_correction = IO_intValue(line,positions,2_pInt) + divergence_correction = IO_intValue(line,chunkPos,2_pInt) case ('update_gamma') - update_gamma = IO_intValue(line,positions,2_pInt) > 0_pInt + update_gamma = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('petsc_options') - petsc_options = trim(line(positions(4):)) + petsc_options = trim(line(chunkPos(4):)) case ('spectralsolver','myspectralsolver') - spectral_solver = IO_lc(IO_stringValue(line,positions,2_pInt)) + spectral_solver = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('err_curl_tolabs') - err_curl_tolAbs = IO_floatValue(line,positions,2_pInt) + err_curl_tolAbs = IO_floatValue(line,chunkPos,2_pInt) case ('err_curl_tolrel') - err_curl_tolRel = IO_floatValue(line,positions,2_pInt) + err_curl_tolRel = IO_floatValue(line,chunkPos,2_pInt) case ('polaralpha') - polarAlpha = IO_floatValue(line,positions,2_pInt) + polarAlpha = IO_floatValue(line,chunkPos,2_pInt) case ('polarbeta') - polarBeta = IO_floatValue(line,positions,2_pInt) + polarBeta = IO_floatValue(line,chunkPos,2_pInt) #else case ('err_div_tolabs','err_div_tolrel','err_stress_tolrel','err_stress_tolabs',& ! found spectral parameter for FEM build 'memory_efficient','fftw_timelimit','fftw_plan_mode', & @@ -463,23 +463,23 @@ subroutine numerics_init ! FEM parameters #ifdef FEM case ('integrationorder') - integrationorder = IO_intValue(line,positions,2_pInt) + integrationorder = IO_intValue(line,chunkPos,2_pInt) case ('structorder') - structorder = IO_intValue(line,positions,2_pInt) + structorder = IO_intValue(line,chunkPos,2_pInt) case ('thermalorder') - thermalorder = IO_intValue(line,positions,2_pInt) + thermalorder = IO_intValue(line,chunkPos,2_pInt) case ('damageorder') - damageorder = IO_intValue(line,positions,2_pInt) + damageorder = IO_intValue(line,chunkPos,2_pInt) case ('vacancyfluxorder') - vacancyfluxOrder = IO_intValue(line,positions,2_pInt) + vacancyfluxOrder = IO_intValue(line,chunkPos,2_pInt) case ('porosityorder') - porosityOrder = IO_intValue(line,positions,2_pInt) + porosityOrder = IO_intValue(line,chunkPos,2_pInt) case ('hydrogenfluxorder') - hydrogenfluxOrder = IO_intValue(line,positions,2_pInt) + hydrogenfluxOrder = IO_intValue(line,chunkPos,2_pInt) case ('petsc_options') - petsc_options = trim(line(positions(4):)) + petsc_options = trim(line(chunkPos(4):)) case ('bbarstabilisation') - BBarStabilisation = IO_intValue(line,positions,2_pInt) > 0_pInt + BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt #else case ('integrationorder','structorder','thermalorder', 'damageorder','vacancyfluxorder', & 'porosityorder','hydrogenfluxorder','bbarstabilisation') diff --git a/code/plastic_disloKMC.f90 b/code/plastic_disloKMC.f90 index c277bba42..d30a9be2c 100644 --- a/code/plastic_disloKMC.f90 +++ b/code/plastic_disloKMC.f90 @@ -193,8 +193,7 @@ subroutine plastic_disloKMC_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,maxTotalNtwin,& f,instance,j,k,l,m,n,o,p,q,r,s,ns,nt, & Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & @@ -304,102 +303,102 @@ subroutine plastic_disloKMC_init(fileUnit) endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOKMC_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('edge_density') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = edge_density_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('dipole_density') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = dipole_density_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_rate_slip','shearrate_slip') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = shear_rate_slip_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulated_shear_slip') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = accumulated_shear_slip_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('mfp_slip') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = mfp_slip_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolved_stress_slip') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = resolved_stress_slip_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('threshold_stress_slip') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = threshold_stress_slip_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('edge_dipole_distance') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = edge_dipole_distance_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('stress_exponent') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = stress_exponent_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('twin_fraction') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = twin_fraction_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_rate_twin','shearrate_twin') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = shear_rate_twin_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulated_shear_twin') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = accumulated_shear_twin_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('mfp_twin') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = mfp_twin_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolved_stress_twin') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = resolved_stress_twin_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('threshold_stress_twin') plastic_disloKMC_Noutput(instance) = plastic_disloKMC_Noutput(instance) + 1_pInt plastic_disloKMC_outputID(plastic_disloKMC_Noutput(instance),instance) = threshold_stress_twin_ID plastic_disloKMC_output(plastic_disloKMC_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select !-------------------------------------------------------------------------------------------------- ! parameters depending on number of slip system families case ('nslip') - if (positions(1) < Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') - if (positions(1) > Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_SlipFamilies - plastic_disloKMC_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_disloKMC_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('rhoedge0','rhoedgedip0','slipburgers','qedge','v0','clambdaslip','tau_peierls','p_slip','q_slip',& 'u_slip','s_slip') do j = 1_pInt, Nchunks_SlipFamilies - tempPerSlip(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('rhoedge0') @@ -430,17 +429,17 @@ subroutine plastic_disloKMC_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on slip number of twin families case ('ntwin') - if (positions(1) < Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') - if (positions(1) > Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') - Nchunks_TwinFamilies = positions(1) - 1_pInt + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_TwinFamilies - plastic_disloKMC_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_disloKMC_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('ndot0','twinsize','twinburgers','r_twin') do j = 1_pInt, Nchunks_TwinFamilies - tempPerTwin(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('ndot0') @@ -457,71 +456,71 @@ subroutine plastic_disloKMC_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_slipslip','interactionslipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') do j = 1_pInt, Nchunks_SlipSlip - plastic_disloKMC_interaction_SlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloKMC_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_sliptwin','interactionsliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') do j = 1_pInt, Nchunks_SlipTwin - plastic_disloKMC_interaction_SlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloKMC_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twinslip','interactiontwinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') do j = 1_pInt, Nchunks_TwinSlip - plastic_disloKMC_interaction_TwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloKMC_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twintwin','interactiontwintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') do j = 1_pInt, Nchunks_TwinTwin - plastic_disloKMC_interaction_TwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloKMC_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('nonschmid_coefficients') - if (positions(1) < 1_pInt + Nchunks_nonSchmid) & + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOKMC_label//')') do j = 1_pInt,Nchunks_nonSchmid - plastic_disloKMC_nonSchmidCoeff(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloKMC_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems case ('grainsize') - plastic_disloKMC_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('maxtwinfraction') - plastic_disloKMC_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('d0') - plastic_disloKMC_D0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('qsd') - plastic_disloKMC_Qsd(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_Qsd(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_rho') - plastic_disloKMC_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_twinfrac') - plastic_disloKMC_aTolTwinFrac(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_aTolTwinFrac(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cmfptwin') - plastic_disloKMC_Cmfptwin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_Cmfptwin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cthresholdtwin') - plastic_disloKMC_Cthresholdtwin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_Cthresholdtwin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('solidsolutionstrength') - plastic_disloKMC_SolidSolutionStrength(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_SolidSolutionStrength(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('l0') - plastic_disloKMC_L0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_L0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('xc') - plastic_disloKMC_xc(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_xc(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('vcrossslip') - plastic_disloKMC_VcrossSlip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_VcrossSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cedgedipmindistance') - plastic_disloKMC_CEdgeDipMinDistance(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_CEdgeDipMinDistance(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('catomicvolume') - plastic_disloKMC_CAtomicVolume(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_CAtomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('sfe_0k') - plastic_disloKMC_SFE_0K(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_SFE_0K(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('dsfe_dt') - plastic_disloKMC_dSFE_dT(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_dSFE_dT(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('dipoleformationfactor') - plastic_disloKMC_dipoleFormationFactor(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloKMC_dipoleFormationFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif enddo parsingFile diff --git a/code/plastic_disloUCLA.f90 b/code/plastic_disloUCLA.f90 index 2522500d4..c8032fcce 100644 --- a/code/plastic_disloUCLA.f90 +++ b/code/plastic_disloUCLA.f90 @@ -198,8 +198,7 @@ subroutine plastic_disloUCLA_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,maxTotalNtwin,& f,instance,j,k,l,m,n,o,p,q,r,s,ns,nt, & Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & @@ -312,102 +311,102 @@ subroutine plastic_disloUCLA_init(fileUnit) endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOUCLA_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('edge_density') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = edge_density_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('dipole_density') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = dipole_density_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_rate_slip','shearrate_slip') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = shear_rate_slip_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulated_shear_slip') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = accumulated_shear_slip_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('mfp_slip') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = mfp_slip_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolved_stress_slip') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = resolved_stress_slip_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('threshold_stress_slip') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = threshold_stress_slip_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('edge_dipole_distance') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = edge_dipole_distance_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('stress_exponent') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = stress_exponent_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('twin_fraction') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = twin_fraction_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_rate_twin','shearrate_twin') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = shear_rate_twin_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulated_shear_twin') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = accumulated_shear_twin_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('mfp_twin') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = mfp_twin_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolved_stress_twin') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = resolved_stress_twin_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('threshold_stress_twin') plastic_disloUCLA_Noutput(instance) = plastic_disloUCLA_Noutput(instance) + 1_pInt plastic_disloUCLA_outputID(plastic_disloUCLA_Noutput(instance),instance) = threshold_stress_twin_ID plastic_disloUCLA_output(plastic_disloUCLA_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select !-------------------------------------------------------------------------------------------------- ! parameters depending on number of slip system families case ('nslip') - if (positions(1) < Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - if (positions(1) > Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_SlipFamilies - plastic_disloUCLA_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_disloUCLA_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('rhoedge0','rhoedgedip0','slipburgers','qedge','v0','clambdaslip','tau_peierls','p_slip','q_slip',& 'kink_height','omega','kink_width','dislolength','friction_coeff') do j = 1_pInt, Nchunks_SlipFamilies - tempPerSlip(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('rhoedge0') @@ -449,17 +448,17 @@ subroutine plastic_disloUCLA_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on slip number of twin families case ('ntwin') - if (positions(1) < Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - if (positions(1) > Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') - Nchunks_TwinFamilies = positions(1) - 1_pInt + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_TwinFamilies - plastic_disloUCLA_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_disloUCLA_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('ndot0','twinsize','twinburgers','r_twin') do j = 1_pInt, Nchunks_TwinFamilies - tempPerTwin(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('ndot0') @@ -476,71 +475,71 @@ subroutine plastic_disloUCLA_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_slipslip','interactionslipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') do j = 1_pInt, Nchunks_SlipSlip - plastic_disloUCLA_interaction_SlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloUCLA_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_sliptwin','interactionsliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') do j = 1_pInt, Nchunks_SlipTwin - plastic_disloUCLA_interaction_SlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloUCLA_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twinslip','interactiontwinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') do j = 1_pInt, Nchunks_TwinSlip - plastic_disloUCLA_interaction_TwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloUCLA_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twintwin','interactiontwintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') do j = 1_pInt, Nchunks_TwinTwin - plastic_disloUCLA_interaction_TwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloUCLA_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('nonschmid_coefficients') - if (positions(1) < 1_pInt + Nchunks_nonSchmid) & + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOUCLA_label//')') do j = 1_pInt,Nchunks_nonSchmid - plastic_disloUCLA_nonSchmidCoeff(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_disloUCLA_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems case ('grainsize') - plastic_disloUCLA_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('maxtwinfraction') - plastic_disloUCLA_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('d0') - plastic_disloUCLA_D0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('qsd') - plastic_disloUCLA_Qsd(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_Qsd(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_rho') - plastic_disloUCLA_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_twinfrac') - plastic_disloUCLA_aTolTwinFrac(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_aTolTwinFrac(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cmfptwin') - plastic_disloUCLA_Cmfptwin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_Cmfptwin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cthresholdtwin') - plastic_disloUCLA_Cthresholdtwin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_Cthresholdtwin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('solidsolutionstrength') - plastic_disloUCLA_SolidSolutionStrength(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_SolidSolutionStrength(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('l0') - plastic_disloUCLA_L0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_L0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('xc') - plastic_disloUCLA_xc(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_xc(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('vcrossslip') - plastic_disloUCLA_VcrossSlip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_VcrossSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cedgedipmindistance') - plastic_disloUCLA_CEdgeDipMinDistance(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_CEdgeDipMinDistance(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('catomicvolume') - plastic_disloUCLA_CAtomicVolume(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_CAtomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('sfe_0k') - plastic_disloUCLA_SFE_0K(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_SFE_0K(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('dsfe_dt') - plastic_disloUCLA_dSFE_dT(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_dSFE_dT(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('dipoleformationfactor') - plastic_disloUCLA_dipoleFormationFactor(instance) = IO_floatValue(line,positions,2_pInt) + plastic_disloUCLA_dipoleFormationFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif enddo parsingFile diff --git a/code/plastic_dislotwin.f90 b/code/plastic_dislotwin.f90 index f52ad70b2..f9fbaf9e8 100644 --- a/code/plastic_dislotwin.f90 +++ b/code/plastic_dislotwin.f90 @@ -231,8 +231,7 @@ subroutine plastic_dislotwin_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,maxTotalNtwin,maxTotalNtrans,& f,instance,j,k,l,m,n,o,p,q,r,s,ns,nt,nr, & Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & @@ -374,136 +373,136 @@ subroutine plastic_dislotwin_init(fileUnit) if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOTWIN_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('edge_density') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = edge_density_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('dipole_density') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = dipole_density_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_rate_slip','shearrate_slip') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = shear_rate_slip_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulated_shear_slip') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = accumulated_shear_slip_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('mfp_slip') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = mfp_slip_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolved_stress_slip') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = resolved_stress_slip_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('threshold_stress_slip') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = threshold_stress_slip_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('edge_dipole_distance') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = edge_dipole_distance_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('stress_exponent') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = stress_exponent_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('twin_fraction') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = twin_fraction_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_rate_twin','shearrate_twin') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = shear_rate_twin_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulated_shear_twin') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = accumulated_shear_twin_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('mfp_twin') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = mfp_twin_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolved_stress_twin') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = resolved_stress_twin_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('threshold_stress_twin') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = threshold_stress_twin_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolved_stress_shearband') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = resolved_stress_shearband_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_rate_shearband','shearrate_shearband') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = shear_rate_shearband_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('sb_eigenvalues') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = sb_eigenvalues_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('sb_eigenvectors') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = sb_eigenvectors_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('stress_trans_fraction') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = stress_trans_fraction_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('strain_trans_fraction') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = strain_trans_fraction_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('trans_fraction','total_trans_fraction') plastic_dislotwin_Noutput(instance) = plastic_dislotwin_Noutput(instance) + 1_pInt plastic_dislotwin_outputID(plastic_dislotwin_Noutput(instance),instance) = trans_fraction_ID plastic_dislotwin_output(plastic_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select !-------------------------------------------------------------------------------------------------- ! parameters depending on number of slip system families case ('nslip') - if (positions(1) < Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - if (positions(1) > Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_SlipFamilies - plastic_dislotwin_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_dislotwin_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('rhoedge0','rhoedgedip0','slipburgers','qedge','v0','clambdaslip','tau_peierls','p_slip','q_slip') do j = 1_pInt, Nchunks_SlipFamilies - tempPerSlip(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('rhoedge0') @@ -530,17 +529,17 @@ subroutine plastic_dislotwin_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on slip number of twin families case ('ntwin') - if (positions(1) < Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - if (positions(1) > Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - Nchunks_TwinFamilies = positions(1) - 1_pInt + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_TwinFamilies - plastic_dislotwin_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_dislotwin_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('ndot0','twinsize','twinburgers','r_twin') do j = 1_pInt, Nchunks_TwinFamilies - tempPerTwin(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('ndot0') @@ -557,17 +556,17 @@ subroutine plastic_dislotwin_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on number of transformation system families case ('ntrans') - if (positions(1) < Nchunks_TransFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & call IO_warning(53_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - if (positions(1) > Nchunks_TransFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - Nchunks_TransFamilies = positions(1) - 1_pInt + Nchunks_TransFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_TransFamilies - plastic_dislotwin_Ntrans(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_dislotwin_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('lamellarsize','transburgers','s_trans') do j = 1_pInt, Nchunks_TransFamilies - tempPerTrans(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerTrans(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('lamellarsize') @@ -580,91 +579,91 @@ subroutine plastic_dislotwin_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_slipslip','interactionslipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') do j = 1_pInt, Nchunks_SlipSlip - plastic_dislotwin_interaction_SlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_dislotwin_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_sliptwin','interactionsliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') do j = 1_pInt, Nchunks_SlipTwin - plastic_dislotwin_interaction_SlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_dislotwin_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twinslip','interactiontwinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') do j = 1_pInt, Nchunks_TwinSlip - plastic_dislotwin_interaction_TwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_dislotwin_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twintwin','interactiontwintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') do j = 1_pInt, Nchunks_TwinTwin - plastic_dislotwin_interaction_TwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_dislotwin_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin/trans systems case ('grainsize') - plastic_dislotwin_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('maxtwinfraction') - plastic_dislotwin_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('p_shearband') - plastic_dislotwin_pShearBand(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_pShearBand(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('q_shearband') - plastic_dislotwin_qShearBand(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_qShearBand(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('d0') - plastic_dislotwin_D0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_D0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('qsd') - plastic_dislotwin_Qsd(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Qsd(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_rho') - plastic_dislotwin_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_twinfrac') - plastic_dislotwin_aTolTwinFrac(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_aTolTwinFrac(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_transfrac') - plastic_dislotwin_aTolTransFrac(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_aTolTransFrac(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cmfptwin') - plastic_dislotwin_Cmfptwin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Cmfptwin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cthresholdtwin') - plastic_dislotwin_Cthresholdtwin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Cthresholdtwin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('solidsolutionstrength') - plastic_dislotwin_SolidSolutionStrength(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_SolidSolutionStrength(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('l0') - plastic_dislotwin_L0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_L0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('xc') - plastic_dislotwin_xc(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_xc(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('vcrossslip') - plastic_dislotwin_VcrossSlip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_VcrossSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cedgedipmindistance') - plastic_dislotwin_CEdgeDipMinDistance(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_CEdgeDipMinDistance(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('catomicvolume') - plastic_dislotwin_CAtomicVolume(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_CAtomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('sfe_0k') - plastic_dislotwin_SFE_0K(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_SFE_0K(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('dsfe_dt') - plastic_dislotwin_dSFE_dT(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_dSFE_dT(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('dipoleformationfactor') - plastic_dislotwin_dipoleFormationFactor(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_dipoleFormationFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('shearbandresistance') - plastic_dislotwin_sbResistance(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_sbResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('shearbandvelocity') - plastic_dislotwin_sbVelocity(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_sbVelocity(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('qedgepersbsystem') - plastic_dislotwin_sbQedge(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_sbQedge(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cdwp') - plastic_dislotwin_Cdwp(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cnuc') - plastic_dislotwin_Cnuc(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cgro') - plastic_dislotwin_Cgro(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('deltag') - plastic_dislotwin_deltaG(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cmfptrans') - plastic_dislotwin_Cmfptrans(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Cmfptrans(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cthresholdtrans') - plastic_dislotwin_Cthresholdtrans(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_Cthresholdtrans(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('transstackheight') - plastic_dislotwin_transStackHeight(instance) = IO_floatValue(line,positions,2_pInt) + plastic_dislotwin_transStackHeight(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif enddo parsingFile diff --git a/code/plastic_j2.f90 b/code/plastic_j2.f90 index 4a3ec1141..1718f71cb 100644 --- a/code/plastic_j2.f90 +++ b/code/plastic_j2.f90 @@ -131,9 +131,8 @@ subroutine plastic_j2_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & o, & phase, & @@ -218,17 +217,17 @@ subroutine plastic_j2_init(fileUnit) endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_J2_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('flowstress') plastic_j2_Noutput(instance) = plastic_j2_Noutput(instance) + 1_pInt plastic_j2_outputID(plastic_j2_Noutput(instance),instance) = flowstress_ID plastic_j2_output(plastic_j2_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) #ifdef HDF call HDF5_addScalarDataset(outID(instance),myConstituents,'flowstress','MPa') allocate(plastic_j2_Output2(instance)%flowstress(myConstituents)) @@ -238,7 +237,7 @@ subroutine plastic_j2_init(fileUnit) plastic_j2_Noutput(instance) = plastic_j2_Noutput(instance) + 1_pInt plastic_j2_outputID(plastic_j2_Noutput(instance),instance) = strainrate_ID plastic_j2_output(plastic_j2_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) #ifdef HDF call HDF5_addScalarDataset(outID(instance),myConstituents,'strainrate','1/s') allocate(plastic_j2_Output2(instance)%strainrate(myConstituents)) @@ -248,47 +247,47 @@ subroutine plastic_j2_init(fileUnit) end select case ('tau0') - plastic_j2_tau0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_tau0(instance) = IO_floatValue(line,chunkPos,2_pInt) if (plastic_j2_tau0(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') case ('gdot0') - plastic_j2_gdot0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_gdot0(instance) = IO_floatValue(line,chunkPos,2_pInt) if (plastic_j2_gdot0(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') case ('n') - plastic_j2_n(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_n(instance) = IO_floatValue(line,chunkPos,2_pInt) if (plastic_j2_n(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') case ('h0') - plastic_j2_h0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_h0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('h0_slope','slopelnrate') - plastic_j2_h0_slopeLnRate(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_h0_slopeLnRate(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('tausat') - plastic_j2_tausat(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_tausat(instance) = IO_floatValue(line,chunkPos,2_pInt) if (plastic_j2_tausat(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') case ('tausat_sinhfita') - plastic_j2_tausat_SinhFitA(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_tausat_SinhFitA(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('tausat_sinhfitb') - plastic_j2_tausat_SinhFitB(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_tausat_SinhFitB(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('tausat_sinhfitc') - plastic_j2_tausat_SinhFitC(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_tausat_SinhFitC(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('tausat_sinhfitd') - plastic_j2_tausat_SinhFitD(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_tausat_SinhFitD(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('a', 'w0') - plastic_j2_a(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_a(instance) = IO_floatValue(line,chunkPos,2_pInt) if (plastic_j2_a(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') case ('taylorfactor') - plastic_j2_fTaylor(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_fTaylor(instance) = IO_floatValue(line,chunkPos,2_pInt) if (plastic_j2_fTaylor(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') case ('atol_resistance') - plastic_j2_aTolResistance(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) if (plastic_j2_aTolResistance(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') case ('atol_shear') - plastic_j2_aTolShear(instance) = IO_floatValue(line,positions,2_pInt) + plastic_j2_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) case default diff --git a/code/plastic_nonlocal.f90 b/code/plastic_nonlocal.f90 index ce3336272..07b30e297 100644 --- a/code/plastic_nonlocal.f90 +++ b/code/plastic_nonlocal.f90 @@ -305,9 +305,7 @@ implicit none integer(pInt), intent(in) :: fileUnit !*** local variables - integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt -integer(pInt), & - dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions +integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: phase, & maxNinstances, & maxTotalNslip, & @@ -429,553 +427,553 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then ! one of my phases. do not short-circuit here (.and. with next if statement). It's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('rho') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('delta') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('delta_sgl') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_sgl_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_pos') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_neg') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_neg') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_pos_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_neg_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_neg_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_neg_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_neg_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dip') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('delta_dip') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_dip_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dip_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dip_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('excess_rho') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('excess_rho_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('excess_rho_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_forest') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_forest_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shearrate') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = shearrate_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolvedstress') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolvedstress_external') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_external_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolvedstress_back') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_back_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resistance') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resistance_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_dip') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_dip_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_gen') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_gen_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_gen_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl2dip') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl2dip_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl2dip_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_ann_ath') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_ath_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_ann_the') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_ann_the_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_ann_the_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_edgejogs') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_edgejogs_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_flux') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_flux_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_flux_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_flux_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('velocity_edge_pos') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_edge_pos_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('velocity_edge_neg') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_edge_neg_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('velocity_screw_pos') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_pos_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('velocity_screw_neg') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_neg_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('slipdirection.x') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionx_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('slipdirection.y') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectiony_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('slipdirection.z') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionz_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('slipnormal.x') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalx_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('slipnormal.y') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormaly_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('slipnormal.z') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalz_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_edge_pos.x') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posx_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_edge_pos.y') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posy_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_edge_pos.z') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posz_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_edge_neg.x') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negx_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_edge_neg.y') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negy_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_edge_neg.z') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negz_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_screw_pos.x') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posx_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_screw_pos.y') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posy_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_screw_pos.z') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posz_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_screw_neg.x') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negx_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_screw_neg.y') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negy_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('fluxdensity_screw_neg.z') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negz_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('maximumdipoleheight_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_edge_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('maximumdipoleheight_screw') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulatedshear','accumulated_shear') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = accumulatedshear_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('dislocationstress') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = dislocationstress_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('nslip') - if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt do f = 1_pInt, Nchunks_SlipFamilies - Nslip(f,instance) = IO_intValue(line,positions,1_pInt+f) + Nslip(f,instance) = IO_intValue(line,chunkPos,1_pInt+f) enddo case ('rhosgledgepos0') do f = 1_pInt, Nchunks_SlipFamilies - rhoSglEdgePos0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + rhoSglEdgePos0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case ('rhosgledgeneg0') do f = 1_pInt, Nchunks_SlipFamilies - rhoSglEdgeNeg0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + rhoSglEdgeNeg0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case ('rhosglscrewpos0') do f = 1_pInt, Nchunks_SlipFamilies - rhoSglScrewPos0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + rhoSglScrewPos0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case ('rhosglscrewneg0') do f = 1_pInt, Nchunks_SlipFamilies - rhoSglScrewNeg0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + rhoSglScrewNeg0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case ('rhodipedge0') do f = 1_pInt, Nchunks_SlipFamilies - rhoDipEdge0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + rhoDipEdge0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case ('rhodipscrew0') do f = 1_pInt, Nchunks_SlipFamilies - rhoDipScrew0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + rhoDipScrew0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case ('lambda0') do f = 1_pInt, Nchunks_SlipFamilies - lambda0PerSlipFamily(f,instance) = IO_floatValue(line,positions,1_pInt+f) + lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case ('burgers') do f = 1_pInt, Nchunks_SlipFamilies - burgersPerSlipFamily(f,instance) = IO_floatValue(line,positions,1_pInt+f) + burgersPerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case('cutoffradius','r') - cutoffRadius(instance) = IO_floatValue(line,positions,2_pInt) + cutoffRadius(instance) = IO_floatValue(line,chunkPos,2_pInt) case('minimumdipoleheightedge','ddipminedge') do f = 1_pInt, Nchunks_SlipFamilies - minDipoleHeightPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + minDipoleHeightPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case('minimumdipoleheightscrew','ddipminscrew') do f = 1_pInt, Nchunks_SlipFamilies - minDipoleHeightPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + minDipoleHeightPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case('atomicvolume') - atomicVolume(instance) = IO_floatValue(line,positions,2_pInt) + atomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) case('selfdiffusionprefactor','dsd0') - Dsd0(instance) = IO_floatValue(line,positions,2_pInt) + Dsd0(instance) = IO_floatValue(line,chunkPos,2_pInt) case('selfdiffusionenergy','qsd') - selfDiffusionEnergy(instance) = IO_floatValue(line,positions,2_pInt) + selfDiffusionEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) case('atol_rho','atol_density','absolutetolerancedensity','absolutetolerance_density') - aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case('atol_shear','atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') - aTolShear(instance) = IO_floatValue(line,positions,2_pInt) + aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) case('significantrho','significant_rho','significantdensity','significant_density') - significantRho(instance) = IO_floatValue(line,positions,2_pInt) + significantRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case('significantn','significant_n','significantdislocations','significant_dislcations') - significantN(instance) = IO_floatValue(line,positions,2_pInt) + significantN(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('interaction_slipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') do it = 1_pInt,Nchunks_SlipSlip - interactionSlipSlip(it,instance) = IO_floatValue(line,positions,1_pInt+it) + interactionSlipSlip(it,instance) = IO_floatValue(line,chunkPos,1_pInt+it) enddo case('linetension','linetensioneffect','linetension_effect') - linetensionEffect(instance) = IO_floatValue(line,positions,2_pInt) + linetensionEffect(instance) = IO_floatValue(line,chunkPos,2_pInt) case('edgejog','edgejogs','edgejogeffect','edgejog_effect') - edgeJogFactor(instance) = IO_floatValue(line,positions,2_pInt) + edgeJogFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) case('peierlsstressedge','peierlsstress_edge') do f = 1_pInt, Nchunks_SlipFamilies - peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case('peierlsstressscrew','peierlsstress_screw') do f = 1_pInt, Nchunks_SlipFamilies - peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case('doublekinkwidth') - doublekinkwidth(instance) = IO_floatValue(line,positions,2_pInt) + doublekinkwidth(instance) = IO_floatValue(line,chunkPos,2_pInt) case('solidsolutionenergy') - solidSolutionEnergy(instance) = IO_floatValue(line,positions,2_pInt) + solidSolutionEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) case('solidsolutionsize') - solidSolutionSize(instance) = IO_floatValue(line,positions,2_pInt) + solidSolutionSize(instance) = IO_floatValue(line,chunkPos,2_pInt) case('solidsolutionconcentration') - solidSolutionConcentration(instance) = IO_floatValue(line,positions,2_pInt) + solidSolutionConcentration(instance) = IO_floatValue(line,chunkPos,2_pInt) case('p') - pParam(instance) = IO_floatValue(line,positions,2_pInt) + pParam(instance) = IO_floatValue(line,chunkPos,2_pInt) case('q') - qParam(instance) = IO_floatValue(line,positions,2_pInt) + qParam(instance) = IO_floatValue(line,chunkPos,2_pInt) case('viscosity','glideviscosity') - viscosity(instance) = IO_floatValue(line,positions,2_pInt) + viscosity(instance) = IO_floatValue(line,chunkPos,2_pInt) case('attackfrequency','fattack') - fattack(instance) = IO_floatValue(line,positions,2_pInt) + fattack(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglscatter') - rhoSglScatter(instance) = IO_floatValue(line,positions,2_pInt) + rhoSglScatter(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandom') - rhoSglRandom(instance) = IO_floatValue(line,positions,2_pInt) + rhoSglRandom(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandombinning') - rhoSglRandomBinning(instance) = IO_floatValue(line,positions,2_pInt) + rhoSglRandomBinning(instance) = IO_floatValue(line,chunkPos,2_pInt) case('surfacetransmissivity') - surfaceTransmissivity(instance) = IO_floatValue(line,positions,2_pInt) + surfaceTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) case('grainboundarytransmissivity') - grainboundaryTransmissivity(instance) = IO_floatValue(line,positions,2_pInt) + grainboundaryTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) case('cflfactor') - CFLfactor(instance) = IO_floatValue(line,positions,2_pInt) + CFLfactor(instance) = IO_floatValue(line,chunkPos,2_pInt) case('fedgemultiplication','edgemultiplicationfactor','edgemultiplication') - fEdgeMultiplication(instance) = IO_floatValue(line,positions,2_pInt) + fEdgeMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) case('shortrangestresscorrection') - shortRangeStressCorrection(instance) = IO_floatValue(line,positions,2_pInt) > 0.0_pReal + shortRangeStressCorrection(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal case ('nonschmid_coefficients') - if (positions(1) < 1_pInt + Nchunks_nonSchmid) & + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_label//')') do f = 1_pInt,Nchunks_nonSchmid - nonSchmidCoeff(f,instance) = IO_floatValue(line,positions,1_pInt+f) + nonSchmidCoeff(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') - probabilisticMultiplication(instance) = IO_floatValue(line,positions,2_pInt) > 0.0_pReal + probabilisticMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal end select endif; endif enddo parsingFile diff --git a/code/plastic_phenopowerlaw.f90 b/code/plastic_phenopowerlaw.f90 index 1260483f6..40ae49136 100644 --- a/code/plastic_phenopowerlaw.f90 +++ b/code/plastic_phenopowerlaw.f90 @@ -147,8 +147,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt - integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & maxNinstance, & instance,phase,j,k, f,o, & @@ -259,80 +258,80 @@ subroutine plastic_phenopowerlaw_init(fileUnit) endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('resistance_slip') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_slip_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulatedshear_slip','accumulated_shear_slip') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_slip_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shearrate_slip') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_slip_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolvedstress_slip') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_slip_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('totalshear') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalshear_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resistance_twin') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_twin_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('accumulatedshear_twin','accumulated_shear_twin') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_twin_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shearrate_twin') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_twin_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resolvedstress_twin') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_twin_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('totalvolfrac_twin') plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalvolfrac_twin_ID plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case default end select !-------------------------------------------------------------------------------------------------- ! parameters depending on number of slip families case ('nslip') - if (positions(1) < Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (positions(1) > Nchunks_SlipFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) do j = 1_pInt, Nchunks_SlipFamilies - plastic_phenopowerlaw_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('tausat_slip','tau0_slip') tempPerSlip = 0.0_pReal do j = 1_pInt, Nchunks_SlipFamilies if (plastic_phenopowerlaw_Nslip(j,instance) > 0_pInt) & - tempPerSlip(j) = IO_floatValue(line,positions,1_pInt+j) + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) case ('tausat_slip') @@ -343,105 +342,105 @@ subroutine plastic_phenopowerlaw_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! parameters depending on number of twin families case ('ntwin') - if (positions(1) < Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (positions(1) > Nchunks_TwinFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_TwinFamilies = positions(1) - 1_pInt + Nchunks_TwinFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_TwinFamilies - plastic_phenopowerlaw_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('tau0_twin') do j = 1_pInt, Nchunks_TwinFamilies if (plastic_phenopowerlaw_Ntwin(j,instance) > 0_pInt) & - plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- ! parameters depending on number of transformation families case ('ntrans') - if (positions(1) < Nchunks_TransFamilies + 1_pInt) & + if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (positions(1) > Nchunks_TransFamilies + 1_pInt) & + if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_TransFamilies = positions(1) - 1_pInt + Nchunks_TransFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_TransFamilies - plastic_phenopowerlaw_Ntrans(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_sliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') do j = 1_pInt, Nchunks_SlipTwin - plastic_phenopowerlaw_interaction_SlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') do j = 1_pInt, Nchunks_TwinSlip - plastic_phenopowerlaw_interaction_TwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') do j = 1_pInt, Nchunks_TwinTwin - plastic_phenopowerlaw_interaction_TwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('nonschmid_coefficients') - if (positions(1) < 1_pInt + Nchunks_nonSchmid) & + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') do j = 1_pInt,Nchunks_nonSchmid - plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems case ('gdot0_slip') - plastic_phenopowerlaw_gdot0_slip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('n_slip') - plastic_phenopowerlaw_n_slip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('a_slip', 'w0_slip') - plastic_phenopowerlaw_a_slip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('gdot0_twin') - plastic_phenopowerlaw_gdot0_twin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('n_twin') - plastic_phenopowerlaw_n_twin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('s_pr') - plastic_phenopowerlaw_spr(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('twin_b') - plastic_phenopowerlaw_twinB(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('twin_c') - plastic_phenopowerlaw_twinC(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('twin_d') - plastic_phenopowerlaw_twinD(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('twin_e') - plastic_phenopowerlaw_twinE(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('h0_slipslip') - plastic_phenopowerlaw_h0_SlipSlip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('h0_twinslip') - plastic_phenopowerlaw_h0_TwinSlip(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('h0_twintwin') - plastic_phenopowerlaw_h0_TwinTwin(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_resistance') - plastic_phenopowerlaw_aTolResistance(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_shear') - plastic_phenopowerlaw_aTolShear(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_twinfrac') - plastic_phenopowerlaw_aTolTwinfrac(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_transfrac') - plastic_phenopowerlaw_aTolTransfrac(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cnuc') - plastic_phenopowerlaw_Cnuc(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cdwp') - plastic_phenopowerlaw_Cdwp(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('cgro') - plastic_phenopowerlaw_Cgro(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('deltag') - plastic_phenopowerlaw_deltaG(instance) = IO_floatValue(line,positions,2_pInt) + plastic_phenopowerlaw_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('interaction_slipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') do j = 1_pInt, Nchunks_SlipSlip - plastic_phenopowerlaw_interaction_SlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_phenopowerlaw_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case default diff --git a/code/plastic_titanmod.f90 b/code/plastic_titanmod.f90 index f563ba312..2a4e6759b 100644 --- a/code/plastic_titanmod.f90 +++ b/code/plastic_titanmod.f90 @@ -224,8 +224,7 @@ subroutine plastic_titanmod_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt - integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & phase, & instance, j, k, l, m, n, p, q, r, & @@ -347,322 +346,322 @@ subroutine plastic_titanmod_init(fileUnit) endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then ! one of my sections. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('rhoedge') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoscrew') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('segment_edge') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_edge_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('segment_screw') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_screw_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resistance_edge') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_edge_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('resistance_screw') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_screw_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('velocity_edge') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_edge_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('velocity_screw') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_screw_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('tau_slip') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = tau_slip_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('gdot_slip_edge') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_edge_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('gdot_slip_screw') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_screw_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('gdot_slip') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('stressratio_edge_p') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_edge_p_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('stressratio_screw_p') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_screw_p_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_system') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_system_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('twin_fraction') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = twin_fraction_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_basal') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_basal_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_prism') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_prism_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_pyra') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyra_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_pyrca') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyrca_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoedge_basal') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_basal_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoedge_prism') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_prism_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoedge_pyra') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyra_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoedge_pyrca') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyrca_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoscrew_basal') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_basal_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoscrew_prism') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_prism_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoscrew_pyra') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyra_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rhoscrew_pyrca') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyrca_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('shear_total') plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_total_ID plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('debyefrequency') - plastic_titanmod_debyefrequency(instance) = IO_floatValue(line,positions,2_pInt) + plastic_titanmod_debyefrequency(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('kinkf0') - plastic_titanmod_kinkf0(instance) = IO_floatValue(line,positions,2_pInt) + plastic_titanmod_kinkf0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('nslip') - if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_titanmod_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('ntwin') - if (positions(1) < 1_pInt + Nchunks_TwinFamilies) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinFamilies) & call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) + plastic_titanmod_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('rho_edge0') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_rho_edge0(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_rho_edge0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('rho_screw0') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_rho_screw0(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_rho_screw0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('slipburgers') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_burgersPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_burgersPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twinburgers') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_burgersPerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_burgersPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('f0') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_f0_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_f0_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twinf0') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinf0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twinf0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('tau0e') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_tau0e_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_tau0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twintau0') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twintau0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twintau0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('tau0s') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_tau0s_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_tau0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('capre') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_capre_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_capre_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('caprs') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_caprs_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_caprs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('v0e') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_v0e_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_v0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twingamma0') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twingamma0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twingamma0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('v0s') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_v0s_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_v0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('kinkcriticallength') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_kinkcriticallength_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_kinkcriticallength_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twinsize') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinsizePerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twinsizePerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('celambdaslip') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_CeLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_CeLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twinlambdaslip') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinlambdaslipPerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twinlambdaslipPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('cslambdaslip') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_CsLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_CsLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('grainsize') - plastic_titanmod_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) + plastic_titanmod_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('maxtwinfraction') - plastic_titanmod_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) + plastic_titanmod_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('pe') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_pe_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_pe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twinp') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinp_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twinp_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('ps') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_ps_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_ps_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('qe') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_qe_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_qe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twinq') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinq_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twinq_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('qs') do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_qs_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_qs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('twinshearconstant') do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinshearconstant_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_twinshearconstant_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('dc') - plastic_titanmod_dc(instance) = IO_floatValue(line,positions,2_pInt) + plastic_titanmod_dc(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('twinhpconstant') - plastic_titanmod_twinhpconstant(instance) = IO_floatValue(line,positions,2_pInt) + plastic_titanmod_twinhpconstant(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('atol_rho') - plastic_titanmod_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + plastic_titanmod_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('interactionee') do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_ee(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_interaction_ee(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interactionss') do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_ss(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_interaction_ss(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interactiones') do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_es(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_interaction_es(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_slipslip','interactionslipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') do j = 1_pInt, Nchunks_SlipSlip - plastic_titanmod_interactionSlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_interactionSlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_sliptwin','interactionsliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') do j = 1_pInt, Nchunks_SlipTwin - plastic_titanmod_interactionSlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_interactionSlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twinslip','interactiontwinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') do j = 1_pInt, Nchunks_TwinSlip - plastic_titanmod_interactionTwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_interactionTwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('interaction_twintwin','interactiontwintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') do j = 1_pInt, Nchunks_TwinTwin - plastic_titanmod_interactionTwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + plastic_titanmod_interactionTwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo end select endif; endif diff --git a/code/porosity_phasefield.f90 b/code/porosity_phasefield.f90 index c9ae02ef7..a7d2d7ad0 100644 --- a/code/porosity_phasefield.f90 +++ b/code/porosity_phasefield.f90 @@ -84,8 +84,7 @@ subroutine porosity_phasefield_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -131,16 +130,16 @@ subroutine porosity_phasefield_init(fileUnit) if (section > 0_pInt ) then; if (porosity_type(section) == POROSITY_phasefield_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = porosity_typeInstance(section) ! which instance of my porosity is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('porosity') porosity_phasefield_Noutput(instance) = porosity_phasefield_Noutput(instance) + 1_pInt porosity_phasefield_outputID(porosity_phasefield_Noutput(instance),instance) = porosity_ID porosity_phasefield_output(porosity_phasefield_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select end select diff --git a/code/source_damage_anisoBrittle.f90 b/code/source_damage_anisoBrittle.f90 index 225b73875..a033369aa 100644 --- a/code/source_damage_anisoBrittle.f90 +++ b/code/source_damage_anisoBrittle.f90 @@ -103,8 +103,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -169,41 +168,41 @@ subroutine source_damage_anisoBrittle_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_damage_anisoBrittle_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('anisobrittle_drivingforce') source_damage_anisoBrittle_Noutput(instance) = source_damage_anisoBrittle_Noutput(instance) + 1_pInt source_damage_anisoBrittle_outputID(source_damage_anisoBrittle_Noutput(instance),instance) = damage_drivingforce_ID source_damage_anisoBrittle_output(source_damage_anisoBrittle_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('anisobrittle_atol') - source_damage_anisoBrittle_aTol(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_anisoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisobrittle_sdot0') - source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisobrittle_ratesensitivity') - source_damage_anisoBrittle_N(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_anisoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('ncleavage') ! - Nchunks_CleavageFamilies = positions(1) - 1_pInt + Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_Ncleavage(j,instance) = IO_intValue(line,positions,1_pInt+j) + source_damage_anisoBrittle_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('anisobrittle_criticaldisplacement') do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_critDisp(j,instance) = IO_floatValue(line,positions,1_pInt+j) + source_damage_anisoBrittle_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('anisobrittle_criticalload') do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_critLoad(j,instance) = IO_floatValue(line,positions,1_pInt+j) + source_damage_anisoBrittle_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo end select diff --git a/code/source_damage_anisoDuctile.f90 b/code/source_damage_anisoDuctile.f90 index 9a34c3bf3..74a7205b2 100644 --- a/code/source_damage_anisoDuctile.f90 +++ b/code/source_damage_anisoDuctile.f90 @@ -107,8 +107,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -173,41 +172,41 @@ subroutine source_damage_anisoDuctile_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_damage_anisoDuctile_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('anisoductile_drivingforce') source_damage_anisoDuctile_Noutput(instance) = source_damage_anisoDuctile_Noutput(instance) + 1_pInt source_damage_anisoDuctile_outputID(source_damage_anisoDuctile_Noutput(instance),instance) = damage_drivingforce_ID source_damage_anisoDuctile_output(source_damage_anisoDuctile_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('anisoductile_atol') - source_damage_anisoDuctile_aTol(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_anisoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('nslip') ! - Nchunks_SlipFamilies = positions(1) - 1_pInt + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo case ('anisoductile_sdot0') - source_damage_anisoDuctile_sdot_0(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_anisoDuctile_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalplasticstrain') do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,positions,1_pInt+j) + source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo case ('anisoductile_ratesensitivity') - source_damage_anisoDuctile_N(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_anisoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalload') do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_critLoad(j,instance) = IO_floatValue(line,positions,1_pInt+j) + source_damage_anisoDuctile_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo end select diff --git a/code/source_damage_isoBrittle.f90 b/code/source_damage_isoBrittle.f90 index ccfa1ed4f..e3424c63b 100644 --- a/code/source_damage_isoBrittle.f90 +++ b/code/source_damage_isoBrittle.f90 @@ -90,8 +90,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -151,26 +150,26 @@ subroutine source_damage_isoBrittle_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_damage_isoBrittle_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('isobrittle_drivingforce') source_damage_isoBrittle_Noutput(instance) = source_damage_isoBrittle_Noutput(instance) + 1_pInt source_damage_isoBrittle_outputID(source_damage_isoBrittle_Noutput(instance),instance) = damage_drivingforce_ID source_damage_isoBrittle_output(source_damage_isoBrittle_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('isobrittle_criticalstrainenergy') - source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('isobrittle_n') - source_damage_isoBrittle_N(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_isoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('isobrittle_atol') - source_damage_isoBrittle_aTol(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_isoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/source_damage_isoDuctile.f90 b/code/source_damage_isoDuctile.f90 index fcf82412d..cdc2a3242 100644 --- a/code/source_damage_isoDuctile.f90 +++ b/code/source_damage_isoDuctile.f90 @@ -90,8 +90,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -151,26 +150,26 @@ subroutine source_damage_isoDuctile_init(fileUnit) endif if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_damage_isoDuctile_instance(phase) ! which instance of my damage is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('isoductile_drivingforce') source_damage_isoDuctile_Noutput(instance) = source_damage_isoDuctile_Noutput(instance) + 1_pInt source_damage_isoDuctile_outputID(source_damage_isoDuctile_Noutput(instance),instance) = damage_drivingforce_ID source_damage_isoDuctile_output(source_damage_isoDuctile_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('isoductile_criticalplasticstrain') - source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('isoductile_ratesensitivity') - source_damage_isoDuctile_N(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_isoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('isoductile_atol') - source_damage_isoDuctile_aTol(instance) = IO_floatValue(line,positions,2_pInt) + source_damage_isoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/source_thermal_dissipation.f90 b/code/source_thermal_dissipation.f90 index 34ed9a749..43a6136f7 100644 --- a/code/source_thermal_dissipation.f90 +++ b/code/source_thermal_dissipation.f90 @@ -76,8 +76,7 @@ subroutine source_thermal_dissipation_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -135,11 +134,11 @@ subroutine source_thermal_dissipation_init(fileUnit) if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_thermal_dissipation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_thermal_dissipation_instance(phase) ! which instance of my source is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('dissipation_coldworkcoeff') - source_thermal_dissipation_coldworkCoeff(instance) = IO_floatValue(line,positions,2_pInt) + source_thermal_dissipation_coldworkCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/source_thermal_externalheat.f90 b/code/source_thermal_externalheat.f90 index a74ceafe9..3b1013581 100644 --- a/code/source_thermal_externalheat.f90 +++ b/code/source_thermal_externalheat.f90 @@ -81,8 +81,7 @@ subroutine source_thermal_externalheat_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 1000_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,interval @@ -144,20 +143,20 @@ subroutine source_thermal_externalheat_init(fileUnit) if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_thermal_externalheat_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_thermal_externalheat_instance(phase) ! which instance of my source is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('externalheat_time') - if (positions(1) <= 2_pInt) & + if (chunkPos(1) <= 2_pInt) & call IO_error(150_pInt,ext_msg=trim(tag)//' ('//SOURCE_thermal_externalheat_label//')') - source_thermal_externalheat_nIntervals(instance) = positions(1) - 2_pInt + source_thermal_externalheat_nIntervals(instance) = chunkPos(1) - 2_pInt do interval = 1, source_thermal_externalheat_nIntervals(instance) + 1_pInt - temp_time(instance, interval) = IO_floatValue(line,positions,1_pInt + interval) + temp_time(instance, interval) = IO_floatValue(line,chunkPos,1_pInt + interval) enddo case ('externalheat_rate') do interval = 1, source_thermal_externalheat_nIntervals(instance) + 1_pInt - temp_rate(instance, interval) = IO_floatValue(line,positions,1_pInt + interval) + temp_rate(instance, interval) = IO_floatValue(line,chunkPos,1_pInt + interval) enddo end select diff --git a/code/source_vacancy_irradiation.f90 b/code/source_vacancy_irradiation.f90 index ae1dd02fa..5c9785163 100644 --- a/code/source_vacancy_irradiation.f90 +++ b/code/source_vacancy_irradiation.f90 @@ -78,8 +78,7 @@ subroutine source_vacancy_irradiation_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -138,14 +137,14 @@ subroutine source_vacancy_irradiation_init(fileUnit) if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_vacancy_irradiation_instance(phase) ! which instance of my vacancy is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('irradiation_cascadeprobability') - source_vacancy_irradiation_cascadeProb(instance) = IO_floatValue(line,positions,2_pInt) + source_vacancy_irradiation_cascadeProb(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('irradiation_cascadevolume') - source_vacancy_irradiation_cascadeVolume(instance) = IO_floatValue(line,positions,2_pInt) + source_vacancy_irradiation_cascadeVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/source_vacancy_phenoplasticity.f90 b/code/source_vacancy_phenoplasticity.f90 index f780a1d2c..f2fbdc45d 100644 --- a/code/source_vacancy_phenoplasticity.f90 +++ b/code/source_vacancy_phenoplasticity.f90 @@ -76,8 +76,7 @@ subroutine source_vacancy_phenoplasticity_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -135,11 +134,11 @@ subroutine source_vacancy_phenoplasticity_init(fileUnit) if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_vacancy_phenoplasticity_instance(phase) ! which instance of my vacancy is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('phenoplasticity_ratecoeff') - source_vacancy_phenoplasticity_rateCoeff(instance) = IO_floatValue(line,positions,2_pInt) + source_vacancy_phenoplasticity_rateCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/source_vacancy_thermalfluc.f90 b/code/source_vacancy_thermalfluc.f90 index 42678b755..330c7adde 100644 --- a/code/source_vacancy_thermalfluc.f90 +++ b/code/source_vacancy_thermalfluc.f90 @@ -80,8 +80,7 @@ subroutine source_vacancy_thermalfluc_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase @@ -140,11 +139,11 @@ subroutine source_vacancy_thermalfluc_init(fileUnit) if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = source_vacancy_thermalfluc_instance(phase) ! which instance of my vacancy is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('thermalfluctuation_amplitude') - source_vacancy_thermalfluc_amplitude(instance) = IO_floatValue(line,positions,2_pInt) + source_vacancy_thermalfluc_amplitude(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/thermal_adiabatic.f90 b/code/thermal_adiabatic.f90 index d217cadb7..25fb3ae76 100644 --- a/code/thermal_adiabatic.f90 +++ b/code/thermal_adiabatic.f90 @@ -82,8 +82,7 @@ subroutine thermal_adiabatic_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -129,16 +128,16 @@ subroutine thermal_adiabatic_init(fileUnit) if (section > 0_pInt ) then; if (thermal_type(section) == THERMAL_adiabatic_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = thermal_typeInstance(section) ! which instance of my thermal is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('temperature') thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1_pInt thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID thermal_adiabatic_output(thermal_adiabatic_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select end select diff --git a/code/thermal_conduction.f90 b/code/thermal_conduction.f90 index 15ae8e99a..6869d38e2 100644 --- a/code/thermal_conduction.f90 +++ b/code/thermal_conduction.f90 @@ -83,8 +83,7 @@ subroutine thermal_conduction_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -130,16 +129,16 @@ subroutine thermal_conduction_init(fileUnit) if (section > 0_pInt ) then; if (thermal_type(section) == THERMAL_conduction_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = thermal_typeInstance(section) ! which instance of my thermal is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('temperature') thermal_conduction_Noutput(instance) = thermal_conduction_Noutput(instance) + 1_pInt thermal_conduction_outputID(thermal_conduction_Noutput(instance),instance) = temperature_ID thermal_conduction_output(thermal_conduction_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select end select diff --git a/code/vacancyflux_cahnhilliard.f90 b/code/vacancyflux_cahnhilliard.f90 index 25b9d8b3a..c0586f0db 100644 --- a/code/vacancyflux_cahnhilliard.f90 +++ b/code/vacancyflux_cahnhilliard.f90 @@ -98,8 +98,7 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,offset integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -148,20 +147,20 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit) if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('vacancyconc') vacancyflux_cahnhilliard_Noutput(instance) = vacancyflux_cahnhilliard_Noutput(instance) + 1_pInt vacancyflux_cahnhilliard_outputID(vacancyflux_cahnhilliard_Noutput(instance),instance) = vacancyConc_ID vacancyflux_cahnhilliard_output(vacancyflux_cahnhilliard_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('vacancyflux_flucamplitude') - vacancyflux_cahnhilliard_flucAmplitude(instance) = IO_floatValue(line,positions,2_pInt) + vacancyflux_cahnhilliard_flucAmplitude(instance) = IO_floatValue(line,chunkPos,2_pInt) end select endif; endif diff --git a/code/vacancyflux_isochempot.f90 b/code/vacancyflux_isochempot.f90 index da6cd0ad6..21ab6a78d 100644 --- a/code/vacancyflux_isochempot.f90 +++ b/code/vacancyflux_isochempot.f90 @@ -80,8 +80,7 @@ subroutine vacancyflux_isochempot_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o integer(pInt) :: sizeState integer(pInt) :: NofMyHomog @@ -127,16 +126,16 @@ subroutine vacancyflux_isochempot_init(fileUnit) if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux is present homog - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('vacancyconc') vacancyflux_isochempot_Noutput(instance) = vacancyflux_isochempot_Noutput(instance) + 1_pInt vacancyflux_isochempot_outputID(vacancyflux_isochempot_Noutput(instance),instance) = vacancyconc_ID vacancyflux_isochempot_output(vacancyflux_isochempot_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select end select diff --git a/lib/damask/__init__.py b/lib/damask/__init__.py index 2baca8f0d..054b6f691 100644 --- a/lib/damask/__init__.py +++ b/lib/damask/__init__.py @@ -35,11 +35,9 @@ try: core.numerics.init = core.numerics.numerics_init core.debug.init = core.debug.debug_init core.math.init = core.math.math_init - core.math.periodicNearestNeighborDistances = core.math.math_periodicNearestNeighborDistances core.math.tensorAvg = core.math.math_tensorAvg core.FEsolving.init = core.FEsolving.FE_init core.mesh.init = core.mesh.mesh_init - core.mesh.regrid = core.mesh.mesh_regrid core.mesh.nodesAroundCentres = core.mesh.mesh_nodesAroundCentres core.mesh.deformedCoordsFFT = core.mesh.mesh_deformedCoordsFFT core.mesh.volumeMismatch = core.mesh.mesh_volumeMismatch diff --git a/lib/kdtree2.f90 b/lib/kdtree2.f90 deleted file mode 100644 index c057ec823..000000000 --- a/lib/kdtree2.f90 +++ /dev/null @@ -1,1925 +0,0 @@ -!############################################################################################################################# -! BEGIN KDTREE2 -!############################################################################################################################# -!(c) Matthew Kennel, Institute for Nonlinear Science (2004) -! -! Licensed under the Academic Free License version 1.1 found in file LICENSE -! with additional provisions found in that same file. -! -!####################################################### -! modifications: changed precision according to prec.f90 -! k.komerla, m.diehl -!####################################################### - -module kdtree2_priority_queue_module - use prec, only: pInt, & - pReal - ! - ! maintain a priority queue (PQ) of data, pairs of 'priority/payload', - ! implemented with a binary heap. This is the type, and the 'dis' field - ! is the priority. - ! - implicit none - private - type kdtree2_result - ! a pair of distances, indexes - real(pReal) :: dis = 0.0_pReal - integer(pInt) :: idx = -1_pInt !Initializers cause some bugs in compilers. - end type kdtree2_result - ! - ! A heap-based priority queue lets one efficiently implement the following - ! operations, each in log(N) time, as opposed to linear time. - ! - ! 1) add a datum (push a datum onto the queue, increasing its length) - ! 2) return the priority value of the maximum priority element - ! 3) pop-off (and delete) the element with the maximum priority, decreasing - ! the size of the queue. - ! 4) replace the datum with the maximum priority with a supplied datum - ! (of either higher or lower priority), maintaining the size of the - ! queue. - ! - ! - ! In the k-d tree case, the 'priority' is the square distance of a point in - ! the data set to a reference point. The goal is to keep the smallest M - ! distances to a reference point. The tree algorithm searches terminal - ! nodes to decide whether to add points under consideration. - ! - ! A priority queue is useful here because it lets one quickly return the - ! largest distance currently existing in the list. If a new candidate - ! distance is smaller than this, then the new candidate ought to replace - ! the old candidate. In priority queue terms, this means removing the - ! highest priority element, and inserting the new one. - ! - ! Algorithms based on Cormen, Leiserson, Rivest, _Introduction - ! to Algorithms_, 1990, with further optimization by the author. - ! - ! Originally informed by a C implementation by Sriranga Veeraraghavan. - ! - ! This module is not written in the most clear way, but is implemented such - ! for speed, as it its operations will be called many times during searches - ! of large numbers of neighbors. - ! - type pq - ! - ! The priority queue consists of elements - ! priority(1:heap_size), with associated payload(:). - ! - ! There are heap_size active elements. - ! Assumes the allocation is always sufficient. Will NOT increase it - ! to match. - integer(pInt) :: heap_size = 0_pInt - type(kdtree2_result), pointer :: elems(:) - end type pq - - public :: kdtree2_result - - public :: pq - public :: pq_create - public :: pq_delete, pq_insert - public :: pq_extract_max, pq_max, pq_replace_max, pq_maxpri - -contains - -function pq_create(results_in) result(res) - ! - ! Create a priority queue from ALREADY allocated - ! array pointers for storage. NOTE! It will NOT - ! add any alements to the heap, i.e. any existing - ! data in the input arrays will NOT be used and may - ! be overwritten. - ! - ! usage: - ! real(pReal), pointer :: x(:) - ! integer(pInt), pointer :: k(:) - ! allocate(x(1000),k(1000)) - ! pq => pq_create(x,k) - ! - implicit none - type(kdtree2_result), target:: results_in(:) - type(pq) :: res - ! - ! - integer :: nalloc - - nalloc = size(results_in,1) - if (nalloc .lt. 1) then - write (*,*) 'PQ_CREATE: error, input arrays must be allocated.' - end if - res%elems => results_in - res%heap_size = 0_pInt - return -end function pq_create - - ! - ! operations for getting parents and left + right children - ! of elements in a binary heap. - ! - -! -! These are written inline for speed. -! -! integer(pInt) function parent(i) -! integer(pInt), intent(in) :: i -! parent = (i/2) -! return -! end function parent - -! integer(pInt) function left(i) -! integer(pInt), intent(in) ::i -! left = (2*i) -! return -! end function left - -! integer(pInt) function right(i) -! integer(pInt), intent(in) :: i -! right = (2*i)+1 -! return -! end function right - -! logical function compare_priority(p1,p2) -! real(pReal), intent(in) :: p1, p2 -! -! compare_priority = (p1 .gt. p2) -! return -! end function compare_priority - -subroutine heapify(a,i_in) - ! - ! take a heap rooted at 'i' and force it to be in the - ! heap canonical form. This is performance critical - ! and has been tweaked a little to reflect this. - ! - implicit none - type(pq),pointer :: a - integer(pInt), intent(in) :: i_in - ! - integer(pInt) :: i, l, r, largest - - real(pReal) :: pri_i, pri_l, pri_r, pri_largest - - - type(kdtree2_result) :: temp - - i = i_in - - bigloop: do - l = 2_pInt*i ! left(i) - r = l+1_pInt ! right(i) - ! - ! set 'largest' to the index of either i, l, r - ! depending on whose priority is largest. - ! - ! note that l or r can be larger than the heap size - ! in which case they do not count. - - - ! does left child have higher priority? - if (l .gt. a%heap_size) then - ! we know that i is the largest as both l and r are invalid. - exit - else - pri_i = a%elems(i)%dis - pri_l = a%elems(l)%dis - if (pri_l .gt. pri_i) then - largest = l - pri_largest = pri_l - else - largest = i - pri_largest = pri_i - endif - - ! - ! between i and l we have a winner - ! now choose between that and r. - ! - if (r .le. a%heap_size) then - pri_r = a%elems(r)%dis - if (pri_r .gt. pri_largest) then - largest = r - endif - endif - endif - - if (largest .ne. i) then - ! swap data in nodes largest and i, then heapify - - temp = a%elems(i) - a%elems(i) = a%elems(largest) - a%elems(largest) = temp - ! - ! Canonical heapify() algorithm has tail-ecursive call: - ! - ! call heapify(a,largest) - ! we will simulate with cycle - ! - i = largest - cycle bigloop ! continue the loop - else - return ! break from the loop - end if - enddo bigloop - return -end subroutine heapify - -subroutine pq_max(a,e) - ! - ! return the priority and its payload of the maximum priority element - ! on the queue, which should be the first one, if it is - ! in heapified form. - ! - use IO, only: IO_error - - implicit none - type(pq),pointer :: a - type(kdtree2_result),intent(out) :: e - - if (a%heap_size .gt. 0) then - e = a%elems(1) - else - call IO_error (460_pInt, ext_msg='PQ_MAX: heap_size < 1') - endif - return -end subroutine pq_max - -real(pReal) function pq_maxpri(a) - use IO, only: IO_error - - implicit none - type(pq), pointer :: a - - if (a%heap_size .gt. 0) then - pq_maxpri = a%elems(1)%dis - else - call IO_error (460_pInt,ext_msg='PPQ_MAX_PRI: heap_size < 1') - endif - return -end function pq_maxpri - -subroutine pq_extract_max(a,e) - ! - ! return the priority and payload of maximum priority - ! element, and remove it from the queue. - ! (equivalent to 'pop()' on a stack) - ! - use IO, only: IO_error - - implicit none - type(pq),pointer :: a - type(kdtree2_result), intent(out) :: e - - if (a%heap_size .ge. 1) then - ! - ! return max as first element - ! - e = a%elems(1) - - ! - ! move last element to first - ! - a%elems(1) = a%elems(a%heap_size) - a%heap_size = a%heap_size-1_pInt - call heapify(a,1_pInt) - return - else - call IO_error (460_pInt,ext_msg='PQ_EXTRACT_MAX: attempted to pop non-positive PQ') - end if -end subroutine pq_extract_max - - -real(pReal) function pq_insert(a,dis,idx) - ! - ! Insert a new element and return the new maximum priority, - ! which may or may not be the same as the old maximum priority. - ! - implicit none - type(pq),pointer :: a - real(pReal), intent(in) :: dis - integer(pInt), intent(in) :: idx - ! type(kdtree2_result), intent(in) :: e - ! - integer(pInt) :: i, isparent - real(pReal) :: parentdis - ! - - ! if (a%heap_size .ge. a%max_elems) then - ! write (*,*) 'PQ_INSERT: error, attempt made to insert element on full PQ' - ! stop - ! else - a%heap_size = a%heap_size + 1_pInt - i = a%heap_size - - do while (i .gt. 1) - isparent = int(i/2_pInt, pInt) !needed casting? - parentdis = a%elems(isparent)%dis - if (dis .gt. parentdis) then - ! move what was in i's parent into i. - a%elems(i)%dis = parentdis - a%elems(i)%idx = a%elems(isparent)%idx - i = isparent - else - exit - endif - end do - - ! insert the element at the determined position - a%elems(i)%dis = dis - a%elems(i)%idx = idx - - pq_insert = a%elems(1)%dis - return - ! end if - -end function pq_insert - -subroutine pq_adjust_heap(a,i) - implicit none - type(pq), pointer :: a - integer(pInt), intent(in) :: i - ! - ! nominally arguments (a,i), but specialize for a=1 - ! - ! This routine assumes that the trees with roots 2 and 3 are already heaps, i.e. - ! the children of '1' are heaps. When the procedure is completed, the - ! tree rooted at 1 is a heap. - real(pReal) :: prichild - integer(pInt) :: parent, child, N - - type(kdtree2_result) :: e - - e = a%elems(i) - - parent = i - child = 2_pInt*i - N = a%heap_size - - do while (child .le. N) - if (child .lt. N) then - if (a%elems(child)%dis .lt. a%elems(child+1)%dis) then - child = child+1_pInt - endif - endif - prichild = a%elems(child)%dis - if (e%dis .ge. prichild) then - exit - else - ! move child into parent. - a%elems(parent) = a%elems(child) - parent = child - child = 2_pInt*parent - end if - end do - a%elems(parent) = e - return -end subroutine pq_adjust_heap - - -real(pReal) function pq_replace_max(a,dis,idx) - ! - ! Replace the extant maximum priority element - ! in the PQ with (dis,idx). Return - ! the new maximum priority, which may be larger - ! or smaller than the old one. - ! - implicit none - type(pq),pointer :: a - real(pReal), intent(in) :: dis - integer(pInt), intent(in) :: idx - !type(kdtree2_result), intent(in) :: e - ! not tested as well! - - integer(pInt) :: parent, child, N - real(pReal) :: prichild, prichildp1 - - type(kdtree2_result) :: etmp - - if (.true.) then - N=a%heap_size - if (N .ge. 1) then - parent =1_pInt - child=2_pInt - - loop: do while (child .le. N) - prichild = a%elems(child)%dis - - ! - ! posibly child+1 has higher priority, and if - ! so, get it, and increment child. - ! - - if (child .lt. N) then - prichildp1 = a%elems(child+1_pInt)%dis - if (prichild .lt. prichildp1) then - child = child+1_pInt - prichild = prichildp1 - endif - endif - - if (dis .ge. prichild) then - exit loop - ! we have a proper place for our new element, - ! bigger than either children's priority. - else - ! move child into parent. - a%elems(parent) = a%elems(child) - parent = child - child = 2_pInt*parent - end if - end do loop - a%elems(parent)%dis = dis - a%elems(parent)%idx = idx - pq_replace_max = a%elems(1)%dis - else - a%elems(1)%dis = dis - a%elems(1)%idx = idx - pq_replace_max = dis - endif - else - ! - ! slower version using elementary pop and push operations. - ! - call pq_extract_max(a,etmp) - etmp%dis = dis - etmp%idx = idx - pq_replace_max = pq_insert(a,dis,idx) - endif - return -end function pq_replace_max - -subroutine pq_delete(a,i) - ! - ! delete item with index 'i' - ! - use IO, only: IO_error - - implicit none - type(pq),pointer :: a - integer(pInt) :: i - - if ((i .lt. 1) .or. (i .gt. a%heap_size)) then - call IO_error (460_pInt,ext_msg='PQ_DELETE: attempt to remove out of bounds element') - endif - - ! swap the item to be deleted with the last element - ! and shorten heap by one. - a%elems(i) = a%elems(a%heap_size) - a%heap_size = a%heap_size - 1_pInt - - call heapify(a,i) - -end subroutine pq_delete - -end module kdtree2_priority_queue_module - - -module kdtree2_module - use prec - use kdtree2_priority_queue_module - - implicit none - private - ! K-D tree routines in Fortran 90 by Matt Kennel. - ! Original program was written in Sather by Steve Omohundro and - ! Matt Kennel. Only the Euclidean metric is supported. - ! - ! - ! This module is identical to 'kd_tree', except that the order - ! of subscripts is reversed in the data file. - ! In otherwords for an embedding of N D-dimensional vectors, the - ! data file is here, in natural Fortran order myData(1:D, 1:N) - ! because Fortran lays out columns first, - ! - ! whereas conventionally (C-style) it is myData(1:N,1:D) - ! as in the original kd_tree module. - ! - !-------------DATA TYPE, CREATION, DELETION--------------------- - public :: pReal - public :: kdtree2, kdtree2_result, tree_node, kdtree2_create, kdtree2_destroy - !--------------------------------------------------------------- - !-------------------SEARCH ROUTINES----------------------------- - public :: kdtree2_n_nearest,kdtree2_n_nearest_around_point - ! Return fixed number of nearest neighbors around arbitrary vector, - ! or extant point in dataset, with decorrelation window. - ! - public :: kdtree2_r_nearest, kdtree2_r_nearest_around_point - ! Return points within a fixed ball of arb vector/extant point - ! - public :: kdtree2_sort_results - ! Sort, in order of increasing distance, rseults from above. - ! - public :: kdtree2_r_count, kdtree2_r_count_around_point - ! Count points within a fixed ball of arb vector/extant point - ! - public :: kdtree2_n_nearest_brute_force, kdtree2_r_nearest_brute_force - ! brute force of kdtree2_[n|r]_nearest - !---------------------------------------------------------------- - - - integer(pInt), parameter :: bucket_size = 12_pInt - ! The maximum number of points to keep in a terminal node. - - type interval - real(pReal) :: lower,upper - end type interval - - type :: tree_node - ! an internal tree node - private - integer(pInt) :: cut_dim - ! the dimension to cut - real(pReal) :: cut_val - ! where to cut the dimension - real(pReal) :: cut_val_left, cut_val_right - ! improved cutoffs knowing the spread in child boxes. - integer(pInt) :: l, u - type (tree_node), pointer :: left, right - type(interval), pointer :: box(:) => null() - ! child pointers - ! Points included in this node are indexes[k] with k \in [l,u] - - - end type tree_node - - type :: kdtree2 - ! Global information about the tree, one per tree - integer(pInt) :: dimen=0_pInt, n=0_pInt - ! dimensionality and total # of points - real(pReal), pointer :: the_data(:,:) => null() - ! pointer to the actual data array - ! - ! IMPORTANT NOTE: IT IS DIMENSIONED the_data(1:d,1:N) - ! which may be opposite of what may be conventional. - ! This is, because in Fortran, the memory layout is such that - ! the first dimension is in sequential order. Hence, with - ! (1:d,1:N), all components of the vector will be in consecutive - ! memory locations. The search time is dominated by the - ! evaluation of distances in the terminal nodes. Putting all - ! vector components in consecutive memory location improves - ! memory cache locality, and hence search speed, and may enable - ! vectorization on some processors and compilers. - - integer(pInt), pointer :: ind(:) => null() - ! permuted index into the data, so that indexes[l..u] of some - ! bucket represent the indexes of the actual points in that - ! bucket. - logical :: sort = .false. - ! do we always sort output results? - logical :: rearrange = .false. - real(pReal), pointer :: rearranged_data(:,:) => null() - ! if (rearrange .eqv. .true.) then rearranged_data has been - ! created so that rearranged_data(:,i) = the_data(:,ind(i)), - ! permitting search to use more cache-friendly rearranged_data, at - ! some initial computation and storage cost. - type (tree_node), pointer :: root => null() - ! root pointer of the tree - end type kdtree2 - - - type :: tree_search_record - ! - ! One of these is created for each search. - ! - private - ! - ! Many fields are copied from the tree structure, in order to - ! speed up the search. - ! - integer(pInt) :: dimen - integer(pInt) :: nn, nfound - real(pReal) :: ballsize - integer(pInt) :: centeridx=999_pInt, correltime=9999_pInt - ! exclude points within 'correltime' of 'centeridx', iff centeridx >= 0 - integer(pInt) :: nalloc ! how much allocated for results(:)? - logical :: rearrange ! are the data rearranged or original? - ! did the # of points found overflow the storage provided? - logical :: overflow - real(pReal), pointer :: qv(:) ! query vector - type(kdtree2_result), pointer :: results(:) ! results - type(pq) :: pq - real(pReal), pointer :: myData(:,:) ! temp pointer to data - integer(pInt), pointer :: ind(:) ! temp pointer to indexes - end type tree_search_record - - type(tree_search_record), save, target :: sr ! A GLOBAL VARIABLE for search - -contains - -function kdtree2_create(input_data,myDim,sort,rearrange) result (mr) - ! - ! create the actual tree structure, given an input array of data. - ! - ! Note, input data is input_data(1:d,1:N), NOT the other way around. - ! THIS IS THE REVERSE OF THE PREVIOUS VERSION OF THIS MODULE. - ! The reason for it is cache friendliness, improving performance. - ! - ! Optional arguments: If 'myDim' is specified, then the tree - ! will only search the first 'myDim' components - ! of input_data, otherwise, myDim is inferred - ! from SIZE(input_data,1). - ! - ! if sort .eqv. .true. then output results - ! will be sorted by increasing distance. - ! default=.false., as it is faster to not sort. - ! - ! if rearrange .eqv. .true. then an internal - ! copy of the data, rearranged by terminal node, - ! will be made for cache friendliness. - ! default=.true., as it speeds searches, but - ! building takes longer, and extra memory is used. - ! - ! .. Function Return Cut_value .. - use IO, only: IO_error - - implicit none - type (kdtree2), pointer :: mr - integer(pInt), intent(in), optional :: myDim - logical, intent(in), optional :: sort - logical, intent(in), optional :: rearrange - ! .. - ! .. Array Arguments .. - real(pReal), target :: input_data(:,:) - ! - integer(pInt) :: i - ! .. - allocate (mr) - mr%the_data => input_data - ! pointer assignment - - if (present(myDim)) then - mr%dimen = myDim - else - mr%dimen = int(size(input_data,1), pInt) ! size returns default integer - end if - mr%n = int(size(input_data,2), pInt) ! size returns default integer - - if (mr%dimen > mr%n) then - ! unlikely to be correct - write (*,*) 'KD_TREE_TRANS: likely user error.' - write (*,*) 'KD_TREE_TRANS: You passed in matrix with D=',mr%dimen - write (*,*) 'KD_TREE_TRANS: and N=',mr%n - write (*,*) 'KD_TREE_TRANS: note, that new format is myData(1:D,1:N)' - write (*,*) 'KD_TREE_TRANS: with usually N >> D. If N =approx= D, then a k-d tree' - write (*,*) 'KD_TREE_TRANS: is not an appropriate data structure.' - call IO_error (460_pInt) - end if - - call build_tree(mr) - - if (present(sort)) then - mr%sort = sort - else - mr%sort = .false. - endif - - if (present(rearrange)) then - mr%rearrange = rearrange - else - mr%rearrange = .true. - endif - - if (mr%rearrange) then - allocate(mr%rearranged_data(mr%dimen,mr%n)) - do i=1_pInt,mr%n - mr%rearranged_data(:,i) = mr%the_data(:, & - mr%ind(i)) - enddo - else - nullify(mr%rearranged_data) - endif - -end function kdtree2_create - -subroutine build_tree(tp) - implicit none - type (kdtree2), pointer :: tp - ! .. - integer(pInt) :: j - type(tree_node), pointer :: dummy => null() - ! .. - allocate (tp%ind(tp%n)) - forall (j=1_pInt:tp%n) - tp%ind(j) = j - end forall - tp%root => build_tree_for_range(tp,1_pInt,tp%n, dummy) -end subroutine build_tree - -recursive function build_tree_for_range(tp,l,u,parent) result (res) - ! .. Function Return Cut_value .. - implicit none - type (tree_node), pointer :: res - ! .. - ! .. Structure Arguments .. - type (kdtree2), pointer :: tp - type (tree_node),pointer :: parent - ! .. - ! .. Scalar Arguments .. - integer(pInt), intent (In) :: l, u - ! .. - ! .. Local Scalars .. - integer(pInt) :: i, c, m, dimen - logical :: recompute - real(pReal) :: average - -!!$ If (.False.) Then -!!$ If ((l .Lt. 1) .Or. (l .Gt. tp%n)) Then -!!$ Stop 'illegal L value in build_tree_for_range' -!!$ End If -!!$ If ((u .Lt. 1) .Or. (u .Gt. tp%n)) Then -!!$ Stop 'illegal u value in build_tree_for_range' -!!$ End If -!!$ If (u .Lt. l) Then -!!$ Stop 'U is less than L, thats illegal.' -!!$ End If -!!$ Endif -!!$ - ! first compute min and max - dimen = tp%dimen - allocate (res) - allocate(res%box(dimen)) - - ! First, compute an APPROXIMATE bounding box of all points associated with this node. - if ( u < l ) then - ! no points in this box - nullify(res) - return - end if - - if ((u-l)<=bucket_size) then - ! - ! always compute true bounding box for terminal nodes. - ! - do i=1_pInt,dimen - call spread_in_coordinate(tp,i,l,u,res%box(i)) - end do - res%cut_dim = 0_pInt - res%cut_val = 0.0_pReal - res%l = l - res%u = u - res%left =>null() - res%right => null() - else - ! - ! modify approximate bounding box. This will be an - ! overestimate of the true bounding box, as we are only recomputing - ! the bounding box for the dimension that the parent split on. - ! - ! Going to a true bounding box computation would significantly - ! increase the time necessary to build the tree, and usually - ! has only a very small difference. This box is not used - ! for searching but only for deciding which coordinate to split on. - ! - do i=1_pInt,dimen - recompute=.true. - if (associated(parent)) then - if (i .ne. parent%cut_dim) then - recompute=.false. - end if - endif - if (recompute) then - call spread_in_coordinate(tp,i,l,u,res%box(i)) - else - res%box(i) = parent%box(i) - endif - end do - - - c = int(maxloc(res%box(1:dimen)%upper-res%box(1:dimen)%lower,1), pInt) - ! - ! c is the identity of which coordinate has the greatest spread. - ! - - if (.false.) then - ! select exact median to have fully balanced tree. - m = (l+u)/2_pInt - call select_on_coordinate(tp%the_data,tp%ind,c,m,l,u) - else - ! - ! select point halfway between min and max, as per A. Moore, - ! who says this helps in some degenerate cases, or - ! actual arithmetic average. - ! - if (.true.) then - ! actually compute average - average = sum(tp%the_data(c,tp%ind(l:u))) / real(u-l+1_pInt,pReal) - else - average = (res%box(c)%upper + res%box(c)%lower)/2.0_pReal - endif - - res%cut_val = average - m = select_on_coordinate_value(tp%the_data,tp%ind,c,average,l,u) - endif - - ! moves indexes around - res%cut_dim = c - res%l = l - res%u = u -! res%cut_val = tp%the_data(c,tp%ind(m)) - - res%left => build_tree_for_range(tp,l,m,res) - res%right => build_tree_for_range(tp,m+1_pInt,u,res) - - if (associated(res%right) .eqv. .false.) then - res%box = res%left%box - res%cut_val_left = res%left%box(c)%upper - res%cut_val = res%cut_val_left - elseif (associated(res%left) .eqv. .false.) then - res%box = res%right%box - res%cut_val_right = res%right%box(c)%lower - res%cut_val = res%cut_val_right - else - res%cut_val_right = res%right%box(c)%lower - res%cut_val_left = res%left%box(c)%upper - res%cut_val = (res%cut_val_left + res%cut_val_right)/2 - - - ! now remake the true bounding box for self. - ! Since we are taking unions (in effect) of a tree structure, - ! this is much faster than doing an exhaustive - ! search over all points - res%box%upper = max(res%left%box%upper,res%right%box%upper) - res%box%lower = min(res%left%box%lower,res%right%box%lower) - endif - end if -end function build_tree_for_range - -integer(pInt) function select_on_coordinate_value(v,ind,c,alpha,li,ui) result(res) - ! Move elts of ind around between l and u, so that all points - ! <= than alpha (in c cooordinate) are first, and then - ! all points > alpha are second. - - ! - ! Algorithm (matt kennel). - ! - ! Consider the list as having three parts: on the left, - ! the points known to be <= alpha. On the right, the points - ! known to be > alpha, and in the middle, the currently unknown - ! points. The algorithm is to scan the unknown points, starting - ! from the left, and swapping them so that they are added to - ! the left stack or the right stack, as appropriate. - ! - ! The algorithm finishes when the unknown stack is empty. - ! - ! .. Scalar Arguments .. - implicit none - integer(pInt), intent (In) :: c, li, ui - real(pReal), intent(in) :: alpha - ! .. - real(pReal) :: v(1:,1:) - integer(pInt) :: ind(1:) - integer(pInt) :: tmp - ! .. - integer(pInt) :: lb, rb - ! - ! The points known to be <= alpha are in - ! [l,lb-1] - ! - ! The points known to be > alpha are in - ! [rb+1,u]. - ! - ! Therefore we add new points into lb or - ! rb as appropriate. When lb=rb - ! we are done. We return the location of the last point <= alpha. - ! - ! - lb = li; rb = ui - - do while (lb < rb) - if ( v(c,ind(lb)) <= alpha ) then - ! it is good where it is. - lb = lb+1_pInt - else - ! swap it with rb. - tmp = ind(lb); ind(lb) = ind(rb); ind(rb) = tmp - rb = rb-1_pInt - endif - end do - - ! now lb .eq. ub - if (v(c,ind(lb)) <= alpha) then - res = lb - else - res = lb-1_pInt - endif - -end function select_on_coordinate_value - -subroutine select_on_coordinate(v,ind,c,k,li,ui) - ! Move elts of ind around between l and u, so that the kth - ! element - ! is >= those below, <= those above, in the coordinate c. - ! .. Scalar Arguments .. - implicit none - integer(pInt), intent (In) :: c, k, li, ui - ! .. - integer(pInt) :: i, l, m, s, t, u - ! .. - real(pReal) :: v(:,:) - integer(pInt) :: ind(:) - ! .. - l = li - u = ui - do while (l=k) u = m - 1_pInt - end do -end subroutine select_on_coordinate - -subroutine spread_in_coordinate(tp,c,l,u,interv) - ! the spread in coordinate 'c', between l and u. - ! - ! Return lower bound in 'smin', and upper in 'smax', - ! .. - ! .. Structure Arguments .. - implicit none - type (kdtree2), pointer :: tp - type(interval), intent(out) :: interv - ! .. - ! .. Scalar Arguments .. - integer(pInt), intent (In) :: c, l, u - ! .. - ! .. Local Scalars .. - real(pReal) :: last, lmax, lmin, t, smin,smax - integer(pInt) :: i, ulocal - ! .. - ! .. Local Arrays .. - real(pReal), pointer :: v(:,:) - integer(pInt), pointer :: ind(:) - ! .. - v => tp%the_data(1:,1:) - ind => tp%ind(1:) - smin = v(c,ind(l)) - smax = smin - - ulocal = u - - do i = l + 2_pInt, ulocal, 2_pInt - lmin = v(c,ind(i-1_pInt)) - lmax = v(c,ind(i)) - if (lmin>lmax) then - t = lmin - lmin = lmax - lmax = t - end if - if (smin>lmin) smin = lmin - if (smaxlast) smin = last - if (smax qv - sr%nn = nn - sr%nfound = 0_pInt - sr%centeridx = -1_pInt - sr%correltime = 0_pInt - sr%overflow = .false. - - sr%results => results - - sr%nalloc = nn ! will be checked - - sr%ind => tp%ind - sr%rearrange = tp%rearrange - if (tp%rearrange) then - sr%myData => tp%rearranged_data - else - sr%myData => tp%the_data - endif - sr%dimen = tp%dimen - - call validate_query_storage(nn) - sr%pq = pq_create(results) - - call search(tp%root) - - if (tp%sort) then - call kdtree2_sort_results(nn, results) - endif -! deallocate(sr%pqp) - return -end subroutine kdtree2_n_nearest - -subroutine kdtree2_n_nearest_around_point(tp,idxin,correltime,nn,results) - ! Find the 'nn' vectors in the tree nearest to point 'idxin', - ! with correlation window 'correltime', returing results in - ! results(:), which must be pre-allocated upon entry. - implicit none - type (kdtree2), pointer :: tp - integer(pInt), intent (In) :: idxin, correltime, nn - type(kdtree2_result), target :: results(:) - - allocate (sr%qv(tp%dimen)) - sr%qv = tp%the_data(:,idxin) ! copy the vector - sr%ballsize = huge(1.0_pReal) ! the largest real(pReal) number - sr%centeridx = idxin - sr%correltime = correltime - - sr%nn = nn - sr%nfound = 0_pInt - - sr%dimen = tp%dimen - sr%nalloc = nn - - sr%results => results - - sr%ind => tp%ind - sr%rearrange = tp%rearrange - - if (sr%rearrange) then - sr%myData => tp%rearranged_data - else - sr%myData => tp%the_data - endif - - call validate_query_storage(nn) - sr%pq = pq_create(results) - - call search(tp%root) - - if (tp%sort) then - call kdtree2_sort_results(nn, results) - endif - deallocate (sr%qv) - return -end subroutine kdtree2_n_nearest_around_point - -subroutine kdtree2_r_nearest(tp,qv,r2,nfound,nalloc,results) - ! find the nearest neighbors to point 'idxin', within SQUARED - ! Euclidean distance 'r2'. Upon ENTRY, nalloc must be the - ! size of memory allocated for results(1:nalloc). Upon - ! EXIT, nfound is the number actually found within the ball. - ! - ! Note that if nfound .gt. nalloc then more neighbors were found - ! than there were storage to store. The resulting list is NOT - ! the smallest ball inside norm r^2 - ! - ! Results are NOT sorted unless tree was created with sort option. - implicit none - type (kdtree2), pointer :: tp - real(pReal), target, intent (In) :: qv(:) - real(pReal), intent(in) :: r2 - integer(pInt), intent(out) :: nfound - integer(pInt), intent (In) :: nalloc - type(kdtree2_result), target :: results(:) - - ! - sr%qv => qv - sr%ballsize = r2 - sr%nn = 0_pInt ! flag for fixed ball search - sr%nfound = 0_pInt - sr%centeridx = -1_pInt - sr%correltime = 0_pInt - - sr%results => results - - call validate_query_storage(nalloc) - sr%nalloc = nalloc - sr%overflow = .false. - sr%ind => tp%ind - sr%rearrange= tp%rearrange - - if (tp%rearrange) then - sr%myData => tp%rearranged_data - else - sr%myData => tp%the_data - endif - sr%dimen = tp%dimen - - ! - !sr%dsl = Huge(sr%dsl) ! set to huge positive values - !sr%il = -1 ! set to invalid indexes - ! - - call search(tp%root) - nfound = sr%nfound - if (tp%sort) then - call kdtree2_sort_results(nfound, results) - endif - - if (sr%overflow) then - write (*,*) 'KD_TREE_TRANS: warning! return from kdtree2_r_nearest found more neighbors' - write (*,*) 'KD_TREE_TRANS: than storage was provided for. Answer is NOT smallest ball' - write (*,*) 'KD_TREE_TRANS: with that number of neighbors! I.e. it is wrong.' - endif - - return -end subroutine kdtree2_r_nearest - -subroutine kdtree2_r_nearest_around_point(tp,idxin,correltime,r2,nfound,nalloc,results) - ! - ! Like kdtree2_r_nearest, but around a point 'idxin' already existing - ! in the data set. - ! - ! Results are NOT sorted unless tree was created with sort option. - ! - implicit none - type (kdtree2), pointer :: tp - integer(pInt), intent (In) :: idxin, correltime, nalloc - real(pReal), intent(in) :: r2 - integer(pInt), intent(out) :: nfound - type(kdtree2_result), target :: results(:) - ! .. - ! .. Intrinsic Functions .. - intrinsic HUGE - ! .. - allocate (sr%qv(tp%dimen)) - sr%qv = tp%the_data(:,idxin) ! copy the vector - sr%ballsize = r2 - sr%nn = 0_pInt ! flag for fixed r search - sr%nfound = 0_pInt - sr%centeridx = idxin - sr%correltime = correltime - - sr%results => results - - sr%nalloc = nalloc - sr%overflow = .false. - - call validate_query_storage(nalloc) - - ! sr%dsl = HUGE(sr%dsl) ! set to huge positive values - ! sr%il = -1 ! set to invalid indexes - - sr%ind => tp%ind - sr%rearrange = tp%rearrange - - if (tp%rearrange) then - sr%myData => tp%rearranged_data - else - sr%myData => tp%the_data - endif - sr%rearrange = tp%rearrange - sr%dimen = tp%dimen - - ! - !sr%dsl = Huge(sr%dsl) ! set to huge positive values - !sr%il = -1 ! set to invalid indexes - ! - - call search(tp%root) - nfound = sr%nfound - if (tp%sort) then - call kdtree2_sort_results(nfound,results) - endif - - if (sr%overflow) then - write (*,*) 'KD_TREE_TRANS: warning! return from kdtree2_r_nearest found more neighbors' - write (*,*) 'KD_TREE_TRANS: than storage was provided for. Answer is NOT smallest ball' - write (*,*) 'KD_TREE_TRANS: with that number of neighbors! I.e. it is wrong.' - endif - - deallocate (sr%qv) - return -end subroutine kdtree2_r_nearest_around_point - -function kdtree2_r_count(tp,qv,r2) result(nfound) - ! Count the number of neighbors within square distance 'r2'. - implicit none - type (kdtree2), pointer :: tp - real(pReal), target, intent (In) :: qv(:) - real(pReal), intent(in) :: r2 - integer(pInt) :: nfound - ! .. - ! .. Intrinsic Functions .. - intrinsic HUGE - ! .. - sr%qv => qv - sr%ballsize = r2 - - sr%nn = 0_pInt ! flag for fixed r search - sr%nfound = 0_pInt - sr%centeridx = -1_pInt - sr%correltime = 0_pInt - - nullify(sr%results) ! for some reason, FTN 95 chokes on '=> null()' - - sr%nalloc = 0_pInt ! we do not allocate any storage but that's OK - ! for counting. - sr%ind => tp%ind - sr%rearrange = tp%rearrange - if (tp%rearrange) then - sr%myData => tp%rearranged_data - else - sr%myData => tp%the_data - endif - sr%dimen = tp%dimen - - ! - !sr%dsl = Huge(sr%dsl) ! set to huge positive values - !sr%il = -1 ! set to invalid indexes - ! - sr%overflow = .false. - - call search(tp%root) - - nfound = sr%nfound - - return -end function kdtree2_r_count - -function kdtree2_r_count_around_point(tp,idxin,correltime,r2) result(nfound) - ! Count the number of neighbors within square distance 'r2' around - ! point 'idxin' with decorrelation time 'correltime'. - ! - implicit none - type (kdtree2), pointer :: tp - - integer(pInt), intent (In) :: correltime, idxin - real(pReal), intent(in) :: r2 - - integer(pInt) :: nfound - ! .. - ! .. - ! .. Intrinsic Functions .. - intrinsic HUGE - ! .. - allocate (sr%qv(tp%dimen)) - sr%qv = tp%the_data(:,idxin) - sr%ballsize = r2 - - sr%nn = 0_pInt ! flag for fixed r search - sr%nfound = 0_pInt - sr%centeridx = idxin - sr%correltime = correltime - nullify(sr%results) - - sr%nalloc = 0_pInt ! we do not allocate any storage but that's OK - ! for counting. - - sr%ind => tp%ind - sr%rearrange = tp%rearrange - - if (sr%rearrange) then - sr%myData => tp%rearranged_data - else - sr%myData => tp%the_data - endif - sr%dimen = tp%dimen - - ! - !sr%dsl = Huge(sr%dsl) ! set to huge positive values - !sr%il = -1 ! set to invalid indexes - ! - sr%overflow = .false. - - call search(tp%root) - - nfound = sr%nfound - - return -end function kdtree2_r_count_around_point - - -subroutine validate_query_storage(n) - ! - ! make sure we have enough storage for n - ! - use IO, only: IO_error - - implicit none - integer(pInt), intent(in) :: n - - if (int(size(sr%results,1),pInt) < n) then - call IO_error (460_pInt,el=n,ip=int(size(sr%results,1),pInt),ext_msg='KD_TREE_TRANS: not enough storage for results(1:n)') - endif - - return -end subroutine validate_query_storage - -function square_distance(d, iv,qv) result (res) - ! distance between iv[1:n] and qv[1:n] - ! .. Function Return Value .. - ! re-implemented to improve vectorization. - implicit none - real(pReal) :: res - ! .. Scalar Arguments .. - integer(pInt) :: d - ! .. Array Arguments .. - real(pReal) :: iv(:),qv(:) - ! .. - ! .. - res = sum( (iv(1:d)-qv(1:d))**2 ) -end function square_distance - -recursive subroutine search(node) - ! - ! This is the innermost core routine of the kd-tree search. Along - ! with "process_terminal_node", it is the performance bottleneck. - ! - ! This version uses a logically complete secondary search of - ! "box in bounds", whether the sear - ! - implicit none - type (Tree_node), pointer :: node - ! .. - type(tree_node),pointer :: ncloser, nfarther - ! - integer(pInt) :: cut_dim, i - ! .. - real(pReal) :: qval, dis - real(pReal) :: ballsize - real(pReal), pointer :: qv(:) - type(interval), pointer :: box(:) - - if ((associated(node%left) .and. associated(node%right)) .eqv. .false.) then - ! we are on a terminal node - if (sr%nn .eq. 0) then - call process_terminal_node_fixedball(node) - else - call process_terminal_node(node) - endif - else - ! we are not on a terminal node - qv => sr%qv(1:) - cut_dim = node%cut_dim - qval = qv(cut_dim) - - if (qval < node%cut_val) then - ncloser => node%left - nfarther => node%right - dis = (node%cut_val_right - qval)**2 -! extra = node%cut_val - qval - else - ncloser => node%right - nfarther => node%left - dis = (node%cut_val_left - qval)**2 -! extra = qval- node%cut_val_left - endif - - if (associated(ncloser)) call search(ncloser) - - ! we may need to search the second node. - if (associated(nfarther)) then - ballsize = sr%ballsize -! dis=extra**2 - if (dis <= ballsize) then - ! - ! we do this separately as going on the first cut dimen is often - ! a good idea. - ! note that if extra**2 < sr%ballsize, then the next - ! check will also be false. - ! - box => node%box(1:) - do i=1_pInt,sr%dimen - if (i .ne. cut_dim) then - dis = dis + dis2_from_bnd(qv(i),box(i)%lower,box(i)%upper) - if (dis > ballsize) then - return - endif - endif - end do - - ! - ! if we are still here then we need to search mroe. - ! - call search(nfarther) - endif - endif - end if -end subroutine search - - -real(pReal) function dis2_from_bnd(x,amin,amax) result (res) - - implicit none - real(pReal), intent(in) :: x, amin,amax - - if (x > amax) then - res = (x-amax)**2; - return - else - if (x < amin) then - res = (amin-x)**2; - return - else - res = 0.0_pReal - return - endif - endif - return -end function dis2_from_bnd - -logical function box_in_search_range(node, sr) result(res) - ! - ! Return the distance from 'qv' to the CLOSEST corner of node's - ! bounding box - ! for all coordinates outside the box. Coordinates inside the box - ! contribute nothing to the distance. - ! - implicit none - type (tree_node), pointer :: node - type (tree_search_record), pointer :: sr - - integer(pInt) :: dimen, i - real(pReal) :: dis, ballsize - real(pReal) :: l, u - - dimen = sr%dimen - ballsize = sr%ballsize - dis = 0.0_pReal - res = .true. - do i=1_pInt,dimen - l = node%box(i)%lower - u = node%box(i)%upper - dis = dis + (dis2_from_bnd(sr%qv(i),l,u)) - if (dis > ballsize) then - res = .false. - return - endif - end do - res = .true. - return -end function box_in_search_range - - -subroutine process_terminal_node(node) - ! - ! Look for actual near neighbors in 'node', and update - ! the search results on the sr data structure. - ! - implicit none - type (tree_node), pointer :: node - ! - real(pReal), pointer :: qv(:) - integer(pInt), pointer :: ind(:) - real(pReal), pointer :: myData(:,:) - ! - integer(pInt) :: dimen, i, indexofi, k, centeridx, correltime - real(pReal) :: ballsize, sd, newpri - logical :: rearrange - type(pq), pointer :: pqp - ! - ! copy values from sr to local variables - ! - ! - ! Notice, making local pointers with an EXPLICIT lower bound - ! seems to generate faster code. - ! why? I don't know. - qv => sr%qv(1:) - pqp => sr%pq - dimen = sr%dimen - ballsize = sr%ballsize - rearrange = sr%rearrange - ind => sr%ind(1:) - myData => sr%myData(1:,1:) - centeridx = sr%centeridx - correltime = sr%correltime - - ! doing_correl = (centeridx >= 0) ! Do we have a decorrelation window? - ! include_point = .true. ! by default include all points - ! search through terminal bucket. - - mainloop: do i = node%l, node%u - if (rearrange) then - sd = 0.0_pReal - do k = 1_pInt,dimen - sd = sd + (myData(k,i) - qv(k))**2.0_pReal - if (sd>ballsize) cycle mainloop - end do - indexofi = ind(i) ! only read it if we have not broken out - else - indexofi = ind(i) - sd = 0.0_pReal - do k = 1_pInt,dimen - sd = sd + (myData(k,indexofi) - qv(k))**2.0_pReal - if (sd>ballsize) cycle mainloop - end do - endif - - if (centeridx > 0_pInt) then ! doing correlation interval? - if (abs(indexofi-centeridx) < correltime) cycle mainloop - endif - - - ! - ! two choices for any point. The list so far is either undersized, - ! or it is not. - ! - ! If it is undersized, then add the point and its distance - ! unconditionally. If the point added fills up the working - ! list then set the sr%ballsize, maximum distance bound (largest distance on - ! list) to be that distance, instead of the initialized +infinity. - ! - ! If the running list is full size, then compute the - ! distance but break out immediately if it is larger - ! than sr%ballsize, "best squared distance" (of the largest element), - ! as it cannot be a good neighbor. - ! - ! Once computed, compare to best_square distance. - ! if it is smaller, then delete the previous largest - ! element and add the new one. - - if (sr%nfound .lt. sr%nn) then - ! - ! add this point unconditionally to fill list. - ! - sr%nfound = sr%nfound +1_pInt - newpri = pq_insert(pqp,sd,indexofi) - if (sr%nfound .eq. sr%nn) ballsize = newpri - ! we have just filled the working list. - ! put the best square distance to the maximum value - ! on the list, which is extractable from the PQ. - - else - ! - ! now, if we get here, - ! we know that the current node has a squared - ! distance smaller than the largest one on the list, and - ! belongs on the list. - ! Hence we replace that with the current one. - ! - ballsize = pq_replace_max(pqp,sd,indexofi) - endif - end do mainloop - ! - ! Reset sr variables which may have changed during loop - ! - sr%ballsize = ballsize - -end subroutine process_terminal_node - -subroutine process_terminal_node_fixedball(node) - ! - ! Look for actual near neighbors in 'node', and update - ! the search results on the sr data structure, i.e. - ! save all within a fixed ball. - ! - implicit none - type (tree_node), pointer :: node - ! - real(pReal), pointer :: qv(:) - integer(pInt), pointer :: ind(:) - real(pReal), pointer :: myData(:,:) - ! - integer(pInt) :: nfound - integer(pInt) :: dimen, i, indexofi, k - integer(pInt) :: centeridx, correltime, nn - real(pReal) :: ballsize, sd - logical :: rearrange - - ! - ! copy values from sr to local variables - ! - qv => sr%qv(1:) - dimen = sr%dimen - ballsize = sr%ballsize - rearrange = sr%rearrange - ind => sr%ind(1:) - myData => sr%myData(1:,1:) - centeridx = sr%centeridx - correltime = sr%correltime - nn = sr%nn ! number to search for - nfound = sr%nfound - - ! search through terminal bucket. - mainloop: do i = node%l, node%u - - ! - ! two choices for any point. The list so far is either undersized, - ! or it is not. - ! - ! If it is undersized, then add the point and its distance - ! unconditionally. If the point added fills up the working - ! list then set the sr%ballsize, maximum distance bound (largest distance on - ! list) to be that distance, instead of the initialized +infinity. - ! - ! If the running list is full size, then compute the - ! distance but break out immediately if it is larger - ! than sr%ballsize, "best squared distance" (of the largest element), - ! as it cannot be a good neighbor. - ! - ! Once computed, compare to best_square distance. - ! if it is smaller, then delete the previous largest - ! element and add the new one. - - ! which index to the point do we use? - - if (rearrange) then - sd = 0.0_pReal - do k = 1_pInt,dimen - sd = sd + (myData(k,i) - qv(k))**2.0_pReal - if (sd>ballsize) cycle mainloop - end do - indexofi = ind(i) ! only read it if we have not broken out - else - indexofi = ind(i) - sd = 0.0_pReal - do k = 1_pInt,dimen - sd = sd + (myData(k,indexofi) - qv(k))**2.0_pReal - if (sd>ballsize) cycle mainloop - end do - endif - - if (centeridx > 0_pInt) then ! doing correlation interval? - if (abs(indexofi-centeridx) 1_pInt)then - ileft=ileft-1_pInt - value=a(ileft); ivalue=ind(ileft) - else - value=a(iright); ivalue=ind(iright) - a(iright)=a(1); ind(iright)=ind(1) - iright=iright-1_pInt - if (iright == 1_pInt) then - a(1)=value;ind(1)=ivalue - return - endif - endif - i=ileft - j=2_pInt*ileft - do while (j <= iright) - if(j < iright) then - if(a(j) < a(j+1_pInt)) j=j+1_pInt - endif - if(value < a(j)) then - a(i)=a(j); ind(i)=ind(j) - i=j - j=j+j - else - j=iright+1_pInt - endif - end do - a(i)=value; ind(i)=ivalue - end do -end subroutine heapsort - -subroutine heapsort_struct(a,n) - ! - ! Sort a(1:n) in ascending order - ! - ! - implicit none - integer(pInt),intent(in) :: n - type(kdtree2_result),intent(inout) :: a(:) - - ! - ! - type(kdtree2_result) :: value ! temporary value - - integer(pInt) :: i,j - integer(pInt) :: ileft,iright - - ileft=n/2_pInt+1_pInt - iright=n - - ! do i=1,n - ! ind(i)=i - ! Generate initial idum array - ! end do - - if(n.eq.1_pInt) return - - do - if(ileft > 1_pInt)then - ileft=ileft-1_pInt - value=a(ileft) - else - value=a(iright) - a(iright)=a(1) - iright=iright-1_pInt - if (iright == 1_pInt) then - a(1) = value - return - endif - endif - i=ileft - j=2_pInt*ileft - do while (j <= iright) - if(j < iright) then - if(a(j)%dis < a(j+1_pInt)%dis) j=j+1_pInt - endif - if(value%dis < a(j)%dis) then - a(i)=a(j); - i=j - j=j+j - else - j=iright+1_pInt - endif - end do - a(i)=value - end do -end subroutine heapsort_struct - -end module kdtree2_module