FORTRAN example for GET_FFLEX

FORTRAN example for GET_FFLEX_NODEPOS

C---- SUB. NODAL_FORCE_EXT

SUBROUTINE NODAL_FORCE_EXT

& (ID,TIME,UPAR,NPAR,IFBODY,NODARR,NONDE,JFLAG,IFLAG,RESULT)

C---- TO EXPORT * SUBROUTINE

!DEC$ ATTRIBUTES DLLEXPORT,C::NODAL_FORCE_EXT

C---- INCLUDE SYSTEM CALL

INCLUDE 'SYSCAL.F'

C---- DEFINE VARIABLES

C Parameter Information

C id: Nodal sequential identification

C time: Simulation time of RD/Solver

C upar: Parameters defined by user

C npar: Number of user parameters

C ifbody : FFlex body seq. ID

C nodarr: Node Seq. ID array of input node set

C nonde : Number of node of node set

C jflag: When RD/Solver evaluates a Jacobian, the flag is true.

C iflag: When RD/Solver initializes arrays, the flag is true.

C result: Returned values[6]

DOUBLE PRECISION TIME, UPAR(*)

INTEGER ID, NPAR,NONDE,NODARR(*), IFBODY

LOGICAL JFLAG, IFLAG

DOUBLE PRECISION RESULT[REFERENCE](6*nonde)

c local variable

integer NODEID, ActionMarker, BaseMarker

double precision TK, TC, RK, RC

integer ifTXActive, ifTYActive, ifTZActive

integer ifRXActive, ifRYActive, ifRZActive

integer iFinish, i, j, MKID(2), errflg, nmk

double precision CurrentTimePos(12)

double precision CURRENTTIMEVEL(6)

double precision CURRENTTIMEACC(6)

double precision dji(3), vji(3), wji(3), thetaij(3), ATA(9)

double precision CheckA(9), fp(6), dtmp(3)

double precision, STATIC :: InitTimePos(100*3)

double precision, STATIC :: InitTimeOri(100*9)

double precision, STATIC :: InitTimeVel(100*3)

double precision, STATIC :: InitTimeAngVel(100*3)

double precision, STATIC :: InitTimeAcc(100*3)

double precision, STATIC :: InitTimeAngAcc(100*3)

if(nonde .gt. 100) then

call errmes(1000,'Node set limit error',id,

& 'Nodal_Force_Ext')

endif

if(IFLAG .eq. .true.) then

endif

NODEID = upar(1)

ACTIONMARKER = upar(2)

BASEMARKER = upar(3)

TK = upar(4)

TC = upar(5)

RK = upar(6)

RC = upar(7)

call getfinishflag(iFinish)

if(npar.lt.13) then ! Default setting

! For trnanslation x direction, 0: Free, 1: Gen. a bushing force

ifTXActive = 1

! For trnanslation y direction, 0: Free, 1: Gen. a bushing force

ifTYActive = 1

! For trnanslation z direction, 0: Free, 1: Gen. a bushing force

ifTZActive = 1

! For rotational x direction, 0: Free, 1: Gen. a bushing force

ifRXActive = 1

! For rotational y direction, 0: Free, 1: Gen. a bushing force

ifRYActive = 1

! For rotational z direction, 0: Free, 1: Gen. a bushing force

ifRZActive = 0

else

ifTXActive = upar(7)

ifTYActive = upar(8)

ifTZActive = upar(9)

ifRXActive = upar(10)

ifRYActive = upar(11)

ifRZActive = upar(12)

endif

MKID(1)=0 ! Base marker : Ground.Inertia

MKID(2)=0 ! Reference marker : Ground.Inertia

nmk = 0

if(iflag .eq. .false. .and.

& jflag .eq. .false. .and. time .eq. 0.0d0) then

do i=1, nonde

call GET_FFLEX_NODETPOS(ifbody,nodarr(i),MKID,

& nmk,InitTimePos((i-1)*3+1),errflg)

call GET_FFLEX_NODERPOS(ifbody,nodarr(i),nmk,

& InitTimeOri((i-1)*9+1),errflg)

