!======================================================================!
!                                                                      !
! Software Name : FrontISTR Ver. 3.6                                   !
!                                                                      !
!      Module Name : I/O and Utility                                   !
!                                                                      !
!            Written by X. YUAN (AdavanceSoft)                         !
!                                                                      !
!      Contact address :  IIS,The University of Tokyo, CISS            !
!                                                                      !
!      "Structural Analysis for Large Scale Assembly"                  !
!                                                                      !
!======================================================================!
!======================================================================!
!
!>   This module manages read in of various material properties
!>
!!
!>  \author     X. YUAN (AdavanceSoft)
!>  \date       2009/10/31
!>  \version    0.00
!!
!======================================================================!
module fstr_ctrl_material
   use hecmw
   use mMaterial
   use m_table
   implicit none

   private :: read_user_matl

   include 'fstr_ctrl_util_f.inc'

   contains


!----------------------------------------------------------------------
!> Read in !MATERIAL
integer function fstr_ctrl_get_MATERIAL( ctrl, matname )
        integer(kind=kint), intent(in) :: ctrl
        character(len=*), intent(out) :: matname

        matname=""
        fstr_ctrl_get_MATERIAL = fstr_ctrl_get_param_ex( ctrl, 'NAME ',  '# ',  0, 'S', matname )
end function fstr_ctrl_get_MATERIAL

!----------------------------------------------------------------------
!> Read in !USER_MATERIAL
integer function fstr_ctrl_get_USERMATERIAL( ctrl, mattype, nlgeom, nstatus, matval )
        integer(kind=kint), intent(in)    :: ctrl
        integer(kind=kint), intent(inout) :: mattype
        integer(kind=kint), intent(out)   :: nlgeom
        integer(kind=kint), intent(out)   :: nstatus
        real(kind=kreal),intent(out)      :: matval(:)

        integer(kind=kint) :: ipt
        character(len=HECMW_NAME_LEN) :: data_fmt
        character(len=256) :: s, fname

        fstr_ctrl_get_USERMATERIAL = -1
        mattype = USERMATERIAL
        nlgeom = UPDATELAG   !default value
        nstatus = 1
        if( fstr_ctrl_get_param_ex( ctrl, 'NSTATUS ',  '# ',    0,   'I',   nstatus )/= 0) return
        if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ',  '# ',    0,   'E',   ipt )/= 0) return
        if( ipt/=0 ) nlgeom = TOTALLAG

        fstr_ctrl_get_USERMATERIAL = read_user_matl( ctrl, matval )
end function fstr_ctrl_get_USERMATERIAL

