Télécharger prmcp4.eso

Retour à la liste

Numérotation des lignes :

prmcp4
  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.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. C
  41. C**** Variables de COOPTIO
  42. C
  43. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  44. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  45. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  46. C & ,IECHO, IIMPI, IOSPI
  47. C & ,IDIM
  48. C & ,MCOORD
  49. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  50. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  51. C & ,NORINC,NORVAL,NORIND,NORVAD
  52. C & ,NUCROU, IPSAUV
  53. C
  54. -INC SMLENTI
  55. INTEGER JG
  56. POINTEUR ICMPRI.MLENTI
  57. POINTEUR ICCPRI.MLENTI
  58. POINTEUR ICOPRI.MLENTI
  59. POINTEUR MLEWRK.MLENTI
  60. POINTEUR KRPRI.MLENTI
  61. POINTEUR MLQUNF.MLENTI
  62. * Liste de MLENTI
  63. INTEGER NBMLEN
  64. SEGMENT MLENTS
  65. POINTEUR LISMLE(NBMLEN).MLENTI
  66. ENDSEGMENT
  67. POINTEUR GPMLES.MLENTS
  68. *
  69. INTEGER IMPR,IRET
  70. *
  71. INTEGER IBMLEN,IGWRK,IIUNIQ
  72. INTEGER NGWRK,NIUNIQ
  73. INTEGER NUPRI,NBPRI
  74. *
  75. * Executable statements
  76. *
  77. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp4.eso'
  78. * Initialisation de la liste de MLENTI (ici, il y en a deux)
  79. NBMLEN=2
  80. SEGINI GPMLES
  81. GPMLES.LISMLE(1)=ICMPRI
  82. GPMLES.LISMLE(2)=ICCPRI
  83. * NIUNIQ est la dimension de l'espace des noms d'inconnues
  84. JG=NIUNIQ
  85. SEGINI KRPRI
  86. SEGINI MLQUNF
  87. DO 2 IBMLEN=1,NBMLEN
  88. MLEWRK=GPMLES.LISMLE(IBMLEN)
  89. SEGACT MLEWRK
  90. NGWRK=MLEWRK.LECT(/1)
  91. *
  92. ******** En general, ICMPRI peux contenir le meme nom
  93. * d'inconnue plusieurs fois.
  94. * Mais on doit conter sa contribution que une seule
  95. * fois!
  96. * C'est pur ça qu'on utilize le segment MEQUNF.LECT
  97. *
  98. DO 22 IGWRK=1,NGWRK
  99. NUPRI=MLEWRK.LECT(IGWRK)
  100. IF(MLQUNF.LECT(NUPRI) .EQ. 0)THEN
  101. MLQUNF.LECT(NUPRI) = 1
  102. KRPRI.LECT(NUPRI)=KRPRI.LECT(NUPRI)+1
  103. ENDIF
  104. 22 CONTINUE
  105. SEGDES MLEWRK
  106. DO IIUNIQ=1,NIUNIQ,1
  107. MLQUNF.LECT(IIUNIQ) = 0
  108. ENDDO
  109. 2 CONTINUE
  110. SEGSUP GPMLES
  111. JG=0
  112. SEGINI ICOPRI
  113. DO 3 IIUNIQ=1,NIUNIQ
  114. NBPRI=KRPRI.LECT(IIUNIQ)
  115. IF (NBPRI.EQ.NBMLEN) THEN
  116. ICOPRI.LECT(**)=IIUNIQ
  117. ENDIF
  118. 3 CONTINUE
  119. SEGDES ICOPRI
  120. SEGSUP KRPRI
  121. SEGSUP MLQUNF
  122. *
  123. * Normal termination
  124. *
  125. IRET=0
  126. RETURN
  127. *
  128. * Format handling
  129. *
  130. *
  131. * Error handling
  132. *
  133. 9999 CONTINUE
  134. IRET=1
  135. WRITE(IOIMP,*) 'An error was detected in subroutine prmcp4'
  136. RETURN
  137. *
  138. * End of subroutine PRMCP4
  139. *
  140. END
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  

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