Merge branch '95-report-origin-of-configuration-file' into 'development'

Resolve "Report origin of configuration file"

Closes #95

See merge request damask/DAMASK!736

src/IO.f90

@@ -11,6 +11,7 @@ module IO
     IO_STDERR => ERROR_UNIT
 
   use prec
+  use misc
 
   implicit none(type,external)
   private
@@ -30,6 +31,7 @@ module IO
     IO_read, &
     IO_readlines, &
     IO_isBlank, &
+    IO_wrapLines, &
     IO_stringPos, &
     IO_stringValue, &
     IO_intValue, &
@@ -158,6 +160,51 @@ logical pure function IO_isBlank(string)
 end function IO_isBlank
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief Insert EOL at separator trying to keep line length below limit.
+!--------------------------------------------------------------------------------------------------
+function IO_wrapLines(string,separator,filler,length)
+
+  character(len=*),    intent(in) :: string                                                         !< string to split
+  character, optional, intent(in) :: separator                                                      !< line breaks are possible after this character, defaults to ','
+  character(len=*), optional, intent(in) :: filler                                                  !< character(s) to insert after line break, defaults to none
+  integer,   optional, intent(in) :: length                                                         !< (soft) line limit, defaults to 80
+  character(len=:), allocatable :: IO_wrapLines
+
+  integer, dimension(:), allocatable :: pos_sep, pos_split
+  integer :: i,s,e
+
+
+  i = index(string,misc_optional(separator,','))
+  if (i == 0) then
+    IO_wrapLines = string
+  else
+    pos_sep = [0]
+    s = i
+    do while (i /= 0 .and. s < len(string))
+      pos_sep = [pos_sep,s]
+      i = index(string(s+1:),misc_optional(separator,','))
+      s = s + i
+    end do
+    pos_sep = [pos_sep,len(string)]
+
+    pos_split = emptyIntArray
+    s = 1
+    e = 2
+    IO_wrapLines = ''
+    do while (e < size(pos_sep))
+      if (pos_sep(e+1) - pos_sep(s) >= misc_optional(length,80)) then
+        IO_wrapLines = IO_wrapLines//adjustl(string(pos_sep(s)+1:pos_sep(e)))//IO_EOL//misc_optional(filler,'')
+        s = e
+      end if
+      e = e + 1
+    end do
+    IO_wrapLines = IO_wrapLines//adjustl(string(pos_sep(s)+1:))
+  end if
+
+end function IO_wrapLines
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief Locate all whitespace-separated chunks in given string and returns array containing
 !! number them and the left/right position to be used by IO_xxxVal.
@@ -748,6 +795,21 @@ subroutine selfTest()
   str=' ab #';out=IO_rmComment(str)
   if (out /= ' ab'.or. len(out) /= 3)                error stop 'IO_rmComment/6'
 
