reactions.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/.
!||====================================================================
!||    reaction_forces_check_for_requested_output   ../engine/source/output/reactions.f
!||--- called by ------------------------------------------------------
!||    resol                                        ../engine/source/engine/resol.F
!||--- uses       -----------------------------------------------------
!||    h3d_mod                                      ../engine/share/modules/h3d_mod.F
!||====================================================================
      SUBROUTINE reaction_forces_check_for_requested_output(NPBY,H3D_DATA,COMPTREAC)
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is setting COMPTREAC to 1 if FREAC & MREAC output are requested
C
C  CRITERA WHICH SET COMPTREAC TO 1 :
C    - RBODY IS SWITCHED OFF DUE TO CRITERION ON REACTION FORCES (Ifail=NPBY(18)=1)
C    - /ANIM/VECT/FREAC is requested (ANIM_V(17) = 1)
C    - /ANIM/VECT/MREAC is requested (ANIM_V(18) = 1)
C    - /H3D/NODA/FREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /H3D/NODA/MREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /TH/NODE/REAC is requested (IREAC=1)
C
C  SEQUENCE IN SOLVER LOOP :
C    - REACTION_FORCES_CHECK_FOR_REQUESTED_OUTPUT : check if output is requested
C    - REACTION_FORCES_1 : add FEXT+FINT
C                          --> FREAC = FEXT+FINT
C    - REACTION_FORCES_2 : add additional contribution Fgrav,Fbcs_cyclic,Fcentrif ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif)
C    - REACTION_FORCES_2 : add additional contribution Fdamping ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif) + (Fdamping)
C    - REACTION_FORCES_3 : Finally get what we need
C                          --> FREAC = FTOT - (FEXT+FINT) - (Fgrav,Fbcs_cyclic,Fcentrif) - (Fdamping)
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE h3d_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      "com04_c.inc"
#include      "param_c.inc"
#include      "scr14_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NPBY(NNPBY,*)
      INTEGER,INTENT(INOUT) :: COMPTREAC
      TYPE(h3d_database),INTENT(IN) :: H3D_DATA
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  N, IFAIL
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------     
      
      !---------------------------------------!
      ! CRITERION FOR RBODY WITH 'Ifail' FLAG !
      !---------------------------------------!
      nrbfail = 0
      DO n=1,nrbykin
        ifail = npby(18,n)
        IF(ifail /= 0) THEN
          nrbfail = nrbfail + 1
        END IF
      ENDDO
      IF(nrbfail /= 0) THEN
        comptreac = 1
      ENDIF
 
      !-----------------------------------------------------!
      ! CRITERION BASED ON OUTPUT REQUEST (ANIM, OUTP, H3D) !
      !-----------------------------------------------------!
      IF (anim_v(17) == 1 .OR. h3d_data%N_VECT_FREAC == 1 .OR. anim_v(18) == 1 .OR. h3d_data%N_VECT_MREAC == 1 ) THEN
        comptreac = 1
      END IF
 
      !-----------------------------------------------------!
      ! CRITERION BASED ON OUTPUT REQUEST (TH)              !
      !-----------------------------------------------------!
      IF(ireac /= 0) THEN
        comptreac=1
      ENDIF
 
C-----------------------------------------------
      RETURN
      END
 