!----------------------------------------------------------------------
!> Read in !ELASTIC
integer function fstr_ctrl_get_ELASTICITY( ctrl, mattype, nlgeom, matval, dict )
        integer(kind=kint), intent(in)    :: ctrl
        integer(kind=kint), intent(inout) :: mattype
        integer(kind=kint), intent(out)   :: nlgeom
        real(kind=kreal),intent(out)      :: matval(:)
        type(DICT_STRUCT), pointer        :: dict

        integer(kind=kint) :: i,j, rcode, depends, ipt, n
        real(kind=kreal),pointer :: fval(:,:)
        character(len=HECMW_NAME_LEN) :: data_fmt
        type( tTable )        :: mattable
        logical            :: isok
        character(len=256) :: s

        fstr_ctrl_get_ELASTICITY = -1
        depends = 0
        rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES  ', '# ',           0,   'I',   depends )
        if( depends>1 ) depends=1   ! temperature depends only currently
        if( depends > 3 ) stop "We cannot read dependencies>3 right now"
        nlgeom = TOTALLAG   !default value

        if( fstr_ctrl_get_param_ex( ctrl, 'CAUCHY ',  '# ',    0,   'E',   ipt )/= 0) return
        if( ipt/=0 ) nlgeom = UPDATELAG
        if( fstr_ctrl_get_param_ex( ctrl, 'INFINITE ',  '# ',    0,   'E',   ipt )/= 0) return
        if( ipt/=0 ) nlgeom = INFINITE

        ipt=1
        s = 'ISOTROPIC,ORTHOTROPIC,USER '
        if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ',  s, 0, 'P',   ipt    ) /= 0 ) return

        n = fstr_ctrl_get_data_line_n( ctrl )
        ! ISOTROPIC
        if( ipt==1 ) then
            allocate( fval(2+depends,n) )
            if( depends==0 ) then
              data_fmt = "RR "
              fstr_ctrl_get_ELASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
            endif
            if( depends==1 ) then
              data_fmt = "RRR "
              fstr_ctrl_get_ELASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
            endif
            if( fstr_ctrl_get_ELASTICITY ==0 ) then
              matval(M_YOUNGS) = fval(1,1)
              matval(M_POISSON) = fval(2,1)
              call init_table( mattable, depends, 2+depends,n, fval )
              call dict_add_key( dict, MC_ISOELASTIC, mattable )
                !         call print_table( mattable, 6 ); pause
            endif
            mattype = ELASTIC

        ! ORTHOTROPIC
        else if( ipt==2 ) THEN
            allocate( fval(9+depends,n) )
            if( depends==0 ) then
              data_fmt = "RRRRRRRRR "
              fstr_ctrl_get_ELASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt,    &
               fval(1,:), fval(2,:), fval(3,:), fval(4,:), fval(5,:), fval(6,:),           &
               fval(7,:), fval(8,:), fval(9,:) )
            else if( depends==1 ) then
              data_fmt = "RRRRRRRRRR "
              fstr_ctrl_get_ELASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt,    &
               fval(1,:), fval(2,:), fval(3,:), fval(4,:), fval(5,:), fval(6,:),           &
               fval(7,:), fval(8,:), fval(9,:), fval(10,:) )
            endif
            if( fstr_ctrl_get_ELASTICITY ==0 ) then
              isok = .true.
              do i=1,n
                if( fval(1,i)<=0.d0 .or. fval(2,i)<=0.d0 .or. fval(3,i)<=0.d0  .or.  &
                    fval(7,i)<=0.d0 .or. fval(8,i)<=0.d0 .or. fval(9,i)<=0.d0 ) then
                   isok = .false.;  fstr_ctrl_get_ELASTICITY=1; exit
                endif
              enddo
              if( isok ) then
                call init_table( mattable, depends, 9+depends,n, fval )
                call dict_add_key( dict, MC_ORTHOELASTIC, mattable )
                mattype = MN_ORTHOELASTIC
              endif
            endif

        else if( ipt==3 ) THEN
            allocate( fval(10,10) )
            fval =0.d0
            fstr_ctrl_get_ELASTICITY = fstr_ctrl_get_data_ex( ctrl, 1, 'rrrrrrrrrr ',    &
               fval(1,:), fval(2,:), fval(3,:), fval(4,:), fval(5,:), fval(6,:),           &
               fval(7,:), fval(8,:), fval(9,:), fval(10,:) )
            if( fstr_ctrl_get_ELASTICITY ==0 ) then
              do i=1,10
              do j=1,10
                matval(100+(i-1)*10+j)=fval(i,j)
              enddo
              enddo
            endif
            mattype = USERELASTIC
            nlgeom = INFINITE

        else
            stop "ERROR: Material type not supported"

        endif

        if( associated(fval) ) deallocate(fval)
end function fstr_ctrl_get_ELASTICITY


