h3d__shell__vector__1_8F_source.html

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_shell_vector_1     ../engine/source/output/h3d/h3d_results/h3d_shell_vector_1.F

!||--- called by ------------------------------------------------------

!||    h3d_shell_vector       ../engine/source/output/h3d/h3d_results/h3d_shell_vector.F

!||--- calls      -----------------------------------------------------

!||    h3d_write_vector       ../engine/source/output/h3d/h3d_results/h3d_write_vector.F

!||    initbuf                ../engine/share/resol/initbuf.F

!||--- uses       -----------------------------------------------------

!||    alefvm_mod             ../common_source/modules/ale/alefvm_mod.F

!||    elbufdef_mod           ../common_source/modules/mat_elem/elbufdef_mod.F90

!||    initbuf_mod            ../engine/share/resol/initbuf.F

!||    multi_fvm_mod          ../common_source/modules/ale/multi_fvm_mod.F90

!||    names_and_titles_mod   ../common_source/modules/names_and_titles_mod.F

!||    schlieren_mod          ../engine/share/modules/schlieren_mod.F

!||    stack_mod              ../engine/share/modules/stack_mod.F

!||====================================================================


      SUBROUTINE h3d_shell_vector_1(

     .                  ELBUF_TAB   ,SHELL_VECTOR,IFUNC   ,IPARG       ,GEO        ,

     .                  IXQ         ,IXC       ,IXTG      ,PM         ,

     .                  EL2FA       ,NBF       ,IADP        ,

     .                  NBF_L       ,EHOUR     ,ANIM      ,NBPART      ,IADG       ,

     .                  IPM         ,IGEO      ,THKE      ,ERR_THK_SH4 ,ERR_THK_SH3,

     .                  INVERT      ,X         ,V         ,W           ,

     .                  NV46        ,NERCVOIS  ,NESDVOIS  ,LERCVOIS    ,LESDVOIS,

     .                  STACK       ,ID_ELEM   ,ITY_ELEM  ,INFO1       ,INFO2      ,

     .                  IS_WRITTEN_SHELL,IPARTC,IPARTTG   ,LAYER_INPUT ,IPT_INPUT  ,

     .                  PLY_INPUT   ,GAUSS_INPUT,IUVAR_INPUT,H3D_PART  ,KEYWORD    ,

     .                  D           ,NG        ,MULTI_FVM)

C-----------------------------------------------

C   M o d u l e s

C-----------------------------------------------

      USE initbuf_mod

      USE elbufdef_mod

      USE schlieren_mod

      USE stack_mod

      USE multi_fvm_mod

      USE alefvm_mod , only:alefvm_param

      USE names_and_titles_mod, ONLY: ncharline100

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      "vect01_c.inc"

#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-----------------------------------------------

      my_real

     .   shell_vector(3,*),x(3,numnod),v(3,numnod),w(3,numnod),d(3,numnod),thke(*),ehour(*),geo(npropg,numgeo),

     .   anim(*),pm(npropm,nummat),err_thk_sh4(*), err_thk_sh3(*)

      INTEGER IPARG(NPARG,NGROUP),IXC(NIXC,NUMELC),IXTG(NIXTG,NUMELTG),EL2FA(*),

     .   IXQ(NIXQ,NUMELQ),IFUNC,NBF,

     .   IADP(*),NBF_L, NBPART,IADG(NSPMD,*),IPM(NPROPMI,NUMMAT),

     .   IGEO(NPROPGI,NUMGEO),INVERT(*), NV46,ID_ELEM(*),ITY_ELEM(*),

     .   INFO1,INFO2,IS_WRITTEN_SHELL(*),IPARTC(*),IPARTTG(*),H3D_PART(*),

     .   LAYER_INPUT ,IPT_INPUT,GAUSS_INPUT,PLY_INPUT,IUVAR_INPUT,NG

      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB

      TYPE (STACK_PLY) :: STACK

      CHARACTER(LEN=NCHARLINE100)::KEYWORD

      TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      my_real value(3),p

      INTEGER I,NEL,NPTR,NPTS,NPTT,NLAY,ILAY,MLW,JTURB,NVARF,

     .        OFFSET,IHBE,NPG,MPT,IPT,ISUBSTACK,ITHK,NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*)

      INTEGER NPT_ALL,IPLY,

     .        iok_part(mvsiz),jj(5),iuvar,

     .        is_written_value(mvsiz)

      REAL R4

      TYPE(g_bufel_)  ,POINTER :: GBUF

      TYPE(L_BUFEL_)  ,POINTER :: LBUF

      my_real,DIMENSION(:), POINTER  :: UVAR

C-----------------------------------------------


       CALL initbuf(iparg   ,ng      ,

     2               mlw     ,nel     ,nft     ,iad     ,ity     ,

     3               npt     ,jale    ,ismstr  ,jeul    ,jturb   ,

     4               jthe    ,jlag    ,jmult   ,jhbe    ,jivf    ,

     5               nvaux   ,jpor    ,jcvt    ,jclose  ,jplasol ,

     6               irep    ,iint    ,igtyp   ,israt   ,isrot   ,

     7               icsen   ,isorth  ,isorthg ,ifailure,jsms    )


       IF(mlw /= 13) THEN


          nft = iparg(3,ng)

          iad = iparg(4,ng)

          isubstack = iparg(71,ng)


          iok_part(1:nel) = 0

