Télécharger linli1.eso

Retour à la liste

Numérotation des lignes :

  1. C LINLI1 SOURCE GOUNAND 05/12/21 21:33:49 5281
  2. SUBROUTINE LINLI1(NDDLPR,NDDLDU,NBPOGO,
  3. $ N2FVPR,N2FVDU,
  4. $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ,
  5. $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN,
  6. $ KDFRPR,KDFRDU,
  7. $ XPOPG,
  8. $ FVPR,FVDU,FCPR,FCDU,
  9. $ JDTJAC,LERF,JMTLIN,
  10. $ IMPR,IRET)
  11. IMPLICIT REAL*8 (A-H,O-Z)
  12. IMPLICIT INTEGER (I-N)
  13. C***********************************************************************
  14. C NOM : LINLI1
  15. C DESCRIPTION : Calcul de la matrice.
  16. C
  17. C ! Commentaires non à jour !
  18. C
  19. C LANGAGE : Fortran 77 (sauf E/S)
  20. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  21. C mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C APPELES : -
  24. C APPELE PAR : LINLIN
  25. C***********************************************************************
  26. C ENTREES : * MYPG (type POGAU) : méthode d'intégration pour
  27. C le maillage élémentaire courant.
  28. C * FFGPR (type MCHEVA) : valeurs des fonctions
  29. C d'interpolation aux points de gauss sur
  30. C l'élément de référence pour la variable
  31. C primale.
  32. C Structure (cf.include SMCHAEL) :
  33. C (1, nb. ddl. pri., 1, 1, nb. poi. gauss, 1)
  34. C * DFFGPR (type MCHEVA) : valeurs des dérivées
  35. C premières des fonctions d'interpolation
  36. C primales aux points de gauss sur l'élément
  37. C réel.
  38. C Structure (cf.include SMCHAEL) :
  39. C (1, nb. ddl pri., 1, dim.esp.réel,
  40. C nb. poi. gauss, nb. élém.)
  41. C * FFGDU (type MCHEVA) : valeurs des fonctions
  42. C d'interpolation aux points de gauss sur
  43. C l'élément de référence pour la variable
  44. C duale.
  45. C Structure (cf.include SMCHAEL) :
  46. C (1, nb. ddl. dua., 1, 1, nb. poi. gauss, 1)
  47. C * DFFGDU (type MCHEVA) : valeurs des dérivées
  48. C premières des fonctions d'interpolation
  49. C duales aux points de gauss sur l'élément
  50. C réel.
  51. C Structure (cf.include SMCHAEL) :
  52. C (1, nb. ddl dua., 1, dim.esp.réel,
  53. C nb. poi. gauss, nb. élém.)
  54. C * CFGPR (type MCHEVA) : valeurs du coefficient
  55. C aux points de Gauss sur le maillage
  56. C élémentaire pour la variable primale.
  57. C Structure (cf.include SMCHAEL) :
  58. C (1, 1, 1, 1,
  59. C nb. poi. gauss, nb. éléments)
  60. C * CFGDU (type MCHEVA) : valeurs du coefficient
  61. C aux points de Gauss sur le maillage
  62. C élémentaire pour la variable duale.
  63. C Structure (cf.include SMCHAEL) :
  64. C (1, 1, 1, 1,
  65. C nb. poi. gauss, nb. éléments)
  66. C * KDERPR (type ENTIER) : dérivation sur la
  67. C variable primale.
  68. C * KDERDU(type ENTIER) : dérivation sur la
  69. C variable duale.
  70. C * JDTJAC (type MCHEVA) : valeurs du déterminant
  71. C de la matrice jacobienne aux points de Gauss
  72. C sur le maillage élémentaire.
  73. C Structure (cf.include SMCHAEL) :
  74. C (1, 1, 1, 1, nb. poi. gauss, nb. éléments)
  75. C * NBELEM (type entier) : nombre d'éléments du
  76. C maillage élémentaire courant.
  77. C ENTREES/SORTIES : * JMTLIN (type MCHEVA) : valeurs de la matrice
  78. C moindres carrés sur le maillage élémentaire.
  79. C Structure (cf.include SMCHAEL) :
  80. C (nb. ddl dual, nb. ddl primal,
  81. C 1, 1,
  82. C 1, nb. éléments)
  83. C SORTIES : -
  84. C TRAVAIL : * NDDLDU (type entier) : nb. de ddl de la
  85. C variable duale par élément.
  86. C * NDDLPR (type entier) : nb. de ddl de la
  87. C variable primale par élément.
  88. C * IESREL (type entier) : dimension de l'espace
  89. C réel (i.e. géométrique).
  90. C * NBPOGO (type entier) : nombre de points
  91. C d'intégration.
  92. C * NLDFPR (type entier) : nombre d'éléments de
  93. C DFFGPR.
  94. C * NLDFDU (type entier) : nombre d'éléments de
  95. C DFFGDU.
  96. C * NLCPR (type entier) : nombre d'éléments de
  97. C CFGPR.
  98. C * NLCDU (type entier) : nombre d'éléments de
  99. C CFGDU.
  100. C * NLDTJ (type entier) : nombre d'éléments de
  101. C JDTJAC.
  102. C Les nombres d'éléments ci-dessus valent :
  103. C - soit NBELEM ;
  104. C - soit 1 si le champ par élément est constant sur le maillage
  105. C élémentaire courant.
  106. C * NLMLIN (type entier) : nombre d'éléments de
  107. C JMTLIN.
  108. C***********************************************************************
  109. C VERSION : v3.1, 30/07/04, possiblité de travailler
  110. C dans l'espace de référence
  111. C VERSION : v1, 11/05/04, version initiale
  112. C HISTORIQUE : v1, 11/05/04, création
  113. C HISTORIQUE :
  114. C HISTORIQUE :
  115. C***********************************************************************
  116. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  117. C en cas de modification de ce sous-programme afin de faciliter
  118. C la maintenance !
  119. C***********************************************************************
  120. -INC CCOPTIO
  121. INTEGER NDDLDU,NDDLPR,NBPOGO
  122. INTEGER N2FVPR,N2FVDU
  123. INTEGER NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ
  124. INTEGER NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN
  125. INTEGER KDFRPR,KDFRDU
  126. REAL*8 XPOPG (NBPOGO)
  127. REAL*8 FVPR(NDDLPR,N2FVPR,NPFVPR,NLFVPR)
  128. REAL*8 FVDU(NDDLDU,N2FVDU,NPFVDU,NLFVDU)
  129. REAL*8 FCPR(NPFCPR,NLFCPR)
  130. REAL*8 FCDU(NPFCDU,NLFCDU)
  131. REAL*8 JDTJAC(NPDTJ,NLDTJ)
  132. REAL*8 JMTLIN(NDDLDU,NDDLPR,NLMLIN)
  133. *
  134. REAL*8 CONTRI,SPOGO,ISPOGO
  135. INTEGER LERF
  136. INTEGER IMPR,IRET
  137. INTEGER IDDLPR,IDDLDU,IPOGO,ILMLIN
  138. INTEGER IPFVPR,IPFVDU,IPFCPR,IPFCDU,IPDTJ
  139. INTEGER ILFVPR,ILFVDU,ILFCPR,ILFCDU,ILDTJ
  140. *
  141. * Executable statements
  142. *
  143. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linli1'
  144. * Write(ioimp,*) 'linli1'
  145. * Write(ioimp,*) 'LERF=',LERF
  146. DO 1 ILMLIN=1,NLMLIN
  147. *
  148. * On suppose que le compilo pourra optimiser les IF
  149. * en les sortant de la boucle 1. (Très chiant a faire
  150. * a la main : 2^5 cas
  151. *
  152. * C'est pourquoi, on évite l'écriture
  153. * ILFVPR=MIN(ILMLIN,NLFVPR) plus courte mais sans
  154. * doute non optimisable
  155. *
  156. IF (NLFVPR.EQ.1) THEN
  157. ILFVPR=1
  158. ELSE
  159. ILFVPR=ILMLIN
  160. ENDIF
  161. IF (NLFVDU.EQ.1) THEN
  162. ILFVDU=1
  163. ELSE
  164. ILFVDU=ILMLIN
  165. ENDIF
  166. *
  167. IF (NLFCPR.EQ.1) THEN
  168. ILFCPR=1
  169. ELSE
  170. ILFCPR=ILMLIN
  171. ENDIF
  172. IF (NLFCDU.EQ.1) THEN
  173. ILFCDU=1
  174. ELSE
  175. ILFCDU=ILMLIN
  176. ENDIF
  177. *
  178. IF (NLDTJ.EQ.1) THEN
  179. ILDTJ=1
  180. ELSE
  181. ILDTJ=ILMLIN
  182. ENDIF
  183. IF (LERF.EQ.2) THEN
  184. SPOGO=0.D0
  185. DO IPOGO=1,NBPOGO
  186. SPOGO=SPOGO+XPOPG(IPOGO)
  187. ENDDO
  188. ISPOGO=1.D0/SPOGO
  189. * WRITE(IOIMP,*) 'ISPOGO=',ISPOGO
  190. ENDIF
  191. DO 12 IPOGO=1,NBPOGO
  192. IF (NPFVPR.EQ.1) THEN
  193. IPFVPR=1
  194. ELSE
  195. IPFVPR=IPOGO
  196. ENDIF
  197. IF (NPFVDU.EQ.1) THEN
  198. IPFVDU=1
  199. ELSE
  200. IPFVDU=IPOGO
  201. ENDIF
  202. *
  203. IF (NPFCPR.EQ.1) THEN
  204. IPFCPR=1
  205. ELSE
  206. IPFCPR=IPOGO
  207. ENDIF
  208. IF (NPFCDU.EQ.1) THEN
  209. IPFCDU=1
  210. ELSE
  211. IPFCDU=IPOGO
  212. ENDIF
  213. *
  214. IF (NPDTJ.EQ.1) THEN
  215. IPDTJ=1
  216. ELSE
  217. IPDTJ=IPOGO
  218. ENDIF
  219. DO 12222 IDDLPR=1,NDDLPR
  220. DO 12224 IDDLDU=1,NDDLDU
  221. CONTRI=
  222. C $ XPOPG(IPOGO)*
  223. $ FVDU(IDDLDU,KDFRDU,IPFVDU,ILFVDU)
  224. $ *FCDU(IPFCDU,ILFCDU)
  225. $ *FCPR(IPFCPR,ILFCPR)
  226. $ *FVPR(IDDLPR,KDFRPR,IPFVPR,ILFVPR)
  227. IF (LERF.EQ.0) THEN
  228. CONTRI=CONTRI*ABS(JDTJAC(IPDTJ,ILDTJ))*XPOPG(IPOGO)
  229. ELSEIF (LERF.EQ.1) THEN
  230. CONTRI=CONTRI*XPOPG(IPOGO)
  231. ELSEIF (LERF.EQ.2) THEN
  232. CONTRI=CONTRI*XPOPG(IPOGO)*ISPOGO
  233. ENDIF
  234. JMTLIN(IDDLDU,IDDLPR,ILMLIN)=
  235. $ JMTLIN(IDDLDU,IDDLPR,ILMLIN)+
  236. $ CONTRI
  237. 12224 CONTINUE
  238. 12222 CONTINUE
  239. 12 CONTINUE
  240. 1 CONTINUE
  241. *
  242. * Normal termination
  243. *
  244. IRET=0
  245. RETURN
  246. *
  247. * Format handling
  248. *
  249. *
  250. * Error handling
  251. *
  252. 9999 CONTINUE
  253. IRET=1
  254. WRITE(IOIMP,*) 'An error was detected in subroutine linli1'
  255. RETURN
  256. *
  257. * End of subroutine LINLI1
  258. *
  259. END
  260.  
  261.  
  262.  
  263.  

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