Télécharger prmcp3.eso

Retour à la liste

Numérotation des lignes :

  1. C PRMCP3 SOURCE PV 16/11/17 22:01:14 9180
  2. SUBROUTINE PRMCP3(MMATEL,MSOPRI,
  3. $ ICOGLO,ICMPRI,ICMDUA,ICCPRI,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : PRMCP3
  9. C DESCRIPTION : Construction du repérage des inconnues.
  10. C
  11. * Repérage global des inconnues : ICOGLO (LISTMOTS)
  12. * Numéros des inconnues primales et duales de la matrice exprimées
  13. * dans ce repérage : ICMPRI, ICMDUA
  14. * Numéros des inconnues du chpoint primal : ICCPRI
  15. C
  16. C
  17. C LANGAGE : ESOPE
  18. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19. C mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES : CUNIQ, CREPER
  22. C APPELE PAR : PRMCP2
  23. C***********************************************************************
  24. C ENTREES : MMATEL, MSOPRI
  25. C ENTREES/SORTIES : -
  26. C SORTIES : ICOGLO, ICMPRI, ICMDUA, ICCPRI
  27. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28. C***********************************************************************
  29. C VERSION : v1, 18/04/2000, version initiale
  30. C HISTORIQUE : v1, 18/04/2000, création
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38. -INC CCOPTIO
  39. POINTEUR MMATEL.IMATRI
  40. -INC SMCHPOI
  41. POINTEUR MSOPRI.MSOUPO
  42. -INC SMLMOTS
  43. INTEGER JGM,JGN
  44. POINTEUR ICOGLO.MLMOTS
  45. POINTEUR ICCPR2.MLMOTS
  46. POINTEUR GPINCS.MLMOTS
  47. -INC SMLENTI
  48. INTEGER JG
  49. POINTEUR ICMPRI.MLENTI
  50. POINTEUR ICMDUA.MLENTI
  51. POINTEUR ICCPRI.MLENTI
  52. *
  53. INTEGER IMPR,IRET
  54. *
  55. INTEGER LNMOTS
  56. PARAMETER (LNMOTS=8)
  57. *
  58. INTEGER IBMC,IBMM,IINC
  59. INTEGER NBMC,NBMM
  60. INTEGER NIUNIQ
  61. *
  62. * Executable statements
  63. *
  64. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp3.eso'
  65. SEGACT MMATEL
  66. SEGACT MSOPRI
  67. NBMM=MMATEL.LISPRI(/2)
  68. NBMC=MSOPRI.NOCOMP(/2)
  69. JGN=LNMOTS
  70. JGM=NBMC
  71. SEGINI ICCPR2
  72. DO 1 IBMC=1,NBMC
  73. ICCPR2.MOTS(IBMC)=MSOPRI.NOCOMP(IBMC)//' '
  74. 1 CONTINUE
  75. JGN=LNMOTS
  76. JGM=(2*NBMM)+NBMC
  77. SEGINI GPINCS
  78. IINC=0
  79. DO 2 IBMM=1,NBMM
  80. IINC=IINC+1
  81. GPINCS.MOTS(IINC)=MMATEL.LISPRI(IBMM)
  82. 2 CONTINUE
  83. DO 4 IBMM=1,NBMM
  84. IINC=IINC+1
  85. GPINCS.MOTS(IINC)=MMATEL.LISDUA(IBMM)
  86. 4 CONTINUE
  87. DO 6 IBMC=1,NBMC
  88. IINC=IINC+1
  89. GPINCS.MOTS(IINC)=ICCPR2.MOTS(IBMC)
  90. 6 CONTINUE
  91. * Elimination des doublons dans les noms
  92. JGN=LNMOTS
  93. JGM=IINC
  94. SEGINI ICOGLO
  95. CALL CUNIQ(GPINCS.MOTS,LNMOTS,IINC,
  96. $ ICOGLO.MOTS,NIUNIQ,
  97. $ IMPR,IRET)
  98. IF (IRET.NE.0) GOTO 9999
  99. JGN=LNMOTS
  100. JGM=NIUNIQ
  101. SEGADJ,ICOGLO
  102. SEGSUP GPINCS
  103. * Noms des inconnues primales et duales de MMATEL et du chpo. primal
  104. * dans le repérage défini par ICOGLO : ICMPRI, ICMDUA et ICCPRI
  105. JG=NBMM
  106. SEGINI ICMPRI
  107. CALL CREPER(LNMOTS,NBMM,NIUNIQ,
  108. $ MMATEL.LISPRI,ICOGLO.MOTS,
  109. $ ICMPRI.LECT,
  110. $ IMPR,IRET)
  111. IF (IRET.NE.0) GOTO 9999
  112. SEGDES ICMPRI
  113. JG=NBMM
  114. SEGINI ICMDUA
  115. CALL CREPER(LNMOTS,NBMM,NIUNIQ,
  116. $ MMATEL.LISDUA,ICOGLO.MOTS,
  117. $ ICMDUA.LECT,
  118. $ IMPR,IRET)
  119. IF (IRET.NE.0) GOTO 9999
  120. SEGDES ICMDUA
  121. JG=NBMC
  122. SEGINI ICCPRI
  123. CALL CREPER(LNMOTS,NBMC,NIUNIQ,
  124. $ ICCPR2.MOTS,ICOGLO.MOTS,
  125. $ ICCPRI.LECT,
  126. $ IMPR,IRET)
  127. IF (IRET.NE.0) GOTO 9999
  128. SEGDES ICCPRI
  129. SEGDES ICOGLO
  130. SEGSUP ICCPR2
  131. SEGDES MSOPRI
  132. SEGDES MMATEL
  133. *
  134. * Normal termination
  135. *
  136. IRET=0
  137. RETURN
  138. *
  139. * Format handling
  140. *
  141. *
  142. * Error handling
  143. *
  144. 9999 CONTINUE
  145. IRET=1
  146. WRITE(IOIMP,*) 'An error was detected in subroutine prmcp3'
  147. RETURN
  148. *
  149. * End of subroutine PRMCP3
  150. *
  151. END
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  

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