!

          DO i=1,5

            jj(i) = nel*(i-1)

          ENDDO

c

          DO i=1,nel

            is_written_value(i) = 0

          ENDDO

C-----------------------------------------------

C           COQUES 3 N 4 N

C-----------------------------------------------

         IF (ity == 3.OR.ity == 7) THEN


            gbuf => elbuf_tab(ng)%GBUF

            npt   = iparg(6,ng)

            ihbe  = iparg(23,ng)

            irep  = iparg(35,ng)

            igtyp = iparg(38,ng)

            ithk  = iparg(28,ng)

            mpt   = iabs(npt)

            nptr  = elbuf_tab(ng)%NPTR

            npts  = elbuf_tab(ng)%NPTS

            nptt  = elbuf_tab(ng)%NPTT

            nlay  = elbuf_tab(ng)%NLAY

            npg   = nptr*npts

c

            IF (ity == 3) offset = 0

            IF (ity == 7) offset = numelc

c

            DO  i=1,nel

              IF (ity == 3) THEN

                id_elem(offset+nft+i) = ixc(nixc,nft+i)

                ity_elem(offset+nft+i) = 3

                IF( h3d_part(ipartc(nft+i)) == 1) iok_part(i) = 1

              ELSEIF (ity == 7) THEN

                id_elem(offset+nft+i) = ixtg(nixtg,nft+i)

                ity_elem(offset+nft+i) = 7

                IF( h3d_part(iparttg(nft+i)) == 1) iok_part(i) = 1

              ENDIF

            ENDDO

C

            IF (igtyp == 51 .OR. igtyp == 52) THEN

              npt_all = 0

              DO ipt=1,nlay

                npt_all = npt_all + elbuf_tab(ng)%BUFLY(ipt)%NPTT

              ENDDO

              IF (nlay == 1) mpt  = max(1,npt_all)

            ENDIF

c

            ilay = layer_input

            ipt = ipt_input

            iply = ply_input

c            IG = IGAUSS_INPUT

            iuvar = iuvar_input

            IF (ilay == -2) ilay = 1

            IF (ilay == -3) ilay = nlay

            IF (ipt == -2) ipt = 1

            IF (ipt == -3) ipt = npt

            value(1:3) = zero

C---------------------

            DO i=1,nel

              shell_vector(1:3,offset+nft+i) = zero   ! Default = zero in all cases !

            ENDDO

c

C--------------------------------------------------

            IF (keyword == 'VECT/VEL') THEN

C--------------------------------------------------

               IF (mlw == 151) THEN

                  DO i = 1, nel

                     value(1) = multi_fvm%VEL(1, i + nft)

                     value(2) = multi_fvm%VEL(2, i + nft)

                     value(3) = multi_fvm%VEL(3, i + nft)

                     CALL h3d_write_vector(iok_part,is_written_shell,shell_vector,i,offset,nft,

     .                    VALUE)

                  ENDDO

               ELSE

                  DO i=1,nel

                     IF(gbuf%G_MOM>0  .AND. alefvm_param%IEnabled > 0)THEN

                        value(1) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)

                        value(2) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)

                        value(3) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)

                        CALL h3d_write_vector(iok_part,is_written_shell,shell_vector,i,offset,nft,VALUE)

                     ENDIF

                  ENDDO

               ENDIF

C--------------------------------------------------

            ELSEIF (keyword == 'VECT/ACC') THEN

C--------------------------------------------------

               IF (mlw == 151 .AND. ALLOCATED(multi_fvm%ACC)) THEN

                  DO i = 1, nel

                     value(1) = multi_fvm%ACC(1, i + nft)

                     value(2) = multi_fvm%ACC(2, i + nft)

                     value(3) = multi_fvm%ACC(3, i + nft)

                     CALL h3d_write_vector(iok_part,is_written_shell,shell_vector,i,offset,nft,VALUE)

                  ENDDO

               ENDIF

C--------------------------------------------------

            ENDIF  ! KEYWORD

         ENDIF  ! ITY

c

C-----------------------------------------------

       ENDIF     ! MLW /= 13

C-----------------------------------------------

      RETURN


      END


my_real
#define my_real
Definition cppsort.cpp:32

h3d_shell_vector_1
subroutine h3d_shell_vector_1(elbuf_tab, shell_vector, ifunc, iparg, geo, ixq, ixc, ixtg, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, invert, x, v, w, nv46, nercvois, nesdvois, lercvois, lesdvois, stack, id_elem, ity_elem, info1, info2, is_written_shell, ipartc, iparttg, layer_input, ipt_input, ply_input, gauss_input, iuvar_input, h3d_part, keyword, d, ng, multi_fvm)
Definition h3d_shell_vector_1.F:51

h3d_write_vector
subroutine h3d_write_vector(iok_part, is_written, vector, i, offset, nft, value)
Definition h3d_write_vector.F:36

max
#define max(a, b)
Definition macros.h:21

alefvm_mod
Definition alefvm_mod.F:88

alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121

initbuf_mod
Definition initbuf.F:160

initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261

names_and_titles_mod
Definition names_and_titles_mod.F:997

names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002

schlieren_mod
Definition schlieren_mod.F:46

stack_mod
Definition stack_mod.F:72