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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMLENTI
  37. INTEGER JG
  38. POINTEUR ICPRIB.MLENTI
  39. POINTEUR ICPRIC.MLENTI
  40. POINTEUR ICPRID.MLENTI
  41. POINTEUR ICOPRI.MLENTI
  42. POINTEUR MLEWRK.MLENTI
  43. * POINTEUR KRPRI.MLENTI
  44. SEGMENT KRPRI
  45. LOGICAL LPRI(NINCO,NSEG)
  46. ENDSEGMENT
  47. * Liste de MLENTI
  48. INTEGER NBMLEN
  49. SEGMENT MLENTS
  50. POINTEUR LISMLE(NBMLEN).MLENTI
  51. ENDSEGMENT
  52. POINTEUR GPMLES.MLENTS
  53. *
  54. INTEGER IMPR,IRET
  55. LOGICAL LTEST
  56. *
  57. INTEGER IBMLEN,IGWRK,IIUNIQ
  58. INTEGER NGWRK,NIUNIQ
  59. INTEGER NUPRI,NBPRI
  60. *
  61. * Executable statements
  62. *
  63. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inccom.eso'
  64. * Initialisation de la liste de MLENTI (ici, il y en a trois)
  65. NBMLEN=2
  66. IF (ICPRID.NE.0) THEN
  67. NBMLEN=NBMLEN+1
  68. ENDIF
  69. SEGINI GPMLES
  70. GPMLES.LISMLE(1)=ICPRIB
  71. GPMLES.LISMLE(2)=ICPRIC
  72. IF (ICPRID.NE.0) THEN
  73. GPMLES.LISMLE(3)=ICPRID
  74. ENDIF
  75. * NIUNIQ est la dimension de l'espace des noms d'inconnues
  76. * JG=NIUNIQ
  77. * SEGINI KRPRI
  78. NINCO=NIUNIQ
  79. NSEG=NBMLEN
  80. SEGINI KRPRI
  81. DO 2 IBMLEN=1,NBMLEN
  82. MLEWRK=GPMLES.LISMLE(IBMLEN)
  83. SEGACT MLEWRK
  84. NGWRK=MLEWRK.LECT(/1)
  85. DO 22 IGWRK=1,NGWRK
  86. NUPRI=MLEWRK.LECT(IGWRK)
  87. * KRPRI.LECT(NUPRI)=KRPRI.LECT(NUPRI)+1
  88. KRPRI.LPRI(NUPRI,IBMLEN)=.TRUE.
  89. 22 CONTINUE
  90. SEGDES MLEWRK
  91. 2 CONTINUE
  92. SEGSUP GPMLES
  93. JG=0
  94. SEGINI ICOPRI
  95. DO 3 IIUNIQ=1,NIUNIQ
  96. LTEST=.TRUE.
  97. DO ISEG=1,NSEG
  98. LTEST=LTEST.AND.KRPRI.LPRI(IIUNIQ,ISEG)
  99. ENDDO
  100. * NBPRI=KRPRI.LECT(IIUNIQ)
  101. * IF (NBPRI.EQ.NBMLEN) THEN
  102. IF (LTEST) ICOPRI.LECT(**)=IIUNIQ
  103. * ENDIF
  104. 3 CONTINUE
  105. SEGDES ICOPRI
  106. SEGSUP KRPRI
  107. *
  108. * Normal termination
  109. *
  110. IRET=0
  111. RETURN
  112. *
  113. * Format handling
  114. *
  115. *
  116. * Error handling
  117. *
  118. 9999 CONTINUE
  119. IRET=1
  120. WRITE(IOIMP,*) 'An error was detected in subroutine inccom'
  121. RETURN
  122. *
  123. * End of subroutine INCCOM
  124. *
  125. END
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  

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