Télécharger fipg.eso

Retour à la liste

Numérotation des lignes :

fipg
  1. C FIPG SOURCE CB215821 18/09/27 21:15:19 9936
  2. SUBROUTINE FIPG(NMPG,MYPGS,
  3. $ MYPG,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : FIPG
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Cherche une méthode d'intégration dans une liste de
  11. C méthodes d'intégration, connaissant son nom.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : -
  18. C APPELES (E/S) : OOOETA
  19. C APPELE PAR : KALPBG, INGATR, INGATE, INGAPR
  20. C***********************************************************************
  21. C ENTREES : NMPG, MYPGS
  22. C ENTREES/SORTIES : -
  23. C SORTIES : MYPG
  24. C***********************************************************************
  25. C VERSION : v1, 22/10/99, version initiale
  26. C HISTORIQUE : v1, 22/10/99, création
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. CBEGININCLUDE SPOGAU
  37. SEGMENT POGAU
  38. CHARACTER*(LNNPG) NOMPG
  39. CHARACTER*(LNTPG) TYPMPG
  40. CHARACTER*(LNFPG) FORLPG
  41. INTEGER NORDPG
  42. REAL*8 XCOPG(NDLPG,NBPG)
  43. REAL*8 XPOPG(NBPG)
  44. ENDSEGMENT
  45. SEGMENT POGAUS
  46. POINTEUR LISPG(0).POGAU
  47. ENDSEGMENT
  48. CENDINCLUDE SPOGAU
  49. POINTEUR MYPGS.POGAUS
  50. POINTEUR PGCOUR.POGAU
  51. POINTEUR MYPG.POGAU
  52. *
  53. INTEGER IMPR,IRET
  54. *
  55. CHARACTER*(*) NMPG
  56. INTEGER LNMPG
  57. INTEGER MPSETA
  58. INTEGER IMETH,NMETH
  59. LOGICAL LFOUND
  60. *
  61. * Executable statements
  62. *
  63. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans fipg'
  64. LFOUND=.FALSE.
  65. LNMPG=LEN(NMPG)
  66. CALL OOOETA(MYPGS,MPSETA,IMOD)
  67. IF (MPSETA.NE.1) SEGACT MYPGS
  68. NMETH=MYPGS.LISPG(/1)
  69. IMETH=0
  70. 1 CONTINUE
  71. IMETH=IMETH+1
  72. PGCOUR=MYPGS.LISPG(IMETH)
  73. SEGACT PGCOUR
  74. IF (LEN(PGCOUR.NOMPG).EQ.LNMPG) THEN
  75. IF (PGCOUR.NOMPG.EQ.NMPG) THEN
  76. LFOUND=.TRUE.
  77. ENDIF
  78. ENDIF
  79. c SEGDES PGCOUR
  80. IF (.NOT.LFOUND.AND.IMETH.LT.NMETH) GOTO 1
  81. IF (LFOUND) THEN
  82. MYPG=PGCOUR
  83. ELSE
  84. WRITE(IOIMP,*) 'On n''a pas trouvé ',NMPG,
  85. $ 'dans les méthodes d''intégration'
  86. GOTO 9999
  87. ENDIF
  88. c IF (MPSETA.NE.1) SEGDES MYPGS
  89. *
  90. * Normal termination
  91. *
  92. IRET=0
  93. RETURN
  94. *
  95. * Format handling
  96. *
  97. *
  98. * Error handling
  99. *
  100. 9999 CONTINUE
  101. IRET=1
  102. WRITE(IOIMP,*) 'An error was detected in subroutine fipg'
  103. RETURN
  104. *
  105. * End of subroutine fipg
  106. *
  107. END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  

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