Esope source files

   1 : C GEOPC     SOURCE    GOUNAND   06/04/06    17:53:43     5371           
   2 :       SUBROUTINE GEOPC(JCOOR,FFPG,
   3 :      $     JPC,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : GEOPC
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : Récupération de la première coordonnée
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C APPELES          :
  17 : C APPELE PAR       :
  18 : C***********************************************************************
  19 : C ENTREES            :
  20 : C ENTREES/SORTIES    : -
  21 : C SORTIES            :
  22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23 : C***********************************************************************
  24 : C VERSION    : v1, 23/03/06, version initiale
  25 : C HISTORIQUE : v1, 23/03/06, création
  26 : C HISTORIQUE :
  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 SMCHAEL
  35 :       SEGMENT MCHAEL
  36 :       POINTEUR IMACHE(N1).MELEME
  37 :       POINTEUR ICHEVA(N1).MCHEVA
  38 :       ENDSEGMENT
  39 :       SEGMENT MCHEVA
  40 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  41 :       ENDSEGMENT
  42 :       SEGMENT LCHEVA
  43 :       POINTEUR LISCHE(NBCHE).MCHEVA
  44 :       ENDSEGMENT
  45 : CENDINCLUDE SMCHAEL
  46 :       POINTEUR JCOOR.MCHEVA
  47 :       POINTEUR JPC.MCHEVA
  48 : * Valeurs des fns d'interpolation du coeff. aux points de Gauss
  49 :       POINTEUR FFPG.MCHEVA
  50 : *
  51 :       INTEGER IMPR,IRET
  52 : *
  53 :       INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  54 :       INTEGER NDDL,IESREL,NBPOGO,NBELEM
  55 : *     
  56 : * Executable statements
  57 : *
  58 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geopc'
  59 :       IESREL=IDIM
  60 :       SEGACT JCOOR
  61 :       NDLIG=JCOOR.VELCHE(/1)
  62 :       NDCOL=JCOOR.VELCHE(/2)
  63 :       N2DLIG=JCOOR.VELCHE(/3)
  64 :       N2DCOL=JCOOR.VELCHE(/4)
  65 :       NDNOEU=JCOOR.VELCHE(/5)
  66 :       NDELM=JCOOR.VELCHE(/6)
  67 :       IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.IESREL.
  68 :      $     OR.NDNOEU.NE.1) THEN
  69 :          WRITE(IOIMP,*) 'Erreur dims JCOOR'
  70 :          GOTO 9999
  71 :       ENDIF
  72 :       NDDL=NDCOL
  73 :       NBELEM=NDELM
  74 :       SEGACT FFPG
  75 :       NDLIG=FFPG.VELCHE(/1)
  76 :       NDCOL=FFPG.VELCHE(/2)
  77 :       N2DLIG=FFPG.VELCHE(/3)
  78 :       N2DCOL=FFPG.VELCHE(/4)
  79 :       NDNOEU=FFPG.VELCHE(/5)
  80 :       NDELM=FFPG.VELCHE(/6)
  81 :       IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL.OR.N2DLIG.NE.1
  82 :      $     .OR.N2DCOL.NE.1.OR.NDELM.NE.1) THEN
  83 :          WRITE(IOIMP,*) 'Erreur dims FFPG'
  84 :          GOTO 9999
  85 :       ENDIF
  86 :       NBPOGO=NDNOEU 
  87 : *
  88 :       NBLIG=1
  89 :       NBCOL=1
  90 :       N2LIG=1
  91 :       N2COL=1
  92 :       NBPOI=NBPOGO
  93 :       NBELM=NBELEM
  94 :       SEGINI JPC
  94 :       CALL GEOPC1(NDDL,IESREL,NBPOGO,NBELEM,
  95 :      $     JCOOR.VELCHE,FFPG.VELCHE,
  96 :      $     JPC.VELCHE,
  97 :      $     IMPR,IRET)
  98 :       IF (IRET.NE.0) GOTO 9999
  99 :       SEGDES JPC
 100 :       IF (IMPR.GT.3) THEN
 101 :          WRITE(IOIMP,*) 'On a créé',
 102 :      $        ' JPC(élément , poi.gauss ,',
 103 :      $        ' 1,1,1,1)'
 103 :          CALL PRCHVA(JPC,IMPR,IRET)
 104 :          IF (IRET.NE.0) GOTO 9999
 105 :       ENDIF
 106 :       SEGDES FFPG
 107 :       SEGDES JCOOR
 108 : *
 109 : * Normal termination
 110 : *
 111 :       IRET=0
 112 :       RETURN
 113 : *
 114 : * Format handling
 115 : *
 116 : *
 117 : * Error handling
 118 : *
 119 :  9999 CONTINUE
 120 :       IRET=1
 121 :       WRITE(IOIMP,*) 'An error was detected in subroutine geopc'
 122 :       RETURN
 123 : *
 124 : * End of subroutine GEOPC
 125 : *
 126 :       END
 127 : 
 128 :