!||====================================================================
!||    reaction_forces_1   ../engine/source/output/reactions.F
!||--- called by ------------------------------------------------------
!||    resol               ../engine/source/engine/resol.F
!||====================================================================
      SUBROUTINE reaction_forces_1(NODFT ,NODLT ,A ,AR ,FREAC)
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is STEP 1 on 3 to OBTAIN FREAC array for output.
C Output is calculated if COMPTREAC=1
C
C  CRITERA WHICH SET COMPTREAC TO 1 :
C    - RBODY IS SWITCHED OFF DUE TO CRITERION ON REACTION FORCES (Ifail=NPBY(18)=1)
C    - /ANIM/VECT/FREAC is requested (ANIM_V(17) = 1)
C    - /ANIM/VECT/MREAC is requested (ANIM_V(18) = 1)
C    - /H3D/NODA/FREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /H3D/NODA/MREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /TH/NODE/REAC is requested (IREAC=1)
C
C  SEQUENCE IN SOLVER LOOP :
C    - REACTION_FORCES_CHECK_FOR_REQUESTED_OUTPUT : check if output is requested
C    - REACTION_FORCES_1 : add FEXT+FINT
C                          --> FREAC = FEXT+FINT
C    - REACTION_FORCES_2 : add additional contribution Fgrav,Fbcs_cyclic,Fcentrif ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif)
C    - REACTION_FORCES_2 : add additional contribution Fdamping ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif) + (Fdamping)
C    - REACTION_FORCES_3 : Finally get what we need
C                          --> FREAC = FTOT - (FEXT+FINT) - (Fgrav,Fbcs_cyclic,Fcentrif) - (Fdamping)
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NODFT, NODLT
      my_real,INTENT(IN) :: a(3,numnod) , ar(3,numnod)
      my_real,INTENT(INOUT) :: freac(6,numnod)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  N
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------     
      
      !------------------------------------------------!
      !       SAVING FORCES (FEXT+FINT+FCONT)          !
      !------------------------------------------------!
      DO n=nodft,nodlt
        freac(1,n) = a(1,n) 
        freac(2,n) = a(2,n) 
        freac(3,n) = a(3,n) 
      ENDDO
 
      IF (iroddl/=0) THEN
        DO n=nodft,nodlt
          freac(4,n) = ar(1,n)
          freac(5,n) = ar(2,n)
          freac(6,n) = ar(3,n)
        ENDDO
      END IF
      
C-----------------------------------------------
      RETURN
      END SUBROUTINE reaction_forces_1
 
!||====================================================================
!||    reaction_forces_2   ../engine/source/output/reactions.F
!||--- called by ------------------------------------------------------
!||    resol               ../engine/source/engine/resol.F
!||====================================================================
      SUBROUTINE reaction_forces_2(NODFT,NODLT,A,AR,MS,IN,FREAC,IFLAG )
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is STEP 2 on 3 to OBTAIN FREAC array for output.
C Output is calculated if COMPTREAC=1
C
C  CRITERA WHICH SET COMPTREAC TO 1 :
C    - RBODY IS SWITCHED OFF DUE TO CRITERION ON REACTION FORCES (Ifail=NPBY(18)=1)
C    - /ANIM/VECT/FREAC is requested (ANIM_V(17) = 1)
C    - /ANIM/VECT/MREAC is requested (ANIM_V(18) = 1)
C    - /H3D/NODA/FREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /H3D/NODA/MREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /TH/NODE/REAC is requested (IREAC=1)
C
C  SEQUENCE IN SOLVER LOOP :
C    - REACTION_FORCES_CHECK_FOR_REQUESTED_OUTPUT : check if output is requested
C    - REACTION_FORCES_1 : add FEXT+FINT
C                          --> FREAC = FEXT+FINT
C    - REACTION_FORCES_2 : add additional contribution Fgrav,Fbcs_cyclic,Fcentrif ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif)
C    - REACTION_FORCES_2 : add additional contribution Fdamping ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif) + (Fdamping)
C    - REACTION_FORCES_3 : Finally get what we need
C                          --> FREAC = FTOT - (FEXT+FINT) - (Fgrav,Fbcs_cyclic,Fcentrif) - (Fdamping)
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NODFT, NODLT, IFLAG
      my_real,INTENT(IN) :: a(3,numnod) , ar(3,numnod), ms(numnod), in(iroddl*numnod)
      my_real,INTENT(INOUT) :: freac(6,numnod)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  N
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------     
      
      !-----------------------------------------------------------!
      !       COMPUTE REACTION FORCES (ADDITIONAL CONTRIBUTION)   !
      !-----------------------------------------------------------!
      DO n=nodft,nodlt
        freac(1,n) = freac(1,n) + iflag * ms(n)*a(1,n) 
        freac(2,n) = freac(2,n) + iflag * ms(n)*a(2,n) 
        freac(3,n) = freac(3,n) + iflag * ms(n)*a(3,n)
      ENDDO
 
      IF (iroddl/=0) THEN
        DO n=nodft,nodlt
          freac(4,n) = freac(4,n) + iflag * in(n)*ar(1,n) 
          freac(5,n) = freac(5,n) + iflag * in(n)*ar(2,n) 
          freac(6,n) = freac(6,n) + iflag * in(n)*ar(3,n) 
        ENDDO
      END IF
      
