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