Download asksgl.eso

Back to the list

   1 : C ASKSGL    SOURCE    CHAT      07/10/22    21:15:07     5921           
   2 :       SUBROUTINE ASKSGL(XK,R)
   3 :       IMPLICIT REAL*8(A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 :  
   6 : *      SUBROUTINE ASSE_KSTAB_GL(K,R)
   7 : C ANTOINE LEGAY LE 15/02/2001
   8 : C TOURNE KSTAB VERS LE REPERE GLOBAL
   9 : *      REAL *8 K(24,24),R(3,3),KRT(24,24),TMP(24,24),KR(24,24)
  10 : *      INTEGER I,J,KK
  11 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  12 : 
  13 :       DIMENSION XK(24,24),R(3,3),XKRT(24,24),TMP(24,24),XKR(24,24)
  13 :       CALL ZDANUL(XKRT,576)
  13 :       CALL ZDANUL(XKR,576)
  14 :       DO KK=1,8
  15 :          DO J=1,3
  16 :             DO I=1,3
  17 : CCCCCCC ATTENTION< INVERSE LE 3 NOVEMBRE 2001
  18 :                XKR((KK-1)*3+I,(KK-1)*3+J)  = R(I,J)
  19 :                XKRT((KK-1)*3+I,(KK-1)*3+J) = R(J,I)
  20 :             ENDDO
  21 :          ENDDO
  22 :       ENDDO
  23 : C      WRITE(6,*)'****************** KR ***************'
  24 : C      DO I=1,24
  25 : C      WRITE(6,*)(KR(I,J),J=1,24)
  26 : C      ENDDO
  27 : C      WRITE(6,*)'*********************************'
  27 : *      CALL MULMAT(24,24,24,XK,XKR,TMP)
  27 : *      CALL MULMAT(24,24,24,XKRT,TMP,XKR)
  27 :        call mulmat ( tmp,xk,xkr,24,24,24)
  27 :        call mulmat(xkr,xkrt,tmp,24,24,24)
  27 :       CALL SHIFTD(XKR,XK,576)
  28 : 
  29 : C
  30 :       RETURN
  31 :       END
  32 : 
  33 :  

© Cast3M 2003 - All rights reserved.
Disclaimer