Télécharger fifal.eso

Retour à la liste

Numérotation des lignes :

  1. C FIFAL SOURCE GOUNAND 05/12/21 21:20:41 5281
  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. -INC CCOPTIO
  35. CBEGININCLUDE SFALRF
  36. SEGMENT FALRF
  37. CHARACTER*(LNNFA) NOMFA
  38. INTEGER NUQUAF(NBLRF)
  39. POINTEUR ELEMF(NBLRF).ELREF
  40. ENDSEGMENT
  41. SEGMENT FALRFS
  42. POINTEUR LISFA(0).FALRF
  43. ENDSEGMENT
  44. CENDINCLUDE SFALRF
  45. POINTEUR MYFALS.FALRFS
  46. POINTEUR FACOUR.FALRF
  47. POINTEUR MYFAL.FALRF
  48. *
  49. INTEGER IMPR,IRET
  50. *
  51. CHARACTER*(*) NMFAL
  52. INTEGER LNMFAL
  53. INTEGER MPSETA
  54. INTEGER IFALS,NFALS
  55. LOGICAL LFOUND
  56. *
  57. * Executable statements
  58. *
  59. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans fifal'
  60. LFOUND=.FALSE.
  61. LNMFAL=LEN(NMFAL)
  62. * On veut laisser MYFALS dans le même état (actif, inactif) qu'avant
  63. * l'appel à FIFAL.
  64. CALL OOOETA(MYFALS,MPSETA)
  65. IF (MPSETA.NE.1) SEGACT MYFALS
  66. NFALS=MYFALS.LISFA(/1)
  67. IFALS=0
  68. * Boucle 1 : repeat...until
  69. 1 CONTINUE
  70. IFALS=IFALS+1
  71. FACOUR=MYFALS.LISFA(IFALS)
  72. SEGACT FACOUR
  73. IF (LEN(FACOUR.NOMFA).EQ.LNMFAL) THEN
  74. IF (FACOUR.NOMFA.EQ.NMFAL) THEN
  75. LFOUND=.TRUE.
  76. ENDIF
  77. ENDIF
  78. SEGDES FACOUR
  79. IF (.NOT.LFOUND.AND.IFALS.LT.NFALS) GOTO 1
  80. IF (LFOUND) THEN
  81. MYFAL=FACOUR
  82. ELSE
  83. WRITE(IOIMP,*) 'On n''a pas trouvé ',NMFAL,
  84. $ 'dans les familles d''éléments finis'
  85. GOTO 9999
  86. ENDIF
  87. IF (MPSETA.NE.1) SEGDES MYFALS
  88. *
  89. * Normal termination
  90. *
  91. IRET=0
  92. RETURN
  93. *
  94. * Format handling
  95. *
  96. *
  97. * Error handling
  98. *
  99. 9999 CONTINUE
  100. IRET=1
  101. WRITE(IOIMP,*) 'An error was detected in subroutine fifal'
  102. RETURN
  103. *
  104. * End of subroutine fifal
  105. *
  106. END
  107.  
  108.  
  109.  

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