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.  
  121. -INC PPARAM
  122. -INC CCOPTIO
  123. INTEGER NDDLDU,NDDLPR,NBPOGO
  124. INTEGER N2FVPR,N2FVDU
  125. INTEGER NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ
  126. INTEGER NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN
  127. INTEGER KDFRPR,KDFRDU
  128. REAL*8 XPOPG (NBPOGO)
  129. REAL*8 FVPR(NDDLPR,N2FVPR,NPFVPR,NLFVPR)
  130. REAL*8 FVDU(NDDLDU,N2FVDU,NPFVDU,NLFVDU)
  131. REAL*8 FCPR(NPFCPR,NLFCPR)
  132. REAL*8 FCDU(NPFCDU,NLFCDU)
  133. REAL*8 JDTJAC(NPDTJ,NLDTJ)
  134. REAL*8 JMTLIN(NDDLDU,NDDLPR,NLMLIN)
  135. *
  136. REAL*8 CONTRI,SPOGO,ISPOGO
  137. INTEGER LERF
  138. INTEGER IMPR,IRET
  139. INTEGER IDDLPR,IDDLDU,IPOGO,ILMLIN
  140. INTEGER IPFVPR,IPFVDU,IPFCPR,IPFCDU,IPDTJ
  141. INTEGER ILFVPR,ILFVDU,ILFCPR,ILFCDU,ILDTJ
  142. *
  143. * Executable statements
  144. *
  145. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linli1'
  146. * Write(ioimp,*) 'linli1'
  147. * Write(ioimp,*) 'LERF=',LERF
  148. DO 1 ILMLIN=1,NLMLIN
  149. *
  150. * On suppose que le compilo pourra optimiser les IF
  151. * en les sortant de la boucle 1. (Très chiant a faire
  152. * a la main : 2^5 cas
  153. *
  154. * C'est pourquoi, on évite l'écriture
  155. * ILFVPR=MIN(ILMLIN,NLFVPR) plus courte mais sans
  156. * doute non optimisable
  157. *
  158. IF (NLFVPR.EQ.1) THEN
  159. ILFVPR=1
  160. ELSE
  161. ILFVPR=ILMLIN
  162. ENDIF
  163. IF (NLFVDU.EQ.1) THEN
  164. ILFVDU=1
  165. ELSE
  166. ILFVDU=ILMLIN
  167. ENDIF
  168. *
  169. IF (NLFCPR.EQ.1) THEN
  170. ILFCPR=1
  171. ELSE
  172. ILFCPR=ILMLIN
  173. ENDIF
  174. IF (NLFCDU.EQ.1) THEN
  175. ILFCDU=1
  176. ELSE
  177. ILFCDU=ILMLIN
  178. ENDIF
  179. *
  180. IF (NLDTJ.EQ.1) THEN
  181. ILDTJ=1
  182. ELSE
  183. ILDTJ=ILMLIN
  184. ENDIF
  185. IF (LERF.EQ.2) THEN
  186. SPOGO=0.D0
  187. DO IPOGO=1,NBPOGO
  188. SPOGO=SPOGO+XPOPG(IPOGO)
  189. ENDDO
  190. ISPOGO=1.D0/SPOGO
  191. * WRITE(IOIMP,*) 'ISPOGO=',ISPOGO
  192. ENDIF
  193. DO 12 IPOGO=1,NBPOGO
  194. IF (NPFVPR.EQ.1) THEN
  195. IPFVPR=1
  196. ELSE
  197. IPFVPR=IPOGO
  198. ENDIF
  199. IF (NPFVDU.EQ.1) THEN
  200. IPFVDU=1
  201. ELSE
  202. IPFVDU=IPOGO
  203. ENDIF
  204. *
  205. IF (NPFCPR.EQ.1) THEN
  206. IPFCPR=1
  207. ELSE
  208. IPFCPR=IPOGO
  209. ENDIF
  210. IF (NPFCDU.EQ.1) THEN
  211. IPFCDU=1
  212. ELSE
  213. IPFCDU=IPOGO
  214. ENDIF
  215. *
  216. IF (NPDTJ.EQ.1) THEN
  217. IPDTJ=1
  218. ELSE
  219. IPDTJ=IPOGO
  220. ENDIF
  221. DO 12222 IDDLPR=1,NDDLPR
  222. DO 12224 IDDLDU=1,NDDLDU
  223. CONTRI=
  224. C $ XPOPG(IPOGO)*
  225. $ FVDU(IDDLDU,KDFRDU,IPFVDU,ILFVDU)
  226. $ *FCDU(IPFCDU,ILFCDU)
  227. $ *FCPR(IPFCPR,ILFCPR)
  228. $ *FVPR(IDDLPR,KDFRPR,IPFVPR,ILFVPR)
  229. IF (LERF.EQ.0) THEN
  230. CONTRI=CONTRI*ABS(JDTJAC(IPDTJ,ILDTJ))*XPOPG(IPOGO)
  231. ELSEIF (LERF.EQ.1) THEN
  232. CONTRI=CONTRI*XPOPG(IPOGO)
  233. ELSEIF (LERF.EQ.2) THEN
  234. CONTRI=CONTRI*XPOPG(IPOGO)*ISPOGO
  235. ENDIF
  236. JMTLIN(IDDLDU,IDDLPR,ILMLIN)=
  237. $ JMTLIN(IDDLDU,IDDLPR,ILMLIN)+
  238. $ CONTRI
  239. 12224 CONTINUE
  240. 12222 CONTINUE
  241. 12 CONTINUE
  242. 1 CONTINUE
  243. *
  244. * Normal termination
  245. *
  246. IRET=0
  247. RETURN
  248. *
  249. * Format handling
  250. *
  251. *
  252. * Error handling
  253. *
  254. 9999 CONTINUE
  255. IRET=1
  256. WRITE(IOIMP,*) 'An error was detected in subroutine linli1'
  257. RETURN
  258. *
  259. * End of subroutine LINLI1
  260. *
  261. END
  262.  
  263.  
  264.  
  265.  

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