c3sumg3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	c3sumg3 (jft, jlt, r11, r12, r13, r21, r22, r23, r31, r32, r33, k11, k12, k13, k22, k23, k33, m11, m12, m13, m22, m23, m33, mf11, mf12, mf13, mf22, mf23, mf33, fm12, fm13, fm23, ke11, ke22, ke33, ke12, ke13, ke23, idril, iorth)

Function/Subroutine Documentation

c3sumg3()

subroutine c3sumg3	(	integer	jft,
		integer	jlt,
			r11,
			r12,
			r13,
			r21,
			r22,
			r23,
			r31,
			r32,
			r33,
			k11,
			k12,
			k13,
			k22,
			k23,
			k33,
			m11,
			m12,
			m13,
			m22,
			m23,
			m33,
			mf11,
			mf12,
			mf13,
			mf22,
			mf23,
			mf33,
			fm12,
			fm13,
			fm23,
			ke11,
			ke22,
			ke33,
			ke12,
			ke13,
			ke23,
		integer	idril,
		integer	iorth )

Definition at line 34 of file c3sumg3.F.

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#include      "implicit_f.inc"
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER JFT,JLT,IDRIL,IORTH
      my_real 
     .    r11(*),r12(*),r13(*),
     .    r21(*),r22(*),r23(*),
     .    r31(*),r32(*),r33(*)
       my_real
     .    k11(3,3,*),k12(3,3,*),k13(3,3,*),
     .    k22(3,3,*),k23(3,3,*),k33(3,3,*),
     .    m11(3,3,*),m12(3,3,*),m13(3,3,*),
     .    m22(3,3,*),m23(3,3,*),m33(3,3,*),
     .    mf11(3,3,*),mf12(3,3,*),mf13(3,3,*),
     .    mf22(3,3,*),mf23(3,3,*),mf33(3,3,*),
     .    fm12(3,3,*),fm13(3,3,*),fm23(3,3,*),
     .    ke11(6,6,*),ke22(6,6,*),ke33(6,6,*),
     .    ke12(6,6,*),ke13(6,6,*),ke23(6,6,*)
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER I, J, EP,IS,IAS,MI,MJ
      my_real 
     .     q(3,3,mvsiz)
      DATA is/1/,ias/0/
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
C---------------------------------------
C   TRANS LOCAL-->GLOBAL ET 5DDL-->6DDL
C---------------------------------------
       DO i=jft,jlt
        q(1,1,i)=r11(i)
        q(1,2,i)=r21(i)
        q(1,3,i)=r31(i)
        q(2,1,i)=r12(i)
        q(2,2,i)=r22(i)
        q(2,3,i)=r32(i)
        q(3,1,i)=r13(i)
        q(3,2,i)=r23(i)
        q(3,3,i)=r33(i)
       ENDDO 
