forcefingeo.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	forcefingeo (ibfv, npc, tf, a, v, x, vel, sensor_tab, fsky, fext, itabm1, h3d_data, nsensor, python, wfext, nodes)

Function/Subroutine Documentation

forcefingeo()

subroutine forcefingeo	(	integer, dimension(nifv,*)	ibfv,
		integer, dimension(*)	npc,
			tf,
			a,
			v,
			x,
			vel,
		type (sensor_str_), dimension(nsensor)	sensor_tab,
			fsky,
			fext,
		integer, dimension(*)	itabm1,
		type(h3d_database)	h3d_data,
		integer, intent(in)	nsensor,
		type(python_), intent(inout)	python,
		double precision, intent(inout)	wfext,
		type(nodal_arrays_)	nodes )

Definition at line 37 of file forcefingeo.F.

C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE nodal_arrays_mod
      USE python_funct_mod
      use python_call_funct_cload_mod
      USE h3d_mod 
      USE sensor_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "param_c.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      "impl1_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "parit_c.inc"
C-----------------------------------------------
C   E x t e r n a l  F u n c t i o n s
C-----------------------------------------------
      my_real finter,finter_smooth
      EXTERNAL finter,finter_smooth
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(NODAL_ARRAYS_) :: NODES
      TYPE(PYTHON_), INTENT(inout) :: PYTHON
      INTEGER ,INTENT(IN) :: NSENSOR
      INTEGER IBFV(NIFV,*), NPC(*)
      INTEGER ITABM1(*)
      my_real tf(*), a(3,*), v(3,*), x(3,*),
     .   vel(lfxvelr,*),fsky(8,lsky),fext(3,*)
      TYPE(H3D_DATABASE) :: H3D_DATA
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
      DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, N1, N2, K
      INTEGER NCUR, NCUR_OLD, ISENS, ISMOOTH
      my_real
     .   axi, aa, a0, vv, dydx, ts, ts_old,
     .   startt, stopt, facx, facy, f1, f2,
     .   xa, ya, za, xf, yf, zf,
     .   fac, skew1, skew2, skew3, wfextt
C=======================================================================
      wfextt = zero
      ts_old = zero
      ncur_old = 0
C----------------------------------
C     CONCENTRATED FORCE
C----------------------------------
      DO n=1,nfxvel
        IF (ibfv(13,n) /= 2) cycle
        ncur = ibfv(15,n)
        IF (ncur == 0) cycle
        startt = vel(2,n)
        stopt  = vel(3,n)
        IF(tt<startt) cycle
        IF(tt>stopt ) cycle
        n1 = iabs(ibfv(1,n))
        n2 = ibfv(14,n)
c        N2 = SYSFUS2(N2,ITABM1,NUMNOD)
        facx = vel(5,n)
        facy = vel(8,n)
C
        isens=0
        DO k=1,nsensor
          IF(ibfv(4,n)==sensor_tab(k)%SENS_ID) isens=k
        ENDDO
        IF(isens==0)THEN
           ts=tt
        ELSE
           ts = tt-sensor_tab(isens)%TSTART
           IF(ts < zero) cycle
        ENDIF
C
        IF(ncur_old/=ncur.OR.ts_old/=ts) THEN
!!          F1 = FINTER(NCUR,(TS-DT1)*FACX,NPC,TF,DYDX)
!!          F2 = FINTER(NCUR,TS*FACX,NPC,TF,DYDX)
          ismooth = 0
          IF (ncur > 0) ismooth = npc(2*nfunct+ncur+1)
          IF (ismooth == 0) THEN
            f1 = finter(ncur,(ts-dt1)*facx,npc,tf,dydx)
            f2 = finter(ncur,ts*facx,npc,tf,dydx)
          ELSE IF(ismooth > 0) THEN
            f1 = finter_smooth(ncur,(ts-dt1)*facx,npc,tf,dydx)
            f2 = finter_smooth(ncur,ts*facx,npc,tf,dydx)
          ELSE IF(ismooth < 0) THEN
            CALL python_call_funct_cload(python, -ismooth,ts-dt1, f1,n1,nodes)
            CALL python_call_funct_cload(python, -ismooth,ts, f2,n2,nodes)
          ENDIF ! IF (ISMOOTH == 0)
          ncur_old = ncur
          ts_old = ts
        ENDIF
C
        a0 = facy*f1
        aa = facy*f2
C
        IF(n2d/=1)THEN
         axi=one
        ELSE
         axi=x(2,n2)
        ENDIF
C
        xa = x(1,n1)
        ya = x(2,n1)
        za = x(3,n1)
        xf = x(1,n2)
        yf = x(2,n2)
        zf = x(3,n2)
        fac= sqrt((xf-xa)**2+(yf-ya)**2+(zf-za)**2)
        IF(fac < vel(7,n)) cycle
        skew1= (xf-xa)/fac
        skew2= (yf-ya)/fac
        skew3= (zf-za)/fac
        vv = skew1*v(1,n2)+skew2*v(2,n2)+skew3*v(3,n2)
        a(1,n2) = a(1,n2)+skew1*aa
        a(2,n2) = a(2,n2)+skew2*aa
        a(3,n2) = a(3,n2)+skew3*aa
C
        IF( anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT+
     .      anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT > 0 
     .           .AND.impl_s==0) THEN
          fext(1,n2) = fext(1,n2)+skew1*aa
          fext(2,n2) = fext(2,n2)+skew2*aa
          fext(3,n2) = fext(3,n2)+skew3*aa
        ENDIF
        wfextt = wfextt + dt1*half*(a0+aa)*vv*axi
      ENDDO
C
!$OMP ATOMIC
      wfext = wfext + wfextt
C
      RETURN