material.f90

Go to the documentation of this file.

# 1 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/material.f90"
# 1 "<built-in>"
# 1 "<command-line>"
# 1 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/material.f90"
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
module material
  use prec
  use math
  use config
  use results
  use io
  use debug
  use numerics
  use rotations
  use discretization
 
  implicit none
  private
 
  character(len=*), parameter, public :: &
    elasticity_hooke_label               = 'hooke', &
    plasticity_none_label                = 'none', &
    plasticity_isotropic_label           = 'isotropic', &
    plasticity_phenopowerlaw_label       = 'phenopowerlaw', &
    plasticity_kinehardening_label       = 'kinehardening', &
    plasticity_dislotwin_label           = 'dislotwin', &
    plasticity_disloucla_label           = 'disloucla', &
    plasticity_nonlocal_label            = 'nonlocal', &
    source_thermal_dissipation_label     = 'thermal_dissipation', &
    source_thermal_externalheat_label    = 'thermal_externalheat', &
    source_damage_isobrittle_label       = 'damage_isobrittle', &
    source_damage_isoductile_label       = 'damage_isoductile', &
    source_damage_anisobrittle_label     = 'damage_anisobrittle', &
    source_damage_anisoductile_label     = 'damage_anisoductile', &
    kinematics_thermal_expansion_label   = 'thermal_expansion', &
    kinematics_cleavage_opening_label    = 'cleavage_opening', &
    kinematics_slipplane_opening_label   = 'slipplane_opening', &
    stiffness_degradation_damage_label   = 'damage', &
    thermal_isothermal_label             = 'isothermal', &
    thermal_adiabatic_label              = 'adiabatic', &
    thermal_conduction_label             = 'conduction', &
    damage_none_label                    = 'none', &
    damage_local_label                   = 'local', &
    damage_nonlocal_label                = 'nonlocal', &
    homogenization_none_label            = 'none', &
    homogenization_isostrain_label       = 'isostrain', &
    homogenization_rgc_label             = 'rgc'
 
  enum, bind(c); enumerator :: &
    elasticity_undefined_id ,&
    elasticity_hooke_id ,&
    plasticity_undefined_id ,&
    plasticity_none_id, &
    plasticity_isotropic_id, &
    plasticity_phenopowerlaw_id, &
    plasticity_kinehardening_id, &
    plasticity_dislotwin_id, &
    plasticity_disloucla_id, &
    plasticity_nonlocal_id, &
    source_undefined_id ,&
    source_thermal_dissipation_id, &
    source_thermal_externalheat_id, &
    source_damage_isobrittle_id, &
    source_damage_isoductile_id, &
    source_damage_anisobrittle_id, &
    source_damage_anisoductile_id, &
    kinematics_undefined_id ,&
    kinematics_cleavage_opening_id, &
    kinematics_slipplane_opening_id, &
    kinematics_thermal_expansion_id, &
    stiffness_degradation_undefined_id, &
    stiffness_degradation_damage_id, &
    thermal_isothermal_id, &
    thermal_adiabatic_id, &
    thermal_conduction_id, &
    damage_none_id, &
    damage_local_id, &
    damage_nonlocal_id, &
    homogenization_undefined_id, &
    homogenization_none_id, &
    homogenization_isostrain_id, &
    homogenization_rgc_id
  end enum
 
  integer(kind(ELASTICITY_undefined_ID)),     dimension(:),   allocatable, public, protected :: &
    phase_elasticity
  integer(kind(PLASTICITY_undefined_ID)),     dimension(:),   allocatable, public, protected :: &
    phase_plasticity
  integer(kind(THERMAL_isothermal_ID)),       dimension(:),   allocatable, public, protected :: &
    thermal_type
  integer(kind(DAMAGE_none_ID)),              dimension(:),   allocatable, public, protected :: &
    damage_type
  integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:),   allocatable, public, protected :: &
    homogenization_type
 
  integer, public, protected :: &
    material_nphase, &                                                                              !< number of phases
    material_nhomogenization
 
  integer(kind(SOURCE_undefined_ID)),         dimension(:,:), allocatable, public, protected :: &
    phase_source, &                                                                                 !< active sources mechanisms of each phase
    phase_kinematics, &                                                                             !< active kinematic mechanisms of each phase
    phase_stiffnessdegradation
 
  integer, public, protected :: &
    homogenization_maxngrains
 
  integer, dimension(:), allocatable, public, protected :: &
    phase_nsources, &                                                                               !< number of source mechanisms active in each phase
    phase_nkinematics, &                                                                            !< number of kinematic mechanisms active in each phase
    phase_nstiffnessdegradations, &                                                                 !< number of stiffness degradation mechanisms active in each phase
    phase_elasticityinstance, &                                                                     !< instance of particular elasticity of each phase
    phase_plasticityinstance, &                                                                     !< instance of particular plasticity of each phase
    homogenization_ngrains, &                                                                       !< number of grains in each homogenization
    homogenization_typeinstance, &                                                                  !< instance of particular type of each homogenization
    thermal_typeinstance, &                                                                         !< instance of particular type of each thermal transport
    damage_typeinstance
 
  real(preal), dimension(:), allocatable, public, protected :: &
    thermal_initialt, &                                                                             !< initial temperature per each homogenization
    damage_initialphi
 
  integer, dimension(:),     allocatable, public, protected :: &                                    ! (elem)
    material_homogenizationat
  integer, dimension(:,:),   allocatable, public, target :: &                                       ! (ip,elem) ToDo: ugly target for mapping hack
    material_homogenizationmemberat
  integer, dimension(:,:), allocatable, public, protected :: &                                      ! (constituent,elem)
    material_phaseat
  integer, dimension(:,:,:), allocatable, public, protected :: &                                    ! (constituent,elem)
    material_phasememberat
 
  type(tplasticstate), allocatable, dimension(:), public :: &
    plasticstate
  type(tsourcestate),  allocatable, dimension(:), public :: &
    sourcestate
  type(tstate),        allocatable, dimension(:), public :: &
    homogstate, &
    thermalstate, &
    damagestate
 
  integer, dimension(:,:,:), allocatable, public, protected :: &
    material_texture
 
  type(rotation), dimension(:,:,:), allocatable, public, protected :: &
    material_orientation0
 
  logical, dimension(:), allocatable, public, protected :: &
    phase_localplasticity
 
  integer, dimension(:), allocatable, private :: &
    microstructure_nconstituents
 
  integer, dimension(:,:), allocatable, private :: &
    microstructure_phase, &                                                                         !< phase IDs of each microstructure
    microstructure_texture
 
  type(rotation), dimension(:), allocatable, private :: &
    texture_orientation
 
 
