Télécharger prmcp4.eso

Retour à la liste

Numérotation des lignes :

  1. C PRMCP4 SOURCE CHAT 05/01/13 02:28:45 5004
  2. SUBROUTINE PRMCP4(ICMPRI,ICCPRI,NIUNIQ,
  3. $ ICOPRI,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : PRMCP4
  9. C DESCRIPTION : Construction de la liste des inconnues communes à la
  10. C matrice et au chpoint.
  11. C
  12. * Construction de ICOPRI (LISTENTI), liste des inconnues
  13. * appartenant à la fois à ICMPRI et ICCPRI
  14. C
  15. C
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES : -
  21. C APPELE PAR : PRMCP2
  22. C***********************************************************************
  23. C ENTREES : ICMPRI, ICCPRI, NIUNIQ
  24. C ENTREES/SORTIES : -
  25. C SORTIES : ICOPRI
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 18/04/2000, version initiale
  29. C HISTORIQUE : v1, 18/04/2000, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. -INC CCOPTIO
  38. C
  39. C**** Variables de COOPTIO
  40. C
  41. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  42. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  43. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  44. C & ,IECHO, IIMPI, IOSPI
  45. C & ,IDIM
  46. C & ,MCOORD
  47. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  48. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  49. C & ,NORINC,NORVAL,NORIND,NORVAD
  50. C & ,NUCROU, IPSAUV
  51. C
  52. -INC SMLENTI
  53. INTEGER JG
  54. POINTEUR ICMPRI.MLENTI
  55. POINTEUR ICCPRI.MLENTI
  56. POINTEUR ICOPRI.MLENTI
  57. POINTEUR MLEWRK.MLENTI
  58. POINTEUR KRPRI.MLENTI
  59. POINTEUR MLQUNF.MLENTI
  60. * Liste de MLENTI
  61. INTEGER NBMLEN
  62. SEGMENT MLENTS
  63. POINTEUR LISMLE(NBMLEN).MLENTI
  64. ENDSEGMENT
  65. POINTEUR GPMLES.MLENTS
  66. *
  67. INTEGER IMPR,IRET
  68. *
  69. INTEGER IBMLEN,IGWRK,IIUNIQ
  70. INTEGER NGWRK,NIUNIQ
  71. INTEGER NUPRI,NBPRI
  72. *
  73. * Executable statements
  74. *
  75. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp4.eso'
  76. * Initialisation de la liste de MLENTI (ici, il y en a deux)
  77. NBMLEN=2
  78. SEGINI GPMLES
  79. GPMLES.LISMLE(1)=ICMPRI
  80. GPMLES.LISMLE(2)=ICCPRI
  81. * NIUNIQ est la dimension de l'espace des noms d'inconnues
  82. JG=NIUNIQ
  83. SEGINI KRPRI
  84. SEGINI MLQUNF
  85. DO 2 IBMLEN=1,NBMLEN
  86. MLEWRK=GPMLES.LISMLE(IBMLEN)
  87. SEGACT MLEWRK
  88. NGWRK=MLEWRK.LECT(/1)
  89. *
  90. ******** En general, ICMPRI peux contenir le meme nom
  91. * d'inconnue plusieurs fois.
  92. * Mais on doit conter sa contribution que une seule
  93. * fois!
  94. * C'est pur ça qu'on utilize le segment MEQUNF.LECT
  95. *
  96. DO 22 IGWRK=1,NGWRK
  97. NUPRI=MLEWRK.LECT(IGWRK)
  98. IF(MLQUNF.LECT(NUPRI) .EQ. 0)THEN
  99. MLQUNF.LECT(NUPRI) = 1
  100. KRPRI.LECT(NUPRI)=KRPRI.LECT(NUPRI)+1
  101. ENDIF
  102. 22 CONTINUE
  103. SEGDES MLEWRK
  104. DO IIUNIQ=1,NIUNIQ,1
  105. MLQUNF.LECT(IIUNIQ) = 0
  106. ENDDO
  107. 2 CONTINUE
  108. SEGSUP GPMLES
  109. JG=0
  110. SEGINI ICOPRI
  111. DO 3 IIUNIQ=1,NIUNIQ
  112. NBPRI=KRPRI.LECT(IIUNIQ)
  113. IF (NBPRI.EQ.NBMLEN) THEN
  114. ICOPRI.LECT(**)=IIUNIQ
  115. ENDIF
  116. 3 CONTINUE
  117. SEGDES ICOPRI
  118. SEGSUP KRPRI
  119. SEGSUP MLQUNF
  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 prmcp4'
  134. RETURN
  135. *
  136. * End of subroutine PRMCP4
  137. *
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  

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