1 : C CALPN SOURCE GOUNAND 05/12/21 21:15:33 5281
2 : SUBROUTINE CALPN(MYLRF,
3 : $ PN,
4 : $ IMPR,IRET)
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8 (A-H,O-Z)
7 : C***********************************************************************
8 : C NOM : CALPN
9 : C PROJET : Noyau linéaire NLIN
10 : C DESCRIPTION : Calcul de la matrice nodale [PN].
11 : C Si {Un} sont les degrés de liberté nodaux
12 : C sur l'élément de référence et
13 : C {a} les coefficients dans la base polynômiale
14 : C alors {Un} = [PN] {a}.
15 : C Explicitement :
16 : C [PN] = ( P1(ksi1) ..... Pn(ksi1))
17 : C ( ... ..... ... )
18 : C ( P1(ksin) ..... Pn(ksin))
19 : C n = nb. ddl sur l'élément (NDFN)
20 : C ksii = coords. du ieme noeud d'approximation
21 : C dans l'espace de référence (de dimension
22 : C NDIML)
23 : C Pi = ieme polynome d'interpolation sur
24 : C l'élément de référence.
25 : C
26 : C
27 : C LANGAGE : Esope
28 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
29 : C mél : gounand@semt2.smts.cea.fr
30 : C***********************************************************************
31 : C APPELES : VALPOL
32 : C APPELE PAR : KFNREF
33 : C***********************************************************************
34 : C ENTREES : MYLRF
35 : C ENTREES/SORTIES : -
36 : C SORTIES : PN
37 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
38 : C***********************************************************************
39 : C VERSION : v1, 16/09/99, version initiale
40 : C HISTORIQUE : v1, 16/09/99, création
41 : C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
42 : C HISTORIQUE :
43 : C HISTORIQUE :
44 : C***********************************************************************
45 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
46 : C en cas de modification de ce sous-programme afin de faciliter
47 : C la maintenance !
48 : C***********************************************************************
49 : -INC CCOPTIO
50 : CBEGININCLUDE SELREF
51 : SEGMENT ELREF
52 : CHARACTER*(LNNOM) NOMLRF
53 : CHARACTER*(LNFORM) FORME
54 : CHARACTER*(LNTYPL) TYPEL
55 : CHARACTER*(LNESP) ESPACE
56 : INTEGER DEGRE
57 : REAL*8 XCONOD(NDIMEL,NBNOD)
58 : INTEGER NPQUAF(NBDDL)
59 : INTEGER NUMCMP(NBDDL)
60 : INTEGER QUENOD(NBDDL)
61 : INTEGER ORDDER(NDIMEL,NBDDL)
62 : POINTEUR MBPOLY.POLYNS
63 : ENDSEGMENT
64 : SEGMENT ELREFS
65 : POINTEUR LISEL(0).ELREF
66 : ENDSEGMENT
67 : CENDINCLUDE SELREF
68 : POINTEUR MYLRF.ELREF
69 : CBEGININCLUDE SPOLYNO
70 : SEGMENT POLYNO
71 : REAL*8 COEMON(NBMON)
72 : INTEGER EXPMON(NDIML,NBMON)
73 : ENDSEGMENT
74 : SEGMENT POLYNS
75 : POINTEUR LIPOLY(NBPOLY).POLYNO
76 : ENDSEGMENT
77 : CENDINCLUDE SPOLYNO
78 : POINTEUR MYBPOL.POLYNS
79 : POINTEUR MYPOLY.POLYNO
80 : CBEGININCLUDE SMMREEL
81 : SEGMENT MMREEL
82 : REAL*8 MAT(JLIG,JCOL)
83 : ENDSEGMENT
84 : CENDINCLUDE SMMREEL
85 : INTEGER JLIG,JCOL
86 : POINTEUR PN.MMREEL
87 : *
88 : INTEGER IMPR,IRET
89 : *
90 : INTEGER INDFN,JNDFN
91 : INTEGER NDIML,NDIML2,NDFN,NBMONO,NPOLY
92 : *
93 : * Executable statements
94 : *
95 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calpn'
96 : *
97 : * Initialisations
98 : *
99 : SEGACT MYLRF
100 : NDIML=MYLRF.XCONOD(/1)
101 : NDFN =MYLRF.NPQUAF(/1)
102 : MYBPOL=MYLRF.MBPOLY
103 : SEGACT MYBPOL
104 : NPOLY=MYBPOL.LIPOLY(/1)
105 : IF (NPOLY.NE.NDFN) THEN
106 : WRITE(IOIMP,*) 'Element fini mal défini'
107 : GOTO 9999
108 : ENDIF
109 : JLIG=NDFN
110 : JCOL=NDFN
111 : SEGINI PN
112 : *
113 : * On calcule la matrice [PN] colonne par colonne
114 : *
115 : DO 1 JNDFN=1,NDFN
116 : MYPOLY=MYBPOL.LIPOLY(JNDFN)
117 : SEGACT MYPOLY
118 : NDIML2=MYPOLY.EXPMON(/1)
119 : IF (NDIML2.NE.NDIML) THEN
120 : WRITE(IOIMP,*) 'Grosse erreur...(dimensions de segments)'
121 : GOTO 9999
122 : ENDIF
123 : NBMONO=MYPOLY.EXPMON(/2)
124 : DO 12 INDFN=1,NDFN
125 : * Calcul du polynôme JNDFN (ou une de ses dérivées) au point de
126 : * l'élément de référence numéro INDFN
126 : CALL VALPOL(NDIML,NBMONO,
127 : $ MYLRF.XCONOD(1,INDFN),
128 : $ MYPOLY.COEMON,MYPOLY.EXPMON,
129 : $ MYLRF.ORDDER(1,JNDFN),
130 : $ PN.MAT(INDFN,JNDFN),
131 : $ IMPR,IRET)
132 : IF (IRET.NE.0) GOTO 9999
133 : 12 CONTINUE
134 : SEGDES MYPOLY
135 : 1 CONTINUE
136 : IF (IMPR.GT.3) THEN
137 : WRITE(IOIMP,*) 'On a créé [PN] (',NDFN,'x',NDFN,') :'
138 : DO 3 INDFN=1,NDFN
139 : WRITE(IOIMP,4004) (PN.MAT(INDFN,JNDFN),JNDFN=1,NDFN)
140 : 3 CONTINUE
141 : ENDIF
142 : SEGDES PN
143 : SEGDES MYBPOL
144 : SEGDES MYLRF
145 : *
146 : * Normal termination
147 : *
148 : IRET=0
149 : RETURN
150 : *
151 : * Format handling
152 : *
153 : 4004 FORMAT (2X,6(1X,1PE13.5))
154 : *
155 : * Error handling
156 : *
157 : 9999 CONTINUE
158 : IRET=1
159 : WRITE(IOIMP,*) 'An error was detected in subroutine calpn'
160 : RETURN
161 : *
162 : * End of subroutine CALPN
163 : *
164 : END
165 :
166 :
167 :
168 :
© Cast3M 2003 - All rights reserved.
Disclaimer