Télécharger relr1a.eso

Retour à la liste

Numérotation des lignes :

  1. C RELR1A SOURCE GOUNAND 11/05/24 21:15:58 6976
  2. SUBROUTINE RELR1A(MINCD,KRSPGD,KRINCD,
  3. $ MEL,DES,
  4. $ DDDNUL,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : RELR1A
  10. C DESCRIPTION :
  11. * construction de la correspondance :
  12. * ieme ddl dual de la matrice assemblée <->
  13. * (numéro d'élément, numéro ddl dual local)
  14. * de la rigidité dans lesquels il apparait
  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 : RELR14
  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, 30/06/2003, version initiale
  35. C HISTORIQUE : v1, 30/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 SMRIGID
  45. POINTEUR DES.DESCR
  46. -INC SMELEME
  47. POINTEUR MEL.MELEME
  48. * Includes persos
  49. CBEGININCLUDE SMMINC
  50. SEGMENT MINC
  51. INTEGER NPOS(NPT+1)
  52. INTEGER MPOS(NPT,NBI+1)
  53. ENDSEGMENT
  54. SEGMENT IMINC
  55. INTEGER LNUPO (NDDL)
  56. INTEGER LNUINC(NDDL)
  57. ENDSEGMENT
  58. CENDINCLUDE SMMINC
  59. POINTEUR MINCD.MINC
  60. * Segment LSTIND (liste séquentielle indexée)
  61. SEGMENT LSTIND
  62. INTEGER IDX(NBM+1)
  63. INTEGER IELRIG(NBTVAL)
  64. INTEGER ILIGR (NBTVAL)
  65. ENDSEGMENT
  66. POINTEUR DDDNUL.LSTIND
  67. *
  68. -INC SMLENTI
  69. POINTEUR KRSPGD.MLENTI
  70. POINTEUR KRINCD.MLENTI
  71. POINTEUR DDDNOL.MLENTI
  72. POINTEUR DDDIUL.MLENTI
  73. *
  74. INTEGER IMPR,IRET
  75. *
  76. * Executable statements
  77. *
  78. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr1a.eso'
  79. NPODUA=MINCD.NPOS(/1)-1
  80. NDDLDU=MINCD.NPOS(NPODUA+1)-1
  81. NEL=MEL.NUM(/2)
  82. NDDLOD=DES.NOELED(/1)
  83. *
  84. * Passe 1 : construction de la correspondance :
  85. * ieme ddl dual <-> nombre de fois qu'il
  86. * apparait dans MEL
  87. * DDDNOL
  88. *
  89. JG=NDDLDU
  90. SEGINI DDDNOL
  91. DO IEL=1,NEL
  92. DO IDDLOD=1,NDDLOD
  93. IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL))
  94. IINC=KRINCD.LECT(IDDLOD)
  95. IPOS=MINCD.MPOS(IPO,IINC)
  96. IF (IPOS.EQ.0) THEN
  97. WRITE(IOIMP,*) 'Erreur grave no1'
  98. GOTO 9999
  99. ENDIF
  100. IDDLDU=MINCD.NPOS(IPO)+IPOS-1
  101. DDDNOL.LECT(IDDLDU)=DDDNOL.LECT(IDDLDU)+1
  102. ENDDO
  103. ENDDO
  104. *
  105. * Passe 2 : construction de la correspondance :
  106. * ieme ddl dual <-> (numéro d'élément de MEL)
  107. * DDDNUL
  108. JG=NDDLDU
  109. SEGINI DDDIUL
  110. IDEPA=1
  111. DO IDDLDU=1,NDDLDU
  112. DDDIUL.LECT(IDDLDU)=IDEPA
  113. IDEPA=IDEPA+DDDNOL.LECT(IDDLDU)
  114. ENDDO
  115. SEGSUP DDDNOL
  116. NBM=NDDLDU
  117. NBTVAL=IDEPA-1
  118. SEGINI DDDNUL
  119. DO IDDLDU=1,NDDLDU
  120. DDDNUL.IDX(IDDLDU)=DDDIUL.LECT(IDDLDU)
  121. ENDDO
  122. DDDNUL.IDX(NDDLDU+1)=IDEPA
  123. DO IEL=1,NEL
  124. DO IDDLOD=1,NDDLOD
  125. IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL))
  126. IINC=KRINCD.LECT(IDDLOD)
  127. IPOS=MINCD.MPOS(IPO,IINC)
  128. IF (IPOS.EQ.0) THEN
  129. WRITE(IOIMP,*) 'Erreur grave no2'
  130. GOTO 9999
  131. ENDIF
  132. IDDLDU=MINCD.NPOS(IPO)+IPOS-1
  133. IDXCOU=DDDIUL.LECT(IDDLDU)
  134. DDDNUL.IELRIG(IDXCOU)=IEL
  135. DDDNUL.ILIGR (IDXCOU)=IDDLOD
  136. DDDIUL.LECT(IDDLDU)=IDXCOU+1
  137. ENDDO
  138. ENDDO
  139. SEGSUP DDDIUL
  140. SEGDES DDDNUL
  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 relr1a'
  155. RETURN
  156. *
  157. * End of subroutine RELR1A
  158. *
  159. END
  160.  
  161.  
  162.  

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