! BEGIN DEPRECATED
  integer, dimension(:,:),   allocatable, private, target :: mappinghomogenizationconst
! END DEPRECATED
 
  type(thomogmapping), allocatable, dimension(:), public :: &
    thermalmapping, &                                                                               !< mapping for thermal state/fields
    damagemapping
 
  type(group_float),  allocatable, dimension(:), public :: &
    temperature, &                                                                                  !< temperature field
    damage, &                                                                                       !< damage field
    temperaturerate
 
  public :: &
    material_init, &
    material_allocateplasticstate, &
    material_allocatesourcestate, &
    elasticity_hooke_id ,&
    plasticity_none_id, &
    plasticity_isotropic_id, &
    plasticity_phenopowerlaw_id, &
    plasticity_kinehardening_id, &
    plasticity_dislotwin_id, &
    plasticity_disloucla_id, &
    plasticity_nonlocal_id, &
    source_thermal_dissipation_id, &
    source_thermal_externalheat_id, &
    source_damage_isobrittle_id, &
    source_damage_isoductile_id, &
    source_damage_anisobrittle_id, &
    source_damage_anisoductile_id, &
    kinematics_cleavage_opening_id, &
    kinematics_slipplane_opening_id, &
    kinematics_thermal_expansion_id, &
    stiffness_degradation_damage_id, &
    thermal_isothermal_id, &
    thermal_adiabatic_id, &
    thermal_conduction_id, &
    damage_none_id, &
    damage_local_id, &
    damage_nonlocal_id, &
    homogenization_none_id, &
    homogenization_isostrain_id, &
    homogenization_rgc_id
 
