Télécharger relr11.eso

Retour à la liste

Numérotation des lignes :

  1. C RELR11 SOURCE GOUNAND 11/05/24 21:15:52 6976
  2. SUBROUTINE RELR11(MLIN,
  3. $ KJSPGP,KJSPGD,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : RELR11
  9. C DESCRIPTION : Assemblage d'un rigidité
  10. C Construction de :
  11. C - l'ensemble des points sur lesquels il y a au moins une inconnue
  12. C primale : KJSPGP
  13. C - l'ensemble des points sur lesquels il y a au moins une inconnue
  14. C duale : KJSPGD
  15. C
  16. C
  17. C
  18. C LANGAGE : ESOPE
  19. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  20. C mél : gounand@semt2.smts.cea.fr
  21. C***********************************************************************
  22. C APPELES :
  23. C APPELES (E/S) :
  24. C APPELES (BLAS) :
  25. C APPELES (CALCUL) :
  26. C APPELE PAR : RELR10
  27. C***********************************************************************
  28. C SYNTAXE GIBIANE :
  29. C ENTREES :
  30. C ENTREES/SORTIES :
  31. C SORTIES :
  32. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  33. C***********************************************************************
  34. C VERSION : v1, 26/06/2003, version initiale
  35. C HISTORIQUE : v1, 26/06/2003, création
  36. C HISTORIQUE :
  37. C HISTORIQUE :
  38. C***********************************************************************
  39. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40. C en cas de modification de ce sous-programme afin de faciliter
  41. C la maintenance !
  42. C***********************************************************************
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. -INC SMRIGID
  46. POINTEUR MLIN.MRIGID
  47. POINTEUR DES.DESCR
  48. -INC SMELEME
  49. POINTEUR MEL.MELEME
  50. -INC SMLENTI
  51. POINTEUR KJSPGP.MLENTI
  52. POINTEUR KLSPGP.MLENTI
  53. POINTEUR KJSPGD.MLENTI
  54. POINTEUR KLSPGD.MLENTI
  55. *
  56. INTEGER IMPR,IRET
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr11.eso'
  61. *
  62. SEGACT MLIN
  63. NRIG=MLIN.IRIGEL(/2)
  64. *
  65. * Primale
  66. *
  67. JG=XCOOR(/1)/(IDIM+1)
  68. SEGINI KLSPGP
  69. * degré et fin de la liste chaînée
  70. LDG=0
  71. LAST=-1
  72. DO IRIG=1,NRIG
  73. MEL=MLIN.IRIGEL(1,IRIG)
  74. SEGACT MEL
  75. NEL=MEL.NUM(/2)
  76. DES=MLIN.IRIGEL(3,IRIG)
  77. SEGACT DES
  78. NDDL=DES.NOELEP(/1)
  79. DO IEL=1,NEL
  80. DO IDDL=1,NDDL
  81. NUMNO=MEL.NUM(DES.NOELEP(IDDL),IEL)
  82. IF (KLSPGP.LECT(NUMNO).EQ.0) THEN
  83. LDG=LDG+1
  84. KLSPGP.LECT(NUMNO)=LAST
  85. LAST=NUMNO
  86. ENDIF
  87. ENDDO
  88. ENDDO
  89. SEGDES DES
  90. SEGDES MEL
  91. ENDDO
  92. * transfert de la liste chainee dans KJSPGP
  93. JG=LDG
  94. SEGINI KJSPGP
  95. DO IDG=1,LDG
  96. IPREC=KLSPGP.LECT(LAST)
  97. KJSPGP.LECT(IDG)=LAST
  98. LAST=IPREC
  99. ENDDO
  100. SEGSUP KLSPGP
  101. SEGDES KJSPGP
  102. *
  103. * Duale (copie conforme du dessus)
  104. *
  105. JG=XCOOR(/1)/(IDIM+1)
  106. SEGINI KLSPGD
  107. * degré et fin de la liste chaînée
  108. LDG=0
  109. LAST=-1
  110. DO IRIG=1,NRIG
  111. MEL=MLIN.IRIGEL(1,IRIG)
  112. SEGACT MEL
  113. NEL=MEL.NUM(/2)
  114. DES=MLIN.IRIGEL(3,IRIG)
  115. SEGACT DES
  116. NDDL=DES.NOELED(/1)
  117. DO IEL=1,NEL
  118. DO IDDL=1,NDDL
  119. NUMNO=MEL.NUM(DES.NOELED(IDDL),IEL)
  120. IF (KLSPGD.LECT(NUMNO).EQ.0) THEN
  121. LDG=LDG+1
  122. KLSPGD.LECT(NUMNO)=LAST
  123. LAST=NUMNO
  124. ENDIF
  125. ENDDO
  126. ENDDO
  127. SEGDES DES
  128. SEGDES MEL
  129. ENDDO
  130. * transfert de la liste chainee dans KJSPGD
  131. JG=LDG
  132. SEGINI KJSPGD
  133. DO IDG=1,LDG
  134. IPREC=KLSPGD.LECT(LAST)
  135. KJSPGD.LECT(IDG)=LAST
  136. LAST=IPREC
  137. ENDDO
  138. SEGSUP KLSPGD
  139. SEGDES KJSPGD
  140. SEGDES MLIN
  141. *
  142. * Normal termination
  143. *
  144. IRET=0
  145. RETURN
  146. *
  147. * Format handling
  148. *
  149. *
  150. * Error handling
  151. *
  152. 9999 CONTINUE
  153. IRET=1
  154. WRITE(IOIMP,*) 'An error was detected in subroutine relr11'
  155. RETURN
  156. *
  157. * End of subroutine RELR11
  158. *
  159. END
  160.  
  161.  
  162.  

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