alelin.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	alelin (nalelk, linale, w, weight, igrnod)

Function/Subroutine Documentation

alelin()

subroutine alelin	(	integer, intent(in)	nalelk,
		integer, dimension(*), intent(in)	linale,
		dimension(3,numnod), intent(inout)	w,
		integer, dimension(*), intent(in)	weight,
		type (group_), dimension(ngrnod)	igrnod )

Definition at line 33 of file alelin.F.

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