contains
 
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine material_init
 
  integer            :: i,e,m,c,h, mydebug, myphase, myhomog, mymicro
  integer, dimension(:), allocatable :: &
   counterphase, &
   counterhomogenization
 
  mydebug = debug_level(debug_material)
 
  write(6,'(/,a)') ' <<<+-  material init  -+>>>'; flush(6)
 
  call material_parsephase()
  if (iand(mydebug,debug_levelbasic) /= 0) write(6,'(a)') ' Phase          parsed'; flush(6)
 
  call material_parsemicrostructure()
  if (iand(mydebug,debug_levelbasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6)
 
  call material_parsehomogenization()
  if (iand(mydebug,debug_levelbasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6)
 
  call material_parsetexture()
  if (iand(mydebug,debug_levelbasic) /= 0) write(6,'(a)') ' Texture        parsed'; flush(6)
 
  material_nphase          = size(config_phase)
  material_nhomogenization = size(config_homogenization)
 
 
  allocate(plasticstate(material_nphase))
  allocate(sourcestate(material_nphase))
  do myphase = 1,material_nphase
    allocate(sourcestate(myphase)%p(phase_nsources(myphase)))
  enddo
 
  allocate(homogstate(material_nhomogenization))
  allocate(thermalstate(material_nhomogenization))
  allocate(damagestate(material_nhomogenization))
 
  allocate(thermalmapping(material_nhomogenization))
  allocate(damagemapping(material_nhomogenization))
 
  allocate(temperature(material_nhomogenization))
  allocate(damage(material_nhomogenization))
 
  allocate(temperaturerate(material_nhomogenization))
 
  do m = 1,size(config_microstructure)
    if(minval(microstructure_phase(1:microstructure_nconstituents(m),m)) < 1 .or. &
       maxval(microstructure_phase(1:microstructure_nconstituents(m),m)) > size(config_phase)) &
         call io_error(150,m,ext_msg='phase')
    if(minval(microstructure_texture(1:microstructure_nconstituents(m),m)) < 1 .or. &
       maxval(microstructure_texture(1:microstructure_nconstituents(m),m)) > size(config_texture)) &
         call io_error(150,m,ext_msg='texture')
    if(microstructure_nconstituents(m) < 1) &
         call io_error(151,m)
  enddo
  if(homogenization_maxngrains > size(microstructure_phase,1)) call io_error(148)
 
  debugout: if (iand(mydebug,debug_levelextensive) /= 0) then
    write(6,'(/,a,/)') ' MATERIAL configuration'
    write(6,'(a32,1x,a16,1x,a6)') 'homogenization                  ','type            ','grains'
    do h = 1,size(config_homogenization)
      write(6,'(1x,a32,1x,a16,1x,i6)') config_name_homogenization(h),homogenization_type(h),homogenization_ngrains(h)
    enddo
    write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','constituents'
    do m = 1,size(config_microstructure)
      write(6,'(1x,a32,1x,i12)') config_name_microstructure(m), microstructure_nconstituents(m)
      if (microstructure_nconstituents(m) > 0) then
        do c = 1,microstructure_nconstituents(m)
          write(6,'(a1,1x,a32,1x,a32)') '>',config_name_phase(microstructure_phase(c,m)),&
                                            config_name_texture(microstructure_texture(c,m))
        enddo
        write(6,*)
      endif
    enddo
  endif debugout
 
  allocate(material_phaseat(homogenization_maxngrains,discretization_nelem),                   source=0)
  allocate(material_texture(homogenization_maxngrains,discretization_nip,discretization_nelem),source=0)   !this is only needed by plasticity nonlocal
  allocate(material_orientation0(homogenization_maxngrains,discretization_nip,discretization_nelem))
 
  do e = 1, discretization_nelem
     do i = 1, discretization_nip
       mymicro = discretization_microstructureat(e)
       do c = 1, homogenization_ngrains(discretization_homogenizationat(e))
         if(microstructure_phase(c,mymicro) > 0) then
           material_phaseat(c,e)        = microstructure_phase(c,mymicro)
         else
           call io_error(150,ext_msg='phase')
         endif
         if(microstructure_texture(c,mymicro) > 0) then
           material_texture(c,i,e)      = microstructure_texture(c,mymicro)
           material_orientation0(c,i,e) = texture_orientation(material_texture(c,i,e))
         else
           call io_error(150,ext_msg='texture')
         endif
       enddo
     enddo
   enddo
 
  deallocate(microstructure_phase)
  deallocate(microstructure_texture)
  deallocate(texture_orientation)
 
 
  allocate(material_homogenizationat,source=discretization_homogenizationat)
  allocate(material_homogenizationmemberat(discretization_nip,discretization_nelem),source=0)
 
  allocate(counterhomogenization(size(config_homogenization)),source=0)
  do e = 1, discretization_nelem
    do i = 1, discretization_nip
      counterhomogenization(material_homogenizationat(e)) = &
      counterhomogenization(material_homogenizationat(e)) + 1
      material_homogenizationmemberat(i,e) = counterhomogenization(material_homogenizationat(e))
    enddo
  enddo
 
  allocate(material_phasememberat(homogenization_maxngrains,discretization_nip,discretization_nelem),source=0)
 
  allocate(counterphase(size(config_phase)),source=0)
  do e = 1, discretization_nelem
    do i = 1, discretization_nip
      do c = 1, homogenization_maxngrains
        counterphase(material_phaseat(c,e)) = &
        counterphase(material_phaseat(c,e)) + 1
        material_phasememberat(c,i,e) = counterphase(material_phaseat(c,e))
      enddo
    enddo
  enddo
 
  call config_deallocate('material.config/microstructure')
  call config_deallocate('material.config/texture')
 
  call results_openjobfile
  call results_mapping_constituent(material_phaseat,material_phasememberat,config_name_phase)
  call results_mapping_materialpoint(material_homogenizationat,material_homogenizationmemberat,config_name_homogenization)
  call results_closejobfile
 
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN DEPRECATED
  allocate(mappinghomogenizationconst(  discretization_nip,discretization_nelem),source=1)
 
! hack needed to initialize field values used during constitutive initialization
  do myhomog = 1,size(config_homogenization)
    thermalmapping(myhomog)%p => mappinghomogenizationconst
    damagemapping(myhomog)%p => mappinghomogenizationconst
    allocate(temperature(myhomog)%p(1), source=thermal_initialt(myhomog))
    allocate(damage(myhomog)%p(1), source=damage_initialphi(myhomog))
    allocate(temperaturerate(myhomog)%p(1), source=0.0_preal)
  enddo
! END DEPRECATED
 
end subroutine material_init
 
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine material_parsehomogenization
 
  integer :: h
  character(len=pStringLen) :: tag
 
  logical, dimension(:), allocatable :: homogenization_active
 
  allocate(homogenization_type(size(config_homogenization)),           source=homogenization_undefined_id)
  allocate(thermal_type(size(config_homogenization)),                  source=thermal_isothermal_id)
  allocate(damage_type(size(config_homogenization)),                  source=damage_none_id)
  allocate(homogenization_typeinstance(size(config_homogenization)),   source=0)
  allocate(thermal_typeinstance(size(config_homogenization)),          source=0)
  allocate(damage_typeinstance(size(config_homogenization)),           source=0)
  allocate(homogenization_ngrains(size(config_homogenization)),        source=0)
  allocate(homogenization_active(size(config_homogenization)),         source=.false.)  !!!!!!!!!!!!!!!
  allocate(thermal_initialt(size(config_homogenization)),              source=300.0_preal)
  allocate(damage_initialphi(size(config_homogenization)),             source=1.0_preal)
 
  forall (h = 1:size(config_homogenization)) &
    homogenization_active(h) = any(discretization_homogenizationat == h)
 
 
  do h=1, size(config_homogenization)
 
    tag = config_homogenization(h)%getString('mech')
    select case (trim(tag))
      case(homogenization_none_label)
        homogenization_type(h) = homogenization_none_id
        homogenization_ngrains(h) = 1
      case(homogenization_isostrain_label)
        homogenization_type(h) = homogenization_isostrain_id
        homogenization_ngrains(h) = config_homogenization(h)%getInt('nconstituents')
      case(homogenization_rgc_label)
        homogenization_type(h) = homogenization_rgc_id
        homogenization_ngrains(h) = config_homogenization(h)%getInt('nconstituents')
      case default
        call io_error(500,ext_msg=trim(tag))
    end select
 
    homogenization_typeinstance(h) = count(homogenization_type==homogenization_type(h))
 
    if (config_homogenization(h)%keyExists('thermal')) then
      thermal_initialt(h) =  config_homogenization(h)%getFloat('t0',defaultval=300.0_preal)
 
      tag = config_homogenization(h)%getString('thermal')
      select case (trim(tag))
        case(thermal_isothermal_label)
          thermal_type(h) = thermal_isothermal_id
        case(thermal_adiabatic_label)
          thermal_type(h) = thermal_adiabatic_id
        case(thermal_conduction_label)
          thermal_type(h) = thermal_conduction_id
        case default
          call io_error(500,ext_msg=trim(tag))
      end select
 
    endif
 
    if (config_homogenization(h)%keyExists('damage')) then
      damage_initialphi(h) =  config_homogenization(h)%getFloat('initialdamage',defaultval=1.0_preal)
 
      tag = config_homogenization(h)%getString('damage')
      select case (trim(tag))
        case(damage_none_label)
          damage_type(h) = damage_none_id
        case(damage_local_label)
          damage_type(h) = damage_local_id
        case(damage_nonlocal_label)
          damage_type(h) = damage_nonlocal_id
        case default
          call io_error(500,ext_msg=trim(tag))
      end select
 
    endif
 
  enddo
 
  do h=1, size(config_homogenization)
    homogenization_typeinstance(h)  = count(homogenization_type(1:h) == homogenization_type(h))
    thermal_typeinstance(h)         = count(thermal_type(1:h) == thermal_type(h))
    damage_typeinstance(h)          = count(damage_type(1:h) == damage_type(h))
  enddo
 
  homogenization_maxngrains = maxval(homogenization_ngrains,homogenization_active)
 
end subroutine material_parsehomogenization
 
 
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine material_parsemicrostructure
 
  character(len=pStringLen), dimension(:), allocatable :: &
    strings
  integer, allocatable, dimension(:) :: chunkPos
  integer :: m, c, i
  character(len=pStringLen) :: &
    tag
  real(pReal), dimension(:,:), allocatable :: &
    microstructure_fraction
  integer :: &
    maxNconstituents
 
  allocate(microstructure_nconstituents(size(config_microstructure)), source=0)
 
  if(any(discretization_microstructureat > size(config_microstructure))) &
   call io_error(155,ext_msg='More microstructures in geometry than sections in material.config')
 
  do m=1, size(config_microstructure)
    microstructure_nconstituents(m) =  config_microstructure(m)%countKeys('(constituent)')
  enddo
 
  maxnconstituents = maxval(microstructure_nconstituents)
  allocate(microstructure_phase(maxnconstituents,size(config_microstructure)),source=0)
  allocate(microstructure_texture(maxnconstituents,size(config_microstructure)),source=0)
  allocate(microstructure_fraction(maxnconstituents,size(config_microstructure)),source=0.0_preal)
 
  allocate(strings(1))                                                                              ! Intel 16.0 Bug
  do m=1, size(config_microstructure)
    strings = config_microstructure(m)%getStrings('(constituent)',raw=.true.)
    do c = 1, size(strings)
      chunkpos = io_stringpos(strings(c))
 
      do i = 1,5,2
         tag = io_stringvalue(strings(c),chunkpos,i)
 
         select case (tag)
           case('phase')
             microstructure_phase(c,m) =    io_intvalue(strings(c),chunkpos,i+1)
           case('texture')
             microstructure_texture(c,m) =  io_intvalue(strings(c),chunkpos,i+1)
           case('fraction')
             microstructure_fraction(c,m) = io_floatvalue(strings(c),chunkpos,i+1)
         end select
 
      enddo
    enddo
    if (dneq(sum(microstructure_fraction(:,m)),1.0_preal)) call io_error(153,ext_msg=config_name_microstructure(m))
  enddo
 
 
end subroutine material_parsemicrostructure
 
 
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine material_parsephase
 
  integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
  character(len=pStringLen), dimension(:), allocatable ::  str
 
 
  allocate(phase_elasticity(size(config_phase)),source=elasticity_undefined_id)
  allocate(phase_plasticity(size(config_phase)),source=plasticity_undefined_id)
  allocate(phase_nsources(size(config_phase)),              source=0)
  allocate(phase_nkinematics(size(config_phase)),           source=0)
  allocate(phase_nstiffnessdegradations(size(config_phase)),source=0)
  allocate(phase_localplasticity(size(config_phase)),       source=.false.)
 
  do p=1, size(config_phase)
    phase_nsources(p) =                config_phase(p)%countKeys('(source)')
    phase_nkinematics(p) =             config_phase(p)%countKeys('(kinematics)')
    phase_nstiffnessdegradations(p) =  config_phase(p)%countKeys('(stiffness_degradation)')
    phase_localplasticity(p) = .not.   config_phase(p)%KeyExists('/nonlocal/')
 
    select case (config_phase(p)%getString('elasticity'))
      case (elasticity_hooke_label)
        phase_elasticity(p) = elasticity_hooke_id
      case default
        call io_error(200,ext_msg=trim(config_phase(p)%getString('elasticity')))
    end select
 
    select case (config_phase(p)%getString('plasticity'))
      case (plasticity_none_label)
        phase_plasticity(p) = plasticity_none_id
      case (plasticity_isotropic_label)
        phase_plasticity(p) = plasticity_isotropic_id
      case (plasticity_phenopowerlaw_label)
        phase_plasticity(p) = plasticity_phenopowerlaw_id
      case (plasticity_kinehardening_label)
        phase_plasticity(p) = plasticity_kinehardening_id
      case (plasticity_dislotwin_label)
        phase_plasticity(p) = plasticity_dislotwin_id
      case (plasticity_disloucla_label)
        phase_plasticity(p) = plasticity_disloucla_id
      case (plasticity_nonlocal_label)
        phase_plasticity(p) = plasticity_nonlocal_id
      case default
        call io_error(201,ext_msg=trim(config_phase(p)%getString('plasticity')))
    end select
 
  enddo
 
  allocate(phase_source(maxval(phase_nsources),size(config_phase)), source=source_undefined_id)
  allocate(phase_kinematics(maxval(phase_nkinematics),size(config_phase)), source=kinematics_undefined_id)
  allocate(phase_stiffnessdegradation(maxval(phase_nstiffnessdegradations),size(config_phase)), &
           source=stiffness_degradation_undefined_id)
  do p=1, size(config_phase)
 
    str = ['GfortranBug86277']
    str = config_phase(p)%getStrings('(source)',defaultval=str)
    if (str(1) == 'GfortranBug86277') str = [character(len=pStringLen)::]
 
 
 
    do sourcectr = 1, size(str)
      select case (trim(str(sourcectr)))
        case (source_thermal_dissipation_label)
          phase_source(sourcectr,p) = source_thermal_dissipation_id
        case (source_thermal_externalheat_label)
          phase_source(sourcectr,p) = source_thermal_externalheat_id
        case (source_damage_isobrittle_label)
          phase_source(sourcectr,p) = source_damage_isobrittle_id
        case (source_damage_isoductile_label)
          phase_source(sourcectr,p) = source_damage_isoductile_id
        case (source_damage_anisobrittle_label)
          phase_source(sourcectr,p) = source_damage_anisobrittle_id
        case (source_damage_anisoductile_label)
          phase_source(sourcectr,p) = source_damage_anisoductile_id
      end select
    enddo
 
 
    str = ['GfortranBug86277']
    str = config_phase(p)%getStrings('(kinematics)',defaultval=str)
    if (str(1) == 'GfortranBug86277') str = [character(len=pStringLen)::]
 
 
 
    do kinematicsctr = 1, size(str)
      select case (trim(str(kinematicsctr)))
        case (kinematics_cleavage_opening_label)
          phase_kinematics(kinematicsctr,p) = kinematics_cleavage_opening_id
        case (kinematics_slipplane_opening_label)
          phase_kinematics(kinematicsctr,p) = kinematics_slipplane_opening_id
        case (kinematics_thermal_expansion_label)
          phase_kinematics(kinematicsctr,p) = kinematics_thermal_expansion_id
      end select
    enddo
 
    str = ['GfortranBug86277']
    str = config_phase(p)%getStrings('(stiffness_degradation)',defaultval=str)
    if (str(1) == 'GfortranBug86277') str = [character(len=pStringLen)::]
 
 
 
    do stiffdegradationctr = 1, size(str)
      select case (trim(str(stiffdegradationctr)))
        case (stiffness_degradation_damage_label)
          phase_stiffnessdegradation(stiffdegradationctr,p) = stiffness_degradation_damage_id
      end select
    enddo
  enddo
 
  allocate(phase_plasticityinstance(size(config_phase)),source=0)
  allocate(phase_elasticityinstance(size(config_phase)),source=0)
 
  do p=1, size(config_phase)
    phase_elasticityinstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p))
    phase_plasticityinstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p))
  enddo
 
