rbycor.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "com04_c.inc"
#include "scr11_c.inc"
#include "param_c.inc"
#include "impl1_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	rbycor (rby, x, v, vr, skew, fsav, lpby, npby, iskew, itab, weight, a, ar, ms, in, kind, irbkin_l, nrbykin_l, weight_md, ms_2d)

Function/Subroutine Documentation

rbycor()

subroutine rbycor	(		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(*)	weight_md,
			ms_2d )

Definition at line 32 of file rbycor.F.

C-----------------------------------------------
      USE imp_dyna
C----6---------------------------------------------------------------7---------8
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "scr11_c.inc"
#include      "param_c.inc"
#include      "impl1_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,WEIGHT_MD(*)
C     REAL
      my_real
     .   rby(nrby,*) ,x(3,*) ,v(3,*) ,vr(3,*),skew(*),
     .   fsav(nthvki,*) ,a(3,*),ar(3,*),in(*),ms(*) ,ms_2d(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  J,K,N,KK
C     REAL
      my_real
     .   enrot_t,encin_t,xmass_t,
     .   xmomt_t,ymomt_t,zmomt_t,encin2_t,enrot2_t
C-----------------------------------------------
C-------------------------------------
C CALCUL SUPER RIGID BODIES (non multi-thread) sur premiere tache libre
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
          IF( idyna>0 ) THEN
            CALL rgbcor(
     1        dy_v,dy_vr,x,rby(1,n),lpby(k),
     2        npby(1,n),skew,iskew,fsav(1,j),itab,
     3        weight,dy_a,dy_ar,ms,in,enrot,encin,xmass,
     4        xmomt,ymomt,zmomt,npby(4,n),weight_md,encin2,enrot2,
     5        ms_2d)
          ELSE
            CALL rgbcor(
     1        v,vr,x,rby(1,n),lpby(k),
     2        npby(1,n),skew,iskew,fsav(1,j),itab,
     3        weight,a,ar,ms,in,enrot,encin,xmass,
     4        xmomt,ymomt,zmomt,npby(4,n),weight_md,encin2,enrot2,
     5        ms_2d)
          ENDIF
        ENDIF
      ENDDO
!$OMP END SINGLE
C-------------------------------------
C CALCUL FORCE RIGID BODIES CLASSIQUES (multi-thread)
C-------------------------------------
C
C   optimisation locks
      enrot_t=zero
      encin_t=zero
      xmass_t=zero
      xmomt_t=zero
      ymomt_t=zero
      zmomt_t=zero
      enrot2_t=zero
      encin2_t=zero         
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
          IF( idyna>0 ) THEN
            CALL rgbcor(
     1        dy_v,dy_vr,x,rby(1,n),lpby(k),
     2        npby(1,n),skew,iskew,fsav(1,j),itab,
     3        weight,dy_a,dy_ar,ms,in,enrot_t,encin_t,xmass_t,
     4        xmomt_t,ymomt_t,zmomt_t,npby(4,n),weight_md,encin2_t,
     5        enrot2_t,ms_2d)
          ELSE
            CALL rgbcor(
     1        v,vr,x,rby(1,n),lpby(k),
     2        npby(1,n),skew,iskew,fsav(1,j),itab,
     3        weight,a,ar,ms,in,enrot_t,encin_t,xmass_t,
     4        xmomt_t,ymomt_t,zmomt_t,npby(4,n),weight_md,encin2_t,
     5        enrot2_t,ms_2d)
          ENDIF
        ENDIF
      ENDDO
!$OMP END DO NOWAIT
C
#include "lockon.inc"
      enrot=enrot + enrot_t
      encin=encin + encin_t    
      xmass=xmass + xmass_t
      xmomt=xmomt + xmomt_t
      ymomt=ymomt + ymomt_t
      zmomt=zmomt + zmomt_t
      encin2=encin2 + encin2_t
      enrot2=enrot2 + enrot2_t              
#include "lockoff.inc"
C
      RETURN