C-----------------------------------------------
      RETURN
      END SUBROUTINE reaction_forces_2
 
!||====================================================================
!||    reaction_forces_3   ../engine/source/output/reactions.F
!||--- called by ------------------------------------------------------
!||    resol               ../engine/source/engine/resol.F
!||====================================================================
      SUBROUTINE reaction_forces_3(NODFT,NODLT,A,AR,MS,IN,FREAC)
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is STEP 3 on 3 to OBTAIN FREAC array for output.
C Output is calculated if COMPTREAC=1
C
C  CRITERA WHICH SET COMPTREAC TO 1 :
C    - RBODY IS SWITCHED OFF DUE TO CRITERION ON REACTION FORCES (Ifail=NPBY(18)=1)
C    - /ANIM/VECT/FREAC is requested (ANIM_V(17) = 1)
C    - /ANIM/VECT/MREAC is requested (ANIM_V(18) = 1)
C    - /H3D/NODA/FREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /H3D/NODA/MREAC is requested (H3D_DATA%N_VECT_FREAC = 1)
C    - /TH/NODE/REAC is requested (IREAC=1)
C
C  SEQUENCE IN SOLVER LOOP :
C    - REACTION_FORCES_CHECK_FOR_REQUESTED_OUTPUT : check if output is requested
C    - REACTION_FORCES_1 : add FEXT+FINT
C                          --> FREAC = FEXT+FINT
C    - REACTION_FORCES_2 : add additional contribution Fgrav,Fbcs_cyclic,Fcentrif ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif)
C    - REACTION_FORCES_2 : add additional contribution Fdamping ...
C                          first time with IFLAG=-1, then followed with IFLAG = 1 : Fadd=m(A-A~)
C                          --> FREAC = (FEXT+FINT) + (Fgrav,Fbcs_cyclic,Fcentrif) + (Fdamping)
C    - REACTION_FORCES_3 : Finally get what we need
C                          --> FREAC = FTOT - (FEXT+FINT) - (Fgrav,Fbcs_cyclic,Fcentrif) - (Fdamping)
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NODFT, NODLT
      my_real,INTENT(IN) :: a(3,numnod) , ar(3,numnod), ms(numnod), in(iroddl*numnod)
      my_real,INTENT(INOUT) :: freac(6,numnod)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  N
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------     
      
      !------------------------------------------------!
      !       COMPUTE REACTION FORCES (FINALIZATION)   !
      !------------------------------------------------!
      DO n=nodft,nodlt
        freac(1,n) = ms(n)*a(1,n) - freac(1,n) 
        freac(2,n) = ms(n)*a(2,n) - freac(2,n) 
        freac(3,n) = ms(n)*a(3,n) - freac(3,n) 
      ENDDO
 
      IF (iroddl/=0) THEN
        DO n=nodft,nodlt
          freac(4,n) = in(n)*ar(1,n) - freac(4,n)
          freac(5,n) = in(n)*ar(2,n) - freac(5,n)
          freac(6,n) = in(n)*ar(3,n) - freac(6,n)
        ENDDO
      END IF
      
C-----------------------------------------------
      RETURN
      END SUBROUTINE reaction_forces_3