!----------------------------------------------------------------------
!> Read in !HYPERELASTIC
integer function fstr_ctrl_get_HYPERELASTIC( ctrl, mattype, nlgeom, matval )
        integer(kind=kint), intent(in)    :: ctrl
        integer(kind=kint), intent(inout) :: mattype
        integer(kind=kint), intent(out)   :: nlgeom
        real(kind=kreal),intent(out)      :: matval(:)

        integer(kind=kint) :: i,j, rcode, depends, ipt
        real(kind=kreal),pointer :: fval(:,:)
        character(len=HECMW_NAME_LEN) :: data_fmt
        character(len=256) :: s

        fstr_ctrl_get_HYPERELASTIC = -1
        depends = 0
        rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES  ', '# ',           0,   'I',   depends )
        if( depends > 3 ) stop "We cannot read dependencies>3 right now"
        nlgeom = TOTALLAG   !default value
        if( fstr_ctrl_get_param_ex( ctrl, 'CAUCHY ',  '# ',    0,   'E',   ipt )/= 0) return
        if( ipt/=0 ) nlgeom = UPDATELAG

        ipt=1
        ! Gaku Hashimoto (The University of Tokyo, 2015/03/23) <
        ! s = 'NEOHOOKE,MOONEY-RIVLIN,ARRUDA-BOYCE,USER '
        s = 'NEOHOOKE,MOONEY-RIVLIN,ARRUDA-BOYCE,USER,MOONEY-RIVLIN_CUBIC '
        ! > Gaku Hashimoto (The University of Tokyo, 2015/03/23)
        if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ',  s, 0, 'P',   ipt    ) /= 0 ) return

        ! NEOHOOKE
        if( ipt==1 ) then
            allocate( fval(2,depends+1) )
            if( depends==0 ) then
              data_fmt = "RR "
              fstr_ctrl_get_HYPERELASTIC =                           &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
            endif
            if( fstr_ctrl_get_HYPERELASTIC ==0 ) then
                  if( fval(2,1)==0.d0 ) stop "We cannot deal with imcompresible material currently"
              matval(M_PLCONST1) = fval(1,1)
              matval(M_PLCONST2) = 0.d0
              matval(M_PLCONST3) = fval(2,1)
              ! matval(M_YOUNGS) = fval(1,1)
              ! matval(M_POISSON) = fval(2,1)
            endif
            mattype = NEOHOOKE

        ! MOONEY
        else if( ipt==2 ) then
            allocate( fval(3,depends+1) )
            if( depends==0 ) then
              data_fmt = "RRR "
              fstr_ctrl_get_HYPERELASTIC =                       &
                 fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
            endif
            if( fstr_ctrl_get_HYPERELASTIC ==0 ) then
              matval(M_PLCONST1) = fval(1,1)
              matval(M_PLCONST2) = fval(2,1)
              matval(M_PLCONST3) = fval(3,1)
            endif
            mattype = MOONEYRIVLIN

        ! ARRUDA
        else if( ipt==3 ) then
            allocate( fval(3,depends+1) )
            if( depends==0 ) then
              data_fmt = "RRR "
              fstr_ctrl_get_HYPERELASTIC = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
            endif
            if( fstr_ctrl_get_HYPERELASTIC ==0 ) then
              matval(M_PLCONST1) = fval(1,1)
              matval(M_PLCONST2) = fval(2,1)
              matval(M_PLCONST3) = fval(3,1)
            endif
            mattype = ARRUDABOYCE

        else if( ipt==4 ) THEN    !User
            allocate( fval(10,10) )
            fval =0.d0
            fstr_ctrl_get_HYPERELASTIC = fstr_ctrl_get_data_ex( ctrl, 1, 'rrrrrrrrrr ',    &
               fval(1,:), fval(2,:), fval(3,:), fval(4,:), fval(5,:), fval(6,:),           &
               fval(7,:), fval(8,:), fval(9,:), fval(10,:) )
            if( fstr_ctrl_get_HYPERELASTIC ==0 ) then
              do i=1,10
              do j=1,10
                matval(100+(i-1)*10+j)=fval(i,j)
              enddo
              enddo
            endif
            mattype = USERHYPERELASTIC
        ! Gaku Hashimoto (The University of Tokyo, 2015/03/23) <
        else if( ipt==5 ) then
            
            ALLOCATE( fval(10, depends+1) )
            
            IF( depends .EQ. 0 ) THEN
             
             data_fmt = "RRRRRRRRRR "
             
             fstr_ctrl_get_HYPERELASTIC = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1, :), fval(2, :), fval(3, :), fval(4,:), fval(5,:), &
                                                                       fval(6,:), fval(7,:), fval(8,:), fval(9,:), fval(10,:) )                  
            END IF
            
            IF( fstr_ctrl_get_HYPERELASTIC .EQ. 0 ) THEN
             
             matval(M_PLCONST1) = fval(1, 1)
             matval(M_PLCONST2) = fval(2, 1)
             matval(M_PLCONST3) = fval(3, 1)
             matval(M_PLCONST4) = fval(4, 1)
             matval(M_PLCONST5) = fval(5, 1)
             matval(M_PLCONST6) = fval(6, 1)
             matval(M_PLCONST7) = fval(7, 1)
             matval(M_PLCONST8) = fval(8, 1)
             matval(M_PLCONST9) = fval(9, 1)
             
             matval(M_D1CONST) = fval(10, 1)
             
            END IF
            
            mattype = MOONEYRIVLIN_CUBIC
            
        ! > Gaku Hashimoto (The University of Tokyo, 2015/03/23)
        endif

        if( associated(fval) ) deallocate(fval)
