Télécharger la plaquette Cast3M


fr en

Télécharger fifal.eso

Retour à la liste

Numérotation des lignes : 

fifal

  1. C FIFAL     SOURCE    GOUNAND   21/06/02    21:15:54     11022          
  2.       SUBROUTINE FIFAL(NMFAL,MYFALS,
  3.      $     MYFAL,
  4.      $     IMPR,IRET)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM         : FIFAL
  9. C PROJET      : Noyau linéaire NLIN
  10. C DESCRIPTION : Cherche une famille d'éléments par son nom.
  11. C
  12. C LANGAGE     : ESOPE
  13. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C               mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES          : OOOETA (état d'un segment)
  17. C APPELE PAR       : KEEF
  18. C***********************************************************************
  19. C ENTREES            : * NMFAL  (type CH*(*)) : nom de famille
  20. C                        d'éléments finis (cf. NOMFA dans l'include
  21. C                        SFALRF).
  22. C                      * MYFALS (type FALRFS) : segment de description
  23. C                        des familles d'éléments de références.
  24. C SORTIES            : * MYFAL  (type FALRF)  :
  25. C***********************************************************************
  26. C VERSION    : v1, 24/03/00, version initiale
  27. C HISTORIQUE : v1, 24/03/00, création
  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 TNLIN      
  38. *-INC SFALRF
  39.       POINTEUR MYFALS.FALRFS
  40.       POINTEUR FACOUR.FALRF
  41.       POINTEUR MYFAL.FALRF
  42. *
  43.       INTEGER IMPR,IRET
  44. *
  45.       CHARACTER*(*) NMFAL
  46.       INTEGER LNMFAL
  47.       INTEGER MPSETA
  48.       INTEGER IFALS,NFALS
  49.       LOGICAL LFOUND
  50. *
  51. * Executable statements
  52. *
  53.       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans fifal'
  54.       LFOUND=.FALSE.
  55.       LNMFAL=LEN(NMFAL)
  56. * On veut laisser MYFALS dans le même état (actif, inactif) qu'avant
  57. * l'appel à FIFAL.
  58.       CALL OOOETA(MYFALS,MPSETA,IMOD)
  59.       IF (MPSETA.NE.1) SEGACT MYFALS
  60.       NFALS=MYFALS.LISFA(/1)
  61.       IFALS=0
  62. * Boucle 1 : repeat...until
  63.  1    CONTINUE
  64.       IFALS=IFALS+1
  65.       FACOUR=MYFALS.LISFA(IFALS)
  66.       SEGACT FACOUR
  67.       IF (LEN(FACOUR.NOMFA).EQ.LNMFAL) THEN
  68.          IF (FACOUR.NOMFA.EQ.NMFAL) THEN
  69.             LFOUND=.TRUE.
  70.          ENDIF
  71.       ENDIF
  72.       SEGDES FACOUR
  73.       IF (.NOT.LFOUND.AND.IFALS.LT.NFALS) GOTO 1
  74.       IF (LFOUND) THEN
  75.          MYFAL=FACOUR
  76.       ELSE
  77.          WRITE(IOIMP,*) 'On n''a pas trouvé ',NMFAL,
  78.      $        'dans les familles d''éléments finis'
  79.          GOTO 9999
  80.       ENDIF
  81.       IF (MPSETA.NE.1) SEGDES MYFALS
  82. *
  83. * Normal termination
  84. *
  85.       IRET=0
  86.       RETURN
  87. *
  88. * Format handling
  89. *
  90. *
  91. * Error handling
  92. *
  93.  9999 CONTINUE
  94.       IRET=1
  95.       WRITE(IOIMP,*) 'An error was detected in subroutine fifal'
  96.       RETURN
  97. *
  98. * End of subroutine fifal
  99. *
  100.       END
  101.  
  102.  
  103.  
  104.  
  105.  

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