Télécharger chamat.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAMAT SOURCE CHAT 05/01/12 21:54:52 5004
  2. SUBROUTINE CHAMAT(A,B,NMAX,NPP,N,ICENT2,C1,C2,DEPS,ICAS,
  3. . IFLU,ICOD,LFLUAG,KERRE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. DIMENSION A(NMAX,*),B(*)
  7. C
  8. C IFLU = 0 ON FLUE AVEC SIGMA ET ON CALCULE SIGMA FINAL
  9. C IFLU > 0 ON FLUE AVEC SIGMA-X ET ON CALCULE (SIGMA-X) FINAL
  10. C
  11. KERRE=0
  12. IBOU2=N
  13. NP=NPP
  14. IF(NPP.EQ.1) NP=0
  15. NP1=NP+1
  16. IF(ICAS.EQ.2) IBOU2=N/2
  17. DO 32 IC=1,ICAS
  18. IP=(IC-1)*IBOU2
  19. FAC=C1*DEPS
  20. IDEC=1
  21. IOUT=ICENT2
  22. IF(IFLU.EQ.0) GO TO 8
  23. C
  24. 10 FAC=FAC/(1.+FAC)
  25. J1=IDEC*N+1+IP
  26. IF(NP.EQ.0) GO TO 21
  27. DO 1 I=1,NP
  28. IK=I+IP
  29. DO 2 J=I,NP
  30. JK=J+IP
  31. 2 A(IK,JK)=A(IK,JK)+FAC*A(J1,JK)
  32. B(IK)=B(IK)+FAC*B(J1)
  33. 1 J1=J1+1
  34. 21 DO 3 I=NP1,IBOU2
  35. IK=I+IP
  36. A(IK,IK)=A(IK,IK)+FAC*A(J1,IK)
  37. B(IK)=B(IK)+FAC*B(J1)
  38. 3 J1=J1+1
  39. IF(IOUT.EQ.0) GO TO 8
  40. IOUT=0
  41. IDEC=2
  42. FAC=C2*DEPS
  43. GO TO 10
  44. 8 IF(ICOD.EQ.1) GO TO 32
  45. DO 9 I=NP1,IBOU2
  46. IK=I+IP
  47. IF(A(IK,IK).EQ.0.) GO TO 999
  48. 9 B(IK)=B(IK)/A(IK,IK)
  49. IF(NP.EQ.0) GO TO 22
  50. C
  51. C RESOLUTION DE LA MATRICE PLEINE
  52. C
  53. CALL MINV23(A(IP+1,IP+1),B(IP+1),NMAX,NP,KERRE)
  54. IF(KERRE.NE.0) RETURN
  55. 22 IF(LFLUAG.NE.0) GO TO 32
  56. FAC=1.+C1*DEPS
  57. IOUT=ICENT2
  58. IDEC=1
  59. 6 J1=IDEC*N+1+IP
  60. IF(NP.EQ.0) GO TO 23
  61. DO 4 I=1,NP
  62. IK=I+IP
  63. DO 5 J=1,NP
  64. JK=J+IP
  65. 5 B(J1)=B(J1)-A(J1,JK)*B(JK)
  66. B(J1)=B(J1)/FAC
  67. 4 J1=J1+1
  68. 23 DO 7 I=NP1,IBOU2
  69. IK=I+IP
  70. B(J1)=(B(J1)-A(J1,IK)*B(IK))/FAC
  71. 7 J1=J1+1
  72. IF(IOUT.EQ.0) GO TO 32
  73. IOUT=0
  74. IDEC=2
  75. FAC=1.+C2*DEPS
  76. GO TO 6
  77. 32 CONTINUE
  78. RETURN
  79. 999 KERRE=6
  80. RETURN
  81. END
  82.  
  83.  

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