fixed small bug in detecting the lattice structure. only first 3 letters count (e.g. 'ort' and 'orthography' will give the orthorombic lattice type)

This commit is contained in:
Martin Diehl 2013-11-28 08:56:02 +00:00
parent 345e5cd47c
commit 2d624d022f
6 changed files with 37 additions and 17 deletions

View File

@ -194,8 +194,11 @@ subroutine constitutive_dislotwin_init(file)
Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, &
Nchunks_SlipFamilies, Nchunks_TwinFamilies, &
index_myFamily, index_otherFamily
character(len=65536) :: tag
character(len=65536) :: line = '' ! to start initialized
character(len=32) :: &
structure = ''
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>'
write(6,'(a)') ' $Id$'
@ -350,7 +353,8 @@ subroutine constitutive_dislotwin_init(file)
constitutive_dislotwin_Noutput(i) = constitutive_dislotwin_Noutput(i) + 1_pInt
constitutive_dislotwin_output(constitutive_dislotwin_Noutput(i),i) = IO_lc(IO_stringValue(line,positions,2_pInt))
case ('lattice_structure')
select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
structure = IO_lc(IO_stringValue(line,positions,2_pInt))
select case(structure(1:3))
case(LATTICE_iso_label)
constitutive_dislotwin_structureID(i) = LATTICE_iso_ID
case(LATTICE_fcc_label)

View File

@ -47,7 +47,7 @@ module constitutive_j2
constitutive_j2_output !< name of each post result output
integer(kind(LATTICE_iso_ID)), dimension(:), allocatable, public :: &
constitutive_j2_structureID !< ID of the lattice structure
constitutive_j2_structureID !< ID of the lattice structure
integer(pInt), dimension(:), allocatable, private :: &
constitutive_j2_Noutput !< number of outputs per instance
@ -119,6 +119,8 @@ subroutine constitutive_j2_init(myFile)
integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions
integer(pInt) :: section = 0_pInt, maxNinstance, i,o, mySize
character(len=32) :: &
structure = ''
character(len=65536) :: &
tag = '', &
line = '' ! to start initialized
@ -203,7 +205,8 @@ subroutine constitutive_j2_init(myFile)
constitutive_j2_output(constitutive_j2_Noutput(i),i) = &
IO_lc(IO_stringValue(line,positions,2_pInt))
case ('lattice_structure')
select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
structure = IO_lc(IO_stringValue(line,positions,2_pInt))
select case(structure(1:3))
case(LATTICE_iso_label)
constitutive_j2_structureID(i) = LATTICE_iso_ID
case(LATTICE_fcc_label)

View File

@ -86,9 +86,11 @@ subroutine constitutive_none_init(myFile)
integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions
integer(pInt) :: section = 0_pInt, maxNinstance, i
character(len=32) :: &
structure = ''
character(len=65536) :: &
tag = '', &
line = '' ! to start initialized
line = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>'
write(6,'(a)') ' $Id$'
@ -135,7 +137,8 @@ subroutine constitutive_none_init(myFile)
case ('plasticity','elasticity')
cycle
case ('lattice_structure')
select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
structure = IO_lc(IO_stringValue(line,positions,2_pInt))
select case(structure(1:3))
case(LATTICE_iso_label)
constitutive_none_structureID(i) = LATTICE_iso_ID
case(LATTICE_fcc_label)

View File

@ -266,8 +266,11 @@ integer(pInt) :: section = 0_pInt, &
Nchunks_SlipFamilies = 0_pInt, &
Nchunks_nonSchmid = 0_pInt, &
mySize = 0_pInt ! to suppress warnings, safe as init is called only once
character(len=65536) :: tag, &
line = '' ! to start initialized
character(len=32) :: &
structure = ''
character(len=65536) :: &
tag = '', &
line = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>'
write(6,'(a)') ' $Id$'
@ -428,8 +431,9 @@ do while (trim(line) /= '#EOF#')
case ('(output)')
Noutput(i) = Noutput(i) + 1_pInt
constitutive_nonlocal_output(Noutput(i),i) = IO_lc(IO_stringValue(line,positions,2_pInt))
case ('lattice_structure')
select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
case ('lattice_structure')
structure = IO_lc(IO_stringValue(line,positions,2_pInt))
select case(structure(1:3))
case(LATTICE_iso_label)
constitutive_nonlocal_structureID(i) = LATTICE_iso_ID
case(LATTICE_fcc_label)

View File

@ -154,9 +154,11 @@ subroutine constitutive_phenopowerlaw_init(myFile)
Nchunks_SlipFamilies, Nchunks_TwinFamilies, Nchunks_nonSchmid, &
structID, index_myFamily, index_otherFamily, &
mySize=0_pInt, section = 0_pInt
character(len=32) :: &
structure = ''
character(len=65536) :: &
tag = '', &
line = '' ! to start initialized
line = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>'
write(6,'(a)') ' $Id$'
@ -304,8 +306,9 @@ subroutine constitutive_phenopowerlaw_init(myFile)
case ('totalvolfrac')
constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = totalvolfrac_ID
end select
case ('lattice_structure')
select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
case ('lattice_structure')
structure = IO_lc(IO_stringValue(line,positions,2_pInt))
select case(structure(1:3))
case(LATTICE_iso_label)
constitutive_phenopowerlaw_structureID(i) = LATTICE_iso_ID
case(LATTICE_fcc_label)

View File

@ -231,9 +231,11 @@ subroutine constitutive_titanmod_init(myFile)
Nchunks_SlipFamilies, Nchunks_TwinFamilies, &
mySize, structID, &
maxTotalNslip,maxTotalNtwin, maxNinstance
character(len=32) :: &
structure = ''
character(len=65536) :: &
tag = '', &
line = '' ! to start initialized
line = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_TITANMOD_label//' init -+>>>'
write(6,'(a)') ' $Id$'
@ -414,8 +416,9 @@ subroutine constitutive_titanmod_init(myFile)
case ('(output)')
constitutive_titanmod_Noutput(i) = constitutive_titanmod_Noutput(i) + 1_pInt
constitutive_titanmod_output(constitutive_titanmod_Noutput(i),i) = IO_lc(IO_stringValue(line,positions,2_pInt))
case ('lattice_structure')
select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
case ('lattice_structure')
structure = IO_lc(IO_stringValue(line,positions,2_pInt))
select case(structure(1:3))
case(LATTICE_iso_label)
constitutive_titanmod_structureID(i) = LATTICE_iso_ID
case(LATTICE_fcc_label)