rbyvit.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/.
!||====================================================================
!||    rbyvit          ../engine/source/constraints/general/rbody/rbyvit.F
!||--- called by ------------------------------------------------------
!||    resol           ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    rgbodv          ../engine/source/constraints/general/rbody/rgbodv.F
!||    spmd_all_dmax   ../engine/source/mpi/elements/spmd_sph.F
!||--- uses       -----------------------------------------------------
!||    message_mod     ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE rbyvit(RBY   ,X       ,V        ,VR   ,SKEW,
     2                  FSAV  ,LPBY    ,NPBY     ,ISKEW,ITAB,
     3                  WEIGHT,A       ,AR       ,MS   ,IN  ,
     4                  KIND  ,IRBKIN_L,NRBYKIN_L,NODREAC,FTHREAC,
     5                  FREAC )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C----6---------------------------------------------------------------7---------8
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      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ISKEW(*),ITAB(*),
     .        KIND(NRBYKIN),IRBKIN_L(*),NRBYKIN_L,NODREAC(*)
C     REAL
      my_real
     .   rby(nrby,*) ,x(3,*) ,v(3,*) ,vr(3,*),skew(*),
     .   fsav(nthvki,*) ,a(3,*),ar(3,*),in(*),ms(*),fthreac(*),freac(*)
C----------------------------------------------3
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  J,K,N,KK,IFAIL,ICOMM
      my_real
     .       FN, FT,EXPN,EXPT
      my_real, DIMENSION(:), ALLOCATABLE ::  
     .       crit
C     REAL
      SAVE crit
C-----------------------------------------------
!$OMP SINGLE
       IF(nrbfail /= 0 .AND. nspmd > 1)THEN
         ALLOCATE(crit(nrbykin))
         crit(1:nrbykin) = zero
       ELSE
         ALLOCATE(crit(0))
       END IF
!$OMP END SINGLE
C-------------------------------------
C CALCUL SUPER RIGID BODIES (non multi-thread) sur premiere tache libre
C-------------------------------------
 
!$OMP SINGLE
 
        DO kk=1,nrbykin_l
          n=irbkin_l(kk)
          k  = kind(n)
          IF(npby(7,n)>0.AND.npby(4,n)/=0)THEN
            j = ninter+nrwall+n
            ifail = npby(18,n)
            fn    = rby(26,n)
            ft    = rby(27,n)
            expn  = rby(28,n)
            expt  = rby(29,n)
C correction variables globales faites dans rbycor
            CALL rgbodv(v        ,vr         ,x     ,rby(1,n)  ,lpby(k),
     2                  npby(1,n),skew       ,iskew ,fsav(1,j) ,itab   ,
     3                  weight   ,a         ,ar     ,ms        ,in     ,
     4                  npby(4,n),npby(6,n) ,ifail  ,fn        ,expn   ,
     5                  ft       ,expt      ,rby(30,n),nodreac,fthreac ,
     6                  freac     )
C
            IF(nrbfail /= 0 .AND. nspmd > 1) crit(n)= rby(30,n)
C
          ENDIF
        ENDDO
 
!$OMP END SINGLE
 
C-------------------------------------
C CALCUL FORCE RIGID BODIES CLASSIQUES (multi-thread)
C-------------------------------------
 
!$OMP DO SCHEDULE(DYNAMIC,1)
 
        DO kk=1,nrbykin_l
          n=irbkin_l(kk)
          k  = kind(n)
          IF(npby(7,n)>0.AND.npby(4,n)==0)THEN
            j = ninter+nrwall+n
            ifail = npby(18,n)
            fn    = rby(26,n)
            ft    = rby(27,n)
            expn  = rby(28,n)
            expt  = rby(29,n)
C correction variables globales faites dans rbycor
            CALL rgbodv(v        ,vr         ,x     ,rby(1,n)  ,lpby(k),
     2                  npby(1,n),skew       ,iskew ,fsav(1,j) ,itab   ,
     3                  weight   ,a         ,ar     ,ms        ,in     ,
     4                  npby(4,n),npby(6,n) ,ifail  ,fn        ,expn   ,
     5                  ft       ,expt      ,rby(30,n),nodreac,fthreac ,
     6                  freac     )
C
            IF(nrbfail /= 0 .AND. nspmd > 1) crit(n)= rby(30,n)
C
          ENDIF
        ENDDO
 
!$OMP END DO
C
!$OMP SINGLE
      IF(nrbfail /= 0 .AND. nspmd > 1)THEN
        CALL spmd_all_dmax(crit,nrbykin)
        DO n=1,nrbykin
          rby(30,n) = crit(n)
        ENDDO
      END IF
      DEALLOCATE(crit)
!$OMP END SINGLE
C
      RETURN
      END