end function fstr_ctrl_get_HYPERELASTIC


!----------------------------------------------------------------------
!> Read in !VISCOELASTIC
integer function fstr_ctrl_get_VISCOELASTICITY( ctrl, mattype, nlgeom, dict )
        integer(kind=kint), intent(in)    :: ctrl
        integer(kind=kint), intent(inout) :: mattype
        integer(kind=kint), intent(out)   :: nlgeom
        type(DICT_STRUCT), pointer        :: dict

        integer(kind=kint) :: i,j, rcode, depends, ipt, n
        real(kind=kreal),pointer :: fval(:,:)
        character(len=HECMW_NAME_LEN) :: data_fmt
        type( tTable )        :: mattable
        character(len=256) :: s

        fstr_ctrl_get_VISCOELASTICITY = -1
        depends = 0
        rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES  ', '# ',           0,   'I',   depends )
        if( depends>1 ) depends=1   ! temperature depends only currently
        depends = 0
        nlgeom = TOTALLAG   !default value
        if( fstr_ctrl_get_param_ex( ctrl, 'INFINITE ',  '# ',    0,   'E',   ipt )/= 0) return
        if( ipt/=0 ) nlgeom = INFINITE

        ipt=1
        s = 'ISOTROPIC,USER '
        if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ',  s, 0, 'P',   ipt    ) /= 0 ) return
        ipt = 1

        ! ISOTROPIC
        if( ipt==1 ) then
            n = fstr_ctrl_get_data_line_n( ctrl )
            allocate( fval(2+depends,n) )
            if( depends==0 ) then
              data_fmt = "RR "
              fstr_ctrl_get_VISCOELASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
              if( fval(2,1)==0.d0 ) stop "Error in defining viscoelasticity: Relaxation time cannot be zero!"
            endif
            if( depends==1 ) then
              data_fmt = "RRR "
              fstr_ctrl_get_VISCOELASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
            endif
            if( fstr_ctrl_get_VISCOELASTICITY ==0 ) then
              call init_table( mattable, 1, 2+depends,n, fval )
              call dict_add_key( dict, MC_VISCOELASTIC, mattable )
                !         call print_table( mattable, 6 ); pause
            endif
            mattype = VISCOELASTIC

        else
            stop "ERROR: Material type not supported"

        endif

        call finalize_table( mattable )
        if( associated(fval) ) deallocate(fval)
end function fstr_ctrl_get_VISCOELASTICITY


!> Read in !TRS
integer function fstr_ctrl_get_TRS( ctrl, mattype, matval )
        integer(kind=kint), intent(in)    :: ctrl
        integer(kind=kint), intent(inout) :: mattype
        real(kind=kreal),intent(out)      :: matval(:)

        integer :: ipt
        character(len=256) :: s

        ipt=1
        s = 'WLF,ARRHENIUS '
        if( fstr_ctrl_get_param_ex( ctrl, 'DEFINITION ',  s, 0, 'P',   ipt    ) /= 0 ) return

        fstr_ctrl_get_TRS                                                           &
        = fstr_ctrl_get_data_ex( ctrl, 1, "RRR ", matval(1), matval(2), matval(3) )
        if( fstr_ctrl_get_TRS/=0 ) return
        mattype = mattype+ipt

end function fstr_ctrl_get_TRS


