r2r_getdata.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "scr05_c.inc"
#include "task_c.inc"
#include "rad2r_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	r2r_getdata (iexlnk, igrnod, x, v, vr, a, ar, ms, in, xdp, dx, r2r_on, dd_r2r, weight, iad_elem, fr_elem, stifn, stifr, dd_r2r_elem, sdd_r2r_elem, nloc_dmg, wfext, wfext_md)
subroutine	get_force_spmd (idp, nng, grnod, wf, wm, wf2, wm2, v, vr, a, ar, ms, in, dd_r2r, nglob, weight, iad_elem, fr_elem, nb, iex, typ, flag_rot, nbd)
subroutine	get_displ_spmd (idp, nng, grnod, x, dd_r2r, nglob, weight, iad_elem, fr_elem, iex)
subroutine	r2r_sendkine (iexlnk, igrnod, ms, in)

Function/Subroutine Documentation

get_displ_spmd()

subroutine get_displ_spmd	(	integer	idp,
		integer	nng,
		integer, dimension(*)	grnod,
			x,
		integer, dimension(*)	dd_r2r,
		integer	nglob,
		integer, dimension(*)	weight,
		integer, dimension(2,*)	iad_elem,
		integer, dimension(*)	fr_elem,
		integer	iex )

Definition at line 291 of file r2r_getdata.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      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IDP, NNG, NGLOB,IEX,GRNOD(*),
     .          WEIGHT(*), DD_R2R(*), IAD_ELEM(2,*), FR_ELEM(*)
