Télécharger mulmav.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  32. DIMENSION C1(*),C2(*),C3(N,1),C4(N,1),V(*),X(*),NLBLI(2,1),A(6),
  33. *B(6)
  34. C -1 -1 -1
  35. C 1 - X1=-(A3-A4*A2 *A1) *A4*A2 V1
  36. C
  37. DO 20 I=1,N
  38. BB=0.D0
  39. DO 10 J=1,N
  40. BB=BB+C4(I,J)*V(J)
  41. 10 CONTINUE
  42. X(I)=-BB
  43. 20 CONTINUE
  44. C WRITE(IOIMP,*)' X1 ',X1
  45. C WRITE(IOIMP,1000)(X(I),I=1,N)
  46. C -1 -1
  47. C 2 - X1=X1-(A3-A4*A2 *A1) *V2
  48. C
  49. IF(ICHLI.NE.0) THEN
  50. C WRITE(IOIMP,*)' CHARGEMENT '
  51. DO 40 I=1,N
  52. BB=X(I)
  53. DO 30 J=1,N
  54. BB=BB+C3(I,J)*V(J+N)
  55. 30 CONTINUE
  56. X(I)=BB
  57. 40 CONTINUE
  58. C WRITE(IOIMP,1000)(X(I),I=1,N)
  59. ENDIF
  60. C -1
  61. C 3 - X2=A2 *(V1-A1*X1)
  62. C
  63. NA=0
  64. NB=0
  65. DO 50 NBL =1,NBLI
  66. ND1=NLBLI(1,NBL)
  67. ND2=NLBLI(2,NBL)
  68. C WRITE(IOIMP,*) ' NBL ND1 ND2 ',NBL,ND1,ND2
  69. IF(ND1.EQ.ND2) THEN
  70. ND = ND1
  71. NX = ND+N
  72. X(NX+1)=C2(NB+1)*(V(ND+1)-C1(NA+1)*X(ND+1))
  73. X(NX+2)=C2(NB+2)*(V(ND+2)-C1(NA+2)*X(ND+2)-C1(NA+3)*X(ND+6))
  74. X(NX+3)=C2(NB+3)*(V(ND+3)-C1(NA+4)*X(ND+3)-C1(NA+5)*X(ND+5))
  75. X(NX+4)=C2(NB+4)*(V(ND+4)-C1(NA+6)*X(ND+4))
  76. X(NX+5)=C2(NB+5)*(V(ND+5)-C1(NA+7)*X(ND+3)-C1(NA+8)*X(ND+5))
  77. X(NX+6)=C2(NB+6)*(V(ND+6)-C1(NA+9)*X(ND+2)-C1(NA+10)*X(ND+6))
  78. C WRITE(IOIMP,*) 'C2 NB ',NB
  79. C WRITE(IOIMP,1000)(C2(NB+I),I=1,6)
  80. C1000 FORMAT(12(1X,1PE10.3))
  81. C WRITE(IOIMP,*) 'C1 NA ',NA
  82. C WRITE(IOIMP,1000)(C1(NA+I),I=1,10)
  83. C WRITE(IOIMP,*) 'V ND ',ND
  84. C WRITE(IOIMP,1000)(V(ND+I),I=1,6)
  85. C WRITE(IOIMP,*) 'X NX ',NX
  86. C WRITE(IOIMP,1000)(X(NX+I),I=1,6)
  87. NA =NA+10
  88. NB = NB+6
  89. ELSE
  90. NX1 = ND1+N
  91. NX2 = ND2+N
  92. X(NX1+1)=V(ND1+1)-C1(NA+ 1)*X(ND1+1)-C1(NA+11)*X(ND2+1)
  93. X(NX1+2)=V(ND1+2)-C1(NA+ 2)*X(ND1+2)-C1(NA+ 3)*X(ND1+6)
  94. * -C1(NA+12)*X(ND2+2)-C1(NA+13)*X(ND2+6)
  95. X(NX1+3)=V(ND1+3)-C1(NA+ 4)*X(ND1+3)-C1(NA+ 5)*X(ND1+5)
  96. * -C1(NA+14)*X(ND2+3)-C1(NA+15)*X(ND2+5)
  97. X(NX1+4)=V(ND1+4)-C1(NA+ 6)*X(ND1+4)-C1(NA+16)*X(ND2+4)
  98. X(NX1+5)=V(ND1+5)-C1(NA+ 7)*X(ND1+3)-C1(NA+ 8)*X(ND1+5)
  99. * -C1(NA+17)*X(ND2+3)-C1(NA+18)*X(ND2+5)
  100. X(NX1+6)=V(ND1+6)-C1(NA+ 9)*X(ND1+2)-C1(NA+10)*X(ND1+6)
  101. * -C1(NA+19)*X(ND2+2)-C1(NA+20)*X(ND2+6)
  102. X(NX2+1)=V(ND2+1)-C1(NA+21)*X(ND1+1)-C1(NA+31)*X(ND2+1)
  103. X(NX2+2)=V(ND2+2)-C1(NA+22)*X(ND1+2)-C1(NA+23)*X(ND1+6)
  104. * -C1(NA+32)*X(ND2+2)-C1(NA+33)*X(ND2+6)
  105. X(NX2+3)=V(ND2+3)-C1(NA+24)*X(ND1+3)-C1(NA+25)*X(ND1+5)
  106. * -C1(NA+34)*X(ND2+3)-C1(NA+35)*X(ND2+5)
  107. X(NX2+4)=V(ND2+4)-C1(NA+26)*X(ND1+4)-C1(NA+36)*X(ND2+4)
  108. X(NX2+5)=V(ND2+5)-C1(NA+27)*X(ND1+3)-C1(NA+28)*X(ND1+5)
  109. * -C1(NA+37)*X(ND2+3)-C1(NA+38)*X(ND2+5)
  110. X(NX2+6)=V(ND2+6)-C1(NA+29)*X(ND1+2)-C1(NA+30)*X(ND1+6)
  111. * -C1(NA+39)*X(ND2+2)-C1(NA+40)*X(ND2+6)
  112. C
  113. C WRITE(IOIMP,*) ' NBL ',NBL
  114. C WRITE(IOIMP,1000) (X(NX1+I),I=1,6),(X(NX2+I),I=1,6)
  115. A(1)=C2(NB+ 1)*X(NX1+1)+C2(NB+11)*X(NX2+1)
  116. A(2)=C2(NB+ 2)*X(NX1+2)+C2(NB+ 3)*X(NX1+6)
  117. * +C2(NB+12)*X(NX2+2)+C2(NB+13)*X(NX2+6)
  118. A(3)=C2(NB+ 4)*X(NX1+3)+C2(NB+ 5)*X(NX1+5)
  119. * +C2(NB+14)*X(NX2+3)+C2(NB+15)*X(NX2+5)
  120. A(4)=C2(NB+ 6)*X(NX1+4)+C2(NB+16)*X(NX2+4)
  121. A(5)=C2(NB+ 7)*X(NX1+3)+C2(NB+ 8)*X(NX1+5)
  122. * +C2(NB+17)*X(NX2+3)+C2(NB+18)*X(NX2+5)
  123. A(6)=C2(NB+ 9)*X(NX1+2)+C2(NB+10)*X(NX1+6)
  124. * +C2(NB+19)*X(NX2+2)+C2(NB+20)*X(NX2+6)
  125. B(1)=C2(NB+21)*X(NX1+1)+C2(NB+31)*X(NX2+1)
  126. B(2)=C2(NB+22)*X(NX1+2)+C2(NB+23)*X(NX1+6)
  127. * +C2(NB+32)*X(NX2+2)+C2(NB+33)*X(NX2+6)
  128. B(3)=C2(NB+24)*X(NX1+3)+C2(NB+25)*X(NX1+5)
  129. * +C2(NB+34)*X(NX2+3)+C2(NB+35)*X(NX2+5)
  130. B(4)=C2(NB+26)*X(NX1+4)+C2(NB+36)*X(NX2+4)
  131. B(5)=C2(NB+27)*X(NX1+3)+C2(NB+28)*X(NX1+5)
  132. * +C2(NB+37)*X(NX2+3)+C2(NB+38)*X(NX2+5)
  133. B(6)=C2(NB+29)*X(NX1+2)+C2(NB+30)*X(NX1+6)
  134. * +C2(NB+39)*X(NX2+2)+C2(NB+40)*X(NX2+6)
  135. DO 45 I=1,6
  136. X(NX1+I)=A(I)
  137. X(NX2+I)=B(I)
  138. 45 CONTINUE
  139. C WRITE(IOIMP,1000)(X(NX1+I),I=1,6),(X(NX2+I),I=1,6)
  140. NA=NA+40
  141. NB=NB+40
  142. ENDIF
  143. 50 CONTINUE
  144. RETURN
  145. END
  146.  
  147.  

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