end subroutine material_parsephase
 
 
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine material_parsetexture
 
  integer :: j,t
  character(len=pStringLen), dimension(:), allocatable ::  strings                                  ! Values for given key in material config
  integer, dimension(:), allocatable :: chunkPos
  real(pReal), dimension(3,3) :: transformation                                                     ! maps texture to microstructure coordinate system
  real(pReal), dimension(3)   :: Eulers                                                             ! Euler angles in degrees from file
  type(rotation)              :: transformation_
 
  do t=1, size(config_texture)
    if (config_texture(t)%countKeys('(gauss)') /= 1) call io_error(147,ext_msg='count((gauss)) != 1')
    if (config_texture(t)%keyExists('symmetry'))     call io_error(147,ext_msg='symmetry')
    if (config_texture(t)%keyExists('(random)'))     call io_error(147,ext_msg='(random)')
    if (config_texture(t)%keyExists('(fiber)'))      call io_error(147,ext_msg='(fiber)')
  enddo
 
  allocate(texture_orientation(size(config_texture)))
 
  do t=1, size(config_texture)
 
    strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
    chunkpos = io_stringpos(strings(1))
    do j = 1,5,2
      select case (io_stringvalue(strings(1),chunkpos,j))
        case('phi1')
          eulers(1) = io_floatvalue(strings(1),chunkpos,j+1)
        case('phi')
          eulers(2) = io_floatvalue(strings(1),chunkpos,j+1)
        case('phi2')
          eulers(3) = io_floatvalue(strings(1),chunkpos,j+1)
      end select
    enddo
    call texture_orientation(t)%fromEulers(eulers,degrees=.true.)
 
    if (config_texture(t)%keyExists('axes')) then
      strings = config_texture(t)%getStrings('axes')
      do j = 1, 3                                                                                   ! look for "x", "y", and "z" entries
        select case (strings(j))
          case('x', '+x')
            transformation(j,1:3) = [ 1.0_preal, 0.0_preal, 0.0_preal]                              ! original axis is now +x-axis
          case('-x')
            transformation(j,1:3) = [-1.0_preal, 0.0_preal, 0.0_preal]                              ! original axis is now -x-axis
          case('y', '+y')
            transformation(j,1:3) = [ 0.0_preal, 1.0_preal, 0.0_preal]                              ! original axis is now +y-axis
          case('-y')
            transformation(j,1:3) = [ 0.0_preal,-1.0_preal, 0.0_preal]                              ! original axis is now -y-axis
          case('z', '+z')
            transformation(j,1:3) = [ 0.0_preal, 0.0_preal, 1.0_preal]                              ! original axis is now +z-axis
          case('-z')
            transformation(j,1:3) = [ 0.0_preal, 0.0_preal,-1.0_preal]                              ! original axis is now -z-axis
          case default
            call io_error(157,t)
        end select
      enddo
      call transformation_%fromMatrix(transformation)
      texture_orientation(t) = texture_orientation(t) * transformation_
    endif
 
  enddo
 
