Télécharger la plaquette Cast3M


fr en

Télécharger suqrfs.eso

Retour à la liste

Numérotation des lignes : 

suqrfs

  1. C SUQRFS    SOURCE    GOUNAND   21/06/02    21:17:51     11022          
  2.       SUBROUTINE SUQRFS(MYQRFS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : SUQRFS
  7. C PROJET      : Noyau linéaire NLIN
  8. C DESCRIPTION : Supprimme le segment contenant les informations sur
  9. C               les QUAFs de référence.
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          :
  16. C APPELES (E/S)    :
  17. C APPELE PAR       :
  18. C***********************************************************************
  19. C ENTREES            : -
  20. C SORTIES            :
  21. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22. C***********************************************************************
  23. C VERSION    : v1, 19/12/02, version initiale
  24. C HISTORIQUE : v1, 19/12/02, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29. C en cas de modification de ce sous-programme afin de faciliter
  30. C la maintenance !
  31. C***********************************************************************
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC TNLIN      
  36. *-INC SIQUAF
  37.       POINTEUR MYQRFS.IQUAFS
  38.       POINTEUR MYQRF.IQUAF
  39. -INC SMELEME
  40.       POINTEUR MYMEL.MELEME
  41.       POINTEUR MYSMEL.MELEME
  42. *
  43.       INTEGER IMPR,IRET
  44. *
  45.       INTEGER NBQRF,IBQRF
  46.       INTEGER NBSOUS,IBSOUS
  47. *
  48. * Executable statements
  49. *
  50.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans suqrfs'
  51.       SEGACT MYQRFS*MOD
  52.       NBQRF=MYQRFS.LISQRF(/1)
  53.       DO IBQRF=1,NBQRF
  54.          MYQRF=MYQRFS.LISQRF(IBQRF)
  55.          IF (MYQRF.NE.0) THEN
  56.             SEGACT MYQRF*MOD
  57.             MYMEL=MYQRF.LFACE
  58.             SEGACT MYMEL*MOD
  59.             NBSOUS=MYMEL.LISOUS(/1)
  60.             DO IBSOUS=1,NBSOUS
  61.                MYSMEL=MYMEL.LISOUS(IBSOUS)
  62. *               SEGACT MYSMEL*MOD
  63.                SEGSUP MYSMEL
  64.             ENDDO
  65.             SEGSUP MYMEL
  66.             SEGSUP MYQRF
  67.          ENDIF
  68.       ENDDO
  69.       SEGSUP MYQRFS
  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 suqrfs'
  84.       RETURN
  85. *
  86. * End of subroutine SUQRFS
  87. *
  88.       END
  89.  
  90.  
  91.  
  92.  
  93.  

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