Télécharger relr12.eso

Retour à la liste

Numérotation des lignes :

relr12
  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.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. -INC SMRIGID
  46. POINTEUR MLIN.MRIGID
  47. POINTEUR DES.DESCR
  48. -INC SMLMOTS
  49. POINTEUR LINCP.MLMOTS
  50. POINTEUR LINCD.MLMOTS
  51. POINTEUR LINTMP.MLMOTS
  52. *
  53. INTEGER IMPR,IRET
  54. *
  55. * Executable statements
  56. *
  57. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr12.eso'
  58. *
  59. SEGACT MLIN
  60. NRIG=MLIN.IRIGEL(/2)
  61. *
  62. * Primale
  63. *
  64. JGN=4
  65. JGM=0
  66. IGM=0
  67. SEGINI LINTMP
  68. DO IRIG=1,NRIG
  69. DES=MLIN.IRIGEL(3,IRIG)
  70. SEGACT DES
  71. NDDL=DES.LISINC(/2)
  72. JGM=JGM+NDDL
  73. SEGADJ LINTMP
  74. DO IDDL=1,NDDL
  75. IGM=IGM+1
  76. LINTMP.MOTS(IGM)=DES.LISINC(IDDL)
  77. ENDDO
  78. SEGDES DES
  79. ENDDO
  80. * Suppression des doublons
  81. SEGINI LINCP
  82. CALL CUNIQ(LINTMP.MOTS,JGN,JGM,
  83. $ LINCP.MOTS,JGM2,
  84. $ IMPR,IRET)
  85. IF (IRET.NE.0) GOTO 9999
  86. JGM=JGM2
  87. SEGADJ LINCP
  88. SEGDES LINCP
  89. SEGSUP LINTMP
  90. *
  91. * Duale (copie conforme du dessus)
  92. *
  93. JGN=4
  94. JGM=0
  95. IGM=0
  96. SEGINI LINTMP
  97. DO IRIG=1,NRIG
  98. DES=MLIN.IRIGEL(3,IRIG)
  99. SEGACT DES
  100. NDDL=DES.LISDUA(/2)
  101. JGM=JGM+NDDL
  102. SEGADJ LINTMP
  103. DO IDDL=1,NDDL
  104. IGM=IGM+1
  105. LINTMP.MOTS(IGM)=DES.LISDUA(IDDL)
  106. ENDDO
  107. SEGDES DES
  108. ENDDO
  109. * Suppression des doublons
  110. SEGINI LINCD
  111. CALL CUNIQ(LINTMP.MOTS,JGN,JGM,
  112. $ LINCD.MOTS,JGM2,
  113. $ IMPR,IRET)
  114. IF (IRET.NE.0) GOTO 9999
  115. JGM=JGM2
  116. SEGADJ LINCD
  117. SEGDES LINCD
  118. SEGSUP LINTMP
  119. SEGDES MLIN
  120. *
  121. * Normal termination
  122. *
  123. IRET=0
  124. RETURN
  125. *
  126. * Format handling
  127. *
  128. *
  129. * Error handling
  130. *
  131. 9999 CONTINUE
  132. IRET=1
  133. WRITE(IOIMP,*) 'An error was detected in subroutine relr12'
  134. RETURN
  135. *
  136. * End of subroutine RELR12
  137. *
  138. END
  139.  
  140.  
  141.  

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