Télécharger inccom.eso

Retour à la liste

Numérotation des lignes :

  1. C INCCOM SOURCE GOUNAND 12/12/06 21:15:10 7593
  2. SUBROUTINE INCCOM(ICPRIB,ICPRIC,ICPRID,NIUNIQ,
  3. $ ICOPRI,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : INCCOM
  9. C DESCRIPTION : Construction de ICOPRI (LISTENTI), liste des inconnues
  10. C appartenant à la fois à ICPRIB,ICPRIC et ICPRID
  11. C
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELE PAR : PROMAT
  19. C***********************************************************************
  20. C ENTREES : ICPRIB, ICPRIC, ICPRID, NIUNIQ
  21. C SORTIES : ICOPRI
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 31/01/2000, version initiale
  25. C HISTORIQUE : v1, 31/01/2000, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. -INC SMLENTI
  35. INTEGER JG
  36. POINTEUR ICPRIB.MLENTI
  37. POINTEUR ICPRIC.MLENTI
  38. POINTEUR ICPRID.MLENTI
  39. POINTEUR ICOPRI.MLENTI
  40. POINTEUR MLEWRK.MLENTI
  41. * POINTEUR KRPRI.MLENTI
  42. SEGMENT KRPRI
  43. LOGICAL LPRI(NINCO,NSEG)
  44. ENDSEGMENT
  45. * Liste de MLENTI
  46. INTEGER NBMLEN
  47. SEGMENT MLENTS
  48. POINTEUR LISMLE(NBMLEN).MLENTI
  49. ENDSEGMENT
  50. POINTEUR GPMLES.MLENTS
  51. *
  52. INTEGER IMPR,IRET
  53. LOGICAL LTEST
  54. *
  55. INTEGER IBMLEN,IGWRK,IIUNIQ
  56. INTEGER NGWRK,NIUNIQ
  57. INTEGER NUPRI,NBPRI
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inccom.eso'
  62. * Initialisation de la liste de MLENTI (ici, il y en a trois)
  63. NBMLEN=2
  64. IF (ICPRID.NE.0) THEN
  65. NBMLEN=NBMLEN+1
  66. ENDIF
  67. SEGINI GPMLES
  68. GPMLES.LISMLE(1)=ICPRIB
  69. GPMLES.LISMLE(2)=ICPRIC
  70. IF (ICPRID.NE.0) THEN
  71. GPMLES.LISMLE(3)=ICPRID
  72. ENDIF
  73. * NIUNIQ est la dimension de l'espace des noms d'inconnues
  74. * JG=NIUNIQ
  75. * SEGINI KRPRI
  76. NINCO=NIUNIQ
  77. NSEG=NBMLEN
  78. SEGINI KRPRI
  79. DO 2 IBMLEN=1,NBMLEN
  80. MLEWRK=GPMLES.LISMLE(IBMLEN)
  81. SEGACT MLEWRK
  82. NGWRK=MLEWRK.LECT(/1)
  83. DO 22 IGWRK=1,NGWRK
  84. NUPRI=MLEWRK.LECT(IGWRK)
  85. * KRPRI.LECT(NUPRI)=KRPRI.LECT(NUPRI)+1
  86. KRPRI.LPRI(NUPRI,IBMLEN)=.TRUE.
  87. 22 CONTINUE
  88. SEGDES MLEWRK
  89. 2 CONTINUE
  90. SEGSUP GPMLES
  91. JG=0
  92. SEGINI ICOPRI
  93. DO 3 IIUNIQ=1,NIUNIQ
  94. LTEST=.TRUE.
  95. DO ISEG=1,NSEG
  96. LTEST=LTEST.AND.KRPRI.LPRI(IIUNIQ,ISEG)
  97. ENDDO
  98. * NBPRI=KRPRI.LECT(IIUNIQ)
  99. * IF (NBPRI.EQ.NBMLEN) THEN
  100. IF (LTEST) ICOPRI.LECT(**)=IIUNIQ
  101. * ENDIF
  102. 3 CONTINUE
  103. SEGDES ICOPRI
  104. SEGSUP KRPRI
  105. *
  106. * Normal termination
  107. *
  108. IRET=0
  109. RETURN
  110. *
  111. * Format handling
  112. *
  113. *
  114. * Error handling
  115. *
  116. 9999 CONTINUE
  117. IRET=1
  118. WRITE(IOIMP,*) 'An error was detected in subroutine inccom'
  119. RETURN
  120. *
  121. * End of subroutine INCCOM
  122. *
  123. END
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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