Télécharger relr13.eso

Retour à la liste

Numérotation des lignes :

  1. C RELR13 SOURCE GOUNAND 11/05/24 21:15:55 6976
  2. SUBROUTINE RELR13(MLIN,KJSPGP,KJSPGD,LINCP,LINCD,
  3. $ MINCP,MINCD,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : RELR13
  9. C DESCRIPTION :
  10. *
  11. * Construction des tableaux de correspondance ddl <-> (point, nom de
  12. * variable) :
  13. * - pour les inconnues primales : MINCP
  14. * - pour les inconnues duales : MINCD
  15. *
  16. C
  17. C
  18. C
  19. C LANGAGE : ESOPE
  20. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  21. C mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C APPELES :
  24. C APPELES (E/S) :
  25. C APPELES (BLAS) :
  26. C APPELES (CALCUL) :
  27. C APPELE PAR :
  28. C***********************************************************************
  29. C SYNTAXE GIBIANE :
  30. C ENTREES :
  31. C ENTREES/SORTIES :
  32. C SORTIES :
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION : v1, 27/06/2003, version initiale
  36. C HISTORIQUE : v1, 27/06/2003, création
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44. -INC CCOPTIO
  45. -INC SMCOORD
  46. -INC SMRIGID
  47. POINTEUR MLIN.MRIGID
  48. POINTEUR DES.DESCR
  49. -INC SMELEME
  50. POINTEUR MEL.MELEME
  51. * Includes persos
  52. CBEGININCLUDE SMMINC
  53. SEGMENT MINC
  54. INTEGER NPOS(NPT+1)
  55. INTEGER MPOS(NPT,NBI+1)
  56. ENDSEGMENT
  57. SEGMENT IMINC
  58. INTEGER LNUPO (NDDL)
  59. INTEGER LNUINC(NDDL)
  60. ENDSEGMENT
  61. CENDINCLUDE SMMINC
  62. POINTEUR MINCP.MINC
  63. POINTEUR MINCD.MINC
  64. *
  65. -INC SMLENTI
  66. POINTEUR KJSPGP.MLENTI
  67. POINTEUR KJSPGD.MLENTI
  68. POINTEUR KRSPGP.MLENTI
  69. POINTEUR KRSPGD.MLENTI
  70. POINTEUR KRINCP.MLENTI
  71. POINTEUR KRINCD.MLENTI
  72. -INC SMLMOTS
  73. POINTEUR LINCP.MLMOTS
  74. POINTEUR LINCD.MLMOTS
  75. *
  76. INTEGER IMPR,IRET
  77. *
  78. LOGICAL LEXIST
  79. *
  80. * Executable statements
  81. *
  82. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr13.eso'
  83. SEGACT MLIN
  84. NRIG=MLIN.IRIGEL(/2)
  85. *
  86. * Primale
  87. *
  88. * Construction du segment de repérage dans l'ensemble des points
  89. SEGACT KJSPGP
  90. NPOPRI=KJSPGP.LECT(/1)
  91. JG=XCOOR(/1)/(IDIM+1)
  92. SEGINI KRSPGP
  93. CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI)
  94. SEGDES KJSPGP
  95. SEGACT LINCP
  96. NINCP=LINCP.MOTS(/2)
  97. * Initialisation de MINCP
  98. NPT=NPOPRI
  99. NBI=NINCP
  100. SEGINI MINCP
  101. DO IRIG=1,NRIG
  102. MEL=MLIN.IRIGEL(1,IRIG)
  103. SEGACT MEL
  104. NEL=MEL.NUM(/2)
  105. DES=MLIN.IRIGEL(3,IRIG)
  106. SEGACT DES
  107. NDDL=DES.NOELEP(/1)
  108. * Construction du segment de repérage dans les inconnues primales
  109. JG=DES.LISINC(/2)
  110. SEGINI KRINCP
  111. CALL CREPER(DES.LISINC(/1),NDDL,NINCP,
  112. $ DES.LISINC,LINCP.MOTS,
  113. $ KRINCP.LECT,
  114. $ IMPR,IRET)
  115. IF (IRET.NE.0) GOTO 9999
  116. DO IEL=1,NEL
  117. DO IDDL=1,NDDL
  118. IPO=KRSPGP.LECT(MEL.NUM(DES.NOELEP(IDDL),IEL))
  119. IINC=KRINCP.LECT(IDDL)
  120. * On cherche si l'inconnue n'existe pas déjà dans MPOS
  121. LEXIST=(MINCP.MPOS(IPO,IINC).NE.0)
  122. * Sinon, on la rajoute...
  123. IF (.NOT.LEXIST) THEN
  124. NPOINC=MINCP.MPOS(IPO,NINCP+1)+1
  125. MINCP.MPOS(IPO,NINCP+1)=NPOINC
  126. MINCP.MPOS(IPO,IINC) =NPOINC
  127. ENDIF
  128. ENDDO
  129. ENDDO
  130. SEGSUP KRINCP
  131. SEGDES DES
  132. SEGDES MEL
  133. ENDDO
  134. * Remplisssage de NPOS
  135. MINCP.NPOS(1)=1
  136. DO IPOPRI=1,NPOPRI
  137. MINCP.NPOS(IPOPRI+1)=MINCP.NPOS(IPOPRI)
  138. $ + MINCP.MPOS(IPOPRI,NINCP+1)
  139. ENDDO
  140. SEGDES MINCP
  141. SEGDES LINCP
  142. SEGSUP KRSPGP
  143. *
  144. * Duale (copie conforme de ci-dessus)
  145. *
  146. * Construction du segment de repérage dans l'ensemble des points
  147. SEGACT KJSPGD
  148. NPODUA=KJSPGD.LECT(/1)
  149. JG=XCOOR(/1)/(IDIM+1)
  150. SEGINI KRSPGD
  151. CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA)
  152. SEGDES KJSPGD
  153. SEGACT LINCD
  154. NINCD=LINCD.MOTS(/2)
  155. * Initialisation de MINCP
  156. NPT=NPODUA
  157. NBI=NINCD
  158. SEGINI MINCD
  159. DO IRIG=1,NRIG
  160. MEL=MLIN.IRIGEL(1,IRIG)
  161. SEGACT MEL
  162. NEL=MEL.NUM(/2)
  163. DES=MLIN.IRIGEL(3,IRIG)
  164. SEGACT DES
  165. NDDL=DES.NOELED(/1)
  166. * Construction du segment de repérage dans les inconnues primales
  167. JG=DES.LISDUA(/2)
  168. SEGINI KRINCD
  169. CALL CREPER(DES.LISDUA(/1),NDDL,NINCD,
  170. $ DES.LISDUA,LINCD.MOTS,
  171. $ KRINCD.LECT,
  172. $ IMPR,IRET)
  173. IF (IRET.NE.0) GOTO 9999
  174. DO IEL=1,NEL
  175. DO IDDL=1,NDDL
  176. IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDL),IEL))
  177. IINC=KRINCD.LECT(IDDL)
  178. * On cherche si l'inconnue n'existe pas déjà dans MPOS
  179. LEXIST=(MINCD.MPOS(IPO,IINC).NE.0)
  180. * Sinon, on la rajoute...
  181. IF (.NOT.LEXIST) THEN
  182. NPOINC=MINCD.MPOS(IPO,NINCD+1)+1
  183. MINCD.MPOS(IPO,NINCD+1)=NPOINC
  184. MINCD.MPOS(IPO,IINC) =NPOINC
  185. ENDIF
  186. ENDDO
  187. ENDDO
  188. SEGSUP KRINCD
  189. SEGDES DES
  190. SEGDES MEL
  191. ENDDO
  192. * Remplisssage de NPOS
  193. MINCD.NPOS(1)=1
  194. DO IPODUA=1,NPODUA
  195. MINCD.NPOS(IPODUA+1)=MINCD.NPOS(IPODUA)
  196. $ + MINCD.MPOS(IPODUA,NINCD+1)
  197. ENDDO
  198. SEGDES MINCD
  199. SEGDES LINCD
  200. SEGSUP KRSPGD
  201. SEGDES MLIN
  202. *
  203. * Normal termination
  204. *
  205. IRET=0
  206. RETURN
  207. *
  208. * Format handling
  209. *
  210. *
  211. * Error handling
  212. *
  213. 9999 CONTINUE
  214. IRET=1
  215. WRITE(IOIMP,*) 'An error was detected in subroutine relr13'
  216. RETURN
  217. *
  218. * End of subroutine RELR13
  219. *
  220. END
  221.  
  222.  
  223.  

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