<commit_before>!======================================================================!
!                                                                      !
! Software Name : FrontISTR Ver. 3.6                                   !
!                                                                      !
!      Module Name : Static Analysis                                   !
!                                                                      !
!            Written by <NAME>(AdavanceSoft), <NAME>(Advancesoft)    !
!                                                                      !
!                                                                      !
!      Contact address :  IIS,The University of Tokyo, CISS            !
!                                                                      !
!      "Structural Analysis for Large Scale Assembly"                  !
!                                                                      !
!======================================================================!
!======================================================================!
!
!> \brief  This module provides functions to take into acount external load
!!
!>  \author                date                  version
!>  X.Yuan(Advancesoft)    2009/08/26        original
!>  X.Yuan                 2013/03/18        consider anisotropic expansion
!
!======================================================================!
!======================================================================!
module m_fstr_ass_load
    implicit none
    contains
!
!======================================================================!
!> This subroutine assmble following external force into fstrSOLID%GL and hecMAT%B afterwards
!>  -#  concentrated nodal force
!>  -#  surface pressure
!>  -#  volume force
!>  -#  thermal force

    subroutine fstr_ass_load(cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM)
!======================================================================!
      use m_fstr
      use m_static_lib
      use m_fstr_precheck
      use mMechGauss
      use mReadTemp
      use mULoad
!#ifdef PARA_CONTACT
      use m_fstr_para_contact
!#endif
      integer, intent(in)                  :: cstep       !< current step
      type (hecmwST_matrix),intent(inout)  :: hecMAT      !< hecmw matrix
      type (hecmwST_local_mesh),intent(in) :: hecMESH     !< hecmw mesh
      type (fstr_solid),intent(inout)      :: fstrSOLID   !< fstr_solid
      type (fstr_param),intent(inout)      :: fstrPARAM   !< analysis control parameters

      real(kind=kreal) :: xx(20), yy(20), zz(20)
      real(kind=kreal) :: params(0:6)
      real(kind=kreal) :: vect(60)
      integer(kind=kint) :: iwk(60)
      integer(kind=kint) :: nodLocal(20)
      real(kind=kreal) :: tt(20), tt0(20), coords(3,3), factor
      integer(kind=kint) :: ndof, ig0, ig, ityp, ltype, iS0, iE0, ik, in, i, j
      integer(kind=kint) :: icel, ic_type, nn, iS, isect, id, iset, nsize
      integer(kind=kint) :: itype, iE, ierror, grpid, cdsys_ID
      real(kind=kreal) :: fval, rho, thick, pa1
      logical :: fg_surf
      integer(kind=kint) :: tstep
      type( tMaterial ), pointer :: material     !< material information
      integer(kind=kint) :: ihead
      real(kind=kreal) :: a

      ndof = hecMAT%NDOF

! -------------------------------------------------------------------
!  CLOAD
! -------------------------------------------------------------------
      fstrSOLID%GL(:) = 0.0d0
      do ig0 = 1, fstrSOLID%CLOAD_ngrp_tot
        grpid = fstrSOLID%CLOAD_ngrp_GRPID(ig0)
        if( .not. fstr_isLoadActive( fstrSOLID, grpid, cstep ) ) cycle
        factor = fstrSOLID%factor(2)
        if( cstep > 1 ) then
          if( fstr_isLoadActive( fstrSOLID, grpid, cstep-1 ) ) factor = 1.0d0
        endif
        ig = fstrSOLID%CLOAD_ngrp_ID(ig0)
        ityp = fstrSOLID%CLOAD_ngrp_DOF(ig0)
        fval = fstrSOLID%CLOAD_ngrp_val(ig0)
        iS0 = hecMESH%node_group%grp_index(ig-1) + 1
        iE0 = hecMESH%node_group%grp_index(ig  )
        do ik = iS0, iE0
          in = hecMESH%node_group%grp_item(ik)
          fstrSOLID%GL(ndof*(in-1)+ityp) = fstrSOLID%GL(ndof*(in-1)+ityp)+factor*fval
        enddo
      enddo
