rbyvit.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	rbyvit (rby, x, v, vr, skew, fsav, lpby, npby, iskew, itab, weight, a, ar, ms, in, kind, irbkin_l, nrbykin_l, nodreac, fthreac, freac, nhier_rby)

Function/Subroutine Documentation

rbyvit()

subroutine rbyvit	(		rby,
			x,
			v,
			vr,
			skew,
			fsav,
		integer, dimension(*)	lpby,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	iskew,
		integer, dimension(*)	itab,
		integer, dimension(*)	weight,
			a,
			ar,
			ms,
			in,
		integer, dimension(nrbykin)	kind,
		integer, dimension(*)	irbkin_l,
		integer	nrbykin_l,
		integer, dimension(*)	nodreac,
			fthreac,
			freac,
		integer, intent(in)	nhier_rby )

Definition at line 33 of file rbyvit.F.

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(*)
      INTEGER, INTENT(IN) :: NHIER_RBY
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,IM
      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
!      
      IF (nhier_rby ==0) THEN
C-------------------------------------
C COMPUTATION FOR SUPER RIGID BODIES (non multi-thread) on first free task
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 of global variables done in 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 FORCE COMPUTATION FOR CLASSICAL RIGID BODIES (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 of global variables done in 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
      ELSE ! hierarchy level>0
!$OMP SINGLE
        DO n=nrbykin,1,-1
          k  = kind(n)
          im  =npby(1,n)
          IF(npby(7,n)>0 .AND. im>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)
! 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     )
!
            IF(nrbfail /= 0 .AND. nspmd > 1) crit(n)= rby(30,n)
!
          ENDIF
        ENDDO
!$OMP END SINGLE
      END IF !(NHIER_RBY ==0) THEN
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