!----------------------------------------------------------------------
!> Read in !PLASTIC
integer function fstr_ctrl_get_PLASTICITY( ctrl, mattype, nlgeom, matval, mattable, dict )
        integer(kind=kint), intent(in)    :: ctrl
        integer(kind=kint), intent(inout) :: mattype
        integer(kind=kint), intent(out)   :: nlgeom
        real(kind=kreal),intent(out)      :: matval(:)
        real(kind=kreal), pointer         :: mattable(:)
        type(DICT_STRUCT), pointer        :: dict

        integer(kind=kint) :: i, n, rcode, depends, ipt, hipt
        real(kind=kreal),pointer :: fval(:,:)
        real(kind=kreal) :: dum, fdum
        character(len=HECMW_NAME_LEN) :: data_fmt
        character(len=256)    :: s
        type( tTable )        :: mttable
        real(kind=kreal), parameter :: PI=3.14159265358979d0

        fstr_ctrl_get_PLASTICITY = -1
        ipt = 0; hipt = 0

        depends = 0
        rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES  ', '# ',           0,   'I',   depends )
        if( depends>1 ) depends = 1 ! we consider temprature dependence only currently
        if( depends > 3 ) stop "We cannot read dependencies>3 right now"
        nlgeom = UPDATELAG   !default value
        if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ',  '# ',    0,   'E',   ipt )/= 0) return
        ! rcode = fstr_ctrl_get_param_ex( ctrl, 'FILE  ', '# ',           0,   'S',   fname )
        if( ipt/=0 ) nlgeom = TOTALLAG
        if( fstr_ctrl_get_param_ex( ctrl, 'INFINITE ',  '# ',    0,   'E',   ipt )/= 0) return
        if( ipt/=0 ) nlgeom = INFINITE

        call setDigit( 1, 1, mattype )
        call setDigit( 2, 2, mattype )

        ! hardening
        s = 'BILINEAR,MULTILINEAR,SWIFT,RAMBERG-OSGOOD,KINEMATIC,COMBINED '
        if( fstr_ctrl_get_param_ex( ctrl, 'HARDEN ',  s , 0, 'P',   hipt    ) /= 0 ) return
        if( hipt==0 ) hipt=1  ! default: linear hardening
        call setDigit( 5, hipt-1, mattype )

        ! yield function
        s = 'MISES,MOHR-COULOMB,DRUCKER-PRAGER,USER '
        call setDigit( 2, 2, mattype )
        if( fstr_ctrl_get_param_ex( ctrl, 'YIELD ',  s , 0, 'P',   ipt    ) /= 0 ) return
        if( ipt==0 ) ipt=1  ! default: mises yield function
        call setDigit( 4, ipt-1, mattype )

        n = fstr_ctrl_get_data_line_n( ctrl )
        if( n == 0 ) return               ! fail in reading plastic
        if( hipt==2 .and. n<2 ) return    ! not enought data
        if( ( ipt==3 .or. ipt==4 ) .and. hipt>2 ) hipt = 1

        select case (ipt)
        case (1)  !Mises
            select case (hipt)
            case (1,5)  ! linear hardening, kinematic hardening
              allocate( fval(2,n) )
              data_fmt = "RR "
              fstr_ctrl_get_PLASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
              if( fstr_ctrl_get_PLASTICITY ==0 ) then
                matval(M_PLCONST1) = fval(1,1)
                if(hipt==1) then
                  matval(M_PLCONST2) = fval(2,1)
                else
                  matval(M_PLCONST2) = 0.d0
                  matval(M_PLCONST3) = fval(2,1)
                endif
              endif
            case (2)  ! multilinear approximation
              allocate( fval(depends+2,n) )
              if( depends==0 ) then
                data_fmt = "RR "
                fstr_ctrl_get_PLASTICITY = &
                  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:) )
                if( fstr_ctrl_get_PLASTICITY ==0 ) then
                  if( fval(2,1)/=0.d0 ) then
                    print *, "Multilinear hardening: First plastic strain must be zero"
                                    stop
                  endif
                  do i=1,n
                    if( fval(2,i)<0.0 ) &
                      stop "Multilinear hardening: Error in plastic strain definition"
                  enddo
                  call init_table( mttable,1, 2+depends, n, fval )
                  call dict_add_key( dict, MC_YIELD, mttable )

                endif
              else  ! depends==1
                data_fmt = "RRR "
                fstr_ctrl_get_PLASTICITY = &
                  fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
                if( fstr_ctrl_get_PLASTICITY ==0 ) then
                  call init_table( mttable,2, 2+depends,n, fval )
                  call dict_add_key( dict, MC_YIELD, mttable )
                endif
              endif
            case (3, 4, 6)  ! swift, Ramberg-Osgood, Combined
              allocate( fval(3,1) )
              data_fmt = "RRR "
              fstr_ctrl_get_PLASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
              if( fstr_ctrl_get_PLASTICITY ==0 ) then
                matval(M_PLCONST1) = fval(1,1)
                matval(M_PLCONST2) = fval(2,1)
                matval(M_PLCONST3) = fval(3,1)
              endif
            case default
               print *, "Error in hardening definition!"
               stop
            end select
        case (2, 3)  ! Mohr-Coulomb, Drucker-Prager
            call setDigit( 5, 0, mattype )
            allocate( fval(3,depends+1) )
            data_fmt = "RRr "
            fstr_ctrl_get_PLASTICITY                                                         &
            = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
            if( fstr_ctrl_get_PLASTICITY ==0 ) then
              matval(M_PLCONST1) = fval(1,1)    ! c
              matval(M_PLCONST2) = fval(3,1)    ! H
              if( ipt==3 ) then     ! Drucker-Prager
                dum = fval(2,1)*PI/180.d0
                fdum = 2.d0*sin(dum)/ ( sqrt(3.d0)*(3.d0+sin(dum)) )
                matval(M_PLCONST3) = fdum
                fdum = 6.d0* cos(dum)/ ( sqrt(3.d0)*(3.d0+sin(dum)) )
                matval(M_PLCONST4) = fdum
              else                  ! Mohr-Coulomb
                matval(M_PLCONST3) = fval(2,1)*PI/180.d0
              endif
            endif

        case(4)
            fstr_ctrl_get_PLASTICITY = read_user_matl( ctrl, matval )

        case default
            stop "Yield function not supported"
        end select

        if( associated(fval) ) deallocate(fval)
        call finalize_table( mttable )
