Télécharger la plaquette Cast3M


fr en

Télécharger mulmav.eso

Retour à la liste

Numérotation des lignes : 

mulmav

  1. C MULMAV    SOURCE    CHAT      05/01/13    01:55:26     5004
  2.       SUBROUTINE MULMAV(C1,C2,C3,C4,V,X,N,ICHLI,NLBLI,NBLI)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C  =====================================================================
  7. C    SOUS-PROGRAMME FORTRAN APPELE PAR ELFRES
  8. C    CALCUL DE X ET F EN FONCTION DE V1 ET V2 EN RESOLVANT:
  9. C
  10. C        ( A1 A2 ) (X1)    (V1)
  11. C        (       ) (  )  = (  )
  12. C        ( A3 A4 ) (X2)    (V2)
  13. C
  14. C   AVEC  C1  MATRICE BANDE A1
  15. C
  16. C                             -1
  17. C         C2  MATRICE BANDE A2
  18. C                               -1    -1      -1
  19. C         C4  MATRICE  (A3-A4*A2  *A1)  *A4*A2
  20. C                               -1    -1
  21. C         C3  MATRICE  (A3-A4*A2  *A1)
  22. C
  23. C         NLBLI : TABLEAU POUR L' UTILISATION DES MATRICES BANDES
  24. C
  25. C         ICHLI : SI NUL V2 EST NUL  (PAS DE CHARGEMENT SUR LA LIAISON)
  26. C
  27. C    CREATION    : 04/08/87
  28. C    PROGRAMMEUR : GUILBAUD
  29. C  =====================================================================
  30. C
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34.       DIMENSION C1(*),C2(*),C3(N,1),C4(N,1),V(*),X(*),NLBLI(2,1),A(6),
  35.      *B(6)
  36. C                      -1    -1      -1
  37. C   1 -   X1=-(A3-A4*A2  *A1)  *A4*A2  V1
  38. C
  39.       DO 20 I=1,N
  40.       BB=0.D0
  41.       DO 10 J=1,N
  42.       BB=BB+C4(I,J)*V(J)
  43.    10 CONTINUE
  44.       X(I)=-BB
  45.    20 CONTINUE
  46. C     WRITE(IOIMP,*)' X1 ',X1
  47. C     WRITE(IOIMP,1000)(X(I),I=1,N)
  48. C                        -1    -1
  49. C   2 -   X1=X1-(A3-A4*A2  *A1)  *V2
  50. C
  51.       IF(ICHLI.NE.0) THEN
  52. C     WRITE(IOIMP,*)' CHARGEMENT '
  53.         DO 40 I=1,N
  54.         BB=X(I)
  55.         DO 30 J=1,N
  56.         BB=BB+C3(I,J)*V(J+N)
  57.    30   CONTINUE
  58.         X(I)=BB
  59.    40   CONTINUE
  60. C     WRITE(IOIMP,1000)(X(I),I=1,N)
  61.       ENDIF
  62. C              -1
  63. C   3 -   X2=A2  *(V1-A1*X1)
  64. C
  65.       NA=0
  66.       NB=0
  67.       DO 50 NBL =1,NBLI
  68.       ND1=NLBLI(1,NBL)
  69.       ND2=NLBLI(2,NBL)
  70. C     WRITE(IOIMP,*) ' NBL ND1 ND2 ',NBL,ND1,ND2
  71.       IF(ND1.EQ.ND2) THEN
  72.         ND = ND1
  73.         NX = ND+N
  74.         X(NX+1)=C2(NB+1)*(V(ND+1)-C1(NA+1)*X(ND+1))
  75.         X(NX+2)=C2(NB+2)*(V(ND+2)-C1(NA+2)*X(ND+2)-C1(NA+3)*X(ND+6))
  76.         X(NX+3)=C2(NB+3)*(V(ND+3)-C1(NA+4)*X(ND+3)-C1(NA+5)*X(ND+5))
  77.         X(NX+4)=C2(NB+4)*(V(ND+4)-C1(NA+6)*X(ND+4))
  78.         X(NX+5)=C2(NB+5)*(V(ND+5)-C1(NA+7)*X(ND+3)-C1(NA+8)*X(ND+5))
  79.         X(NX+6)=C2(NB+6)*(V(ND+6)-C1(NA+9)*X(ND+2)-C1(NA+10)*X(ND+6))
  80. C     WRITE(IOIMP,*) 'C2 NB ',NB
  81. C     WRITE(IOIMP,1000)(C2(NB+I),I=1,6)
  82. C1000 FORMAT(12(1X,1PE10.3))
  83. C     WRITE(IOIMP,*) 'C1 NA ',NA
  84. C     WRITE(IOIMP,1000)(C1(NA+I),I=1,10)
  85. C     WRITE(IOIMP,*) 'V  ND ',ND
  86. C     WRITE(IOIMP,1000)(V(ND+I),I=1,6)
  87. C     WRITE(IOIMP,*) 'X  NX ',NX
  88. C     WRITE(IOIMP,1000)(X(NX+I),I=1,6)
  89.         NA =NA+10
  90.         NB = NB+6
  91.       ELSE
  92.         NX1 = ND1+N
  93.         NX2 = ND2+N
  94.         X(NX1+1)=V(ND1+1)-C1(NA+ 1)*X(ND1+1)-C1(NA+11)*X(ND2+1)
  95.         X(NX1+2)=V(ND1+2)-C1(NA+ 2)*X(ND1+2)-C1(NA+ 3)*X(ND1+6)
  96.      *                   -C1(NA+12)*X(ND2+2)-C1(NA+13)*X(ND2+6)
  97.         X(NX1+3)=V(ND1+3)-C1(NA+ 4)*X(ND1+3)-C1(NA+ 5)*X(ND1+5)
  98.      *                   -C1(NA+14)*X(ND2+3)-C1(NA+15)*X(ND2+5)
  99.         X(NX1+4)=V(ND1+4)-C1(NA+ 6)*X(ND1+4)-C1(NA+16)*X(ND2+4)
  100.         X(NX1+5)=V(ND1+5)-C1(NA+ 7)*X(ND1+3)-C1(NA+ 8)*X(ND1+5)
  101.      *                   -C1(NA+17)*X(ND2+3)-C1(NA+18)*X(ND2+5)
  102.         X(NX1+6)=V(ND1+6)-C1(NA+ 9)*X(ND1+2)-C1(NA+10)*X(ND1+6)
  103.      *                   -C1(NA+19)*X(ND2+2)-C1(NA+20)*X(ND2+6)
  104.         X(NX2+1)=V(ND2+1)-C1(NA+21)*X(ND1+1)-C1(NA+31)*X(ND2+1)
  105.         X(NX2+2)=V(ND2+2)-C1(NA+22)*X(ND1+2)-C1(NA+23)*X(ND1+6)
  106.      *                   -C1(NA+32)*X(ND2+2)-C1(NA+33)*X(ND2+6)
  107.         X(NX2+3)=V(ND2+3)-C1(NA+24)*X(ND1+3)-C1(NA+25)*X(ND1+5)
  108.      *                   -C1(NA+34)*X(ND2+3)-C1(NA+35)*X(ND2+5)
  109.         X(NX2+4)=V(ND2+4)-C1(NA+26)*X(ND1+4)-C1(NA+36)*X(ND2+4)
  110.         X(NX2+5)=V(ND2+5)-C1(NA+27)*X(ND1+3)-C1(NA+28)*X(ND1+5)
  111.      *                   -C1(NA+37)*X(ND2+3)-C1(NA+38)*X(ND2+5)
  112.         X(NX2+6)=V(ND2+6)-C1(NA+29)*X(ND1+2)-C1(NA+30)*X(ND1+6)
  113.      *                   -C1(NA+39)*X(ND2+2)-C1(NA+40)*X(ND2+6)
  114. C
  115. C     WRITE(IOIMP,*) ' NBL ',NBL
  116. C     WRITE(IOIMP,1000) (X(NX1+I),I=1,6),(X(NX2+I),I=1,6)
  117.         A(1)=C2(NB+ 1)*X(NX1+1)+C2(NB+11)*X(NX2+1)
  118.         A(2)=C2(NB+ 2)*X(NX1+2)+C2(NB+ 3)*X(NX1+6)
  119.      *      +C2(NB+12)*X(NX2+2)+C2(NB+13)*X(NX2+6)
  120.         A(3)=C2(NB+ 4)*X(NX1+3)+C2(NB+ 5)*X(NX1+5)
  121.      *      +C2(NB+14)*X(NX2+3)+C2(NB+15)*X(NX2+5)
  122.         A(4)=C2(NB+ 6)*X(NX1+4)+C2(NB+16)*X(NX2+4)
  123.         A(5)=C2(NB+ 7)*X(NX1+3)+C2(NB+ 8)*X(NX1+5)
  124.      *      +C2(NB+17)*X(NX2+3)+C2(NB+18)*X(NX2+5)
  125.         A(6)=C2(NB+ 9)*X(NX1+2)+C2(NB+10)*X(NX1+6)
  126.      *      +C2(NB+19)*X(NX2+2)+C2(NB+20)*X(NX2+6)
  127.         B(1)=C2(NB+21)*X(NX1+1)+C2(NB+31)*X(NX2+1)
  128.         B(2)=C2(NB+22)*X(NX1+2)+C2(NB+23)*X(NX1+6)
  129.      *      +C2(NB+32)*X(NX2+2)+C2(NB+33)*X(NX2+6)
  130.         B(3)=C2(NB+24)*X(NX1+3)+C2(NB+25)*X(NX1+5)
  131.      *      +C2(NB+34)*X(NX2+3)+C2(NB+35)*X(NX2+5)
  132.         B(4)=C2(NB+26)*X(NX1+4)+C2(NB+36)*X(NX2+4)
  133.         B(5)=C2(NB+27)*X(NX1+3)+C2(NB+28)*X(NX1+5)
  134.      *      +C2(NB+37)*X(NX2+3)+C2(NB+38)*X(NX2+5)
  135.         B(6)=C2(NB+29)*X(NX1+2)+C2(NB+30)*X(NX1+6)
  136.      *      +C2(NB+39)*X(NX2+2)+C2(NB+40)*X(NX2+6)
  137.         DO 45 I=1,6
  138.         X(NX1+I)=A(I)
  139.         X(NX2+I)=B(I)
  140.   45    CONTINUE
  141. C     WRITE(IOIMP,1000)(X(NX1+I),I=1,6),(X(NX2+I),I=1,6)
  142.         NA=NA+40
  143.         NB=NB+40
  144.       ENDIF
  145.   50  CONTINUE
  146.       RETURN
  147.       END
  148.  
  149.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales