rlink0.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	rlink0 (v, vr, ms, in, nlik, idir, idrot, nod, nsn, ic, icr, iskw, isk, skew, iskwn, fr_rl, weight)

Function/Subroutine Documentation

rlink0()

subroutine rlink0	(		v,
			vr,
			ms,
			in,
		integer	nlik,
		integer	idir,
		integer	idrot,
		integer, dimension(*)	nod,
		integer	nsn,
		integer	ic,
		integer	icr,
		integer	iskw,
		integer	isk,
			skew,
		integer, dimension(liskn,*)	iskwn,
		integer, dimension(*)	fr_rl,
		integer, dimension(*)	weight )

Definition at line 31 of file rlink0.F.

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      "task_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NLIK, IDIR, IDROT, NSN, IC, ICR, ISKW, ISK
      INTEGER NOD(*), ISKWN(LISKN,*), FR_RL(*), WEIGHT(*)
C     REAL
      my_real
     .   v(3,*), vr(3,*), ms(*), in(*), skew(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IC1, ICC, IC2, IC3, N, K
C     REAL
      my_real
     .   mass, iner, vx, vy, vz, dvx, dvy, dvz, vvx, vvy, vvz,
     .   f1(nsn), f2(nsn), f3(nsn), f4(nsn)
      DOUBLE PRECISION FRL6(4,6)
C-----------------------------------------------
C
      idir=ic
      idrot=icr
      nlik =nsn
      DO 10 i=0,numskw
      IF(isk/=iskwn(4,i+1))GOTO 10
       iskw=i+1
       GOTO 20
  10  CONTINUE
C
  20  CONTINUE
C
      IF(ic==0)GOTO 150
      ic1=ic/4
      icc=ic-4*ic1
      ic2=icc/2
      ic3=icc-2*ic2
C
      vx  =zero
      vy  =zero
      vz  =zero
      mass=zero
C
      DO i=1,nsn
        n = nod(i)
        IF(weight(n)==1) THEN
          f1(i)=ms(n)
          f2(i)=ms(n)*v(1,n)
          f3(i)=ms(n)*v(2,n)
          f4(i)=ms(n)*v(3,n)
        ELSE
          f1(i)=zero
          f2(i)=zero
          f3(i)=zero
          f4(i)=zero
        ENDIF
      ENDDO
C
C Traitement Parith/ON avant echange
C
      DO k = 1, 6
       frl6(1,k) = zero
       frl6(2,k) = zero
       frl6(3,k) = zero
       frl6(4,k) = zero
      END DO
      CALL sum_6_float(1  ,nsn  ,f1, frl6(1,1), 4)
      CALL sum_6_float(1  ,nsn  ,f2, frl6(2,1), 4)
      CALL sum_6_float(1  ,nsn  ,f3, frl6(3,1), 4)
      CALL sum_6_float(1  ,nsn  ,f4, frl6(4,1), 4)
      IF(nspmd>1) THEN
        IF(fr_rl(ispmd+1)/=0) THEN
          CALL spmd_exch_fr6(fr_rl,frl6,4*6)
        END IF
      END IF
      mass = frl6(1,1)+frl6(1,2)+frl6(1,3)+
     +       frl6(1,4)+frl6(1,5)+frl6(1,6)
      vx = frl6(2,1)+frl6(2,2)+frl6(2,3)+
     +     frl6(2,4)+frl6(2,5)+frl6(2,6)
      vy = frl6(3,1)+frl6(3,2)+frl6(3,3)+
     +     frl6(3,4)+frl6(3,5)+frl6(3,6)
      vz = frl6(4,1)+frl6(4,2)+frl6(4,3)+
     +     frl6(4,4)+frl6(4,5)+frl6(4,6)
 
      IF(mass /= zero) THEN
        vx=vx/mass
        vy=vy/mass
        vz=vz/mass
      ENDIF
C
      DO i=1,nsn
        n = nod(i)
        dvx  =v(1,n)-vx
        dvy  =v(2,n)-vy
        dvz  =v(3,n)-vz
        vvx  =ic1*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
        vvy  =ic2*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
        vvz  =ic3*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
        v(1,n) =v(1,n)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
        v(2,n) =v(2,n)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
        v(3,n) =v(3,n)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
      ENDDO
C
  150 IF(icr==0)RETURN
      ic1=icr/4
      icc=icr-4*ic1
      ic2=icc/2
      ic3=icc-2*ic2
C
      vx  =zero
      vy  =zero
      vz  =zero
      iner=zero
C
      DO i=1,nsn
        n = nod(i)
        IF(weight(n)==1) THEN
          f1(i)=in(n)
          f2(i)=in(n)*vr(1,n)
          f3(i)=in(n)*vr(2,n)
          f4(i)=in(n)*vr(3,n)
        ELSE
          f1(i)=zero
          f2(i)=zero
          f3(i)=zero
          f4(i)=zero
        ENDIF
      ENDDO
C
C Traitement Parith/ON avant echange
C
      DO k = 1, 6
        frl6(1,k) = zero
        frl6(2,k) = zero
        frl6(3,k) = zero
        frl6(4,k) = zero
      END DO
      CALL sum_6_float(1  ,nsn  ,f1, frl6(1,1), 4)
      CALL sum_6_float(1  ,nsn  ,f2, frl6(2,1), 4)
      CALL sum_6_float(1  ,nsn  ,f3, frl6(3,1), 4)
      CALL sum_6_float(1  ,nsn  ,f4, frl6(4,1), 4)
      IF(nspmd>1) THEN
        IF(fr_rl(ispmd+1)/=0) THEN
          CALL spmd_exch_fr6(fr_rl,frl6,4*6)
        END IF
      END IF
      iner = frl6(1,1)+frl6(1,2)+frl6(1,3)+
     +       frl6(1,4)+frl6(1,5)+frl6(1,6)
      vx = frl6(2,1)+frl6(2,2)+frl6(2,3)+
     +     frl6(2,4)+frl6(2,5)+frl6(2,6)
      vy = frl6(3,1)+frl6(3,2)+frl6(3,3)+
     +     frl6(3,4)+frl6(3,5)+frl6(3,6)
      vz = frl6(4,1)+frl6(4,2)+frl6(4,3)+
     +     frl6(4,4)+frl6(4,5)+frl6(4,6)
C
      IF(iner==zero)RETURN
C
      vx=vx/iner
      vy=vy/iner
      vz=vz/iner
C
      DO i=1,nsn
        n = nod(i)
        dvx  =vr(1,n)-vx
        dvy  =vr(2,n)-vy
        dvz  =vr(3,n)-vz
        vvx  =ic1*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
        vvy  =ic2*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
        vvz  =ic3*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
        vr(1,n) =vr(1,n)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
        vr(2,n) =vr(2,n)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
        vr(3,n) =vr(3,n)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
      ENDDO
C
      RETURN