Télécharger diagn1.eso

Retour à la liste

Numérotation des lignes :

  1. C DIAGN1 SOURCE PV 16/11/17 21:59:00 9180
  2. SUBROUTINE DIAGN1 (IPRIGI,INFER0)
  3. ************************************************************************
  4. *
  5. * D I A G N 1
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * EXECUTER LA FONCTION ATTRIBUEE A L'OPERATEUR "DIAGNEG".
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. * CALL DIAGN1 (IPRIGI,INFER0)
  17. *
  18. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  19. * -----------
  20. *
  21. * IPRIGI ENTIER (E) POINTEUR D'UNE 'RIGIDITE'.
  22. * INFER0 ENTIER (S) NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA
  23. * MATRICE DIAGONALE "D" DE LA 'RIGIDITE'
  24. * DECOMPOSEE EN "L.D.LT"
  25. *
  26. * AUTEUR, DATE DE CREATION:
  27. * -------------------------
  28. *
  29. * PASCAL MANIGOT 8 OCTOBRE 1984
  30. *
  31. * LANGAGE:
  32. * --------
  33. *
  34. * ESOPE + FORTRAN77
  35. *
  36. ************************************************************************
  37. *
  38. IMPLICIT INTEGER(I-N)
  39. -INC CCOPTIO
  40. -INC SMMATRI
  41. -INC SMRIGID
  42. -INC SMTABLE
  43. *
  44. integer insym
  45. isupt = 0
  46. insym = 0
  47. MRIGID = IPRIGI
  48. SEGACT,MRIGID
  49. isupt = isupeq
  50. * write (6,*) ' isupeq 1 ',isupeq
  51. ipoiri = jrcond
  52. if (ipoiri.ne.0) then
  53. mrigid = ipoiri
  54. segact mrigid
  55. if (isupt.eq.0) isupt = isupeq
  56. * write (6,*) ' isupoq 2 ',isupeq
  57. endif
  58. NRG = IRIGEL(/1)
  59. NBR = IRIGEL(/2)
  60. if (nbr.eq.0) then
  61. infer0 = 0
  62. segdes mrigid
  63. return
  64. endif
  65. IPMATR = ICHOLE
  66. IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN
  67. INSYM = 1
  68. ENDIF
  69. IF (NRG.GE.7) THEN
  70. DO 9 IN = 1,NBR
  71. IANTI=IRIGEL(7,IN)
  72. IF(IANTI.GT.0) THEN
  73. INSYM = 1
  74. ENDIF
  75. 9 CONTINUE
  76. ENDIF
  77. SEGDES,MRIGID
  78. *
  79. if (isupt.eq.0) then
  80. IF (IPMATR .EQ. 0) THEN
  81. IF (INSYM .EQ. 0) THEN
  82. CALL TRIANG (mrigid,1D-18,0)
  83. ELSE
  84. CALL ldmt1(mrigid,1d-18)
  85. ENDIF
  86. IF (IERR .NE. 0) RETURN
  87. MRIGID = IPRIGI
  88. SEGACT,MRIGID
  89. IPMATR = ICHOLE
  90. SEGDES,MRIGID
  91. END IF
  92. *
  93. MMATRI = IPMATR
  94. SEGACT,MMATRI
  95. INFER0 = INEG
  96. SEGDES,MMATRI
  97. else
  98. mtable = isupt
  99. segact mtable
  100. CALL ACCTAB(mtable,'ENTIER',13,0.d0,' ',.true.,IP0,
  101. & 'ENTIER',infer0,X1,CHARRE,.true.,ITMOD)
  102. ** write (6,*) ' unilateral nbneg ',infer0
  103. segdes mtable
  104. endif
  105. *
  106. END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  

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