h3d_sol_skin_tensor.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    h3d_sol_skin_tensor    ../engine/source/output/h3d/h3d_results/h3d_sol_skin_tensor.F
!||--- called by ------------------------------------------------------
!||    h3d_skin_tensor        ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
!||--- calls      -----------------------------------------------------
!||    gpsstrain_skin         ../engine/source/output/anim/generate/tensgpstrain.F
!||    h3d_sol_skin_ixskin    ../engine/source/output/h3d/h3d_results/h3d_sol_skin_ixskin.F
!||    spmd_exch_nodarea2     ../engine/source/mpi/anim/spmd_exch_nodarea2.F
!||    spmd_exch_nodareai     ../engine/source/mpi/anim/spmd_exch_nodareai.F
!||    tens3dto2d             ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
!||    tensgps_skin           ../engine/source/output/anim/generate/tensor6.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod           ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    element_mod            ../common_source/modules/elements/element_mod.F90
!||    initbuf_mod            ../engine/share/resol/initbuf.F
!||    names_and_titles_mod   ../common_source/modules/names_and_titles_mod.F
!||====================================================================
      SUBROUTINE h3d_sol_skin_tensor(
     .                   ELBUF_TAB,SKIN_TENSOR, IPARG   ,IXS     ,X     ,PM  ,
     4                   IPARTS  ,IPM     ,IGEO    ,IXS10 ,IXS16 , IXS20  ,
     5                   IS_WRITTEN_SKIN  ,H3D_PART,INFO1   ,KEYWORD ,NSKIN ,
     6                   IAD_ELEM        ,FR_ELEM     , WEIGHT  , TAG_SKINS6   )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE initbuf_mod
      USE elbufdef_mod
      USE names_and_titles_mod, ONLY: ncharline100
      use element_mod , only : nixs
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "mvsiz_p.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
      my_real
     .   skin_tensor(3,*),pm(npropm,*), x(3,*)
      INTEGER IPARG(NPARG,*), 
     .   IXS(NIXS,*),IPM(NPROPMI,*),IPARTS(*),
     .   ixs10(6,*) ,ixs16(8,*) ,ixs20(12,*) ,
     .   igeo(npropgi,*),is_written_skin(*),
     .   h3d_part(*),info1,nskin,tag_skins6(*),iad_elem(2,*),fr_elem(*),weight(*)
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
      CHARACTER(LEN=NCHARLINE100):: KEYWORD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C----------------------------------------------- 
      my_real
     .   evar(3,mvsiz)
      INTEGER I, II, J, LENR, NEL, NFT, N
      INTEGER IOK_PART(MVSIZ), TAG_SKIN_ND(NUMNOD)
 
      INTEGER IXSKIN(7, NUMSKIN), IXSK(5, MVSIZ), IDEB
      INTEGER JJ
 
 
 
      INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGPS    
      my_real
     .       , DIMENSION(:,:), ALLOCATABLE :: AFLU, VFLU,VALUE
      INTEGER FACES(4,6),NS,K1,PWR(7),LL
      DATA pwr/1,2,4,8,16,32,64/
      DATA faces/4,3,2,1,
     .           5,6,7,8,
     .           1,2,6,5,
     .           3,4,8,7,
     .           2,3,7,6,
     .           1,5,8,4/
C-----------------------------------------------
C
      ALLOCATE(aflu(3,numnod),vflu(3,numnod),value(6,numnod))
      ALLOCATE(itagps(numnod))
      aflu  = zero
      vflu  = zero
      VALUE = zero
      itagps = 0
C------TAG_SKIN_ND only the big seg(mid-node of S10 not include)
        tag_skin_nd(1:numnod) = 0 
        DO i=1,numels
            ll=tag_skins6(i)
            DO jj=1,6
              IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
              DO k1=1,4
                ns=ixs(faces(k1,jj)+1,i)
                tag_skin_nd(ns) = 1 
              END DO
            END DO
        END DO
       iok_part(1:mvsiz)=0
       IF (keyword == 'TENS/STRESS/OUTER') THEN
         CALL tensgps_skin(elbuf_tab,vflu   ,aflu    ,iparg   ,
     .           ixs  ,ixs10   ,ixs16   ,ixs20   ,
     .           x  ,itagps  ,pm    ,tag_skin_nd)
 
         IF(nspmd > 1)THEN
           lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
           CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
           DO j=1,3
            CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
            CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
           ENDDO
         ENDIF
         DO j=1,3
           DO n=1,numnod
             IF (itagps(n)>0) value(j,n)=vflu(j,n)/itagps(n)
           ENDDO
         ENDDO
         DO j=4,6
           DO n=1,numnod
             IF (itagps(n)>0) value(j,n)=aflu(j-3,n)/itagps(n)
           ENDDO
         ENDDO
       ELSEIF (keyword == 'TENS/STRAIN/OUTER') THEN
         CALL gpsstrain_skin(elbuf_tab,vflu ,aflu    ,iparg   ,
     .                    ixs      ,ixs10   ,ixs16   ,ixs20   ,x        ,
     .                    itagps  ,pm    ,tag_skin_nd )
         IF(nspmd > 1)THEN
           lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
           CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
           DO j=1,3
            CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
            CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
           ENDDO
         ENDIF
         DO j=1,3
           DO n=1,numnod
             IF (itagps(n)>0) value(j,n)=vflu(j,n)/itagps(n)
           ENDDO
         ENDDO
C------------change shear to eij         
         DO j=4,6
           DO n=1,numnod
             IF (itagps(n)>0) value(j,n)=half*aflu(j-3,n)/itagps(n)
           ENDDO
         ENDDO
       END IF 
C
       nft = nskin 
       ixskin(1:7,1:numskin)=0       
       CALL h3d_sol_skin_ixskin(elbuf_tab,iparg,iparts,ixs,ixs10,
     .                          ixskin  ,tag_skins6,nskin )
       ideb = nft
       DO i=nft+1,nskin,mvsiz
         nel = min(nskin-ideb,mvsiz)
         DO ii = 1, nel
           n = ii+ideb
           ixsk(1:5,ii) = ixskin(1:5,n)
C-------------check for strain case still eij=0.5*shear          
         END DO ! II = 1, NEL
         CALL tens3dto2d(nel,ixsk,x,VALUE,evar)
         IF (keyword == 'TENS/STRAIN/OUTER') THEN
            DO ii=1,nel
             n = ii+ideb
             skin_tensor(1:3,n) = evar(1:3,ii)
             IF(h3d_part(ixsk(1,ii)) == 1) is_written_skin(n) = 1
            END DO
         ELSEIF (keyword == 'TENS/STRESS/OUTER') THEN
            DO ii=1,nel
             n = ii+ideb
             skin_tensor(1:3,n) = evar(1:3,ii)
             IF(h3d_part(ixsk(1,ii)) == 1) is_written_skin(n) = 1
            END DO
         END IF
         ideb = ideb + nel
       END DO 
       DEALLOCATE(aflu,vflu,VALUE,itagps)
C-----------
      RETURN
      END