+  if ('abc, def' /= IO_wrapLines('abc, def')) &
+                                                     error stop 'IO_wrapLines/1'
+  if ('abc,'//IO_EOL//'def' /= IO_wrapLines('abc,def',length=3)) &
+                                                     error stop 'IO_wrapLines/2'
+  if ('abc,'//IO_EOL//'def' /= IO_wrapLines('abc,def',length=5)) &
+                                                     error stop 'IO_wrapLines/3'
+  if ('abc, def' /= IO_wrapLines('abc, def',length=3,separator='.')) &
+                                                     error stop 'IO_wrapLines/4'
+  if ('abc.'//IO_EOL//'def' /= IO_wrapLines('abc. def',length=3,separator='.')) &
+                                                     error stop 'IO_wrapLines/5'
+  if ('abc,'//IO_EOL//'defg,'//IO_EOL//'hij' /= IO_wrapLines('abc,defg,hij',length=4)) &
+                                                     error stop 'IO_wrapLines/6'
+  if ('abc,'//IO_EOL//'xxdefg,'//IO_EOL//'xxhij' /= IO_wrapLines('abc,defg, hij',filler='xx',length=4)) &
+                                                     error stop 'IO_wrapLines/7'
+
 end subroutine selfTest
 
 end module IO

src/config.f90

@@ -4,6 +4,7 @@
 !--------------------------------------------------------------------------------------------------
 module config
   use IO
+  use misc
   use YAML_parse
   use YAML_types
   use result
@@ -18,8 +19,9 @@ module config
 
   public :: &
     config_init, &
-    config_material_deallocate,&
+    config_material_deallocate, &
-    config_numerics_deallocate
+    config_numerics_deallocate, &
+    config_listReferences
 
 contains
 
@@ -36,6 +38,58 @@ subroutine config_init()
 end subroutine config_init
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief Deallocate config_material.
+!--------------------------------------------------------------------------------------------------
+subroutine config_material_deallocate()
+
+  print'(/,1x,a)', 'deallocating material configuration'; flush(IO_STDOUT)
+  deallocate(config_material)
+
+end subroutine config_material_deallocate
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Deallocate config_numerics if present.
+!--------------------------------------------------------------------------------------------------
+subroutine config_numerics_deallocate()
+
+  if (.not. associated(config_numerics, emptyDict)) then
+    print'(/,1x,a)', 'deallocating numerics configuration'; flush(IO_STDOUT)
+    deallocate(config_numerics)
+  end if
+
+end subroutine config_numerics_deallocate
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Return string with references from dict.
+!--------------------------------------------------------------------------------------------------
+function config_listReferences(config,indent) result(references)
+
+  type(tDict) :: config
+  integer, optional :: indent
+  character(len=:), allocatable :: references
+
+
+  type(tList), pointer :: ref
+  character(len=:), allocatable :: filler
+  integer :: r
+
+
+  filler = repeat(' ',misc_optional(indent,0))
+  ref => config%get_list('references',emptyList)
+  if (ref%length == 0) then
+    references = ''
+  else
+    references = 'references:'
+    do r = 1, ref%length
+      references = references//IO_EOL//filler//'- '//IO_wrapLines(ref%get_asString(r),filler=filler//'  ')
+    end do
+  end if
+
+end function config_listReferences
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief Read material.yaml.
 !--------------------------------------------------------------------------------------------------
@@ -93,27 +147,4 @@ subroutine parse_numerics()
 
 end subroutine parse_numerics
 
-
-!--------------------------------------------------------------------------------------------------
-!> @brief Deallocate config_material.
-!--------------------------------------------------------------------------------------------------
-subroutine config_material_deallocate()
-
-  print'(/,1x,a)', 'deallocating material configuration'; flush(IO_STDOUT)
-  deallocate(config_material)
-
-end subroutine config_material_deallocate
-
-!--------------------------------------------------------------------------------------------------
-!> @brief Deallocate config_numerics if present.
-!--------------------------------------------------------------------------------------------------
-subroutine config_numerics_deallocate()
-
-  if (.not. associated(config_numerics, emptyDict)) then
-    print'(/,1x,a)', 'deallocating numerics configuration'; flush(IO_STDOUT)
-    deallocate(config_numerics)
-  end if
-
-end subroutine config_numerics_deallocate
-
 end module config

src/material.f90

@@ -79,7 +79,7 @@ end subroutine material_init
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Parse material.yaml to get the global structure
+!> @brief Parse material.yaml to get the global structure.
 !--------------------------------------------------------------------------------------------------
 subroutine parse()
 

src/phase.f90

@@ -382,6 +382,7 @@ subroutine phase_init
   type(tDict), pointer :: &
     phases, &
     phase
+  character(len=:), allocatable :: refs
 
 
   print'(/,1x,a)', '<<<+-  phase init  -+>>>'; flush(IO_STDOUT)
@@ -393,7 +394,10 @@ subroutine phase_init
   allocate(phase_O_0(phases%length))
 
   do ph = 1,phases%length
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
     phase => phases%get_dict(ph)
+    refs = config_listReferences(phase,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
     phase_lattice(ph) = phase%get_asString('lattice')
     if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) &
       call IO_error(130,ext_msg='phase_init: '//phase%get_asString('lattice'))
@@ -516,7 +520,7 @@ end subroutine phase_result
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief allocates and initialize per grain variables
+!> @brief Allocate and initialize.
 !--------------------------------------------------------------------------------------------------
 subroutine crystallite_init()
 

src/phase_damage.f90

@@ -79,9 +79,10 @@ module subroutine damage_init()
     ph, &
     Nmembers
   type(tDict), pointer :: &
-   phases, &
+    phases, &
-   phase, &
+    phase, &
-   source
+    source
+  character(len=:), allocatable :: refs
   logical:: damage_active
 
 
@@ -103,6 +104,9 @@ module subroutine damage_init()
     phase => phases%get_dict(ph)
     source => phase%get_dict('damage',defaultVal=emptyDict)
     if (source%length > 0) then
+      print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+      refs = config_listReferences(source,indent=3)
+      if (len(refs) > 0) print'(/,1x,a)', refs
       damage_active = .true.
       param(ph)%mu = source%get_asFloat('mu')
       param(ph)%l_c = source%get_asFloat('l_c')

src/phase_damage_anisobrittle.f90

@@ -41,7 +41,9 @@ module function anisobrittle_init() result(mySources)
     src
   integer :: Nmembers,ph
   integer, dimension(:), allocatable :: N_cl
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
 
 
   mySources = source_active('anisobrittle')
@@ -62,6 +64,10 @@ module function anisobrittle_init() result(mySources)
 
       associate(prm  => param(ph))
 
+        print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+        refs = config_listReferences(src,indent=3)
+        if (len(refs) > 0) print'(/,1x,a)', refs
+
         N_cl = src%get_as1dInt('N_cl',defaultVal=emptyIntArray)
         prm%sum_N_cl = sum(abs(N_cl))
 

src/phase_damage_isobrittle.f90

@@ -39,7 +39,9 @@ module function isobrittle_init() result(mySources)
     phase, &
     src
   integer :: Nmembers,ph
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
 
 
   mySources = source_active('isobrittle')
@@ -64,6 +66,10 @@ module function isobrittle_init() result(mySources)
 
         prm%W_crit = src%get_asFloat('G_crit')/src%get_asFloat('l_c')
 
+        print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+        refs = config_listReferences(src,indent=3)
+        if (len(refs) > 0) print'(/,1x,a)', refs
+
 #if defined (__GFORTRAN__)
         prm%output = output_as1dString(src)
 #else

src/phase_mechanical_elastic.f90

@@ -28,6 +28,7 @@ module subroutine elastic_init(phases)
     phase, &
     mech, &
     elastic
+  character(len=:), allocatable :: refs
 
 
   print'(/,1x,a)', '<<<+-  phase:mechanical:elastic init  -+>>>'
@@ -42,6 +43,9 @@ module subroutine elastic_init(phases)
     phase   => phases%get_dict(ph)
     mech    => phase%get_dict('mechanical')
     elastic => mech%get_dict('elastic')
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+    refs = config_listReferences(elastic,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
     if (elastic%get_asString('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asString('type'))
 
     associate(prm => param(ph))

src/phase_mechanical_plastic_dislotungsten.f90

@@ -93,7 +93,9 @@ module function plastic_dislotungsten_init() result(myPlasticity)
     rho_mob_0, &                                                                                    !< initial dislocation density
     rho_dip_0, &                                                                                    !< initial dipole density
     a                                                                                               !< non-Schmid coefficients
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
   type(tDict), pointer :: &
     phases, &
     phase, &
@@ -128,6 +130,10 @@ module function plastic_dislotungsten_init() result(myPlasticity)
     mech  => phase%get_dict('mechanical')
     pl  => mech%get_dict('plastic')
 
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+    refs = config_listReferences(pl,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
+
 #if defined (__GFORTRAN__)
     prm%output = output_as1dString(pl)
 #else

src/phase_mechanical_plastic_dislotwin.f90

@@ -140,7 +140,9 @@ module function plastic_dislotwin_init() result(myPlasticity)
   real(pReal), allocatable, dimension(:) :: &
     rho_mob_0, &                                                                                    !< initial unipolar dislocation density per slip system
     rho_dip_0                                                                                       !< initial dipole dislocation density per slip system
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
   type(tDict), pointer :: &
     phases, &
     phase, &
@@ -181,6 +183,10 @@ module function plastic_dislotwin_init() result(myPlasticity)
     mech  => phase%get_dict('mechanical')
     pl  => mech%get_dict('plastic')
 
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+    refs = config_listReferences(pl,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
+
 #if defined (__GFORTRAN__)
     prm%output = output_as1dString(pl)
 #else

src/phase_mechanical_plastic_isotropic.f90

@@ -54,7 +54,9 @@ module function plastic_isotropic_init() result(myPlasticity)
     sizeState, sizeDotState
   real(pReal) :: &
     xi_0                                                                                            !< initial critical stress
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
   type(tDict), pointer :: &
     phases, &
     phase, &
@@ -86,6 +88,10 @@ module function plastic_isotropic_init() result(myPlasticity)
     mech => phase%get_dict('mechanical')
     pl => mech%get_dict('plastic')
 
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+    refs = config_listReferences(pl,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
+
 #if defined (__GFORTRAN__)
     prm%output = output_as1dString(pl)
 #else

src/phase_mechanical_plastic_kinehardening.f90

@@ -77,13 +77,16 @@ module function plastic_kinehardening_init() result(myPlasticity)
   real(pReal), dimension(:), allocatable :: &
     xi_0, &                                                                                         !< initial resistance against plastic flow
     a                                                                                               !< non-Schmid coefficients
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
   type(tDict), pointer :: &
     phases, &
     phase, &
     mech, &
     pl
 
+
   myPlasticity = plastic_active('kinehardening')
   if (count(myPlasticity) == 0) return
 
@@ -111,6 +114,10 @@ module function plastic_kinehardening_init() result(myPlasticity)
     mech => phase%get_dict('mechanical')
     pl => mech%get_dict('plastic')
 
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+    refs = config_listReferences(pl,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
+
 #if defined (__GFORTRAN__)
     prm%output = output_as1dString(pl)
 #else

src/phase_mechanical_plastic_none.f90

@@ -31,6 +31,7 @@ module function plastic_none_init() result(myPlasticity)
   phases => config_material%get_dict('phase')
   do ph = 1, phases%length
     if (.not. myPlasticity(ph)) cycle
+    print'(a,i0,a)', ' phase ',ph
     call phase_allocateState(plasticState(ph),count(material_ID_phase == ph),0,0,0)
   end do
 

src/phase_mechanical_plastic_nonlocal.f90

@@ -188,7 +188,9 @@ module function plastic_nonlocal_init() result(myPlasticity)
     s, t, l
   real(pReal), dimension(:), allocatable :: &
     a
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
   type(tInitialParameters) :: &
     ini
   type(tDict), pointer :: &
@@ -234,13 +236,17 @@ module function plastic_nonlocal_init() result(myPlasticity)
     mech => phase%get_dict('mechanical')
     pl => mech%get_dict('plastic')
 
-    plasticState(ph)%nonlocal = pl%get_asBool('flux',defaultVal=.True.)
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+    refs = config_listReferences(pl,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
+
 #if defined (__GFORTRAN__)
     prm%output = output_as1dString(pl)
 #else
     prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
 #endif
 
+    plasticState(ph)%nonlocal = pl%get_asBool('flux',defaultVal=.True.)
     prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain')
     prm%atol_rho = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal)
 

src/phase_mechanical_plastic_phenopowerlaw.f90

@@ -91,7 +91,9 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
     xi_0_sl, &                                                                                      !< initial critical shear stress for slip
     xi_0_tw, &                                                                                      !< initial critical shear stress for twin
     a                                                                                               !< non-Schmid coefficients
-  character(len=:), allocatable :: extmsg
+  character(len=:), allocatable :: &
+    refs, &
+    extmsg
   type(tDict), pointer :: &
     phases, &
     phase, &
@@ -122,6 +124,16 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
     mech => phase%get_dict('mechanical')
     pl => mech%get_dict('plastic')
 
+    print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+    refs = config_listReferences(pl,indent=3)
+    if (len(refs) > 0) print'(/,1x,a)', refs
+
+#if defined (__GFORTRAN__)
+    prm%output = output_as1dString(pl)
+#else
+    prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
+#endif
+
 !--------------------------------------------------------------------------------------------------
 ! slip related parameters
     N_sl         = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray)
@@ -217,15 +229,6 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       prm%h_0_tw_sl = 0.0_pReal
     end if slipAndTwinActive
 
-!--------------------------------------------------------------------------------------------------
-!  output pararameters
-
-#if defined (__GFORTRAN__)
-    prm%output = output_as1dString(pl)
-#else
-    prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
-#endif
-
 !--------------------------------------------------------------------------------------------------
 ! allocate state arrays
     Nmembers = count(material_ID_phase == ph)

src/phase_thermal.f90

@@ -84,7 +84,7 @@ module subroutine thermal_init(phases)
     thermal
   type(tList), pointer :: &
     sources
-
+  character(len=:), allocatable :: refs
   integer :: &
     ph, so, &
     Nmembers
@@ -92,7 +92,6 @@ module subroutine thermal_init(phases)
 
   print'(/,1x,a)', '<<<+-  phase:thermal init  -+>>>'
 
-
   allocate(current(phases%length))
   allocate(thermalState(phases%length))
   allocate(thermal_Nsources(phases%length),source = 0)
@@ -107,6 +106,9 @@ module subroutine thermal_init(phases)
 
     ! ToDo: temperature dependency of K and C_p
     if (thermal%length > 0) then
+      print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
+      refs = config_listReferences(thermal,indent=3)
+      if (len(refs) > 0) print'(/,1x,a)', refs
       param(ph)%C_p = thermal%get_asFloat('C_p')
       param(ph)%K(1,1) = thermal%get_asFloat('K_11')
       if (any(phase_lattice(ph) == ['hP','tI'])) param(ph)%K(3,3) = thermal%get_asFloat('K_33')

src/phase_thermal_dissipation.f90

@@ -34,6 +34,7 @@ module function dissipation_init(source_length) result(mySources)
     src
   class(tList), pointer :: &
     sources
+  character(len=:), allocatable :: refs
   integer :: so,Nmembers,ph
 
 
@@ -56,6 +57,9 @@ module function dissipation_init(source_length) result(mySources)
       if (mySources(so,ph)) then
         associate(prm  => param(ph))
           src => sources%get_dict(so)
+          print'(1x,a,i0,a,i0)', 'phase ',ph,' source ',so
+          refs = config_listReferences(src,indent=3)
+          if (len(refs) > 0) print'(/,1x,a)', refs
 
           prm%kappa = src%get_asFloat('kappa')
           Nmembers = count(material_ID_phase == ph)

src/phase_thermal_externalheat.f90

@@ -36,6 +36,7 @@ module function externalheat_init(source_length) result(mySources)
     src
   type(tList), pointer :: &
     sources
+  character(len=:), allocatable :: refs
   integer :: so,Nmembers,ph
 
 
@@ -60,6 +61,9 @@ module function externalheat_init(source_length) result(mySources)
         source_thermal_externalheat_offset(ph) = so
         associate(prm  => param(ph))
           src => sources%get_dict(so)
+          print'(1x,a,i0,a,i0)', 'phase ',ph,' source ',so
+          refs = config_listReferences(src,indent=3)
+          if (len(refs) > 0) print'(/,1x,a)', refs
 
           prm%f = table(src,'t','f')