i24_save_sub.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/.
!||====================================================================
!||    i24_save_sub         ../engine/source/interfaces/int24/i24_save_sub.F
!||--- called by ------------------------------------------------------
!||    i24for3              ../engine/source/interfaces/int24/i24for3.F
!||--- calls      -----------------------------------------------------
!||    i24intarea_fic       ../engine/source/interfaces/int24/i24intarea_fic.F90
!||--- uses       -----------------------------------------------------
!||    i24intarea_fic_mod   ../engine/source/interfaces/int24/i24intarea_fic.F90
!||    tri7box              ../engine/share/modules/tri7box.F
!||====================================================================
       SUBROUTINE i24_save_sub(NUMNOD,MVSIZ,NISUB,S_ADDSUBM,S_LISUBM,S_TYPSUB,NISUBMAX,I_STOK,
     *                         IE,ITYPSUB,NIN,I,NN,NFT,
     *                         ADDSUBM,LISUBM,TYPSUB,
     *                         INTAREAN,INTCAREA,ISENSINT,
     *                         FXI,FYI,FZI,FNI,DT12,
     *                         FSAVSUB1,FSAVPARIT ,NRTSE,
     *                         IRTSE,NSNE,IS2SE   ,IS2PT,NSNR)
!! \brief Routine to save values for type24 Sub interface for output
!! \details moved from i24for3.F to secondary subroutine due to compiler issue.
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE i24intarea_fic_mod  , ONLY : i24intarea_fic  
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NUMNOD       !< NUMBER of nodes in Model
      INTEGER MVSIZ        !< Vector size
      INTEGER S_ADDSUBM    !< Size of ADDSUBM (computed in Starter)
      INTEGER S_LISUBM     !< Size of LISUBM (computed in Starter)
      INTEGER S_TYPSUB     !< Size of TYPSUB (computed in Starter)
      INTEGER NISUBMAX     !< Size of ISENSINT
      INTEGER NISUB        !< Number of Sub interfaces
      INTEGER I_STOK       !< Number of contact pair / Dimension for FSAVPARIT
      INTEGER IE
      INTEGER ITYPSUB
      INTEGER NIN
      INTEGER NN
      INTEGER I            !< Iterator over Impact : Main Surface/Sec Node from caller routine
      INTEGER NFT          !< Current pinter to FSAVSUB1
      INTEGER ADDSUBM(S_ADDSUBM)
      INTEGER LISUBM(S_LISUBM)
      INTEGER TYPSUB(S_TYPSUB)
      INTEGER ISENSINT(NISUBMAX+1)
      my_real fxi(mvsiz)
      my_real fyi(mvsiz)
      my_real fzi(mvsiz)
      my_real fni(mvsiz)
      my_real dt12
      my_real intarean(numnod)
      INTEGER INTCAREA
      my_real fsavsub1(25,nisub)
      my_real fsavparit(nisub+1,11,i_stok)
      INTEGER, INTENT(IN) :: NSNE,NRTSE,NSNR
      INTEGER, DIMENSION(5,NRTSE),INTENT(IN) :: IRTSE
      INTEGER, DIMENSION(2,NSNE),INTENT(IN) :: IS2SE
      INTEGER, DIMENSION(NSNE),INTENT(IN) :: IS2PT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER KK,ISUB,IG
      my_real impx,impy,impz,arean_fic
C-----------------------------------------------
      DO kk=addsubm(ie),addsubm(ie+1)-1
            isub=lisubm(kk)
            itypsub = typsub(isub)
 
            IF(itypsub == 2 ) THEN   ! Inter =0 : collecting forces from all inter with only 1 surface : main side
 
              impx=-fxi(i)*dt12
              impy=-fyi(i)*dt12
              impz=-fzi(i)*dt12
 
              fsavsub1(1,isub)=fsavsub1(1,isub)+impx
              fsavsub1(2,isub)=fsavsub1(2,isub)+impy
              fsavsub1(3,isub)=fsavsub1(3,isub)+impz
 
              fsavsub1(8,isub) =fsavsub1(8,isub) +abs(impx)
              fsavsub1(9,isub) =fsavsub1(9,isub) +abs(impy)
              fsavsub1(10,isub)=fsavsub1(10,isub)+abs(impz)
 
              fsavsub1(11,isub)=fsavsub1(11,isub)-fni(i)*dt12
 
              IF(isensint(isub+1)/=0) THEN
                fsavparit(isub+1,1,i+nft) =  -fxi(i)
                fsavparit(isub+1,2,i+nft) =  -fyi(i)
                fsavparit(isub+1,3,i+nft) =  -fzi(i)
              ENDIF
 
              IF(intcarea > 0)  THEN
                 IF(nn > 0) THEN
                     IF(nn <=numnod) THEN
                        fsavsub1(25,isub) = fsavsub1(25,isub) + intarean(nn) 
                     ELSE
                        ig = nn - numnod
                        CALL i24intarea_fic(irtse   ,nsne    ,is2se   ,is2pt   ,ig      , 
     +                                    nrtse , numnod     ,intarean,  arean_fic )
                        fsavsub1(25,isub) = fsavsub1(25,isub) + arean_fic
                    ENDIF
                 ELSE
                    IF(isedge_fi(nin)%P(nn)==1)THEN
                       CALL i24intarea_fic(irtse_fi(nin)%P    ,nsnr    ,is2se_fi(nin)%P  ,is2pt_fi(nin)%P   ,nn      , 
     +                                        nsnr , nsnr     , intareanfi(nin)%P, arean_fic)
                          fsavsub1(25,isub) = fsavsub1(25,isub) + arean_fic 
                    ELSE ! cas noeud remote en SPMD non edge
                          fsavsub1(25,isub) = fsavsub1(25,isub) + intareanfi(nin)%P(nn)
                    ENDIF
                 ENDIF
              ENDIF
 
            ENDIF
 
      ENDDO
 
      END