Télécharger exincs.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  35. -INC SMLENTI
  36. POINTEUR ICPRIB.MLENTI
  37. POINTEUR ICDUAB.MLENTI
  38. POINTEUR ICPRIC.MLENTI
  39. POINTEUR ICDUAC.MLENTI
  40. POINTEUR JCPRIB.MLENTI
  41. POINTEUR JCDUAB.MLENTI
  42. POINTEUR JCPRIC.MLENTI
  43. POINTEUR JCDUAC.MLENTI
  44. POINTEUR LNBMEB.MLENTI
  45. POINTEUR LNBMEC.MLENTI
  46. *
  47. INTEGER IMPR,IRET
  48. *
  49. * Executable statements
  50. *
  51. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exincs.eso'
  52. CALL EXENEN(ICDUAB,LNBMEB,
  53. $ JCDUAB,
  54. $ IMPR,IRET)
  55. IF (IRET.NE.0) GOTO 9999
  56. CALL EXENEN(ICPRIB,LNBMEB,
  57. $ JCPRIB,
  58. $ IMPR,IRET)
  59. IF (IRET.NE.0) GOTO 9999
  60. CALL EXENEN(ICPRIC,LNBMEC,
  61. $ JCPRIC,
  62. $ IMPR,IRET)
  63. IF (IRET.NE.0) GOTO 9999
  64. CALL EXENEN(ICDUAC,LNBMEC,
  65. $ JCDUAC,
  66. $ IMPR,IRET)
  67. IF (IRET.NE.0) GOTO 9999
  68. *
  69. * Normal termination
  70. *
  71. IRET=0
  72. RETURN
  73. *
  74. * Format handling
  75. *
  76. *
  77. * Error handling
  78. *
  79. 9999 CONTINUE
  80. IRET=1
  81. WRITE(IOIMP,*) 'An error was detected in subroutine exincs'
  82. RETURN
  83. *
  84. * End of subroutine EXINCS
  85. *
  86. END
  87.  
  88.  
  89.  
  90.  

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