Esope source files

   1 : C FIPG      SOURCE    GOUNAND   05/12/21    21:22:37     5281           
   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)
  63 :       CALL OOOETA(MYPGS,MPSETA)
  64 :       IF (MPSETA.NE.1) SEGACT MYPGS
  65 :       NMETH=MYPGS.LISPG(/1)
  66 :       IMETH=0
  67 :  1    CONTINUE
  68 :       IMETH=IMETH+1
  69 :       PGCOUR=MYPGS.LISPG(IMETH)
  70 :       SEGACT PGCOUR
  71 :       IF (LEN(PGCOUR.NOMPG).EQ.LNMPG) THEN
  72 :          IF (PGCOUR.NOMPG.EQ.NMPG) THEN
  73 :             LFOUND=.TRUE.
  74 :          ENDIF
  75 :       ENDIF
  76 :       SEGDES PGCOUR
  77 :       IF (.NOT.LFOUND.AND.IMETH.LT.NMETH) GOTO 1
  78 :       IF (LFOUND) THEN
  79 :          MYPG=PGCOUR
  80 :       ELSE
  81 :          WRITE(IOIMP,*) 'On n''a pas trouvé ',NMPG,
  82 :      $        'dans les méthodes d''intégration'
  83 :          GOTO 9999
  84 :       ENDIF
  85 :       IF (MPSETA.NE.1) SEGDES MYPGS
  86 : *
  87 : * Normal termination
  88 : *
  89 :       IRET=0
  90 :       RETURN
  91 : *
  92 : * Format handling
  93 : *
  94 : *
  95 : * Error handling
  96 : *
  97 :  9999 CONTINUE
  98 :       IRET=1
  99 :       WRITE(IOIMP,*) 'An error was detected in subroutine fipg'
 100 :       RETURN
 101 : *
 102 : * End of subroutine fipg
 103 : *
 104 :       END
 105 : 
 106 :  
 107 :