Télécharger relr13.eso

Retour à la liste

Numérotation des lignes :

relr13
  1. C RELR13 SOURCE PV 20/03/30 21:23:57 10567
  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.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMCOORD
  48. -INC SMRIGID
  49. POINTEUR MLIN.MRIGID
  50. POINTEUR DES.DESCR
  51. -INC SMELEME
  52. POINTEUR MEL.MELEME
  53. * Includes persos
  54. CBEGININCLUDE SMMINC
  55. SEGMENT MINC
  56. INTEGER NPOS(NPT+1)
  57. INTEGER MPOS(NPT,NBI+1)
  58. ENDSEGMENT
  59. SEGMENT IMINC
  60. INTEGER LNUPO (NDDL)
  61. INTEGER LNUINC(NDDL)
  62. ENDSEGMENT
  63. CENDINCLUDE SMMINC
  64. POINTEUR MINCP.MINC
  65. POINTEUR MINCD.MINC
  66. *
  67. -INC SMLENTI
  68. POINTEUR KJSPGP.MLENTI
  69. POINTEUR KJSPGD.MLENTI
  70. POINTEUR KRSPGP.MLENTI
  71. POINTEUR KRSPGD.MLENTI
  72. POINTEUR KRINCP.MLENTI
  73. POINTEUR KRINCD.MLENTI
  74. -INC SMLMOTS
  75. POINTEUR LINCP.MLMOTS
  76. POINTEUR LINCD.MLMOTS
  77. *
  78. INTEGER IMPR,IRET
  79. *
  80. LOGICAL LEXIST
  81. *
  82. * Executable statements
  83. *
  84. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr13.eso'
  85. SEGACT MLIN
  86. NRIG=MLIN.IRIGEL(/2)
  87. *
  88. * Primale
  89. *
  90. * Construction du segment de repérage dans l'ensemble des points
  91. SEGACT KJSPGP
  92. NPOPRI=KJSPGP.LECT(/1)
  93. JG=nbpts
  94. SEGINI KRSPGP
  95. CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI)
  96. SEGDES KJSPGP
  97. SEGACT LINCP
  98. NINCP=LINCP.MOTS(/2)
  99. * Initialisation de MINCP
  100. NPT=NPOPRI
  101. NBI=NINCP
  102. SEGINI MINCP
  103. DO IRIG=1,NRIG
  104. MEL=MLIN.IRIGEL(1,IRIG)
  105. SEGACT MEL
  106. NEL=MEL.NUM(/2)
  107. DES=MLIN.IRIGEL(3,IRIG)
  108. SEGACT DES
  109. NDDL=DES.NOELEP(/1)
  110. * Construction du segment de repérage dans les inconnues primales
  111. JG=DES.LISINC(/2)
  112. SEGINI KRINCP
  113. CALL CREPER(DES.LISINC(/1),NDDL,NINCP,
  114. $ DES.LISINC,LINCP.MOTS,
  115. $ KRINCP.LECT,
  116. $ IMPR,IRET)
  117. IF (IRET.NE.0) GOTO 9999
  118. DO IEL=1,NEL
  119. DO IDDL=1,NDDL
  120. IPO=KRSPGP.LECT(MEL.NUM(DES.NOELEP(IDDL),IEL))
  121. IINC=KRINCP.LECT(IDDL)
  122. * On cherche si l'inconnue n'existe pas déjà dans MPOS
  123. LEXIST=(MINCP.MPOS(IPO,IINC).NE.0)
  124. * Sinon, on la rajoute...
  125. IF (.NOT.LEXIST) THEN
  126. NPOINC=MINCP.MPOS(IPO,NINCP+1)+1
  127. MINCP.MPOS(IPO,NINCP+1)=NPOINC
  128. MINCP.MPOS(IPO,IINC) =NPOINC
  129. ENDIF
  130. ENDDO
  131. ENDDO
  132. SEGSUP KRINCP
  133. SEGDES DES
  134. SEGDES MEL
  135. ENDDO
  136. * Remplisssage de NPOS
  137. MINCP.NPOS(1)=1
  138. DO IPOPRI=1,NPOPRI
  139. MINCP.NPOS(IPOPRI+1)=MINCP.NPOS(IPOPRI)
  140. $ + MINCP.MPOS(IPOPRI,NINCP+1)
  141. ENDDO
  142. SEGDES MINCP
  143. SEGDES LINCP
  144. SEGSUP KRSPGP
  145. *
  146. * Duale (copie conforme de ci-dessus)
  147. *
  148. * Construction du segment de repérage dans l'ensemble des points
  149. SEGACT KJSPGD
  150. NPODUA=KJSPGD.LECT(/1)
  151. JG=nbpts
  152. SEGINI KRSPGD
  153. CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA)
  154. SEGDES KJSPGD
  155. SEGACT LINCD
  156. NINCD=LINCD.MOTS(/2)
  157. * Initialisation de MINCP
  158. NPT=NPODUA
  159. NBI=NINCD
  160. SEGINI MINCD
  161. DO IRIG=1,NRIG
  162. MEL=MLIN.IRIGEL(1,IRIG)
  163. SEGACT MEL
  164. NEL=MEL.NUM(/2)
  165. DES=MLIN.IRIGEL(3,IRIG)
  166. SEGACT DES
  167. NDDL=DES.NOELED(/1)
  168. * Construction du segment de repérage dans les inconnues primales
  169. JG=DES.LISDUA(/2)
  170. SEGINI KRINCD
  171. CALL CREPER(DES.LISDUA(/1),NDDL,NINCD,
  172. $ DES.LISDUA,LINCD.MOTS,
  173. $ KRINCD.LECT,
  174. $ IMPR,IRET)
  175. IF (IRET.NE.0) GOTO 9999
  176. DO IEL=1,NEL
  177. DO IDDL=1,NDDL
  178. IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDL),IEL))
  179. IINC=KRINCD.LECT(IDDL)
  180. * On cherche si l'inconnue n'existe pas déjà dans MPOS
  181. LEXIST=(MINCD.MPOS(IPO,IINC).NE.0)
  182. * Sinon, on la rajoute...
  183. IF (.NOT.LEXIST) THEN
  184. NPOINC=MINCD.MPOS(IPO,NINCD+1)+1
  185. MINCD.MPOS(IPO,NINCD+1)=NPOINC
  186. MINCD.MPOS(IPO,IINC) =NPOINC
  187. ENDIF
  188. ENDDO
  189. ENDDO
  190. SEGSUP KRINCD
  191. SEGDES DES
  192. SEGDES MEL
  193. ENDDO
  194. * Remplisssage de NPOS
  195. MINCD.NPOS(1)=1
  196. DO IPODUA=1,NPODUA
  197. MINCD.NPOS(IPODUA+1)=MINCD.NPOS(IPODUA)
  198. $ + MINCD.MPOS(IPODUA,NINCD+1)
  199. ENDDO
  200. SEGDES MINCD
  201. SEGDES LINCD
  202. SEGSUP KRSPGD
  203. SEGDES MLIN
  204. *
  205. * Normal termination
  206. *
  207. IRET=0
  208. RETURN
  209. *
  210. * Format handling
  211. *
  212. *
  213. * Error handling
  214. *
  215. 9999 CONTINUE
  216. IRET=1
  217. WRITE(IOIMP,*) 'An error was detected in subroutine relr13'
  218. RETURN
  219. *
  220. * End of subroutine RELR13
  221. *
  222. END
  223.  
  224.  
  225.  
  226.  

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