Télécharger la plaquette Cast3M


fr en

Télécharger calpc1.eso

Retour à la liste

Numérotation des lignes : 

calpc1

  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.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30.       REAL*8 IPROCO(NPGMAX,NELMAX)
  31.       REAL*8 MYCOF(NPG,NEL)
  32. *
  33.       REAL*8 CONTRI
  34.       INTEGER IMPR,IRET
  35. *
  36. * Executable statements
  37. *
  38.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calpc1'
  39.       DO 1 IELMAX=1,NELMAX
  40.          IF (NEL.EQ.1) THEN
  41.             IEL=1
  42.          ELSE
  43.             IEL=IELMAX
  44.          ENDIF
  45.          DO 12 IPGMAX=1,NPGMAX
  46.             IF (NPG.EQ.1) THEN
  47.                IPG=1
  48.             ELSE
  49.                IPG=IPGMAX
  50.             ENDIF
  51.             IF (IPOW.EQ.1) THEN
  52.                CONTRI=MYCOF(IPG,IEL)
  53.             ELSE
  54.                CONTRI=MYCOF(IPG,IEL)**IPOW
  55.             ENDIF
  56.             IPROCO(IPGMAX,IELMAX)=IPROCO(IPGMAX,IELMAX)*CONTRI
  57.  12      CONTINUE
  58.  1    CONTINUE
  59. *
  60. * Normal termination
  61. *
  62.       IRET=0
  63.       RETURN
  64. *
  65. * Format handling
  66. *
  67. *
  68. * Error handling
  69. *
  70.  9999 CONTINUE
  71.       IRET=1
  72.       WRITE(IOIMP,*) 'An error was detected in subroutine calpc1'
  73.       RETURN
  74. *
  75. * End of subroutine CALPC1
  76. *
  77.       END
  78.  
  79.  
  80.  
  81.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales