Télécharger linlin.eso

Retour à la liste

Numérotation des lignes :

linlin
  1. C LINLIN SOURCE GOUNAND 21/06/02 21:17:10 11022
  2. SUBROUTINE LINLIN(PGCOUR,
  3. $ FVPR,FVDU,FCPR,FCDU,
  4. $ KDERPR,KDERDU,
  5. $ JDTJAC,NBELEM,LERF,IESREF,
  6. $ JMTLIN,
  7. $ IMPR,IRET)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. IMPLICIT INTEGER (I-N)
  10. C***********************************************************************
  11. C NOM : LINLIN
  12. C DESCRIPTION : Calcul de la matrice.
  13. C
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES : LINLI1 (calcul de JMTLIN (fortran 77))
  20. C APPELE PAR : NLIN
  21. C***********************************************************************
  22. C ENTREES : * PGCOUR (type POGAU) : méthode d'intégration pour
  23. C le maillage élémentaire courant.
  24. C * FFGPR (type MCHEVA) : valeurs des fonctions
  25. C d'interpolation aux points de gauss sur
  26. C l'élément de référence pour la variable
  27. C primale.
  28. C Structure (cf.include SMCHAEL) :
  29. C (1, nb. ddl. pri., 1, 1, nb. poi. gauss, 1)
  30. C * DFFGPR (type MCHEVA) : valeurs des dérivées
  31. C premières des fonctions d'interpolation
  32. C primales aux points de gauss sur l'élément
  33. C réel.
  34. C Structure (cf.include SMCHAEL) :
  35. C (1, nb. ddl pri., 1, dim.esp.réel,
  36. C nb. poi. gauss, nb. élém.)
  37. C * FFGDU (type MCHEVA) : valeurs des fonctions
  38. C d'interpolation aux points de gauss sur
  39. C l'élément de référence pour la variable
  40. C duale.
  41. C Structure (cf.include SMCHAEL) :
  42. C (1, nb. ddl. dua., 1, 1, nb. poi. gauss, 1)
  43. C * DFFGDU (type MCHEVA) : valeurs des dérivées
  44. C premières des fonctions d'interpolation
  45. C duales aux points de gauss sur l'élément
  46. C réel.
  47. C Structure (cf.include SMCHAEL) :
  48. C (1, nb. ddl dua., 1, dim.esp.réel,
  49. C nb. poi. gauss, nb. élém.)
  50. C * CFGPR (type MCHEVA) : valeurs du coefficient
  51. C aux points de Gauss sur le maillage
  52. C élémentaire pour la variable primale.
  53. C Structure (cf.include SMCHAEL) :
  54. C (1, 1, 1, 1,
  55. C nb. poi. gauss, nb. éléments)
  56. C * CFGDU (type MCHEVA) : valeurs du coefficient
  57. C aux points de Gauss sur le maillage
  58. C élémentaire pour la variable duale.
  59. C Structure (cf.include SMCHAEL) :
  60. C (1, 1, 1, 1,
  61. C nb. poi. gauss, nb. éléments)
  62. C * KDERPR (type ENTIER) : dérivation sur la
  63. C variable primale.
  64. C * KDERDU(type ENTIER) : dérivation sur la
  65. C variable duale.
  66. C * JDTJAC (type MCHEVA) : valeurs du déterminant
  67. C de la matrice jacobienne aux points de Gauss
  68. C sur le maillage élémentaire.
  69. C Structure (cf.include SMCHAEL) :
  70. C (1, 1, 1, 1, nb. poi. gauss, nb. éléments)
  71. C * NBELEM (type entier) : nombre d'éléments du
  72. C maillage élémentaire courant.
  73. C ENTREES/SORTIES : * JMTLIN (type MCHEVA) : valeurs de la matrice
  74. C moindres carrés sur le maillage élémentaire.
  75. C Structure (cf.include SMCHAEL) :
  76. C (nb. ddl dual, nb. ddl primal,
  77. C 1, 1,
  78. C 1, nb. éléments)
  79. C SORTIES : -
  80. C TRAVAIL : * NDDLDU (type entier) : nb. de ddl de la
  81. C variable duale par élément.
  82. C * NDDLPR (type entier) : nb. de ddl de la
  83. C variable primale par élément.
  84. C * IESREL (type entier) : dimension de l'espace
  85. C réel (i.e. géométrique).
  86. C * NBPOGO (type entier) : nombre de points
  87. C d'intégration.
  88. C * NLDFPR (type entier) : nombre d'éléments de
  89. C DFFGPR.
  90. C * NLDFDU (type entier) : nombre d'éléments de
  91. C DFFGDU.
  92. C * NLCPR (type entier) : nombre d'éléments de
  93. C CFGPR.
  94. C * NLCDU (type entier) : nombre d'éléments de
  95. C CFGDU.
  96. C * NLDTJ (type entier) : nombre d'éléments de
  97. C JDTJAC.
  98. C Les nombres d'éléments ci-dessus valent :
  99. C - soit NBELEM ;
  100. C - soit 1 si le champ par élément est constant sur le maillage
  101. C élémentaire courant.
  102. C * NLMLIN (type entier) : nombre d'éléments de
  103. C JMTLIN.
  104. C***********************************************************************
  105. C VERSION : v3.1, 30/07/04, possiblité de travailler
  106. C dans l'espace de référence
  107. C VERSION : v1, 11/05/04, version initiale
  108. C HISTORIQUE : v1, 11/05/04, création
  109. C HISTORIQUE :
  110. C HISTORIQUE :
  111. C***********************************************************************
  112. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  113. C en cas de modification de ce sous-programme afin de faciliter
  114. C la maintenance !
  115. C***********************************************************************
  116.  
  117. -INC PPARAM
  118. -INC CCOPTIO
  119. -INC TNLIN
  120. *-INC SPOGAU
  121. POINTEUR PGCOUR.POGAU
  122. *-INC SMCHAEL
  123. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  124. POINTEUR FVPR.MCHEVA,FVDU.MCHEVA
  125. POINTEUR FCPR.MCHEVA,FCDU.MCHEVA
  126. POINTEUR JDTJAC.MCHEVA
  127. POINTEUR JMTLIN.MCHEVA
  128. *
  129. INTEGER KDERPR,KDERDU
  130. INTEGER NBELEM
  131. INTEGER LERF
  132. INTEGER IMPR,IRET
  133. *
  134. INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  135. INTEGER NLDTJ,NLMLIN
  136. INTEGER NDDLPR,NDDLDU,IESREL,NBPOGO
  137. *
  138. * Executable statements
  139. *
  140. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linlin'
  141. *
  142. IF (KDERPR.LT.0.OR.KDERPR.GT.IDIM) THEN
  143. WRITE(IOIMP,*) 'Erreur KDERPR=',KDERPR
  144. GOTO 9999
  145. ENDIF
  146. *
  147. IF (KDERDU.LT.0.OR.KDERDU.GT.IDIM) THEN
  148. WRITE(IOIMP,*) 'Erreur KDERDU=',KDERDU
  149. GOTO 9999
  150. ENDIF
  151. *
  152. IESREL=IDIM
  153. IF (LERF.NE.0) THEN
  154. IESDER=IESREF
  155. ELSE
  156. IESDER=IESREL
  157. ENDIF
  158. *
  159. SEGACT PGCOUR
  160. NBPOGO=PGCOUR.XPOPG(/1)
  161. *
  162. * SEGPRT,FVPR
  163. SEGACT FVPR
  164. NDLIG=FVPR.WELCHE(/1)
  165. NDCOL=FVPR.WELCHE(/2)
  166. N2DLIG=FVPR.WELCHE(/3)
  167. N2DCOL=FVPR.WELCHE(/4)
  168. NDNOEU=FVPR.WELCHE(/5)
  169. NDELM=FVPR.WELCHE(/6)
  170. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  171. $ ((N2DCOL.NE.1.AND.KDERPR.EQ.0)
  172. $ .OR.(N2DCOL.NE.IESDER.AND.KDERPR.NE.0))
  173. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  174. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  175. WRITE(IOIMP,*) 'Erreur dims FVPR'
  176. GOTO 9999
  177. ENDIF
  178. NDDLPR=NDCOL
  179. N2FVPR=N2DCOL
  180. NPFVPR=NDNOEU
  181. NLFVPR=NDELM
  182. *
  183. * SEGPRT,FVDU
  184. SEGACT FVDU
  185. NDLIG=FVDU.WELCHE(/1)
  186. NDCOL=FVDU.WELCHE(/2)
  187. N2DLIG=FVDU.WELCHE(/3)
  188. N2DCOL=FVDU.WELCHE(/4)
  189. NDNOEU=FVDU.WELCHE(/5)
  190. NDELM=FVDU.WELCHE(/6)
  191. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  192. $ ((N2DCOL.NE.1.AND.KDERDU.EQ.0)
  193. $ .OR.(N2DCOL.NE.IESDER.AND.KDERDU.NE.0))
  194. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  195. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  196. WRITE(IOIMP,*) 'Erreur dims FVDU'
  197. GOTO 9999
  198. ENDIF
  199. NDDLDU=NDCOL
  200. N2FVDU=N2DCOL
  201. NPFVDU=NDNOEU
  202. NLFVDU=NDELM
  203. *
  204. * SEGPRT,FCPR
  205. SEGACT FCPR
  206. NDLIG =FCPR.WELCHE(/1)
  207. NDCOL =FCPR.WELCHE(/2)
  208. N2DLIG=FCPR.WELCHE(/3)
  209. N2DCOL=FCPR.WELCHE(/4)
  210. NDNOEU=FCPR.WELCHE(/5)
  211. NDELM =FCPR.WELCHE(/6)
  212. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  213. $ N2DCOL.NE.1
  214. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  215. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  216. WRITE(IOIMP,*) 'Erreur dims FCPR'
  217. GOTO 9999
  218. ENDIF
  219. NPFCPR=NDNOEU
  220. NLFCPR=NDELM
  221. *
  222. * SEGPRT,FCDU
  223. SEGACT FCDU
  224. NDLIG =FCDU.WELCHE(/1)
  225. NDCOL =FCDU.WELCHE(/2)
  226. N2DLIG=FCDU.WELCHE(/3)
  227. N2DCOL=FCDU.WELCHE(/4)
  228. NDNOEU=FCDU.WELCHE(/5)
  229. NDELM =FCDU.WELCHE(/6)
  230. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  231. $ N2DCOL.NE.1
  232. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  233. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  234. WRITE(IOIMP,*) 'Erreur dims FCDU'
  235. GOTO 9999
  236. ENDIF
  237. NPFCDU=NDNOEU
  238. NLFCDU=NDELM
  239. *
  240. SEGACT JDTJAC
  241. NDLIG=JDTJAC.WELCHE(/1)
  242. NDCOL=JDTJAC.WELCHE(/2)
  243. N2DLIG=JDTJAC.WELCHE(/3)
  244. N2DCOL=JDTJAC.WELCHE(/4)
  245. NDNOEU=JDTJAC.WELCHE(/5)
  246. NDELM=JDTJAC.WELCHE(/6)
  247. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1
  248. $ .OR.N2DCOL.NE.1
  249. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  250. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  251. WRITE(IOIMP,*) 'Erreur dims JDTJAC'
  252. GOTO 9999
  253. ENDIF
  254. NPDTJ=NDNOEU
  255. NLDTJ=NDELM
  256. *
  257. IF (JMTLIN.EQ.0) THEN
  258. NBLIG=NDDLDU
  259. NBCOL=NDDLPR
  260. N2LIG=1
  261. N2COL=1
  262. NBPOI=1
  263. NBELM=NBELEM
  264. * On pourrait aussi envisager de renvoyer une seule matrice pour le cas
  265. * où NLCFG=NLFPRG=NLFDUG=NLDTJ=1
  266. SEGINI JMTLIN
  267. NLMLIN=NBELM
  268. ELSE
  269. SEGACT JMTLIN*MOD
  270. NDLIG=JMTLIN.WELCHE(/1)
  271. NDCOL=JMTLIN.WELCHE(/2)
  272. N2DLIG=JMTLIN.WELCHE(/3)
  273. N2DCOL=JMTLIN.WELCHE(/4)
  274. NDNOEU=JMTLIN.WELCHE(/5)
  275. NDELM=JMTLIN.WELCHE(/6)
  276. IF (NDLIG.NE.NDDLDU.OR.NDCOL.NE.NDDLPR.OR.N2DLIG.NE.1
  277. $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1
  278. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  279. WRITE(IOIMP,*) 'Erreur dims JMTLIN'
  280. GOTO 9999
  281. ENDIF
  282. NLMLIN=NDELM
  283. ENDIF
  284. *
  285. KDFRPR=MAX(1,KDERPR)
  286. KDFRDU=MAX(1,KDERDU)
  287. *
  288. * On effectue le calcul de la matrice de moindres carrés
  289. *
  290. CALL LINLI1(NDDLPR,NDDLDU,NBPOGO,
  291. $ N2FVPR,N2FVDU,
  292. $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ,
  293. $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN,
  294. $ KDFRPR,KDFRDU,
  295. $ PGCOUR.XPOPG,
  296. $ FVPR.WELCHE,FVDU.WELCHE,FCPR.WELCHE,FCDU.WELCHE,
  297. $ JDTJAC.WELCHE,LERF,JMTLIN.WELCHE,
  298. $ IMPR,IRET)
  299. IF (IRET.NE.0) GOTO 9999
  300. * SEGDES JMTLIN
  301. SEGDES JMTLIN
  302. * IMPR=6
  303. IF (IMPR.GT.3) THEN
  304. WRITE(IOIMP,*) 'On a créé',
  305. $ ' JMTLIN(élément ,1 ,1 ,1 ,',
  306. $ ' ddl.pri , ddl.dua)'
  307. CALL PRCHVA(JMTLIN,IMPR,IRET)
  308. IF (IRET.NE.0) GOTO 9999
  309. ENDIF
  310. * IMPR=0
  311. SEGDES JDTJAC
  312. SEGDES FCDU
  313. SEGDES FCPR
  314. SEGDES FVDU
  315. SEGDES FVPR
  316. SEGDES PGCOUR
  317. *
  318. * Normal termination
  319. *
  320. IRET=0
  321. RETURN
  322. *
  323. * Format handling
  324. *
  325. *
  326. * Error handling
  327. *
  328. 9999 CONTINUE
  329. IRET=1
  330. WRITE(IOIMP,*) 'An error was detected in subroutine linlin'
  331. RETURN
  332. *
  333. * End of subroutine LINLIN
  334. *
  335. END
  336.  
  337.  
  338.  
  339.  

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