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.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC CCGEOME
  49. *
  50. * Includes perso
  51. *
  52. CBEGININCLUDE SFAPG
  53. SEGMENT FAPG
  54. CHARACTER*(LNNFAP) NOMFAP
  55. INTEGER NBQUAF(NBMPG)
  56. POINTEUR MPOGAU(NBMPG).POGAU
  57. ENDSEGMENT
  58. SEGMENT FAPGS
  59. POINTEUR LISFPG(0).FAPG
  60. ENDSEGMENT
  61. CENDINCLUDE SFAPG
  62. POINTEUR MYFPGS.FAPGS
  63. POINTEUR MYFAL.FAPG
  64. CBEGININCLUDE SPOGAU
  65. SEGMENT POGAU
  66. CHARACTER*(LNNPG) NOMPG
  67. CHARACTER*(LNTPG) TYPMPG
  68. CHARACTER*(LNFPG) FORLPG
  69. INTEGER NORDPG
  70. REAL*8 XCOPG(NDLPG,NBPG)
  71. REAL*8 XPOPG(NBPG)
  72. ENDSEGMENT
  73. SEGMENT POGAUS
  74. POINTEUR LISPG(0).POGAU
  75. ENDSEGMENT
  76. CENDINCLUDE SPOGAU
  77. POINTEUR MYPG.POGAU
  78. *
  79. INTEGER ITYPL
  80. CHARACTER*(*) NMFAP
  81. INTEGER IBLRF,NBLRF
  82. INTEGER IMPR,IRET
  83. *
  84. * Executable statements
  85. *
  86. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans kepg'
  87. CALL FIFAL(NMFAP,MYFPGS,
  88. $ MYFAL,
  89. $ IMPR,IRET)
  90. IF (IRET.NE.0) GOTO 9999
  91. SEGACT MYFAL
  92. NBLRF=MYFAL.NBQUAF(/1)
  93. CALL FIENTI(ITYPL,MYFAL.NBQUAF,NBLRF,
  94. $ IBLRF,
  95. $ IMPR,IRET)
  96. IF (IRET.NE.0) THEN
  97. WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYPL),
  98. $ ' dans la famille de méthode d''intégration ',MYFAL.NOMFAP
  99. GOTO 9999
  100. ENDIF
  101. MYPG=MYFAL.MPOGAU(IBLRF)
  102. SEGDES MYFAL
  103. *
  104. * Normal termination
  105. *
  106. IRET=0
  107. RETURN
  108. *
  109. * Format handling
  110. *
  111. *
  112. * Error handling
  113. *
  114. 9999 CONTINUE
  115. IRET=1
  116. WRITE(IOIMP,*) 'An error was detected in subroutine kepg'
  117. RETURN
  118. *
  119. * End of subroutine KEPG
  120. *
  121. END
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  

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