C-----      CBATRAN233     QI^tKQJ K(1,3)>0,K(2,3)>0,K(3,1)>0,K(3,2)>0-------
       CALL cbatran2(jft,jlt,q,k11,q,is)
       CALL cbatran2(jft,jlt,q,k22,q,is)
       CALL cbatran2(jft,jlt,q,k33,q,is)
       CALL cbatran2(jft,jlt,q,k12,q,ias)
       CALL cbatran2(jft,jlt,q,k13,q,ias)
       CALL cbatran2(jft,jlt,q,k23,q,ias)
       IF (iorth >0 .AND.idril>0) THEN
        CALL cbatran3(jft,jlt,q,m11,q,is)
        CALL cbatran3(jft,jlt,q,m22,q,is)
        CALL cbatran3(jft,jlt,q,m33,q,is)
        CALL cbatran3(jft,jlt,q,m12,q,ias)
        CALL cbatran3(jft,jlt,q,m13,q,ias)
        CALL cbatran3(jft,jlt,q,m23,q,ias)
       ELSE
        CALL cbatran2(jft,jlt,q,m11,q,is)
        CALL cbatran2(jft,jlt,q,m22,q,is)
        CALL cbatran2(jft,jlt,q,m33,q,is)
        CALL cbatran2(jft,jlt,q,m12,q,ias)
        CALL cbatran2(jft,jlt,q,m13,q,ias)
        CALL cbatran2(jft,jlt,q,m23,q,ias)
       END IF !(IORTH >0.AND.IDRIL>0)
       IF (iorth >0) THEN
       CALL cbatran3(jft,jlt,q,mf11,q,ias)
       CALL cbatran3(jft,jlt,q,mf12,q,ias)
       CALL cbatran3(jft,jlt,q,mf13,q,ias)
       CALL cbatran3(jft,jlt,q,mf22,q,ias)
       CALL cbatran3(jft,jlt,q,mf23,q,ias)
       CALL cbatran3(jft,jlt,q,mf33,q,ias)
       CALL cbatran3(jft,jlt,q,fm12,q,ias)
       CALL cbatran3(jft,jlt,q,fm13,q,ias)
       CALL cbatran3(jft,jlt,q,fm23,q,ias)
       ELSEIF (idril>0) THEN
        CALL cbatran233(jft,jlt,q,mf11,q)
        CALL cbatran233(jft,jlt,q,mf12,q)
        CALL cbatran233(jft,jlt,q,mf13,q)
        CALL cbatran233(jft,jlt,q,mf22,q)
        CALL cbatran233(jft,jlt,q,mf23,q)
        CALL cbatran233(jft,jlt,q,mf33,q)
        CALL cbatran233(jft,jlt,q,fm12,q)
        CALL cbatran233(jft,jlt,q,fm13,q)
        CALL cbatran233(jft,jlt,q,fm23,q)
       ELSE
        CALL cbatran232(jft,jlt,q,mf11,q)
        CALL cbatran232(jft,jlt,q,mf12,q)
        CALL cbatran232(jft,jlt,q,mf13,q)
        CALL cbatran232(jft,jlt,q,mf22,q)
        CALL cbatran232(jft,jlt,q,mf23,q)
        CALL cbatran232(jft,jlt,q,mf33,q)
        CALL cbatran223(jft,jlt,q,fm12,q)
        CALL cbatran223(jft,jlt,q,fm13,q)
        CALL cbatran223(jft,jlt,q,fm23,q)
       END IF
C---------------------------------------
C   ASSEMBLAGE
C---------------------------------------
C---------KII -------- 
       DO i=1,3 
        mi=i+3
        DO j=i,3 
         mj=j+3
         DO ep=jft,jlt
          ke11(i,j,ep)=k11(i,j,ep)
          ke11(mi,mj,ep)=m11(i,j,ep)
          ke22(i,j,ep)=k22(i,j,ep)
          ke22(mi,mj,ep)=m22(i,j,ep)
          ke33(i,j,ep)=k33(i,j,ep)
          ke33(mi,mj,ep)=m33(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,3 
        DO j=1,3 
         mj=j+3
         DO ep=jft,jlt
          ke11(i,mj,ep)=mf11(i,j,ep)
          ke22(i,mj,ep)=mf22(i,j,ep)
          ke33(i,mj,ep)=mf33(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,6 
        DO j=i,6 
         DO ep=jft,jlt
          ke11(j,i,ep)=ke11(i,j,ep)
          ke22(j,i,ep)=ke22(i,j,ep)
          ke33(j,i,ep)=ke33(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C---------KIJ -------- 
       DO i=1,3 
        mi=i+3
        DO j=1,3 
         mj=j+3
         DO ep=jft,jlt
          ke12(i,j,ep)=k12(i,j,ep)
          ke12(i,mj,ep)=mf12(i,j,ep)
          ke12(mi,j,ep)=fm12(i,j,ep)
          ke12(mi,mj,ep)=m12(i,j,ep)
          ke13(i,j,ep)=k13(i,j,ep)
          ke13(i,mj,ep)=mf13(i,j,ep)
          ke13(mi,j,ep)=fm13(i,j,ep)
          ke13(mi,mj,ep)=m13(i,j,ep)
          ke23(i,j,ep)=k23(i,j,ep)
          ke23(i,mj,ep)=mf23(i,j,ep)
          ke23(mi,j,ep)=fm23(i,j,ep)
          ke23(mi,mj,ep)=m23(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C
      RETURN