alelin.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/.
!||====================================================================
!||    alelin            ../engine/source/ale/grid/alelin.F
!||--- called by ------------------------------------------------------
!||    alewdx            ../engine/source/ale/grid/alewdx.F
!||--- calls      -----------------------------------------------------
!||    spmd_glob_dsum9   ../engine/source/mpi/interfaces/spmd_th.F
!||    spmd_rbcast       ../engine/source/mpi/generic/spmd_rbcast.F
!||--- uses       -----------------------------------------------------
!||    groupdef_mod      ../common_source/modules/groupdef_mod.F
!||====================================================================
      SUBROUTINE alelin(NALELK ,LINALE ,W ,WEIGHT ,IGRNOD)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_mod
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-----------------------------------------------
#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)   :: NALELK
      INTEGER,INTENT(IN)   :: LINALE(*), WEIGHT(*)
      my_real, INTENT(INOUT) :: w(3,numnod)
      TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: ID(3), K, JJ, M1, M2, N, IC, IM, N1, J, I, NI, GR_ID
      INTEGER :: uID, II
      my_real :: ww, wm1m2(6)
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C
C This subroutines is handling links on grid velocities.
C It can be defined using /ALE/LINK/VEL                 
C /VEL/ALE
C
C   NALELK    : number of ALE LINKS
C   LINALE[:] : definition array
C         [1] : user ID         (uID)
C         [2] : main node     (M1)
C         [3] : main node     (M2)
C         [4] : number of nodes (N)
C         [5] : direction XYZ   (IC)
C         [6] : formulation     (IM)
C
C                  |ALE LINK 1                                       |2              |NALELK
C             +----+----+----+----+----+----+----+----+----+...-+----+----+----+--...+----+----+--...
C   LINALE    |uID | M1 | M2 | N  | IC | IM |id1 |id2 |id3 |... |idn | ...           |
C             +----+----+----+----+----+----+----+----+----+...-+----+----+----+--...+----+----+--...
C (1:SLINALE)   1    2    3    4    5    6   6+1                 6+N
C    +LLINAL               |
C                         (N=1 if grnod_id is used)
C
C    First subarrays are used to define ale links from starter (1:SLINALE). Engine links are in (SLINALE+1:SLINALE+LLINAL)
C    Only Starter part is written in restart files.
C
C-----------------------------------------------
C   P r e - C o n d i t i o n s
C-----------------------------------------------
C
C None : NALELK=0 => Nothing is done.
C
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
        k=0
        n=0
        gr_id = -huge(gr_id)
        DO jj=1,nalelk
        
          wm1m2(1) = zero
          wm1m2(2) = zero 
          wm1m2(3) = zero      
          wm1m2(4) = zero 
          wm1m2(5) = zero 
          wm1m2(6) = zero
          k        = k+iabs(n)+6
          uid      = linale(k-5)
          m1       = linale(k-4)
          m2       = linale(k-3)
          n        = linale(k-2)     
          
          IF(uid<0)cycle !OFF          
          IF(m1 > 0)THEN                ! test if node is on current domain
            IF(weight(m1) ==  1)THEN
              wm1m2(1) = w(1,m1)
              wm1m2(2) = w(2,m1)
              wm1m2(3) = w(3,m1)
            END IF
          END IF
          
          IF(m2 > 0)THEN                ! test if node is on current domain
            IF(weight(m2) ==  1)THEN
              wm1m2(4) = w(1,m2)
              wm1m2(5) = w(2,m2)
              wm1m2(6) = w(3,m2)
            END IF
          END IF
 
          IF(nspmd > 1) THEN
            ! Exchange in order to manage the alelink hierarchy
            CALL spmd_glob_dsum9(wm1m2,6)
            CALL spmd_rbcast(wm1m2,wm1m2,1,6,0,2)
          END IF
 
          ic=linale(k-1)
          im=linale(k)
          id(1)=ic/4
          ic=ic-4*id(1)
          id(2)=ic/2
          id(3)=ic-2*id(2)
 
          IF(n>0)THEN
            n1=n+1
          ELSE
            gr_id=linale(k+1)          
            n1=igrnod(gr_id)%NENTITY+1
            n=1!IABS(N)
          ENDIF   
          
          DO j=1,3
           IF(id(j) /=  0) THEN
             IF(im ==  0) THEN
               IF(linale(k-2)>0)THEN !---NODE LIST IF NUMNOD>0
                 DO i=1,n
                   ni=linale(k+i)
                   IF(ni > 0)THEN                ! test if node is on current domain
                     w(j,ni)=wm1m2(j)+(wm1m2(3+j)-wm1m2(j))*i/n1
                   ENDIF
                 ENDDO
               ELSE !---GRNOD IF NUMNOD =-1
                 ii=0          
                 DO i=1,igrnod(gr_id)%NENTITY
                   ni=igrnod(gr_id)%ENTITY(i)
                   ii=ii+1
                   w(j,ni)=wm1m2(j)+(wm1m2(3+j)-wm1m2(j))*ii/n1
                 ENDDO
               endif!(LINALE(K-2)>0)
               
             ELSE
             
               IF(im*abs(wm1m2(j)) > im*abs(wm1m2(3+j)))THEN
                 ww=wm1m2(j)
               ELSE
                 ww=wm1m2(3+j)
               ENDIF
                              
               IF(linale(k-2)>0)THEN !---NODE LIST IF NUMNOD>0
                 DO i=1,n
                   ni=linale(k+i)
                   IF(ni > 0)THEN              ! test if node is on current domain
                     w(j,ni)=ww
                   ENDIF
                 ENDDO
               ELSE !---GRNOD IF NUMNOD =-1
                 gr_id=linale(k+1)                 
                 DO i=1,igrnod(gr_id)%NENTITY
                   ni=igrnod(gr_id)%ENTITY(i)
                   w(j,ni)=ww   
                 ENDDO
               endif!(LINALE(K-2)>0) 
                               
             endif!(IM ==  0)
           endif!(ID(J) /=  0)
          ENDDO !next J
        ENDDO
C-----------------------------------------------
      RETURN
      END