Télécharger fipg.eso

Retour à la liste

Numérotation des lignes :

  1. C FIPG SOURCE MAGN 17/02/24 21:15:09 9323
  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. -INC CCOPTIO
  34. CBEGININCLUDE SPOGAU
  35. SEGMENT POGAU
  36. CHARACTER*(LNNPG) NOMPG
  37. CHARACTER*(LNTPG) TYPMPG
  38. CHARACTER*(LNFPG) FORLPG
  39. INTEGER NORDPG
  40. REAL*8 XCOPG(NDLPG,NBPG)
  41. REAL*8 XPOPG(NBPG)
  42. ENDSEGMENT
  43. SEGMENT POGAUS
  44. POINTEUR LISPG(0).POGAU
  45. ENDSEGMENT
  46. CENDINCLUDE SPOGAU
  47. POINTEUR MYPGS.POGAUS
  48. POINTEUR PGCOUR.POGAU
  49. POINTEUR MYPG.POGAU
  50. *
  51. INTEGER IMPR,IRET
  52. *
  53. CHARACTER*(*) NMPG
  54. INTEGER LNMPG
  55. INTEGER MPSETA
  56. INTEGER IMETH,NMETH
  57. LOGICAL LFOUND
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans fipg'
  62. LFOUND=.FALSE.
  63. LNMPG=LEN(NMPG)
  64. CALL OOOETA(MYPGS,MPSETA)
  65. IF (MPSETA.NE.1) SEGACT MYPGS
  66. NMETH=MYPGS.LISPG(/1)
  67. IMETH=0
  68. 1 CONTINUE
  69. IMETH=IMETH+1
  70. PGCOUR=MYPGS.LISPG(IMETH)
  71. SEGACT PGCOUR
  72. IF (LEN(PGCOUR.NOMPG).EQ.LNMPG) THEN
  73. IF (PGCOUR.NOMPG.EQ.NMPG) THEN
  74. LFOUND=.TRUE.
  75. ENDIF
  76. ENDIF
  77. c SEGDES PGCOUR
  78. IF (.NOT.LFOUND.AND.IMETH.LT.NMETH) GOTO 1
  79. IF (LFOUND) THEN
  80. MYPG=PGCOUR
  81. ELSE
  82. WRITE(IOIMP,*) 'On n''a pas trouvé ',NMPG,
  83. $ 'dans les méthodes d''intégration'
  84. GOTO 9999
  85. ENDIF
  86. c IF (MPSETA.NE.1) SEGDES MYPGS
  87. *
  88. * Normal termination
  89. *
  90. IRET=0
  91. RETURN
  92. *
  93. * Format handling
  94. *
  95. *
  96. * Error handling
  97. *
  98. 9999 CONTINUE
  99. IRET=1
  100. WRITE(IOIMP,*) 'An error was detected in subroutine fipg'
  101. RETURN
  102. *
  103. * End of subroutine fipg
  104. *
  105. END
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  

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