!
!
! -------------------------------------------------------------------
!  DLOAD
! -------------------------------------------------------------------
      do ig0 = 1, fstrSOLID%DLOAD_ngrp_tot
        grpid = fstrSOLID%DLOAD_ngrp_GRPID(ig0)
        if( .not. fstr_isLoadActive( fstrSOLID, grpid, cstep ) ) cycle
        factor = fstrSOLID%factor(2)
        if( cstep > 1 ) then
          if( fstr_isLoadActive( fstrSOLID, grpid, cstep-1 ) ) factor = 1.0d0
        endif
        ig = fstrSOLID%DLOAD_ngrp_ID(ig0)
        ltype = fstrSOLID%DLOAD_ngrp_LID(ig0)
        do i = 0, 6
          params(i)= fstrSOLID%DLOAD_ngrp_params(i,ig0)
        enddo
! ----- START & END
        fg_surf = (ltype == 100)
        if( fg_surf ) then                  ! surface group
          iS0 = hecMESH%surf_group%grp_index(ig-1) + 1
          iE0 = hecMESH%surf_group%grp_index(ig  )
        else                                ! element group
          iS0 = hecMESH%elem_group%grp_index(ig-1) + 1
          iE0 = hecMESH%elem_group%grp_index(ig  )
        endif
        do ik = iS0, iE0
          if( fg_surf ) then                ! surface group
            ltype   = hecMESH%surf_group%grp_item(2*ik)*10
            icel    = hecMESH%surf_group%grp_item(2*ik-1)
            ic_type = hecMESH%elem_type(icel)
          else                              ! element group
            icel    = hecMESH%elem_group%grp_item(ik)
            ic_type = hecMESH%elem_type(icel)
          endif
          if( hecmw_is_etype_link(ic_type) ) cycle
         ! if( ic_type==3422 ) ic_type=342
          nn = hecmw_get_max_node(ic_type)
! ----- node ID
          iS = hecMESH%elem_node_index(icel-1)
          if( fstrSOLID%DLOAD_follow == 0 ) then
            do j = 1, nn
              nodLOCAL(j) = hecMESH%elem_node_item (iS+j)
! ----- nodal coordinate
              xx(j) = hecMESH%node( 3*nodLOCAL(j)-2 )
              yy(j) = hecMESH%node( 3*nodLOCAL(j)-1 )
              zz(j) = hecMESH%node( 3*nodLOCAL(j)   )
! ----- create iwk array ***
              do i = 1, ndof
                iwk( ndof*(j-1)+i ) = ndof*( nodLOCAL(j)-1 )+i
              enddo
            enddo
          else
            do j = 1, nn
              nodLOCAL(j) = hecMESH%elem_node_item (iS+j)
! ----- nodal coordinate
              xx(j) = hecMESH%node( 3*nodLOCAL(j)-2 )+fstrSOLID%unode( 3*nodLOCAL(j)-2 )+fstrSOLID%dunode( 3*nodLOCAL(j)-2 )
              yy(j) = hecMESH%node( 3*nodLOCAL(j)-1 )+fstrSOLID%unode( 3*nodLOCAL(j)-1 )+fstrSOLID%dunode( 3*nodLOCAL(j)-1 )
              zz(j) = hecMESH%node( 3*nodLOCAL(j)   )+fstrSOLID%unode( 3*nodLOCAL(j)   )+fstrSOLID%dunode( 3*nodLOCAL(j)   )
! ----- create iwk array ***
              do i = 1, ndof
                iwk( ndof*(j-1)+i ) = ndof*( nodLOCAL(j)-1 )+i
              enddo
            enddo
          end if<commit_msg>Fixed bug in fstr_ass_load<commit_after>!======================================================================!
!                                                                      !
! Software Name : FrontISTR Ver. 3.6                                   !
!                                                                      !
!      Module Name : Static Analysis                                   !
!                                                                      !
!            Written by <NAME>(AdavanceSoft), <NAME>(Advancesoft)    !
!                                                                      !
!                                                                      !
!      Contact address :  IIS,The University of Tokyo, CISS            !
!                                                                      !
!      "Structural Analysis for Large Scale Assembly"                  !
!                                                                      !
!======================================================================!
!======================================================================!
!
!> \brief  This module provides functions to take into acount external load
!!
!>  \author                date                  version
!>  X.Yuan(Advancesoft)    2009/08/26        original
!>  X.Yuan                 2013/03/18        consider anisotropic expansion
!
!======================================================================!
!======================================================================!
module m_fstr_ass_load
    implicit none
    contains
