Télécharger exincs.eso

Retour à la liste

Numérotation des lignes :

exincs
  1. C EXINCS SOURCE CHAT 05/01/12 23:50:48 5004
  2. SUBROUTINE EXINCS(ICDUAB,ICPRIB,ICPRIC,ICDUAC,
  3. $ LNBMEB,LNBMEC,
  4. $ JCDUAB,JCPRIB,JCPRIC,JCDUAC,
  5. $ IMPR,IRET)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : EXINCS
  10. C DESCRIPTION : Extraction des inconnues qui vont servir
  11. C pour le produit matriciel.
  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 APPELES : EXENEN
  19. C APPELE PAR : PROMAT
  20. C***********************************************************************
  21. C ENTREES : ICDUAB, ICPRIB, ICPRIC, ICDUAC, LNBMEB, LNBMEC
  22. C SORTIES : JCDUAB, JCPRIB, JCPRIC, JCDUAC
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION : v1, 08/02/2000, version initiale
  26. C HISTORIQUE : v1, 08/02/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMLENTI
  38. POINTEUR ICPRIB.MLENTI
  39. POINTEUR ICDUAB.MLENTI
  40. POINTEUR ICPRIC.MLENTI
  41. POINTEUR ICDUAC.MLENTI
  42. POINTEUR JCPRIB.MLENTI
  43. POINTEUR JCDUAB.MLENTI
  44. POINTEUR JCPRIC.MLENTI
  45. POINTEUR JCDUAC.MLENTI
  46. POINTEUR LNBMEB.MLENTI
  47. POINTEUR LNBMEC.MLENTI
  48. *
  49. INTEGER IMPR,IRET
  50. *
  51. * Executable statements
  52. *
  53. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exincs.eso'
  54. CALL EXENEN(ICDUAB,LNBMEB,
  55. $ JCDUAB,
  56. $ IMPR,IRET)
  57. IF (IRET.NE.0) GOTO 9999
  58. CALL EXENEN(ICPRIB,LNBMEB,
  59. $ JCPRIB,
  60. $ IMPR,IRET)
  61. IF (IRET.NE.0) GOTO 9999
  62. CALL EXENEN(ICPRIC,LNBMEC,
  63. $ JCPRIC,
  64. $ IMPR,IRET)
  65. IF (IRET.NE.0) GOTO 9999
  66. CALL EXENEN(ICDUAC,LNBMEC,
  67. $ JCDUAC,
  68. $ IMPR,IRET)
  69. IF (IRET.NE.0) GOTO 9999
  70. *
  71. * Normal termination
  72. *
  73. IRET=0
  74. RETURN
  75. *
  76. * Format handling
  77. *
  78. *
  79. * Error handling
  80. *
  81. 9999 CONTINUE
  82. IRET=1
  83. WRITE(IOIMP,*) 'An error was detected in subroutine exincs'
  84. RETURN
  85. *
  86. * End of subroutine EXINCS
  87. *
  88. END
  89.  
  90.  
  91.  
  92.  

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