lag_anith.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/.
!||====================================================================
!||    lag_anith    ../engine/source/tools/lagmul/lag_anith.F
!||--- called by ------------------------------------------------------
!||    lag_mult     ../engine/source/tools/lagmul/lag_mult.F
!||--- uses       -----------------------------------------------------
!||    h3d_mod      ../engine/share/modules/h3d_mod.F
!||    output_mod   ../common_source/modules/output/output_mod.F90
!||====================================================================
      SUBROUTINE lag_anith(OUTPUT,IADLL  ,LLL   ,JLL    ,SLL    ,XLL    ,
     2                     FANI  ,FSAV   ,NC     ,H3D_DATA)
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE h3d_mod
      USE output_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      "param_c.inc"
#include      "comlock.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      type(output_), intent(inout) :: output
      INTEGER NC,IADLL(*),LLL(*),JLL(*),SLL(*)
C     REAL
      my_real
     .  xll(*),fani(3,*),fsav(nthvki,*)
      TYPE(h3d_database) :: H3D_DATA
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,IC,IK,NIN
C======================================================================|
C---
C     SAUVEGARDE DES FORCES D'ANIM
C---
      IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
     .          ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .              (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
#include "lockon.inc"
          DO ic=1,nc
            DO ik=iadll(ic),iadll(ic+1)-1
              i = lll(ik)
              j = jll(ik)
              IF(j<=3) fani(j,i) = fani(j,i) - xll(ik)
            ENDDO
          ENDDO
#include "lockoff.inc"
      ENDIF
C----
C     SAUVEGARDE DE L'IMPULSION NORMALE - TH
C---
#include "lockon.inc"
        DO ic=1,nc
          DO ik=iadll(ic),iadll(ic+1)-1
            nin = sll(ik)
            IF(nin/=0)THEN
              j = jll(ik)
              fsav(j,nin)=fsav(j,nin) + xll(ik)*dt12
            ENDIF
          ENDDO
        ENDDO
#include "lockoff.inc"
C
C---
      RETURN
      END
 
C SPMD routine
!||====================================================================
!||    lag_anithp     ../engine/source/tools/lagmul/lag_anith.F
!||--- called by ------------------------------------------------------
!||    lag_multp      ../engine/source/tools/lagmul/lag_mult.F
!||--- calls      -----------------------------------------------------
!||    spmd_sg_fani   ../engine/source/mpi/lag_multipliers/spmd_lag.F
!||--- uses       -----------------------------------------------------
!||    h3d_mod        ../engine/share/modules/h3d_mod.F
!||    output_mod     ../common_source/modules/output/output_mod.F90
!||====================================================================
      SUBROUTINE lag_anithp(OUTPUT, IADLL  ,LLL   ,JLL  ,SLL     ,XLL    ,
     2                      FANI   ,FSAV  ,NC   ,INDEXLAG,FANIG  ,
     3                      FR_LAGF,NBNODL,LLAGF,NLAGF   ,H3D_DATA)
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE h3d_mod
      USE output_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      "param_c.inc"
#include      "comlock.inc"
#include      "com01_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
#include      "scr07_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      type(output_), intent(inout) :: output
      INTEGER NC,IADLL(*),LLL(*),JLL(*),SLL(*),
     .        FR_LAGF(*), LLAGF(*), INDEXLAG(*), NBNODL, NLAGF
C     REAL
      my_real
     .  xll(*),fani(3,*),fsav(nthvki,*), fanig(3,*)
      TYPE(h3d_database) :: H3D_DATA
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,IC,IK,NIN,N
C======================================================================|
C---
C     SAUVEGARDE DES FORCES D'ANIM
C---
      IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
     .          ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
     .              (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
        IF(ispmd==0)THEN
          DO i = 1, nbnodl
            fanig(1,i) = zero
            fanig(2,i) = zero
            fanig(3,i) = zero
          END DO
          DO ic=1,nc
            DO ik=iadll(ic),iadll(ic+1)-1
C              I = LLL(IK)
              i = indexlag(lll(ik))
              j = jll(ik)
              IF(j<=3) fanig(j,i) = fanig(j,i) - xll(ik)
            ENDDO
          ENDDO
        END IF
        IF(nspmd > 1)THEN
          CALL spmd_sg_fani(
     1     fani,fanig,fr_lagf,nbnodl,llagf,nlagf)
        ELSE
          DO i = 1, nlagf
            n = llagf(i)
            fani(1,n)  = fanig(1,i)
            fani(2,n)  = fanig(2,i)
            fani(3,n)  = fanig(3,i)
          END DO            
        END IF  
      ENDIF
C----
C     SAUVEGARDE DE L'IMPULSION NORMALE - TH
C---
        DO ic=1,nc
          DO ik=iadll(ic),iadll(ic+1)-1
            nin = sll(ik)
            IF(nin/=0)THEN
              j = jll(ik)
              fsav(j,nin)=fsav(j,nin) + xll(ik)*dt12
            ENDIF
          ENDDO
        ENDDO
C
C---
      RETURN
      END
 
!||====================================================================
!||    lagth_rby   ../engine/source/tools/lagmul/lag_anith.F
!||====================================================================
      SUBROUTINE lagth_rby(LPBY  ,NPBY  ,FANI  ,FS   ,AF   ,AM   ,X   )
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      "param_c.inc"
#include      "lagmult.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LPBY(*), NPBY(NNPBY,*)
C     REAL
      my_real
     .   af(3,*), am(3,*), x(3,*), fani(3,*), fs(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, NN, N2, NSL, TNSL
C-----------------------------------------------
      TNSL = 0
      n2 = ninter+nrwall+nrbykin
      n  = 1
      DO n=1,nrbylag
        n2=n2+1
        nsl  = npby(2,n)
c        DO I = 1,6
c          FANI(I) = ZERO
c        ENDDO
        DO i=1,nsl
          nn = lpby(tnsl+i)
          fs(n2+1)=fs(n2+1)+af(1,nn)*dt1
          fs(n2+2)=fs(n2+2)+af(2,nn)*dt1
c          FS(N2+3)=FS(N2+3)+AF(3,NN)*DT1
c          FS(N2+4)=FS(N2+4)+AM(1,NN)*DT1
c          FS(N2+5)=FS(N2+5)+AM(2,NN)*DT1
c          FS(N2+6)=FS(N2+6)+AM(3,NN)*DT1
c          FANI(1) =FANI(1) +AF(1,NN) 
c          FANI(2) =FANI(2) +AF(2,NN) 
c          FANI(3) =FANI(3) +AF(3,NN) 
c          FANI(4) =FANI(4) +AM(1,NN) 
c          FANI(5) =FANI(5) +AM(2,NN) 
c          FANI(6) =FANI(6) +AM(3,NN) 
        ENDDO
        tnsl = tnsl + 3*nsl
      ENDDO
C---
      RETURN
      END