Download kepg.eso

Back to the list

   1 : C KEPG      SOURCE    CHAT      07/10/29    21:21:43     5940           
   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'
  84 :       CALL FIFAL(NMFAP,MYFPGS,
  85 :      $     MYFAL,
  86 :      $     IMPR,IRET)
  87 :       IF (IRET.NE.0) GOTO 9999
  88 :       SEGACT MYFAL
  89 :       NBLRF=MYFAL.NBQUAF(/1)
  89 :       CALL FIENTI(ITYPL,MYFAL.NBQUAF,NBLRF,
  90 :      $     IBLRF,
  91 :      $     IMPR,IRET)
  92 :       IF (IRET.NE.0) THEN
  93 :          WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYPL),
  94 :      $        ' dans la famille de méthode d''intégration ',MYFAL.NOMFAP 
  95 :          GOTO 9999
  96 :       ENDIF
  97 :       MYPG=MYFAL.MPOGAU(IBLRF)
  98 :       SEGDES MYFAL
  99 : *
 100 : * Normal termination
 101 : *
 102 :       IRET=0
 103 :       RETURN
 104 : *
 105 : * Format handling
 106 : *
 107 : *
 108 : * Error handling
 109 : *
 110 :  9999 CONTINUE
 111 :       IRET=1
 112 :       WRITE(IOIMP,*) 'An error was detected in subroutine kepg'
 113 :       RETURN
 114 : *
 115 : * End of subroutine KEPG
 116 : *
 117 :       END
 118 : 
 119 :  
 120 :  

© Cast3M 2003 - All rights reserved.
Disclaimer