Télécharger kepg.eso

Retour à la liste

Numérotation des lignes :

  1. C KEPG SOURCE BP208322 16/11/18 21:18:08 9177
  2. SUBROUTINE KEPG(ITYPL,NMFAP,
  3. $ MYFPGS,
  4. $ MYPG,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : KEPG
  10. C PROJET : Noyau linéaire NLIN
  11. C DESCRIPTION : On donne un numéro de type d'élément géométrique (un
  12. C QUAF, donc), un nom de famille de méthodes d'intégration
  13. C En sortie, on a le pointeur sur la méthode d'intégration
  14. C (type POGAU)
  15. C
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES : FIFPG, FIENTI (recherche dans une liste)
  21. C APPELE PAR : VERFPG
  22. C***********************************************************************
  23. C ENTREES : * ITYPL (type entier) : numéro d'élément
  24. C géométrique (cf. tableau NOMS dans l'include
  25. C CCOPTIO).
  26. C * NMFAP (type CH*(*)) : nom de famille de
  27. C méthodes d'intégration (cf. NOMFAP dans
  28. C l'include SFAPG).
  29. C * MYFPGS (type FALPGS) : segment de description
  30. C des familles de méthodes d'intégration.
  31. C SORTIES : * MYPG (type POGAU) : pointeur sur l'élément
  32. C fini correspondant à l'élément géométrique de
  33. C numéro ITYPL dans la famille de nom NMFAP
  34. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  35. C***********************************************************************
  36. C VERSION : v1, 18/07/02, version initiale
  37. C HISTORIQUE : v1, 18/07/02, création
  38. C HISTORIQUE :
  39. C HISTORIQUE :
  40. C***********************************************************************
  41. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  42. C en cas de modification de ce sous-programme afin de faciliter
  43. C la maintenance !
  44. C***********************************************************************
  45. -INC CCOPTIO
  46. -INC CCGEOME
  47. *
  48. * Includes perso
  49. *
  50. CBEGININCLUDE SFAPG
  51. SEGMENT FAPG
  52. CHARACTER*(LNNFAP) NOMFAP
  53. INTEGER NBQUAF(NBMPG)
  54. POINTEUR MPOGAU(NBMPG).POGAU
  55. ENDSEGMENT
  56. SEGMENT FAPGS
  57. POINTEUR LISFPG(0).FAPG
  58. ENDSEGMENT
  59. CENDINCLUDE SFAPG
  60. POINTEUR MYFPGS.FAPGS
  61. POINTEUR MYFAL.FAPG
  62. CBEGININCLUDE SPOGAU
  63. SEGMENT POGAU
  64. CHARACTER*(LNNPG) NOMPG
  65. CHARACTER*(LNTPG) TYPMPG
  66. CHARACTER*(LNFPG) FORLPG
  67. INTEGER NORDPG
  68. REAL*8 XCOPG(NDLPG,NBPG)
  69. REAL*8 XPOPG(NBPG)
  70. ENDSEGMENT
  71. SEGMENT POGAUS
  72. POINTEUR LISPG(0).POGAU
  73. ENDSEGMENT
  74. CENDINCLUDE SPOGAU
  75. POINTEUR MYPG.POGAU
  76. *
  77. INTEGER ITYPL
  78. CHARACTER*(*) NMFAP
  79. INTEGER IBLRF,NBLRF
  80. INTEGER IMPR,IRET
  81. *
  82. * Executable statements
  83. *
  84. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans kepg'
  85. CALL FIFAL(NMFAP,MYFPGS,
  86. $ MYFAL,
  87. $ IMPR,IRET)
  88. IF (IRET.NE.0) GOTO 9999
  89. SEGACT MYFAL
  90. NBLRF=MYFAL.NBQUAF(/1)
  91. CALL FIENTI(ITYPL,MYFAL.NBQUAF,NBLRF,
  92. $ IBLRF,
  93. $ IMPR,IRET)
  94. IF (IRET.NE.0) THEN
  95. WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYPL),
  96. $ ' dans la famille de méthode d''intégration ',MYFAL.NOMFAP
  97. GOTO 9999
  98. ENDIF
  99. MYPG=MYFAL.MPOGAU(IBLRF)
  100. SEGDES MYFAL
  101. *
  102. * Normal termination
  103. *
  104. IRET=0
  105. RETURN
  106. *
  107. * Format handling
  108. *
  109. *
  110. * Error handling
  111. *
  112. 9999 CONTINUE
  113. IRET=1
  114. WRITE(IOIMP,*) 'An error was detected in subroutine kepg'
  115. RETURN
  116. *
  117. * End of subroutine KEPG
  118. *
  119. END
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  

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