Télécharger relr12.eso

Retour à la liste

Numérotation des lignes :

  1. C RELR12 SOURCE GOUNAND 11/05/24 21:15:54 6976
  2. SUBROUTINE RELR12(MLIN,
  3. $ LINCP,LINCD,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : RELR12
  9. C DESCRIPTION :
  10. * Construction de :
  11. * - l'ensemble des noms d'inconnues primales : LINCP
  12. * - l'ensemble des noms d'inconnues duales : LINCD
  13. C
  14. C
  15. C
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES :
  21. C APPELES (E/S) :
  22. C APPELES (BLAS) :
  23. C APPELES (CALCUL) :
  24. C APPELE PAR : RELR10
  25. C***********************************************************************
  26. C SYNTAXE GIBIANE :
  27. C ENTREES :
  28. C ENTREES/SORTIES :
  29. C SORTIES :
  30. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  31. C***********************************************************************
  32. C VERSION : v1, 26/06/2003, version initiale
  33. C HISTORIQUE : v1, 26/06/2003, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38. C en cas de modification de ce sous-programme afin de faciliter
  39. C la maintenance !
  40. C***********************************************************************
  41. -INC CCOPTIO
  42. -INC SMCOORD
  43. -INC SMRIGID
  44. POINTEUR MLIN.MRIGID
  45. POINTEUR DES.DESCR
  46. -INC SMLMOTS
  47. POINTEUR LINCP.MLMOTS
  48. POINTEUR LINCD.MLMOTS
  49. POINTEUR LINTMP.MLMOTS
  50. *
  51. INTEGER IMPR,IRET
  52. *
  53. * Executable statements
  54. *
  55. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr12.eso'
  56. *
  57. SEGACT MLIN
  58. NRIG=MLIN.IRIGEL(/2)
  59. *
  60. * Primale
  61. *
  62. JGN=4
  63. JGM=0
  64. IGM=0
  65. SEGINI LINTMP
  66. DO IRIG=1,NRIG
  67. DES=MLIN.IRIGEL(3,IRIG)
  68. SEGACT DES
  69. NDDL=DES.LISINC(/2)
  70. JGM=JGM+NDDL
  71. SEGADJ LINTMP
  72. DO IDDL=1,NDDL
  73. IGM=IGM+1
  74. LINTMP.MOTS(IGM)=DES.LISINC(IDDL)
  75. ENDDO
  76. SEGDES DES
  77. ENDDO
  78. * Suppression des doublons
  79. SEGINI LINCP
  80. CALL CUNIQ(LINTMP.MOTS,JGN,JGM,
  81. $ LINCP.MOTS,JGM2,
  82. $ IMPR,IRET)
  83. IF (IRET.NE.0) GOTO 9999
  84. JGM=JGM2
  85. SEGADJ LINCP
  86. SEGDES LINCP
  87. SEGSUP LINTMP
  88. *
  89. * Duale (copie conforme du dessus)
  90. *
  91. JGN=4
  92. JGM=0
  93. IGM=0
  94. SEGINI LINTMP
  95. DO IRIG=1,NRIG
  96. DES=MLIN.IRIGEL(3,IRIG)
  97. SEGACT DES
  98. NDDL=DES.LISDUA(/2)
  99. JGM=JGM+NDDL
  100. SEGADJ LINTMP
  101. DO IDDL=1,NDDL
  102. IGM=IGM+1
  103. LINTMP.MOTS(IGM)=DES.LISDUA(IDDL)
  104. ENDDO
  105. SEGDES DES
  106. ENDDO
  107. * Suppression des doublons
  108. SEGINI LINCD
  109. CALL CUNIQ(LINTMP.MOTS,JGN,JGM,
  110. $ LINCD.MOTS,JGM2,
  111. $ IMPR,IRET)
  112. IF (IRET.NE.0) GOTO 9999
  113. JGM=JGM2
  114. SEGADJ LINCD
  115. SEGDES LINCD
  116. SEGSUP LINTMP
  117. SEGDES MLIN
  118. *
  119. * Normal termination
  120. *
  121. IRET=0
  122. RETURN
  123. *
  124. * Format handling
  125. *
  126. *
  127. * Error handling
  128. *
  129. 9999 CONTINUE
  130. IRET=1
  131. WRITE(IOIMP,*) 'An error was detected in subroutine relr12'
  132. RETURN
  133. *
  134. * End of subroutine RELR12
  135. *
  136. END
  137.  
  138.  
  139.  

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