end function fstr_ctrl_get_PLASTICITY


!----------------------------------------------------------------------
!> Read in !VISCOELASTIC
integer function fstr_ctrl_get_VISCOPLASTICITY( ctrl, mattype, nlgeom, dict )
        integer(kind=kint), intent(in)    :: ctrl
        integer(kind=kint), intent(inout) :: mattype
        integer(kind=kint), intent(out)   :: nlgeom
        type(DICT_STRUCT), pointer        :: dict

        integer(kind=kint) :: i,j, rcode, depends, ipt, n
        real(kind=kreal),pointer :: fval(:,:)
        character(len=HECMW_NAME_LEN) :: data_fmt
        type( tTable )        :: mattable
        character(len=256) :: s

        fstr_ctrl_get_VISCOPLASTICITY = -1
        depends = 0
        rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES  ', '# ',           0,   'I',   depends )
        if( depends>1 ) depends=1   ! temperature depends only currently
        depends = 0
        nlgeom = UPDATELAG   !default value
        if( fstr_ctrl_get_param_ex( ctrl, 'KIRCHHOFF ',  '# ',    0,   'E',   ipt )/= 0) return
        if( ipt/=0 ) nlgeom = TOTALLAG

        ipt=1
        s = 'NORTON,USER '
        if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ',  s, 0, 'P',   ipt    ) /= 0 ) return
        ipt = 1

        ! NORTON
        if( ipt==1 ) then
            n = fstr_ctrl_get_data_line_n( ctrl )
            allocate( fval(3+depends,n) )
            if( depends==0 ) then
              data_fmt = "RRR "
              fstr_ctrl_get_VISCOPLASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
            endif
            if( depends==1 ) then
              data_fmt = "RRRR "
              fstr_ctrl_get_VISCOPLASTICITY = &
                fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:), fval(4,:) )
            endif
            if( fstr_ctrl_get_VISCOPLASTICITY ==0 ) then
              call init_table( mattable, depends, 3+depends,n, fval )
              call dict_add_key( dict, MC_NORTON, mattable )
                        !  call print_table( mattable, 6 ); pause
            endif
            mattype = NORTON

        else
            stop "ERROR: Material type not supported"

        endif

        call finalize_table( mattable )
        if( associated(fval) ) deallocate(fval)
end function fstr_ctrl_get_VISCOPLASTICITY

!----------------------------------------------------------------------
!> Read in !DENSITY
integer function fstr_ctrl_get_DENSITY( ctrl, matval )
        integer(kind=kint), intent(in) :: ctrl
        real(kind=kreal),intent(out)   :: matval(:)

        integer(kind=kint) :: i, rcode, depends
        real(kind=kreal),pointer :: fval(:,:)
        character(len=HECMW_NAME_LEN) :: data_fmt

        data_fmt = "R "

        fstr_ctrl_get_DENSITY = -1

        depends = 0
        rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES  ', '# ',           0,   'I',   depends )
        if( depends>1 ) depends = 1 ! we consider temprature dependence only currently

        allocate( fval(1,depends+1) )
        do i=2,1+depends
          data_fmt = data_fmt //"R "
        enddo
        fstr_ctrl_get_DENSITY                                      &
        = fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:) )
        if( fstr_ctrl_get_DENSITY==0 ) matval(M_DENSITY) = fval(1,1)

        if( associated(fval) ) deallocate(fval)

