cfield_imp.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	cfield_imp (icfield, fac, npc, tf, a, v, x, xframe, ms, wfextt, nsensor, sensor_tab, weight, iframe, ib, itask, nrbyac, irbyac, npby, rby, iskn, python)

Function/Subroutine Documentation

cfield_imp()

subroutine cfield_imp	(	integer, dimension(sizfield,*)	icfield,
			fac,
		integer, dimension(*)	npc,
			tf,
			a,
			v,
			x,
			xframe,
			ms,
			wfextt,
		integer, intent(in)	nsensor,
		type (sensor_str_), dimension(nsensor), intent(in)	sensor_tab,
		integer, dimension(*)	weight,
		integer, dimension(liskn,*)	iframe,
		integer, dimension(*)	ib,
		integer	itask,
		integer	nrbyac,
		integer, dimension(*)	irbyac,
		integer, dimension(nnpby,*)	npby,
			rby,
		integer, dimension(liskn,*)	iskn,
		type(python_), intent(inout)	python )

Definition at line 36 of file cfield_imp.F.

C-----------------------------------------------  
C   M o d u l e s
C-----------------------------------------------  
      USE sensor_mod
      USE python_funct_mod
      USE finter_mixed_mod
C-----------------------------------------------
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      "com08_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NSENSOR
      TYPE(PYTHON_), INTENT(INOUT) :: PYTHON
      INTEGER NPC(*)
      INTEGER ICFIELD(SIZFIELD,*),IB(*)
      INTEGER WEIGHT(*),ITASK,NRBYAC,IRBYAC(*),NPBY(NNPBY,*),IFRAME(LISKN,*),ISKN(LISKN,*)
      my_real fac(lfacload,*), tf(*), a(3,*), v(3,*), ms(*),x(3,*), xframe(nxframe,*),wfextt, rby(nrby,*)
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NL, N1, IFRA, N2, IFUNC, K1, K2, K3, ISENS,K,NN, IAD,J, PROC, IADF, IADL,IDIR,IFLAG,N1FRAM,IUN,JJ,IMOVFRAM
      my_real nx, ny, nz, axi, a0, aa, vv, fx, fy, fz, ax,  ts,
     .        gama, ma, vrot, x0, y0, z0, x1, y1, z1, x2, y2, z2, vrotm1
      my_real dist(3),arel(3),vn1fram(3),an1fram(3),dw(3)
      my_real finter 
C-----------------------------------------------
      EXTERNAL finter
      DATA iun/1/
C-----------------------------------------------
C
      DO nl=1,nloadc
      nn=icfield(1,nl)
      idir=icfield(2,nl)
      ifunc=icfield(3,nl)
      iad=icfield(4,nl)
C-------only for Itask=0 first-----
      iadf = iad+itask*nn
      iadl = iad-1+(itask+1)*nn
C
      ifra=icfield(7,nl)
      n1fram = 0
      IF(ifra /= 0) n1fram = iframe(1,ifra)
      imovfram = 0
      IF (n1fram /= 0) THEN
        vn1fram(1) = v(1,n1fram)
        vn1fram(2) = v(2,n1fram)
        vn1fram(3) = v(3,n1fram)
        an1fram(1) = a(1,n1fram)
        an1fram(2) = a(2,n1fram)
        an1fram(3) = a(3,n1fram)
        imovfram = 1
      ELSE
        vn1fram(1) = zero
        vn1fram(2) = zero
        vn1fram(3) = zero
        an1fram(1) = zero
        an1fram(2) = zero
        an1fram(3) = zero
      ENDIF
      iflag=icfield(8,nl)
      IF (ifra == 0) THEN
c If no frame defined rotation /X axis of global reference system 
        x0 = 0
        y0 = 0
        z0 = 0
        x2 = 1
        y2 = 0
        z2 = 0
      ENDIF
C 
      isens=icfield(6,nl)
      IF(isens==0)THEN
          ts=tt
      ELSE
          ts = tt-sensor_tab(isens)%TSTART
          IF(ts<0.0)RETURN
      ENDIF
C
      vrot = fac(1,nl)*finter_mixed(python,nfunct,ifunc,ts*fac(2,nl),npc,tf)
      vrotm1=vrot
      IF (dt2 > zero .AND. iflag == 2) vrotm1 = fac(1,nl)*finter_mixed(python,nfunct,ifunc,(ts-dt2)*fac(2,nl),npc,tf)
      x0 = xframe(10,ifra+1)
      y0 = xframe(11,ifra+1)
      z0 = xframe(12,ifra+1)
      IF(idir == 4) THEN
        x2 = xframe(1,ifra+1)
        y2 = xframe(2,ifra+1)
        z2 = xframe(3,ifra+1)
      ELSEIF(idir == 5) THEN
        x2 = xframe(4,ifra+1)
        y2 = xframe(5,ifra+1)
        z2 = xframe(6,ifra+1)
      ELSEIF(idir == 6) THEN
        x2 = xframe(7,ifra+1)
        y2 = xframe(8,ifra+1)
        z2 = xframe(9,ifra+1)
      ENDIF
C
#include "vectorize.inc"
         DO j=iadf,iadl
           n1=iabs(ib(j))
           x1 = x(1,n1)-x0
           y1 = x(2,n1)-y0
           z1 = x(3,n1)-z0
           dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
           dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
           dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2
           IF (dt2 > 0 .AND. iflag == 2) THEN
             dw(1) = ((vrot-vrotm1)/dt2)*x2
             dw(2) = ((vrot-vrotm1)/dt2)*y2
             dw(3) = ((vrot-vrotm1)/dt2)*z2
             arel(1) = dist(1)*vrot*vrot + dist(2) * dw(3) - dist(3) * dw(2)
             arel(2) = dist(2)*vrot*vrot + dist(3) * dw(1) - dist(1) * dw(3)
             arel(3) = dist(3)*vrot*vrot + dist(1) * dw(2) - dist(2) * dw(1)
           ELSE
             arel(1) = dist(1)*vrot*vrot
             arel(2) = dist(2)*vrot*vrot
             arel(3) = dist(3)*vrot*vrot
           ENDIF
           IF (imovfram == 1)
     .            CALL relfram_m1(x(1,n1)  ,v(1,n1), arel , xframe, vn1fram , an1fram   )
             a(1,n1)=a(1,n1)+arel(1)*ms(n1)
             a(2,n1)=a(2,n1)+arel(2)*ms(n1)
             a(3,n1)=a(3,n1)+arel(3)*ms(n1)
            IF(ib(j)>0)
     .        wfextt=wfextt + half*ms(n1)*x1*x1*(vrot-vrotm1)*(vrot-vrotm1)
         ENDDO
C
      ENDDO
C
      RETURN