forints.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/.
!||====================================================================
!||    forints        ../engine/source/elements/forints.F
!||--- called by ------------------------------------------------------
!||    resol          ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    initbuf        ../engine/share/resol/initbuf.F
!||    startimeg      ../engine/source/system/timer.F
!||    stoptimeg      ../engine/source/system/timer.F
!||    xforc3         ../engine/source/elements/xelem/xforc3.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    initbuf_mod    ../engine/share/resol/initbuf.F
!||====================================================================
      SUBROUTINE forints(
     1    PM        ,GEO       ,X         ,A         ,AR ,
     2    V         ,VR        ,MS        ,IN        ,W         ,
     3    ELBUF                ,VAL2      ,VEUL      ,FV        ,
     4    STIFN     ,STIFR     ,FSKY      ,TF        ,BUFMAT    ,
     5    PARTSAV              ,FANI      ,FSAV      ,
     6    SKEW      ,DT2T      ,
     7    IADS      ,IPARG     ,NPC       ,IXS       ,
     8    NELTST    ,ITYPTST   ,IPART     ,IPARTS    ,ITAB      ,
     9    FSKYI     ,BUFGEO    ,KXX       ,IXX       ,ISKY      ,
     A    IPARTX    ,GRESAV    ,GRTH      ,
     B    IGRTH     ,ELBUF_TAB )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE initbuf_mod
      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      "com01_c.inc"
#include      "param_c.inc"
#include      "vect01_c.inc"
#include      "scr17_c.inc"
#include      "task_c.inc"
#include      "parit_c.inc"
#include      "scr23_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXS(NIXS,*),IPART(LIPART1,*) ,IPARTS(*) ,
     .   NPC(*), IPARG(NPARG,*),IADS(8,*),NELTST,ITYPTST,
     .   KXX(NIXX,*),I XX(*), ITAB(*),
     .   IPARTX(*), ISKY(*),GRTH(*),IGRTH(*)
C     REAL
      my_real
     .   X(3,*)    ,V(3,*)   ,VR(3,*),
     .   MS(*)   ,IN(*)   ,PM(NPROPM,*),SKEW(LSKEW,*),GEO(NPROPG,*),
     .   BUFMAT(*) ,W(3,*)    ,VEUL(*),TF(*)  ,
     .   FSAV(NTHVKI,*)       ,ELBUF(*) ,
     .   FV(*)     ,A(3,*)    ,AR(3,*)     ,VAL2(*)  ,
     .   fani(3,*) ,partsav(*),stifn(*) ,stifr(*),
     .   fsky(*) ,
     .   dt2t,fskyi(lskyi,nfskyi) ,bufgeo(*),gresav(*)
C
      TYPE(elbuf_struct_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N, NG, NVC, MLW, JFT, JLT ,K ,
     .   K1, K2, KAD,IAD2,NF1,IPRI,NGLOC, NELEM, OFFSET,
     .   NSG, NEL,ISOLNOD
      INTEGER IADUIX,IADUX ,IADUV ,IADUVR,IADUMS,
     .        IADUIN,IADUSM,IADUSR,IADUMV,IADURV,
     .        IADUF ,IADUTQ
C-----------------------------------------------
C
      DO 240 ng=1,ngroup
          IF(iparg(8,ng)==1.OR.iparg(5,ng)/=100)GOTO 240
          IF (iddw>0) CALL startimeg(ng)
          DO nelem = 1,iparg(2,ng),nvsiz
C---
C
            offset = nelem - 1
C
           CALL initbuf(iparg    ,ng      ,
     2        mtn     ,nel     ,nft     ,iad     ,ity     ,
     3        npt     ,jale    ,ismstr  ,jeul    ,jtur    ,
     4        jthe    ,jlag    ,jmult   ,jhbe    ,jivf    ,
     5        nvaux   ,jpor    ,jcvt    ,jclose  ,jplasol ,
     6        irep    ,iint    ,igtyp   ,israt   ,isrot   ,
     7        icsen   ,isorth  ,isorthg ,ifailure,jsms    )
C
            nsg   =iparg(10,ng)
            nvc   =iparg(19,ng)
            jhbe  =iparg(23,ng)
            igre  =iparg(51,ng)
C
            lft=1
            llt=min(nvsiz,nel-nelem+1)
C           Multi-purpose element Groups are constituted,
C           but Multi-purpose element is not supposed to be vectorized ..
             CALL xforc3(
     1   nft,          nel,          geo,          pm,
     2   itab,         kxx,          ixx,          x,
     3   v,            vr,           a,            ar,
     4   elbuf(iad),   npc,          tf,           skew,
     5   dt2t,         neltst,       ityptst,      stifn,
     6   stifr,        ms,           in,           fskyi,
     7   isky,         partsav,      ipartx,       bufmat,
     8   bufgeo,       gresav,       grth,         igrth,
     9   elbuf_tab(ng),igre)
            IF (iddw>0) CALL stoptimeg(ng)
         END DO
 240  CONTINUE
C----------------------------------
      RETURN
      END