Télécharger supnrm.eso

Retour à la liste

Numérotation des lignes :

supnrm
  1. C SUPNRM SOURCE PV 20/09/26 21:20:02 10724
  2. SUBROUTINE SUPNRM(IMMATRI,MRIGID,dnormm)
  3. c=======================================================================
  4. c sous routine utilisée par l'opérateur super option 'rigidite'
  5. c appelée par supri
  6. c
  7. c modifie la matrice condensée obtenue lorsque les inconnues
  8. c maitres ont été normalisées comme c'est le cas lorsqu'un
  9. c multiplicateur de Lagrange est maitre
  10. c
  11. c en entrée
  12. c IMMATRI : la triangulation modifiée de la matrice totale
  13. c qui contient en particulier les coefficients
  14. c de normalisation
  15. c segment desactivé
  16. c MRIGID : la matrice condensée résultante. On ne considère
  17. c que la première sous zone qui contient la matrice
  18. c condensée. Les autres sous zones contiennent
  19. c des blocages n'agissant que sur des inconnues
  20. c maitres
  21. c segment encore actif
  22. c
  23. c en sortie
  24. c la matrice de la première sous zone est modifieé
  25. c par le coefficient de normalisation
  26. c
  27. c appelée par super
  28. c
  29. c=======================================================================
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8(A-H,O-Z)
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMCOORD
  36. -INC SMRIGID
  37. -INC SMELEME
  38. -INC SMMATRI
  39. SEGMENT ICPR(nbpts)
  40. SEGMENT NCOOR(NNO)
  41. SEGMENT DNORMM(NLIGRP)
  42. c
  43. c executable
  44. c
  45. MMATRI = IMMATRI
  46. SEGACT MMATRI
  47. c
  48. c on etablit la correspondance entre les noeuds du maillage de la
  49. c rigidité et les noeuds du maillage de MMATRI
  50. c
  51. IPT1 = IRIGEL(1,1)
  52. IPT2 = IGEOMA
  53. SEGACT IPT1,IPT2
  54. c
  55. IF ( IPT1.ITYPEL .NE. 28 .OR. IPT2.ITYPEL .NE. 1) THEN
  56. WRITE(IOIMP,*) 'Erreur 1 dans la routine SUPNRM'
  57. WRITE(IOIMP,*) 'Les types d élements ne sont pas les bons'
  58. CALL ERREUR(5)
  59. ENDIF
  60. c ncoor va contenir cette correspondance
  61. NNO = IPT1.NUM(/1)
  62. SEGINI NCOOR
  63. SEGINI ICPR
  64. c on cree un tableau intermédiaire qui donne le numéro dans ipt2
  65. c a partir du numéro global
  66. DO 100 I=1,IPT2.NUM(/2)
  67. ICPR(IPT2.NUM(1,I)) = I
  68. 100 CONTINUE
  69. c
  70. DO 110 I=1,NNO
  71. NCOOR(I) = ICPR(IPT1.NUM(I,1))
  72. * IF (NCOOR(I) .EQ. 0) WRITE(6,*) 'Correspondance foireuse'
  73. * write(6,*) 'Correspondance IPT1' , I , 'IPT2', NCOOR(I)
  74. 110 CONTINUE
  75. c
  76. SEGSUP ,ICPR
  77. c
  78. c on boucle maintenant sur chaque inconnue de la matrice condensée
  79. c on récupère le numéro d'inconnue pour avoir le coefficient de
  80. c normalisation que l'on met dans DNORMM
  81. c
  82. c on active MMATRI
  83. MINCPO = IINCPO
  84. SEGACT ,MINCPO
  85. c
  86. MIMIK = IIMIK
  87. SEGACT ,MIMIK
  88. MHARK = IHARK
  89. SEGACT ,MHARK
  90. MDNOR = IDNORM
  91. SEGACT ,MDNOR
  92. c
  93. DESCR = IRIGEL(3,1)
  94. c
  95. NLIGRP = LISINC(/2)
  96. NLIGRD = LISDUA(/2)
  97. IF (NLIGRP .NE. NLIGRD) THEN
  98. WRITE(IOIMP,*) 'Erreur 2 dans la routine SUPNRM'
  99. WRITE(IOIMP,*) 'La matrice condensée n est pas carrée'
  100. CALL ERREUR(5)
  101. RETURN
  102. ENDIF
  103. SEGINI , DNORMM
  104. c
  105. c boucle sur les inconnues de DESCR
  106. c
  107. DO 200 I=1,NLIGRP
  108. IPOI1 = NCOOR(NOELEP(I))
  109. * write(6,*) 'Pt',IPT1.NUM(NOELEP(I),1),' inc',LISINC(I),
  110. * & 'Four' , IRIGEL(5,1)
  111. DO 120 J=1,INCPO(/1)
  112. KK = INCPO(J,IPOI1)
  113. IF ( KK.NE.0) THEN
  114. * write(6,*) 'KK',kk,'Pt',IPT2.NUM(1,IPOI1),' inc',IMIK(J),
  115. * & 'Four' , IHAR(J)
  116. IF (IMIK(J).EQ.LISINC(I).AND.IHAR(J).EQ.IRIGEL(5,1))THEN
  117. DNORMM(I) = DNOR(KK)
  118. IF (IIMPI.EQ.9022) WRITE(IOIMP,910)(IPT2.NUM(1,IPOI1)),
  119. & LISINC(I),DNORMM(I)
  120. c
  121. c boucle conditionnelle on saute la fin de la boucle
  122. GOTO 200
  123. ENDIF
  124. ENDIF
  125. 120 CONTINUE
  126. 910 FORMAT ('Noeud ',I4,' Composante ',A,' Coef Norm ',E9.3)
  127. c si on arrive ici ca n'est pas bon cela signifie que l'on a pas iden
  128. c tifié l'inconnue dans MMATRI
  129. c
  130. SEGSUP DNORMM,NCOOR
  131. SEGDES MINCPO,MIMIK,MHARK,MDNOR
  132. SEGDES IPT1,IPT2
  133. WRITE(IOIMP,*) 'Erreur 3 dans la routine SUPNRM'
  134. WRITE(IOIMP,*) 'On ne retrouve pas une inconnue dans matri'
  135. CALL ERREUR(5)
  136. RETURN
  137. c
  138. 200 CONTINUE
  139. c
  140. c on va pouvoir modifier la matrice
  141. c
  142. xMATRI = IRIGEL(4,1)
  143. * XMATRI = IMATTT(1)
  144. SEGACT XMATRI*MOD
  145.  
  146. DO 400 I=1,NLIGRP
  147. DO 300 J=1,NLIGRP
  148. RE(I,J,1) = RE(I,J,1) / DNORMM(I) / DNORMM(J)
  149. 300 CONTINUE
  150. 400 CONTINUE
  151. c
  152. c on desactive tout
  153. c
  154. SEGSUP NCOOR
  155. SEGDES ,MINCPO,MIMIK,MHARK,MDNOR
  156. SEGDES ,IPT1,IPT2
  157. SEGDES ,XMATRI
  158. c
  159. RETURN
  160. END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  

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