end subroutine material_parsetexture
 
 
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine material_allocateplasticstate(phase,NipcMyPhase,&
                                         sizeState,sizeDotState,sizeDeltaState)
 
  integer, intent(in) :: &
    phase, &
    nipcmyphase, &
    sizestate, &
    sizedotstate, &
    sizedeltastate
 
  plasticstate(phase)%sizeState        = sizestate
  plasticstate(phase)%sizeDotState     = sizedotstate
  plasticstate(phase)%sizeDeltaState   = sizedeltastate
  plasticstate(phase)%offsetDeltaState = sizestate-sizedeltastate                                   ! deltaState occupies latter part of state by definition
 
  allocate(plasticstate(phase)%atol                (sizestate),               source=0.0_preal)
  allocate(plasticstate(phase)%state0              (sizestate,nipcmyphase),   source=0.0_preal)
  allocate(plasticstate(phase)%partionedState0     (sizestate,nipcmyphase),   source=0.0_preal)
  allocate(plasticstate(phase)%subState0           (sizestate,nipcmyphase),   source=0.0_preal)
  allocate(plasticstate(phase)%state               (sizestate,nipcmyphase),   source=0.0_preal)
 
  allocate(plasticstate(phase)%dotState            (sizedotstate,nipcmyphase),source=0.0_preal)
  if (numerics_integrator == 1) then
    allocate(plasticstate(phase)%previousDotState  (sizedotstate,nipcmyphase),source=0.0_preal)
    allocate(plasticstate(phase)%previousDotState2 (sizedotstate,nipcmyphase),source=0.0_preal)
  endif
  if (numerics_integrator == 4) &
    allocate(plasticstate(phase)%RK4dotState       (4,sizedotstate,nipcmyphase),source=0.0_preal)
  if (numerics_integrator == 5) &
    allocate(plasticstate(phase)%RKCK45dotState  (6,sizedotstate,nipcmyphase),source=0.0_preal)
 
  allocate(plasticstate(phase)%deltaState        (sizedeltastate,nipcmyphase),source=0.0_preal)
 
