1 : C VALPOL SOURCE GOUNAND 08/11/07 21:15:05 6194
2 : SUBROUTINE VALPOL(NDIML,NBMONO,
3 : $ XCONO1,
4 : $ COEMON,EXPMON,
5 : $ ORDER1,
6 : $ VALEUR,
7 : $ IMPR,IRET)
8 : IMPLICIT INTEGER(I-N)
9 : IMPLICIT REAL*8 (A-H,O-Z)
10 : C***********************************************************************
11 : C NOM : VALPOL
12 : C PROJET : Noyau lineaire NLIN
13 : C DESCRIPTION : Calcule la valeur d'un polynome de R^{ndiml} ou la
14 : C valeur d'une de ses derivees en un point de R^{ndiml}.
15 : C NDIML : dimension de l'espace
16 : C NBMONO : nombre de monomes du polynome
17 : C XCONO1 : coordonnees du point
18 : C COEMON : coefficient d'un monome
19 : C EXPMON : exposants du monome
20 : C ORDER1 : ordre de derivation par rapport a
21 : C chacune des coordonnees
22 : C
23 : C LANGAGE : Fortran 77 (sauf pour les E/S)
24 : C AUTEUR : Stephane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
25 : C mel : gounand@semt2.smts.cea.fr
26 : C***********************************************************************
27 : C APPELES : -
28 : C APPELE PAR : CALPN, NI
29 : C***********************************************************************
30 : C ENTREES : NDIML, NBMONO, XCONO1, COEMON, EXPMON, ORDER1
31 : C ENTREES/SORTIES : -
32 : C SORTIES : VALEUR
33 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passe
34 : C***********************************************************************
35 : C VERSION : v1, 16/09/99, version initiale
36 : C HISTORIQUE : v1, 16/09/99, creation
37 : C HISTORIQUE :
38 : C HISTORIQUE :
39 : C***********************************************************************
40 : C Priere de PRENDRE LE TEMPS de completer les commentaires
41 : C en cas de modification de ce sous-programme afin de faciliter
42 : C la maintenance !
43 : C***********************************************************************
44 : -INC CCOPTIO
45 : INTEGER NDIML,NBMONO
46 : REAL*8 XCONO1(NDIML)
47 : REAL*8 COEMON(NBMONO)
48 : INTEGER EXPMON(NDIML,NBMONO)
49 : INTEGER ORDER1(NDIML)
50 : REAL*8 VALEUR
51 : *
52 : INTEGER IMPR,IRET
53 : *
54 : INTEGER IMONO,INDIML,IFACT
55 : INTEGER NEXPKS,NDERKS
56 : REAL*8 VALMON,VAMOEL
57 : *
58 : * Executable statements
59 : *
60 : IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entree dans valpol'
61 : *
62 : * Calcul de la valeur au point de coordonnees XCONO1 de la
63 : * derivee definie par ORDER1 du monome definie par EXPMON
64 : *
65 : VALEUR=0.D0
66 : DO 1 IMONO=1,NBMONO
67 : VALMON=COEMON(IMONO)
68 : DO 12 INDIML=1,NDIML
69 : NEXPKS=EXPMON(INDIML,IMONO)
70 : NDERKS=ORDER1(INDIML)
71 : *
72 : * d/dx^m (x^n) = 0 si m>n
73 : * = n!/(n-m)! x^(n-m) si m<=n
74 : * ou n! = factorielle de n et en choisissant
75 : * 0! = 1
76 : IF (NDERKS.GT.NEXPKS) THEN
77 : VAMOEL=0.D0
78 : ELSEIF (NDERKS.EQ.NEXPKS) THEN
79 : VAMOEL=1.D0
80 : DO 222 IFACT=1,NEXPKS
81 : VAMOEL=VAMOEL*IFACT
82 : 222 CONTINUE
83 : ELSE
84 : VAMOEL=1.D0
85 : DO 122 IFACT=(NEXPKS-NDERKS+1),NEXPKS,1
86 : VAMOEL=VAMOEL*IFACT
87 : 122 CONTINUE
88 : VAMOEL=VAMOEL*(XCONO1(INDIML)**(NEXPKS-NDERKS))
89 : ENDIF
90 : VALMON=VALMON*VAMOEL
91 : 12 CONTINUE
92 : VALEUR=VALEUR+VALMON
93 : 1 CONTINUE
94 : *
95 : * Normal termination
96 : *
97 : IRET=0
98 : RETURN
99 : *
100 : * Format handling
101 : *
102 : *
103 : * Error handling
104 : *
105 : 9999 CONTINUE
106 : IRET=1
107 : WRITE(IOIMP,*) 'An error was detected in subroutine valpol'
108 : RETURN
109 : *
110 : * End of subroutine VALPOL
111 : *
112 : END
113 :
© Cast3M 2003 - All rights reserved.
Disclaimer