Télécharger filfpg.eso

Retour à la liste

Numérotation des lignes :

  1. C FILFPG SOURCE BP208322 16/11/18 21:17:14 9177
  2. SUBROUTINE FILFPG(FAL,MYPGS,CQUAF,CPG,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : FILFPG
  7. C PROJET : Noyau linéaire NLIN
  8. C DESCRIPTION : Remplit l'indice d'un segment décrivant une famille
  9. C de méthodes d'intégration.
  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 : FICH4, FIPG (recherche dans une liste)
  16. C APPELE PAR : INFPGS
  17. C***********************************************************************
  18. C ENTREES : * MYPGS (type POGAUS) : segment de description
  19. C des éléments de références.
  20. C * CQUAF (type CH*(*)) :nom d'un élément QUAF.
  21. C * CPG (type CH*(*)) :nom d'une méthode
  22. C d'intégration
  23. C (cf. NOMPG dans SPOGAU.INC)
  24. C ENTREES/SORTIES : * FAL (type FALRF) : famille courante.
  25. C SORTIES : -
  26. C TRAVAIL : * MYPG (type ELREF) : élément fini courant.
  27. C * NUMER (type ENTIER) : numéro correspondant à
  28. C CQUAF dans le tableau NOMS (cf. include
  29. C CCOPTIO)
  30. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  31. C***********************************************************************
  32. C VERSION : v1, 16/07/02, version initiale
  33. C HISTORIQUE : v1, 16/07/02, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38. C en cas de modification de ce sous-programme afin de faciliter
  39. C la maintenance !
  40. C***********************************************************************
  41. -INC CCOPTIO
  42. -INC CCGEOME
  43. CBEGININCLUDE SPOGAU
  44. SEGMENT POGAU
  45. CHARACTER*(LNNPG) NOMPG
  46. CHARACTER*(LNTPG) TYPMPG
  47. CHARACTER*(LNFPG) FORLPG
  48. INTEGER NORDPG
  49. REAL*8 XCOPG(NDLPG,NBPG)
  50. REAL*8 XPOPG(NBPG)
  51. ENDSEGMENT
  52. SEGMENT POGAUS
  53. POINTEUR LISPG(0).POGAU
  54. ENDSEGMENT
  55. CENDINCLUDE SPOGAU
  56. POINTEUR MYPGS.POGAUS
  57. POINTEUR MYPG.POGAU
  58. CBEGININCLUDE SFAPG
  59. SEGMENT FAPG
  60. CHARACTER*(LNNFAP) NOMFAP
  61. INTEGER NBQUAF(NBMPG)
  62. POINTEUR MPOGAU(NBMPG).POGAU
  63. ENDSEGMENT
  64. SEGMENT FAPGS
  65. POINTEUR LISFPG(0).FAPG
  66. ENDSEGMENT
  67. CENDINCLUDE SFAPG
  68. INTEGER LNNFAP,NBMPG
  69. POINTEUR FAL.FAPG
  70. *
  71. CHARACTER*(*) CQUAF,CPG
  72. *
  73. INTEGER IMPR,IRET
  74. *
  75. INTEGER NUMER
  76. *
  77. * Executable statements
  78. *
  79. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans filfpg'
  80. * On ajuste la dimension du segment pour rajouter une paire
  81. * d'éléments
  82. LNNFAP=FAL.NOMFAP(/1)
  83. NBMPG=FAL.NBQUAF(/1)+1
  84. SEGADJ,FAL
  85. * Numéro de l'élément géométrique dans NOMS
  86. * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques,
  87. * cf. include CCGEOME
  88. CALL FICH4(CQUAF,NOMS,NOMBR,
  89. $ NUMER,
  90. $ IMPR,IRET)
  91. IF (IRET.NE.0) GOTO 9999
  92. FAL.NBQUAF(NBMPG)=NUMER
  93. * Numéro de l'élément fini dans le segment POGAUS
  94. CALL FIPG(CPG,MYPGS,
  95. $ MYPG,
  96. $ IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. FAL.MPOGAU(NBMPG)=MYPG
  99. *
  100. * Normal termination
  101. *
  102. IRET=0
  103. RETURN
  104. *
  105. * Format handling
  106. *
  107. *
  108. * Error handling
  109. *
  110. 9999 CONTINUE
  111. IRET=1
  112. WRITE(IOIMP,*) 'An error was detected in subroutine filfpg'
  113. RETURN
  114. *
  115. * End of subroutine filfpg
  116. *
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  

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