h3d_fld_strain.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/.
C
!||====================================================================
!||    h3d_fld_strain    ../engine/source/output/h3d/h3d_results/h3d_fld_strain.F
!||--- called by ------------------------------------------------------
!||    h3d_skin_scalar   ../engine/source/output/h3d/h3d_results/h3d_skin_scalar.F
!||--- calls      -----------------------------------------------------
!||    roto_sig2d        ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
!||    tsh_dir2          ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod      ../common_source/modules/mat_elem/elbufdef_mod.F90
!||====================================================================
      SUBROUTINE h3d_fld_strain(ELBUF_TAB,X  ,IXS   ,
     .                          JHBE,MLWI,ILAY,KCVT,IOR_TSH,
     .                          ICSTR,NPTR,NPTS,NEL,F_EXP,EVAR )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod    
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER , INTENT(IN) :: JHBE,ILAY,MLWI,KCVT,IOR_TSH,
     .                        NPTR,NPTS,ICSTR,NEL 
      INTEGER ,DIMENSION(NIXS,NUMELS), INTENT(IN) ::  IXS
      my_real , INTENT(IN) ::  F_EXP
      my_real ,DIMENSION(3,MVSIZ), INTENT(OUT) ::  evar
      my_real ,DIMENSION(3,NUMNOD), INTENT(IN) ::  x
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C----------------------------------------------- 
      my_real
     .   dir(mvsiz,2),dirb(mvsiz,2)
      INTEGER I,I1,II,J,IR,IS,IT,IL,JJ(4)
 
      TYPE(g_bufel_)  ,POINTER :: GBUF     
      TYPE(L_BUFEL_)  ,POINTER :: LBUF     
C----------------------------------------------- 
       evar(1:3,1:nel) = zero
       it = 1
       ir = 0
       is = 0
       DO i=1,4
         jj(i) = nel*(i-1)
       ENDDO
        gbuf => elbuf_tab%GBUF
        IF (jhbe==15) THEN
           ir = 1
           is = 1
           lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
            IF (mlwi == 12 .OR. mlwi == 14) THEN
              DO i=1,nel               
               evar(1:2,i) = lbuf%EPE(jj(1:2) + i)       
               evar(3,i)   = half*lbuf%EPE(jj(4) + i)
              ENDDO                   
            ELSEIF (mlwi /= 49 ) THEN                 
              DO i=1,nel               
               evar(1:2,i) = lbuf%STRA(jj(1:2) + i)       
               evar(3,i)   = half*lbuf%STRA(jj(4) + i)
              ENDDO                   
            END IF               
C------      
        ELSE ! 14,16
          IF (mlwi == 12 .OR. mlwi == 14) THEN
            DO ir=1,nptr
              DO is=1,npts
                 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)         
                 DO i=1,nel               
                  evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)       
                  evar(3,i)   = evar(3,i)+half*lbuf%EPE(jj(4) + i)
                 ENDDO                   
              END DO 
            END DO 
          ELSEIF (mlwi /= 49 ) THEN                 
            DO ir=1,nptr
              DO is=1,npts
                 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)         
                 DO i=1,nel               
                  evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)       
                  evar(3,i)   = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
                 ENDDO                   
              ENDDO 
            END DO 
          END IF               
        END IF               
        evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
C------         
        IF (kcvt==2) THEN
           IF(ior_tsh==1)THEN
             DO i=1,nel
              dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
             ENDDO
           ELSEIF(ior_tsh==2)THEN
             IF(jhbe==14)THEN
              ir = 1
              is = 1
             END IF
             lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)         
             DO i=1,nel
              dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
             ENDDO
           END IF
           CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
           CALL roto_sig2d(1,nel,evar,dirb)
        END IF !(KCVT==2) THEN
C
      RETURN
      END SUBROUTINE h3d_fld_strain