!
!======================================================================!
!> This subroutine assmble following external force into fstrSOLID%GL and hecMAT%B afterwards
!>  -#  concentrated nodal force
!>  -#  surface pressure
!>  -#  volume force
!>  -#  thermal force

    subroutine fstr_ass_load(cstep, hecMESH, hecMAT, fstrSOLID, fstrPARAM)
!======================================================================!
      use m_fstr
      use m_static_lib
      use m_fstr_precheck
      use mMechGauss
      use mReadTemp
      use mULoad
!#ifdef PARA_CONTACT
      use m_fstr_para_contact
!#endif
      integer, intent(in)                  :: cstep       !< current step
      type (hecmwST_matrix),intent(inout)  :: hecMAT      !< hecmw matrix
      type (hecmwST_local_mesh),intent(in) :: hecMESH     !< hecmw mesh
      type (fstr_solid),intent(inout)      :: fstrSOLID   !< fstr_solid
      type (fstr_param),intent(inout)      :: fstrPARAM   !< analysis control parameters

      real(kind=kreal) :: xx(20), yy(20), zz(20)
      real(kind=kreal) :: params(0:6)
      real(kind=kreal) :: vect(60)
      integer(kind=kint) :: iwk(60)
      integer(kind=kint) :: nodLocal(20)
      real(kind=kreal) :: tt(20), tt0(20), coords(3,3), factor
      integer(kind=kint) :: ndof, ig0, ig, ityp, ltype, iS0, iE0, ik, in, i, j
      integer(kind=kint) :: icel, ic_type, nn, iS, isect, id, iset, nsize
      integer(kind=kint) :: itype, iE, ierror, grpid, cdsys_ID
      real(kind=kreal) :: fval, rho, thick, pa1
      logical :: fg_surf
      integer(kind=kint) :: tstep
      type( tMaterial ), pointer :: material     !< material information
      integer(kind=kint) :: ihead
      real(kind=kreal) :: a

      ndof = hecMAT%NDOF

! -------------------------------------------------------------------
!  CLOAD
! -------------------------------------------------------------------
      fstrSOLID%GL(:) = 0.0d0
      do ig0 = 1, fstrSOLID%CLOAD_ngrp_tot
        grpid = fstrSOLID%CLOAD_ngrp_GRPID(ig0)
        if( .not. fstr_isLoadActive( fstrSOLID, grpid, cstep ) ) cycle
        factor = fstrSOLID%factor(2)
        if( cstep > 1 ) then
          if( fstr_isLoadActive( fstrSOLID, grpid, cstep-1 ) ) factor = 1.0d0
        endif
        ig = fstrSOLID%CLOAD_ngrp_ID(ig0)
        ityp = fstrSOLID%CLOAD_ngrp_DOF(ig0)
        fval = fstrSOLID%CLOAD_ngrp_val(ig0)
        iS0 = hecMESH%node_group%grp_index(ig-1) + 1
        iE0 = hecMESH%node_group%grp_index(ig  )
        do ik = iS0, iE0
          in = hecMESH%node_group%grp_item(ik)
          fstrSOLID%GL(ndof*(in-1)+ityp) = fstrSOLID%GL(ndof*(in-1)+ityp)+factor*fval
        enddo
      enddo
!
!
! -------------------------------------------------------------------
!  DLOAD
! -------------------------------------------------------------------
      do ig0 = 1, fstrSOLID%DLOAD_ngrp_tot
        grpid = fstrSOLID%DLOAD_ngrp_GRPID(ig0)
        if( .not. fstr_isLoadActive( fstrSOLID, grpid, cstep ) ) cycle
        factor = fstrSOLID%factor(2)
        if( cstep > 1 ) then
          if( fstr_isLoadActive( fstrSOLID, grpid, cstep-1 ) ) factor = 1.0d0
        endif
        ig = fstrSOLID%DLOAD_ngrp_ID(ig0)
        ltype = fstrSOLID%DLOAD_ngrp_LID(ig0)
        do i = 0, 6
          params(i)= fstrSOLID%DLOAD_ngrp_params(i,ig0)
        enddo