call GET_FFLEX_NODETVEL(ifbody,nodarr(i),MKID,nmk,

& InitTimeVel((i-1)*3+1),errflg)

call GET_FFLEX_NODERVEL(ifbody,nodarr(i),MKID,nmk,

& InitTimeAngVel((i-1)*3+1),errflg)

call GET_FFLEX_NODETACC(ifbody,nodarr(i),MKID,nmk,

& InitTimeAcc((i-1)*3+1),errflg)

call GET_FFLEX_NODERACC(ifbody,nodarr(i),MKID,nmk,

& InitTimeAngAcc((i-1)*3+1),errflg)

enddo

endif

do i=1, nonde

call get_fflex_nodepos(ifbody,nodarr(i),MKID, nmk,

& CurrentTimePos,errflg)

call get_fflex_nodevel(ifbody,nodarr(i),MKID, nmk,

& CurrentTimeVel,errflg)

call get_fflex_nodeacc(ifbody,nodarr(i),MKID, nmk,

& CurrentTimeAcc,errflg)

do j=1, 3

dji(j)=CurrentTimePos(j)-InitTimePos((i-1)*3+j)

vji(j)=CurrentTimeVel(j)-InitTimeVel((i-1)*3+j)

wji(j)=CurrentTimeVel(j+3)-InitTimeAngVel((i-1)*3+j)

enddo

call matatb(AtA,CurrentTimePos(4),InitTimeOri((i-1)*9+1))

call eulerangle(123,AtA(1),Thetaij(1),errflg)

call orientationmatrix(123,Thetaij(1),CheckA(1),errflg)

do j=1, 3

fp(j)=-dji(j)*TK-vji(j)*TC;

dtmp(j)=Thetaij(j)*RK;

enddo

call asp(fp(4),CurrentTimePos(4),dtmp); ! Force vector w.r.t global

do j=1, 3

fp(j+3)=fp(j+3)-wji(j)*RC;

enddo

if(ifTXActive.eq.0) then

result((i-1)*6+1)=0.0;

else

result((i-1)*6+1)=fp(1);

endif

if(ifTYActive.eq.0) then

result((i-1)*6+2)=0.0;

else

result((i-1)*6+2)=fp(2);

endif

if(ifTZActive.eq.0) then

result((i-1)*6+3)=0.0;

else

result((i-1)*6+3)=fp(3);

endif

if(ifRXActive.eq.0) then

result((i-1)*6+4)=0.0;

else

result((i-1)*6+4)=fp(4);

endif

if(ifRYActive.eq.0) then

result((i-1)*6+5)=0.0;

else

result((i-1)*6+5)=fp(5);

endif

if(ifRZActive.eq.0) then

result((i-1)*6+6)=0.0;

else

result((i-1)*6+6)=fp(6);

endif

enddo

if(iFinish.eq.1) then

endif

RETURN

END

subroutine asp(result_s, A, sp)

double precision result_s(3),A(9),sp(3)

result_s(1)=A(1)*sp(1)+A(4)*sp(2)+A(7)*sp(3)

result_s(2)=A(2)*sp(1)+A(5)*sp(2)+A(8)*sp(3)

result_s(3)=A(3)*sp(1)+A(6)*sp(2)+A(9)*sp(3)

return

end

subroutine matatb(result_c, a, b)

double precision result_c(9),a(9),b(9)

result_c(1)=a(1)*b(1)+a(2)*b(2)+a(3)*b(3)

result_c(2)=a(4)*b(1)+a(5)*b(2)+a(6)*b(3)

result_c(3)=a(7)*b(1)+a(8)*b(2)+a(9)*b(3)

result_c(4)=a(1)*b(4)+a(2)*b(5)+a(3)*b(6)

result_c(5)=a(4)*b(4)+a(5)*b(5)+a(6)*b(6)

result_c(6)=a(7)*b(4)+a(8)*b(5)+a(9)*b(6)

result_c(7)=a(1)*b(7)+a(2)*b(8)+a(3)*b(9)

result_c(8)=a(4)*b(7)+a(5)*b(8)+a(6)*b(9)

result_c(9)=a(7)*b(7)+a(8)*b(8)+a(9)*b(9)

return

end