Esope source files

   1 : C TIPOCQ    SOURCE    CHAT      05/01/13    03:41:06     5004           
   2 :       SUBROUTINE TIPOCQ(XE, C,Q,MECAN,NCOMP2)
   3 : ***********
   4 : *
   5 : *     ESCLAVE DE MENISM
   6 : *
   7 : *     P.PEGON (ISPRA) AOUT 1996
   8 : *
   9 : ***********
  10 : *
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8 (A-H,O-Z)
  13 :       DIMENSION XE(3,2)
  14 :       DIMENSION C(MECAN,NCOMP2),Q(NCOMP2,NCOMP2)
  15 : *
  15 :       CALL ZERO(C,MECAN,NCOMP2)
  15 :       CALL ZERO(Q,NCOMP2,NCOMP2)
  16 : *
  17 :       NCOMP=NCOMP2/2
  18 :       IF(MECAN.EQ.3.AND.NCOMP.EQ.3)THEN
  19 :         XL=SQRT((XE(1,2)-XE(1,1))**2+(XE(2,2)-XE(2,1))**2)
  20 :         C(1,2)=-1.D0/XL
  21 :         C(1,3)= 1.D0
  22 :         C(1,5)=+1.D0/XL
  23 :         C(2,2)=-1.D0/XL
  24 :         C(2,5)=+1.D0/XL
  25 :         C(2,6)= 1.D0
  26 :         C(3,1)=-1.D0
  27 :         C(3,4)= 1.D0
  28 : *
  29 :         COSDIR=(XE(1,2)-XE(1,1))/XL
  30 :         SINDIR=(XE(2,2)-XE(2,1))/XL
  31 :         DO I=0,1
  32 :           II=I*NCOMP
  33 :           Q(II+1,II+1)= COSDIR
  34 :           Q(II+1,II+2)= SINDIR
  35 :           Q(II+2,II+1)=-SINDIR
  36 :           Q(II+2,II+2)= COSDIR
  37 :           Q(II+3,II+3)= 1
  38 :         ENDDO
  39 :       ENDIF
  40 : *
  41 :       RETURN
  42 :       END
  43 :  
  44 :