! ----- START & END
        fg_surf = (ltype == 100)
        if( fg_surf ) then                  ! surface group
          iS0 = hecMESH%surf_group%grp_index(ig-1) + 1
          iE0 = hecMESH%surf_group%grp_index(ig  )
        else                                ! element group
          iS0 = hecMESH%elem_group%grp_index(ig-1) + 1
          iE0 = hecMESH%elem_group%grp_index(ig  )
        endif
        do ik = iS0, iE0
          if( fg_surf ) then                ! surface group
            ltype   = hecMESH%surf_group%grp_item(2*ik)*10
            icel    = hecMESH%surf_group%grp_item(2*ik-1)
            ic_type = hecMESH%elem_type(icel)
          else                              ! element group
            icel    = hecMESH%elem_group%grp_item(ik)
            ic_type = hecMESH%elem_type(icel)
          endif
          if( hecmw_is_etype_link(ic_type) ) cycle
         ! if( ic_type==3422 ) ic_type=342
          nn = hecmw_get_max_node(ic_type)
! ----- node ID
          iS = hecMESH%elem_node_index(icel-1)
          if( fstrSOLID%DLOAD_follow == 0 ) then
            do j = 1, nn
              nodLOCAL(j) = hecMESH%elem_node_item (iS+j)
! ----- nodal coordinate
              xx(j) = hecMESH%node( 3*nodLOCAL(j)-2 )
              yy(j) = hecMESH%node( 3*nodLOCAL(j)-1 )
              zz(j) = hecMESH%node( 3*nodLOCAL(j)   )
! ----- create iwk array ***
              do i = 1, ndof
                iwk( ndof*(j-1)+i ) = ndof*( nodLOCAL(j)-1 )+i
              enddo
            enddo
          else
            do j = 1, nn
              nodLOCAL(j) = hecMESH%elem_node_item (iS+j)
! ----- nodal coordinate
              if (ndof==2) then
                xx(j) = hecMESH%node( 3*nodLOCAL(j)-2 )+fstrSOLID%unode( 2*nodLOCAL(j)-1 )+fstrSOLID%dunode( 2*nodLOCAL(j)-1 )
                yy(j) = hecMESH%node( 3*nodLOCAL(j)-1 )+fstrSOLID%unode( 2*nodLOCAL(j)   )+fstrSOLID%dunode( 2*nodLOCAL(j)   )
              else if (ndof==3) then
                xx(j) = hecMESH%node( 3*nodLOCAL(j)-2 )+fstrSOLID%unode( 3*nodLOCAL(j)-2 )+fstrSOLID%dunode( 3*nodLOCAL(j)-2 )
                yy(j) = hecMESH%node( 3*nodLOCAL(j)-1 )+fstrSOLID%unode( 3*nodLOCAL(j)-1 )+fstrSOLID%dunode( 3*nodLOCAL(j)-1 )
                zz(j) = hecMESH%node( 3*nodLOCAL(j)   )+fstrSOLID%unode( 3*nodLOCAL(j)   )+fstrSOLID%dunode( 3*nodLOCAL(j)   )
              else if (ndof==6) then
                xx(j) = hecMESH%node( 3*nodLOCAL(j)-2 )+fstrSOLID%unode( 6*nodLOCAL(j)-5 )+fstrSOLID%dunode( 6*nodLOCAL(j)-5 )
                yy(j) = hecMESH%node( 3*nodLOCAL(j)-1 )+fstrSOLID%unode( 6*nodLOCAL(j)-4 )+fstrSOLID%dunode( 6*nodLOCAL(j)-4 )
                zz(j) = hecMESH%node( 3*nodLOCAL(j)   )+fstrSOLID%unode( 6*nodLOCAL(j)-3 )+fstrSOLID%dunode( 6*nodLOCAL(j)-3 )
              endif
! ----- create iwk array ***
              do i = 1, ndof
                iwk( ndof*(j-1)+i ) = ndof*( nodLOCAL(j)-1 )+i
              enddo
            enddo
          end if
{'fraction_non_alphanumeric': 0.20669529048705218, 'fraction_numerical': 0.02012612370857373, 'mean_word_length': 1.6416799574694312, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 29, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 38, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1551338', 'n_tokens_mistral': 5121, 'n_tokens_neox': 4835, 'n_words': 887}