Télécharger la plaquette Cast3M


fr en

Télécharger sufact.eso

Retour à la liste

Numérotation des lignes : 

sufact

  1. C SUFACT    SOURCE    GOUNAND   21/06/02    21:17:44     11022          
  2.       SUBROUTINE SUFACT(FACTIV,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : SUFACT
  7. C DESCRIPTION : Détruit un segment FACTIV et ses sous-objets
  8. C               (cf. include SFACTIV)
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          :
  16. C APPELES (E/S)    :
  17. C APPELES (BLAS)   :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR       :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE    :
  22. C ENTREES            :
  23. C ENTREES/SORTIES    :
  24. C SORTIES            :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION    : v1, 19/12/2002, version initiale
  28. C HISTORIQUE : v1, 19/12/2002, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC TNLIN      
  40. *-INC SFACTIV
  41.       INTEGER NBSOUV,NBSOFV
  42. *
  43.       INTEGER IMPR,IRET
  44. *
  45.       INTEGER IBSOUV,IBSOFV
  46. *
  47. * Executable statements
  48. *
  49.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans sufact.eso'
  50.       IF (FACTIV.NE.0) THEN
  51.          SEGACT FACTIV*MOD
  52.          NBSOUV=FACTIV.IFACTI(/1)
  53.          DO IBSOUV=1,NBSOUV
  54.             SFACTI=FACTIV.IFACTI(IBSOUV)
  55.             IF (SFACTI.NE.0) THEN
  56.                SEGACT SFACTI*MOD
  57.                NBSOFV=SFACTI.ISFACT(/1)
  58.                DO IBSOFV=1,NBSOFV
  59.                   SSFACT=SFACTI.ISFACT(IBSOFV)
  60.                   IF (SSFACT.NE.0) THEN
  61. *                     SEGACT SSFACT*MOD
  62.                      SEGSUP SSFACT
  63.                   ENDIF
  64.                ENDDO
  65.                SEGSUP SFACTI
  66.             ENDIF
  67.          ENDDO
  68.          SEGSUP FACTIV
  69.       ENDIF
  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 sufact'
  84.       RETURN
  85. *
  86. * End of subroutine SUFACT
  87. *
  88.       END
  89.  
  90.  
  91.  
  92.  

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