end subroutine material_allocateplasticstate
 
 
!--------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------
subroutine material_allocatesourcestate(phase,of,NipcMyPhase,&
                                        sizeState,sizeDotState,sizeDeltaState)
 
  integer, intent(in) :: &
    phase, &
    of, &
    nipcmyphase, &
    sizestate, sizedotstate,sizedeltastate
 
  sourcestate(phase)%p(of)%sizeState        = sizestate
  sourcestate(phase)%p(of)%sizeDotState     = sizedotstate
  sourcestate(phase)%p(of)%sizeDeltaState   = sizedeltastate
  sourcestate(phase)%p(of)%offsetDeltaState = sizestate-sizedeltastate                              ! deltaState occupies latter part of state by definition
 
  allocate(sourcestate(phase)%p(of)%atol                (sizestate),               source=0.0_preal)
  allocate(sourcestate(phase)%p(of)%state0              (sizestate,nipcmyphase),   source=0.0_preal)
  allocate(sourcestate(phase)%p(of)%partionedState0     (sizestate,nipcmyphase),   source=0.0_preal)
  allocate(sourcestate(phase)%p(of)%subState0           (sizestate,nipcmyphase),   source=0.0_preal)
  allocate(sourcestate(phase)%p(of)%state               (sizestate,nipcmyphase),   source=0.0_preal)
 
  allocate(sourcestate(phase)%p(of)%dotState            (sizedotstate,nipcmyphase),source=0.0_preal)
  if (numerics_integrator == 1) then
    allocate(sourcestate(phase)%p(of)%previousDotState  (sizedotstate,nipcmyphase),source=0.0_preal)
    allocate(sourcestate(phase)%p(of)%previousDotState2 (sizedotstate,nipcmyphase),source=0.0_preal)
  endif
  if (numerics_integrator == 4) &
    allocate(sourcestate(phase)%p(of)%RK4dotState     (4,sizedotstate,nipcmyphase),source=0.0_preal)
  if (numerics_integrator == 5) &
    allocate(sourcestate(phase)%p(of)%RKCK45dotState  (6,sizedotstate,nipcmyphase),source=0.0_preal)
 
  allocate(sourcestate(phase)%p(of)%deltaState        (sizedeltastate,nipcmyphase),source=0.0_preal)
 
end subroutine material_allocatesourcestate
 
end module material