Esope source files

   1 : C VERFPG    SOURCE    CHAT      07/10/29    21:30:12     5940           
   2 :       SUBROUTINE VERFPG(CGEOME,METING,MYFPGS,
   3 :      $     IMPR,IRET)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : VERFPG
   8 : C PROJET      : Noyau linéaire NLIN
   9 : C DESCRIPTION : On vérifie pour la famille d'espace de méthode
  10 : C               d'intégration :
  11 : C               - qu'elle est valide ;
  12 : C               - qu'il y a bien un élément fini qui correspond à chaque
  13 : C                 élément géométrique.
  14 : C
  15 : C LANGAGE     : ESOPE
  16 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17 : C               mél : gounand@semt2.smts.cea.fr
  18 : C***********************************************************************
  19 : C APPELES          : FIFAL, KEEF (recherche dans une liste)
  20 : C APPELE PAR       : PRNLI2
  21 : C***********************************************************************
  22 : C ENTREES            : * CGEOME (type MELEME) : maillage de QUAFs
  23 : C                        partitionné.
  24 : C                      * METING (type CH*4) : famille de méthodes
  25 : C                        d'intégration 
  26 : C                      * MYFPGS (type FAPGS) : segment de description 
  27 : C                        des familles de méthodes d'intégration.
  28 : C SORTIES            : -
  29 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30 : C***********************************************************************
  31 : C VERSION    : v1, 18/07/02, version initiale
  32 : C HISTORIQUE : v1, 18/07/02, création
  33 : C HISTORIQUE :
  34 : C HISTORIQUE :
  35 : C***********************************************************************
  36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37 : C en cas de modification de ce sous-programme afin de faciliter
  38 : C la maintenance !
  39 : C***********************************************************************
  40 : -INC CCOPTIO
  41 : -INC CCGEOME
  42 : -INC SMELEME
  43 :       POINTEUR CGEOME.MELEME
  44 :       POINTEUR SOUMAI.MELEME
  45 : *
  46 : * Includes persos
  47 : *
  48 : CBEGININCLUDE SFAPG
  49 :       SEGMENT FAPG
  50 :       CHARACTER*(LNNFAP) NOMFAP
  51 :       INTEGER NBQUAF(NBMPG)
  52 :       POINTEUR MPOGAU(NBMPG).POGAU
  53 :       ENDSEGMENT
  54 :       SEGMENT FAPGS
  55 :       POINTEUR LISFPG(0).FAPG
  56 :       ENDSEGMENT
  57 : CENDINCLUDE SFAPG
  58 :       POINTEUR MYFPGS.FAPGS
  59 :       POINTEUR MYFPG.FAPG
  60 : CBEGININCLUDE SPOGAU
  61 :       SEGMENT POGAU
  62 :       CHARACTER*(LNNPG)  NOMPG
  63 :       CHARACTER*(LNTPG)  TYPMPG
  64 :       CHARACTER*(LNFPG)  FORLPG
  65 :       INTEGER NORDPG
  66 :       REAL*8 XCOPG(NDLPG,NBPG)
  67 :       REAL*8 XPOPG(NBPG)
  68 :       ENDSEGMENT
  69 :       SEGMENT POGAUS
  70 :       POINTEUR LISPG(0).POGAU
  71 :       ENDSEGMENT
  72 : CENDINCLUDE SPOGAU
  73 :       POINTEUR MYPG.POGAU
  74 : *
  75 :       CHARACTER*4 METING
  76 :       INTEGER IMPR,IRET
  77 : *
  78 :       INTEGER ISOUS
  79 :       INTEGER NSOUS,ITYPL
  80 :       
  81 : *     
  82 : * Executable statements
  83 : *
  84 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans verfpg'
  84 :       CALL FIFAL(METING,MYFPGS,
  85 :      $     MYFPG,
  86 :      $     IMPR,IRET)
  87 :       IF (IRET.NE.0) THEN
  88 :          WRITE(IOIMP,*) 'La famille de méthodes d''intégration',
  89 :      $        METING,' n''existe pas.'
  90 :          GOTO 9999
  91 :       ELSEIF (IMPR.GT.3) THEN
  92 :          WRITE(IOIMP,*) 'Famille : ',METING
  93 :       ENDIF
  94 :       SEGACT CGEOME
  95 :       NSOUS=CGEOME.LISOUS(/1)
  96 :       DO 1 ISOUS=1,NSOUS
  97 :          SOUMAI=CGEOME.LISOUS(ISOUS)
  98 :          SEGACT SOUMAI
  99 :          ITYPL=SOUMAI.ITYPEL
 100 : *   On vérifie que la famille contient une méthode d'intégration valide 
 101 : *   pour l'élément fini ITYPL
 101 :          CALL KEPG(ITYPL,METING,
 102 :      $        MYFPGS,
 103 :      $        MYPG,
 104 :      $        IMPR,IRET)
 105 :          IF (IRET.NE.0) GOTO 9999
 106 :          SEGDES SOUMAI
 107 :  1    CONTINUE
 108 :       SEGDES CGEOME
 109 : *
 110 : * Normal termination
 111 : *
 112 :       IRET=0
 113 :       RETURN
 114 : *
 115 : * Format handling
 116 : *
 117 : *
 118 : * Error handling
 119 : *
 120 :  9999 CONTINUE
 121 :       IRET=1
 122 :       WRITE(IOIMP,*) 'An error was detected in subroutine verfpg'
 123 :       RETURN
 124 : *
 125 : * End of subroutine VERFPG
 126 : *
 127 :       END
 128 : 
 129 :  
 130 :