C     REAL
        my_real
     .          x(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER LRBUF
        my_real
     .          bufr1(3,nglob)
C
C******************************************************************************C
        IF(ispmd==0)
     .    CALL get_displ_spmd_c(idp,nglob,bufr1)
        lrbuf = 2*4*iad_elem(1,nspmd+1)-iad_elem(1,1)+2*nspmd
        CALL spmd_r2r_rset3(x    ,nng     ,grnod,dd_r2r,weight,
     .                     bufr1,iad_elem,fr_elem,lrbuf,iex)
 
C-----------------------------------------------------------------
        RETURN

get_force_spmd()

subroutine get_force_spmd	(	integer	idp,
		integer	nng,
		integer, dimension(*)	grnod,
			wf,
			wm,
			wf2,
			wm2,
			v,
			vr,
			a,
			ar,
			ms,
			in,
		integer, dimension(*)	dd_r2r,
		integer	nglob,
		integer, dimension(*)	weight,
		integer, dimension(2,*)	iad_elem,
		integer, dimension(*)	fr_elem,
		integer	nb,
		integer	iex,
		integer	typ,
		integer	flag_rot,
		integer	nbd )

Definition at line 212 of file r2r_getdata.F.

C----6------------------------------------------
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      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IDP, NNG, NGLOB, GRNOD(*),IEX,NB,TYP,FLAG_ROT,
     .          WEIGHT(*), DD_R2R(*), IAD_ELEM(2,*), FR_ELEM(*),NBD
C     REAL
        my_real
     .          v(3,*),vr(3,*),a(3,*),ar(3,*),ms(*),in(*),
     .          wf, wm, wf2, wm2
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER LRBUF,i
        my_real
     .          bufr1(3,nglob),bufr2(3,nglob),
     .          bufr3(3,nglob),bufr4(3,nglob),wtmp(4)
        INTEGER POP0,POP1,RATE
        my_real
     .     pop2,pop3,secs
C
C******************************************************************************C
 
        IF(ispmd==0) THEN
          CALL get_force_spmd_c(idp,nbd,bufr1,bufr2,bufr3,bufr4,typ,iex,nglob)
        ENDIF
        lrbuf = 2*4*(iad_elem(1,nspmd+1)-iad_elem(1,1))+2*nspmd
 
        IF (typ/=7) THEN
          IF(flag_rot /= 0)THEN
            IF(typ<4)THEN
              CALL spmd_r2r_rset3(vr  ,nng     ,grnod,dd_r2r,weight,
     .                              bufr4,iad_elem,fr_elem,lrbuf,iex)
            ENDIF
            CALL spmd_r2r_rset3b(ar  ,nng     ,grnod,dd_r2r,weight,
     .                      bufr2,iad_elem,fr_elem,lrbuf, in, vr, wm, wm2,iex)
          END IF
 
          CALL spmd_r2r_rset3b(a   ,nng     ,grnod,dd_r2r,weight,
     .                    bufr1,iad_elem,fr_elem,lrbuf, ms, v,  wf, wf2,iex)
          IF(typ<4)THEN
            CALL spmd_r2r_rset3(v    ,nng     ,grnod,dd_r2r,weight,
     .                          bufr3,iad_elem,fr_elem,lrbuf,iex)
          ENDIF
 
          wtmp(1) = wf
          wtmp(2) = wf2
          wtmp(3) = wm
          wtmp(4) = wm2
          wf  = wtmp(1)
          wf2 = wtmp(2)
          wm  = wtmp(3)
          wm2 = wtmp(4)
        ENDIF
C-----------------------------------------------------------------
        RETURN

r2r_getdata()

subroutine r2r_getdata	(	integer, dimension(nr2r,nr2rlnk)	iexlnk,
		type (group_), dimension(ngrnod), target	igrnod,
			x,
			v,
			vr,
			a,
			ar,
			ms,
			in,
		double precision, dimension(3,*)	xdp,
			dx,
		integer	r2r_on,
		integer, dimension(nspmd+1,*)	dd_r2r,
		integer, dimension(*)	weight,
		integer, dimension(2,*)	iad_elem,
		integer, dimension(*)	fr_elem,
			stifn,
			stifr,
		integer, dimension(*)	dd_r2r_elem,
		integer	sdd_r2r_elem,
		type(nlocal_str_), intent(in), target	nloc_dmg,
		double precision, intent(inout)	wfext,
		double precision, intent(inout)	wfext_md )

Parameters

[in,out]

wfext_md

specific to r2r method

Definition at line 41 of file r2r_getdata.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE rad2r_mod
        USE groupdef_mod
        USE nlocal_reg_mod
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      "com06_c.inc"
#include      "com08_c.inc"
#include      "param_c.inc"
#include      "scr05_c.inc"
#include      "task_c.inc"
#include      "rad2r_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER R2R_ON
        INTEGER IEXLNK(NR2R,NR2RLNK),
     .          WEIGHT(*), DD_R2R(NSPMD+1,*), IAD_ELEM(2,*), FR_ELEM(*),
     .          DD_R2R_ELEM(*),SDD_R2R_ELEM
        my_real x(3,*),v(3,*),vr(3,*),a(3,*),ar(3,*),ms(*),in(*),stifn(*),stifr(*),dx(3,*)
 
        DOUBLE PRECISION XDP(3,*)
        TYPE (GROUP_)  , TARGET, DIMENSION(NGRNOD)  :: IGRNOD
        TYPE(NLOCAL_STR_), TARGET, INTENT(IN)  :: NLOC_DMG
        DOUBLE PRECISION, INTENT(INOUT) :: WFEXT
        DOUBLE PRECISION, INTENT(INOUT) :: WFEXT_MD !< specific to r2r method
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I, IEX, IDP, IDG, NNG, NB,NGLOB,LENR,SIZE,BID
        INTEGER NBD,NL_FLAG,SBUF_SIZE,RBUF_SIZE,PSP
        my_real wf, wm, wf2, wm2, wfb, wmb, wf2b, wm2b,ann,vnn,arn,vrn
        INTEGER, DIMENSION(:), POINTER :: GRNOD
        my_real, POINTER, DIMENSION(:) :: msnl,fnl
C=======================================================================
        wf = zero
        wm = zero
        wf2= zero
        wm2= zero
        nl_flag = 0
 
        IF ((r2r_siu==1).OR.(nspmd==1)) THEN
C-----------------------------------------------------------------------
          DO iex = 1, nr2rlnk
            idg  = iexlnk(1,iex)
            idp  = iexlnk(2,iex)
            nng  = igrnod(idg)%NENTITY
            grnod => igrnod(idg)%ENTITY
 
            IF (nllnk(iex)==1) THEN
C-------Non local coupling interface--------------------------
              nl_flag = 1
              msnl  => nloc_dmg%MASS(1:nloc_dmg%L_NLOC)
              fnl  => nloc_dmg%FNL(1:nloc_dmg%L_NLOC,1)
              CALL get_force_nl_c(idp    ,nbdof_nl(iex)  ,iadd_nl  ,fnl ,msnl ,
     .                            iex)
            ELSE
              CALL get_force_c(idp    ,nng    ,grnod  ,wf     ,wm      ,
     .                         wf2    ,wm2    ,v      ,vr     ,a      ,ar      ,
     .                         ms     ,in     ,x      ,xdp    ,dx     ,typlnk(iex),
     .                         kinlnk(iex),weight  ,iex    ,iresp, wfext)
            ENDIF
C
            IF (r2r_on == 1)  THEN
              CALL get_displ_c(idp,nng,grnod,x)
            ENDIF
          END DO
 
C----------New rad2rad HMPP - synchro SPMD-----------------------------
          IF (nspmd>1) THEN
            IF (sdd_r2r_elem>0) THEN
              IF (nl_flag == 0) THEN
                SIZE =  3+flag_kine + iroddl*(3+flag_kine)
                lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
                CALL spmd_exch_r2r_2(a ,ar,v , vr  ,ms   ,in,
     2                               iad_elem,fr_elem,SIZE , wf, wf2,
     3                               lenr    ,dd_r2r,dd_r2r_elem,weight,flag_kine)
              ELSE
                SIZE =  3+flag_kine + iroddl*(3+flag_kine)
                lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
                sbuf_size = size*lenr + dd_r2r_nl(1)
                rbuf_size = size*lenr + dd_r2r_nl(2)
                CALL spmd_exch_r2r_nl(a ,ar,v , vr  ,ms   ,
     2                                in,iad_elem,fr_elem,SIZE ,
     3                                sbuf_size,rbuf_size,wf, wf2,dd_r2r,
     4                                dd_r2r_elem,weight,flag_kine,nloc_dmg)
              ENDIF
            ENDIF
            CALL spmd_exch_work(wf, wf2)
            CALL spmd_exch_work(wm, wm2)
          END IF
C
        ELSE
C
          DO iex = 1, nr2rlnk
            idg  = iexlnk(1,iex)
            idp  = iexlnk(2,iex)
            nng  = igrnod(idg)%NENTITY
            grnod => igrnod(idg)%ENTITY
C-
            wfb = zero
            wmb = zero
            wf2b= zero
            wm2b= zero
C-
            IF (ispmd==0) THEN
              nglob=dd_r2r(nspmd+1,iex)+dbno(iex)
              nb = dbno(iex)
            ELSE
              nglob=nng
              nb = 0
            ENDIF
C-
            nb = dbno(iex)
            nbd = dd_r2r(nspmd+1,iex)
 
            CALL get_force_spmd(
     1        idp     ,nng      ,grnod,wfb,wmb                   ,
     2        wf2b    ,wm2b     ,v            ,vr,a                    ,
     3        ar     ,ms      ,in,dd_r2r(1,iex),nglob,
     4        weight ,iad_elem,fr_elem,nb,iex,typlnk(iex),rotlnk(iex),nbd)
C-
            wf = wf + wfb
            wm = wm + wmb
            wf2 = wf2 + wf2b
            wm2 = wm2 + wm2b
            IF (r2r_on == 1)  THEN
              CALL get_displ_spmd(
     1          idp,nng              ,grnod,x       ,dd_r2r(1,iex),
     2          nglob,weight       ,iad_elem,fr_elem,iex)
C-
            ENDIF
          END DO
C
        END IF
 
C----- Count the work of external process forces
        IF(ispmd==0) THEN
          wfext_md = wfext_md + r2rfx1 + (wf + wm) * dt1
          r2rfx1 = wf  + wm
          r2rfx2 = wf2 + wm2
        END IF
C
C-----------------------------------------------------------------
        RETURN

r2r_sendkine()

subroutine r2r_sendkine	(	integer, dimension(nr2r,nr2rlnk)	iexlnk,
		type (group_), dimension(ngrnod), target	igrnod,
			ms,
			in )

Definition at line 339 of file r2r_getdata.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE rad2r_mod
        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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "rad2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IEXLNK(NR2R,NR2RLNK)
        my_real ms(*),in(*)
!
        TYPE (GROUP_)  , TARGET, DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I, IEX, IDP, IDG, NNG, OFF
C
        INTEGER, DIMENSION(:), POINTER :: GRNOD
C=======================================================================
 
        flag_kine = 0
        off = 0
 
        IF (r2r_siu==1) THEN
C----------Send of new mass---------------------------------------
          DO iex = 1, nr2rlnk
            idp  = iexlnk(2,iex)
            idg  = iexlnk(1,iex)
            nng  = igrnod(idg)%NENTITY
            grnod => igrnod(idg)%ENTITY
            IF ((typlnk(iex)==5).AND.(kinlnk(iex)==1)) THEN
              flag_kine = 1
              CALL send_mass_kine_c(idp,nng,grnod,ms,in,iex,off)
            ENDIF
            off = off + nng
          END DO
        ENDIF
 
C-----------------------------------------------------------------
        RETURN