end function fstr_ctrl_get_DENSITY


!----------------------------------------------------------------------
!> Read in !EXPANSION_COEFF
integer function fstr_ctrl_get_EXPANSION_COEFF( ctrl, matval, dict )
        integer(kind=kint), intent(in) :: ctrl
        real(kind=kreal),intent(out)   :: matval(:)
        type(DICT_STRUCT), pointer     :: dict

        integer(kind=kint) :: i, n, rcode, depends, ipt
        real(kind=kreal),pointer :: fval(:,:)
        type( tTable )           :: mttable
        character(len=HECMW_NAME_LEN) :: data_fmt, ss

        data_fmt = "R "

        fstr_ctrl_get_EXPANSION_COEFF = -1
        n = fstr_ctrl_get_data_line_n( ctrl )
        if( n == 0 ) return               ! fail in reading plastic

        ss = 'ISOTROPIC,ORTHOTROPIC '
        ipt = 1  !default
        if( fstr_ctrl_get_param_ex( ctrl, 'TYPE ',  ss, 0, 'P',   ipt    ) /= 0 ) return

        depends = 0
        rcode = fstr_ctrl_get_param_ex( ctrl, 'DEPENDENCIES  ', '# ',           0,   'I',   depends )
        if( depends>1 ) depends = 1 ! we consider temprature dependence only currently

        if( ipt==1 ) then
          allocate( fval(depends+1, n) )
          do i=2,1+depends
               data_fmt = data_fmt //"R "
          enddo
          if( depends==0 ) then
            fstr_ctrl_get_EXPANSION_COEFF = &
              fstr_ctrl_get_data_array_ex( ctrl, "R ", fval(1,:) )
          else
            fstr_ctrl_get_EXPANSION_COEFF = &
              fstr_ctrl_get_data_array_ex( ctrl, "RR ", fval(1,:), fval(2,:) )
          endif
          if( fstr_ctrl_get_EXPANSION_COEFF==0 ) then
            matval(M_EXAPNSION) = fval(1,1)
            call init_table( mttable,depends, 1+depends, n, fval )
            call dict_add_key( dict, MC_THEMOEXP, mttable )
          endif
        else
          allocate( fval(3+depends,n) )
          do i=2,3+depends
               data_fmt = trim(data_fmt) //"R "
          enddo
          if( depends==0 ) then
            fstr_ctrl_get_EXPANSION_COEFF = &
              fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:) )
          elseif( depends==1 ) then
            fstr_ctrl_get_EXPANSION_COEFF = &
              fstr_ctrl_get_data_array_ex( ctrl, data_fmt, fval(1,:), fval(2,:), fval(3,:), fval(4,:) )
          endif
          if( fstr_ctrl_get_EXPANSION_COEFF==0 ) then
            call init_table( mttable, depends, 3+depends,n, fval )
            if( fstr_ctrl_get_EXPANSION_COEFF==0 ) call dict_add_key( dict, MC_ORTHOEXP, mttable )
          endif
        endif

        call finalize_table( mttable )
        if( associated(fval) ) deallocate(fval)
end function fstr_ctrl_get_EXPANSION_COEFF


integer function read_user_matl( ctrl, matval )
        integer(kind=kint), intent(in)    :: ctrl
        real(kind=kreal),intent(out)      :: matval(:)

        integer(kind=kint) :: i, j
        real(kind=kreal)   :: fval(10,10)

        read_user_matl = -1

        fval =0.d0
        if( fstr_ctrl_get_data_array_ex( ctrl, 1, 'rrrrrrrrrr ', fval(1,:), fval(2,:), fval(3,:),  &
            fval(4,:), fval(5,:), fval(6,:), fval(7,:), fval(8,:), fval(9,:), fval(10,:) ) /= 0 ) return
        do i=1,10
        do j=1,10
          matval((i-1)*10+j)=fval(i,j)
        enddo
        enddo

        read_user_matl = 0
end function read_user_matl


!* ----------------------------------------------------------------------------------------------- *!
end module fstr_ctrl_material
