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

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