Download calpc1.eso

Back to the list

   1 : C CALPC1    SOURCE    GOUNAND   05/12/21    21:15:23     5281           
   2 :       SUBROUTINE CALPC1(IPROCO,NPGMAX,NELMAX,
   3 :      $        MYCOF,NPG,NEL,IPOW,
   4 :      $        IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : CALPC1
   9 : C DESCRIPTION : Calcul du produit de coefficei 
  10 : C             
  11 : C LANGAGE     : Fortran 77 (sauf E/S)
  12 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13 : C               mél : gounand@semt2.smts.cea.fr
  14 : C***********************************************************************
  15 : C APPELES          : -
  16 : C APPELE PAR       : CALPCO
  17 : C***********************************************************************
  18 : C ENTREES            : MYCOF
  19 : C ENTREES/SORTIES    : IPROCO
  20 : C SORTIES            : -
  21 : C***********************************************************************
  22 : C VERSION    : v1, 19/12/05, version initiale
  23 : C HISTORIQUE : v1, 19/12/05, création
  24 : C HISTORIQUE :
  25 : C HISTORIQUE :
  26 : C***********************************************************************
  27 : -INC CCOPTIO      
  28 :       REAL*8 IPROCO(NPGMAX,NELMAX)
  29 :       REAL*8 MYCOF(NPG,NEL)
  30 : *
  31 :       REAL*8 CONTRI
  32 :       INTEGER IMPR,IRET
  33 : *     
  34 : * Executable statements
  35 : *
  36 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calpc1'
  37 :       DO 1 IELMAX=1,NELMAX
  38 :          IF (NEL.EQ.1) THEN
  39 :             IEL=1
  40 :          ELSE
  41 :             IEL=IELMAX
  42 :          ENDIF
  43 :          DO 12 IPGMAX=1,NPGMAX
  44 :             IF (NPG.EQ.1) THEN
  45 :                IPG=1
  46 :             ELSE
  47 :                IPG=IPGMAX
  48 :             ENDIF
  49 :             IF (IPOW.EQ.1) THEN
  50 :                CONTRI=MYCOF(IPG,IEL)
  51 :             ELSE
  52 :                CONTRI=MYCOF(IPG,IEL)**IPOW
  53 :             ENDIF
  54 :             IPROCO(IPGMAX,IELMAX)=IPROCO(IPGMAX,IELMAX)*CONTRI
  55 :  12      CONTINUE
  56 :  1    CONTINUE
  57 : *
  58 : * Normal termination
  59 : *
  60 :       IRET=0
  61 :       RETURN
  62 : *
  63 : * Format handling
  64 : *
  65 : *
  66 : * Error handling
  67 : *
  68 :  9999 CONTINUE
  69 :       IRET=1
  70 :       WRITE(IOIMP,*) 'An error was detected in subroutine calpc1'
  71 :       RETURN
  72 : *
  73 : * End of subroutine CALPC1
  74 : *
  75 :       END
  76 : 
  77 :       
  78 :  

© Cast3M 2003 - All rights reserved.
Disclaimer