lag_gjnt.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	lag_gjnt (gjbufi, gjbufr, x, vr, ar, iadll, lll, jll, sll, xll, comntag, ltsm, icftag, jcftag, ms, in, v, a, iskip, ncf_s, nc)

Function/Subroutine Documentation

lag_gjnt()

subroutine lag_gjnt	(	integer, dimension(lkjni,*)	gjbufi,
			gjbufr,
			x,
			vr,
			ar,
		integer, dimension(*)	iadll,
		integer, dimension(*)	lll,
		integer, dimension(*)	jll,
		integer, dimension(*)	sll,
			xll,
		integer, dimension(*)	comntag,
			ltsm,
		integer, dimension(*)	icftag,
		integer, dimension(*)	jcftag,
			ms,
			in,
			v,
			a,
		integer	iskip,
		integer	ncf_s,
		integer	nc )

Definition at line 34 of file lag_gjnt.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NC,ISKIP,NCF_S,
     .        LLL(*),JLL(*),SLL(*),IADLL(*),GJBUFI(LKJNI,*),
     .        COMNTAG(*),ICFTAG(*),JCFTAG(*)
      my_real 
     .        gjbufr(lkjnr,*),ltsm(6,*),xll(*),ms(*),in(*),
     .        x(3,*),v(3,*),a(3,*),vr(3,*),ar(3,*)     
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,JTYP,N0,N1,N2,N3,IC,NC_INI,NCL,COMFLAG
      my_real 
     .        vrn(3),dvr(3),vl(3),p(9),l1(3),l2(3),l3(3),alpha, dtd
C======================================================================|
      DO i=1,ngjoint
        jtyp= gjbufi(2,i)        
        n0  = gjbufi(3,i)        
        n1  = gjbufi(4,i)        
        n2  = gjbufi(5,i)
        n3  = gjbufi(6,i)
C
C---    Frame actualisation (main skew) at the beginning of the step        
        vrn(1) = vr(1,n0) + dt12*ar(1,n0)
        vrn(2) = vr(2,n0) + dt12*ar(2,n0)
        vrn(3) = vr(3,n0) + dt12*ar(3,n0)
        vl(1)  = gjbufr( 2,i)*vr(1,n0)
     .          +gjbufr( 3,i)*vr(2,n0)
     .          +gjbufr( 4,i)*vr(3,n0)
        vl(2)  = gjbufr( 5,i)*vr(1,n0)
     .          +gjbufr( 6,i)*vr(2,n0)
     .          +gjbufr( 7,i)*vr(3,n0)
        vl(3)  = gjbufr( 8,i)*vr(1,n0)
     .          +gjbufr( 9,i)*vr(2,n0)
     .          +gjbufr(10,i)*vr(3,n0)
        CALL rotbmr (vl ,gjbufr(2,i) ,dt1)
C---    Frame estimation at the middle of the step    
        dvr(1) = dt12*ar(1,n0)
        dvr(2) = dt12*ar(2,n0)
        dvr(3) = dt12*ar(3,n0)
        p(1) = gjbufr( 2,i)
        p(2) = gjbufr( 3,i)
        p(3) = gjbufr( 4,i)
        p(4) = gjbufr( 5,i)
        p(5) = gjbufr( 6,i)
        p(6) = gjbufr( 7,i)
        p(7) = gjbufr( 8,i)
        p(8) = gjbufr( 9,i)
        p(9) = gjbufr(10,i)
        vl(1)=gjbufr(2,i)*vrn(1)+gjbufr(3,i)*vrn(2)+gjbufr(4,i)*vrn(3)
        vl(2)=gjbufr(5,i)*vrn(1)+gjbufr(6,i)*vrn(2)+gjbufr(7,i)*vrn(3)
        vl(3)=gjbufr(8,i)*vrn(1)+gjbufr(9,i)*vrn(2)+gjbufr(10,i)*vrn(3)
        vl(1)=p(1)*dvr(1)+p(2)*dvr(2)+p(3)*dvr(3)
        vl(2)=p(4)*dvr(1)+p(5)*dvr(2)+p(6)*dvr(3)
        vl(3)=p(7)*dvr(1)+p(8)*dvr(2)+p(9)*dvr(3)
        dtd = half*dt2
        CALL rotbmr (vl ,p ,dtd)
C
        alpha = gjbufr( 1,i)
        l1(1) = gjbufr(11,i)
        l1(2) = gjbufr(12,i)
        l1(3) = gjbufr(13,i)
        l2(1) = gjbufr(14,i)
        l2(2) = gjbufr(15,i)
        l2(3) = gjbufr(16,i)
        nc_ini  = nc
        comflag = 0
        IF (comntag(n0)>1) comflag = 1
        IF (comntag(n1)>1) comflag = 1
        IF (comntag(n2)>1) comflag = 1
C---
        IF (jtyp==1) THEN
          ncl = 11
          CALL gjnt_gear(p      ,l1     ,l2     ,alpha  ,x      ,
     2                   iadll  ,lll    ,jll    ,sll    ,xll    ,
     3                   n0     ,n1     ,n2     ,nc     )  
        ELSEIF (jtyp==2) THEN
          IF (comntag(n3)>1) comflag = 1
          ncl = 13
          l3(1) = gjbufr(17,i)
          l3(2) = gjbufr(18,i)
          l3(3) = gjbufr(19,i)
          CALL gjnt_diff(p      ,l1     ,l2     ,l3     ,alpha  ,
     2                   iadll  ,lll    ,jll    ,sll    ,xll    ,
     3                   x      ,n0     ,n1     ,n2     ,n3     ,
     4                   nc     )  
        ELSEIF (jtyp==3) THEN
          ncl = 9
          CALL gjnt_rack(p      ,l1     ,l2     ,alpha  ,x      ,
     2                   iadll  ,lll    ,jll    ,sll    ,xll    ,
     3                   n0     ,n1     ,n2     ,nc     )  
        ENDIF
C
C---    Solving local Lagrange multipliers
        CALL lag_direct(
     1           iadll    ,lll      ,jll      ,xll      ,ltsm     ,
     2           v        ,vr       ,a        ,ar       ,ms       ,
     3           in       ,nc_ini   ,ncl      )
        IF (comflag==0) THEN
          iskip  = iskip + ncl
          nc = nc_ini
        ELSE
          ic = nc_ini - ncf_s
          DO k=1,ncl
            ic = ic + 1
            icftag(ic) = ic + iskip
            jcftag(ic+iskip) = nc_ini + k
          ENDDO
        ENDIF
      ENDDO
C---
      RETURN