Esope source files

   1 : C GEOPC1    SOURCE    GOUNAND   06/04/06    17:53:42     5371           
   2 :       SUBROUTINE GEOPC1(NDDL,IESREL,NBPOGO,NBELEM,
   3 :      $     JCOOR,FFPG,
   4 :      $     JPC,
   5 :      $     IMPR,IRET)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 :       IMPLICIT INTEGER (I-N)
   8 : C***********************************************************************
   9 : C NOM         : GEOPC1
  10 : C PROJET      : 
  11 : C DESCRIPTION : récupération de la première coordonnée
  12 : C             
  13 : C LANGAGE     : Fortran 77 (sauf E/S)
  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 APPELE PAR       : GEOMET
  19 : C***********************************************************************
  20 : C ENTREES            :
  21 : C ENTREES/SORTIES    :
  22 : C SORTIES            : -
  23 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24 : C***********************************************************************
  25 : C VERSION    : v1, 23/03/06, version initiale
  26 : C HISTORIQUE : v1, 23/03/06, création
  27 : C HISTORIQUE :
  28 : C HISTORIQUE :
  29 : C***********************************************************************
  30 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31 : C en cas de modification de ce sous-programme afin de faciliter
  32 : C la maintenance !
  33 : C***********************************************************************
  34 : -INC CCOPTIO      
  35 : -INC CCREEL
  36 :       INTEGER NDDL,IESREL,NBPOGO,NBELEM
  37 :       REAL*8 JCOOR(NDDL,IESREL,NBELEM)
  38 :       REAL*8 FFPG(NDDL,NBPOGO)
  39 :       REAL*8 JPC(NBPOGO,NBELEM)
  40 : *
  41 :       INTEGER IMPR,IRET
  42 :       INTEGER IELEM,IPOGO,JESREL,IDDL
  43 :       REAL*8 XR
  44 : *     
  45 : * Executable statements
  46 : *
  47 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geopc1'
  48 :       DO IELEM=1,NBELEM
  49 :          DO IPOGO=1,NBPOGO
  50 :             JESREL=1
  51 :             XR=XZERO
  52 :             DO IDDL=1,NDDL
  53 :                XR=XR
  54 :      $              + (JCOOR(IDDL,JESREL,IELEM)
  55 :      $              * FFPG(IDDL,IPOGO))
  56 :             ENDDO
  57 :             JPC(IPOGO,IELEM)=XR
  58 :          ENDDO
  59 :       ENDDO
  60 : *
  61 : * Normal termination
  62 : *
  63 :       IRET=0
  64 :       RETURN
  65 : *
  66 : * Format handling
  67 : *
  68 : *
  69 : * Error handling
  70 : *
  71 :  9999 CONTINUE
  72 :       IRET=1
  73 :       WRITE(IOIMP,*) 'An error was detected in subroutine geopc1'
  74 :       RETURN
  75 : *
  76 : * End of subroutine GEOPC1
  77 : *
  78 :       END
  79 : 
  80 :