Télécharger linlin.eso

Retour à la liste

Numérotation des lignes :

  1. C LINLIN SOURCE GOUNAND 05/12/21 21:33:54 5281
  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. -INC CCOPTIO
  117. CBEGININCLUDE SPOGAU
  118. SEGMENT POGAU
  119. CHARACTER*(LNNPG) NOMPG
  120. CHARACTER*(LNTPG) TYPMPG
  121. CHARACTER*(LNFPG) FORLPG
  122. INTEGER NORDPG
  123. REAL*8 XCOPG(NDLPG,NBPG)
  124. REAL*8 XPOPG(NBPG)
  125. ENDSEGMENT
  126. SEGMENT POGAUS
  127. POINTEUR LISPG(0).POGAU
  128. ENDSEGMENT
  129. CENDINCLUDE SPOGAU
  130. POINTEUR PGCOUR.POGAU
  131. CBEGININCLUDE SMCHAEL
  132. SEGMENT MCHAEL
  133. POINTEUR IMACHE(N1).MELEME
  134. POINTEUR ICHEVA(N1).MCHEVA
  135. ENDSEGMENT
  136. SEGMENT MCHEVA
  137. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  138. ENDSEGMENT
  139. SEGMENT LCHEVA
  140. POINTEUR LISCHE(NBCHE).MCHEVA
  141. ENDSEGMENT
  142. CENDINCLUDE SMCHAEL
  143. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  144. POINTEUR FVPR.MCHEVA,FVDU.MCHEVA
  145. POINTEUR FCPR.MCHEVA,FCDU.MCHEVA
  146. POINTEUR JDTJAC.MCHEVA
  147. POINTEUR JMTLIN.MCHEVA
  148. *
  149. INTEGER KDERPR,KDERDU
  150. INTEGER NBELEM
  151. INTEGER LERF
  152. INTEGER IMPR,IRET
  153. *
  154. INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  155. INTEGER NLDTJ,NLMLIN
  156. INTEGER NDDLPR,NDDLDU,IESREL,NBPOGO
  157. *
  158. * Executable statements
  159. *
  160. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans linlin'
  161. *
  162. IF (KDERPR.LT.0.OR.KDERPR.GT.IDIM) THEN
  163. WRITE(IOIMP,*) 'Erreur KDERPR=',KDERPR
  164. GOTO 9999
  165. ENDIF
  166. *
  167. IF (KDERDU.LT.0.OR.KDERDU.GT.IDIM) THEN
  168. WRITE(IOIMP,*) 'Erreur KDERDU=',KDERDU
  169. GOTO 9999
  170. ENDIF
  171. *
  172. IESREL=IDIM
  173. IF (LERF.NE.0) THEN
  174. IESDER=IESREF
  175. ELSE
  176. IESDER=IESREL
  177. ENDIF
  178. *
  179. SEGACT PGCOUR
  180. NBPOGO=PGCOUR.XPOPG(/1)
  181. *
  182. * SEGPRT,FVPR
  183. SEGACT FVPR
  184. NDLIG=FVPR.VELCHE(/1)
  185. NDCOL=FVPR.VELCHE(/2)
  186. N2DLIG=FVPR.VELCHE(/3)
  187. N2DCOL=FVPR.VELCHE(/4)
  188. NDNOEU=FVPR.VELCHE(/5)
  189. NDELM=FVPR.VELCHE(/6)
  190. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  191. $ ((N2DCOL.NE.1.AND.KDERPR.EQ.0)
  192. $ .OR.(N2DCOL.NE.IESDER.AND.KDERPR.NE.0))
  193. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  194. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  195. WRITE(IOIMP,*) 'Erreur dims FVPR'
  196. GOTO 9999
  197. ENDIF
  198. NDDLPR=NDCOL
  199. N2FVPR=N2DCOL
  200. NPFVPR=NDNOEU
  201. NLFVPR=NDELM
  202. *
  203. * SEGPRT,FVDU
  204. SEGACT FVDU
  205. NDLIG=FVDU.VELCHE(/1)
  206. NDCOL=FVDU.VELCHE(/2)
  207. N2DLIG=FVDU.VELCHE(/3)
  208. N2DCOL=FVDU.VELCHE(/4)
  209. NDNOEU=FVDU.VELCHE(/5)
  210. NDELM=FVDU.VELCHE(/6)
  211. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.
  212. $ ((N2DCOL.NE.1.AND.KDERDU.EQ.0)
  213. $ .OR.(N2DCOL.NE.IESDER.AND.KDERDU.NE.0))
  214. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  215. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  216. WRITE(IOIMP,*) 'Erreur dims FVDU'
  217. GOTO 9999
  218. ENDIF
  219. NDDLDU=NDCOL
  220. N2FVDU=N2DCOL
  221. NPFVDU=NDNOEU
  222. NLFVDU=NDELM
  223. *
  224. * SEGPRT,FCPR
  225. SEGACT FCPR
  226. NDLIG =FCPR.VELCHE(/1)
  227. NDCOL =FCPR.VELCHE(/2)
  228. N2DLIG=FCPR.VELCHE(/3)
  229. N2DCOL=FCPR.VELCHE(/4)
  230. NDNOEU=FCPR.VELCHE(/5)
  231. NDELM =FCPR.VELCHE(/6)
  232. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  233. $ N2DCOL.NE.1
  234. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  235. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  236. WRITE(IOIMP,*) 'Erreur dims FCPR'
  237. GOTO 9999
  238. ENDIF
  239. NPFCPR=NDNOEU
  240. NLFCPR=NDELM
  241. *
  242. * SEGPRT,FCDU
  243. SEGACT FCDU
  244. NDLIG =FCDU.VELCHE(/1)
  245. NDCOL =FCDU.VELCHE(/2)
  246. N2DLIG=FCDU.VELCHE(/3)
  247. N2DCOL=FCDU.VELCHE(/4)
  248. NDNOEU=FCDU.VELCHE(/5)
  249. NDELM =FCDU.VELCHE(/6)
  250. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  251. $ N2DCOL.NE.1
  252. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  253. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  254. WRITE(IOIMP,*) 'Erreur dims FCDU'
  255. GOTO 9999
  256. ENDIF
  257. NPFCDU=NDNOEU
  258. NLFCDU=NDELM
  259. *
  260. SEGACT JDTJAC
  261. NDLIG=JDTJAC.VELCHE(/1)
  262. NDCOL=JDTJAC.VELCHE(/2)
  263. N2DLIG=JDTJAC.VELCHE(/3)
  264. N2DCOL=JDTJAC.VELCHE(/4)
  265. NDNOEU=JDTJAC.VELCHE(/5)
  266. NDELM=JDTJAC.VELCHE(/6)
  267. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1
  268. $ .OR.N2DCOL.NE.1
  269. $ .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
  270. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  271. WRITE(IOIMP,*) 'Erreur dims JDTJAC'
  272. GOTO 9999
  273. ENDIF
  274. NPDTJ=NDNOEU
  275. NLDTJ=NDELM
  276. *
  277. IF (JMTLIN.EQ.0) THEN
  278. NBLIG=NDDLDU
  279. NBCOL=NDDLPR
  280. N2LIG=1
  281. N2COL=1
  282. NBPOI=1
  283. NBELM=NBELEM
  284. * On pourrait aussi envisager de renvoyer une seule matrice pour le cas
  285. * où NLCFG=NLFPRG=NLFDUG=NLDTJ=1
  286. SEGINI JMTLIN
  287. NLMLIN=NBELM
  288. ELSE
  289. SEGACT JMTLIN*MOD
  290. NDLIG=JMTLIN.VELCHE(/1)
  291. NDCOL=JMTLIN.VELCHE(/2)
  292. N2DLIG=JMTLIN.VELCHE(/3)
  293. N2DCOL=JMTLIN.VELCHE(/4)
  294. NDNOEU=JMTLIN.VELCHE(/5)
  295. NDELM=JMTLIN.VELCHE(/6)
  296. IF (NDLIG.NE.NDDLDU.OR.NDCOL.NE.NDDLPR.OR.N2DLIG.NE.1
  297. $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1
  298. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBELEM)) THEN
  299. WRITE(IOIMP,*) 'Erreur dims JMTLIN'
  300. GOTO 9999
  301. ENDIF
  302. NLMLIN=NDELM
  303. ENDIF
  304. *
  305. KDFRPR=MAX(1,KDERPR)
  306. KDFRDU=MAX(1,KDERDU)
  307. *
  308. * On effectue le calcul de la matrice de moindres carrés
  309. *
  310. CALL LINLI1(NDDLPR,NDDLDU,NBPOGO,
  311. $ N2FVPR,N2FVDU,
  312. $ NPFVPR,NPFVDU,NPFCPR,NPFCDU,NPDTJ,
  313. $ NLFVPR,NLFVDU,NLFCPR,NLFCDU,NLDTJ,NLMLIN,
  314. $ KDFRPR,KDFRDU,
  315. $ PGCOUR.XPOPG,
  316. $ FVPR.VELCHE,FVDU.VELCHE,FCPR.VELCHE,FCDU.VELCHE,
  317. $ JDTJAC.VELCHE,LERF,JMTLIN.VELCHE,
  318. $ IMPR,IRET)
  319. IF (IRET.NE.0) GOTO 9999
  320. * SEGDES JMTLIN
  321. SEGDES JMTLIN
  322. * IMPR=6
  323. IF (IMPR.GT.3) THEN
  324. WRITE(IOIMP,*) 'On a créé',
  325. $ ' JMTLIN(élément ,1 ,1 ,1 ,',
  326. $ ' ddl.pri , ddl.dua)'
  327. CALL PRCHVA(JMTLIN,IMPR,IRET)
  328. IF (IRET.NE.0) GOTO 9999
  329. ENDIF
  330. * IMPR=0
  331. SEGDES JDTJAC
  332. SEGDES FCDU
  333. SEGDES FCPR
  334. SEGDES FVDU
  335. SEGDES FVPR
  336. SEGDES PGCOUR
  337. *
  338. * Normal termination
  339. *
  340. IRET=0
  341. RETURN
  342. *
  343. * Format handling
  344. *
  345. *
  346. * Error handling
  347. *
  348. 9999 CONTINUE
  349. IRET=1
  350. WRITE(IOIMP,*) 'An error was detected in subroutine linlin'
  351. RETURN
  352. *
  353. * End of subroutine LINLIN
  354. *
  355. END
  356.  
  357.  
  358.  

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