Télécharger nlin.eso

Retour à la liste

Numérotation des lignes :

  1. C NLIN SOURCE BP208322 16/11/18 21:19:33 9177
  2. SUBROUTINE NLIN(CGEOME,TABGEO,TABVDC,TATRAV,
  3. $ METING,LAXI,LERF,LERJ,IMREG,
  4. $ MYFALS,MYPGS,MYFPGS,
  5. $ TABMAT,
  6. $ IMPR,IRET)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM : NLIN
  11. C DESCRIPTION : Création d'une matrice.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES :
  18. C APPELE PAR : PRLIN2
  19. C***********************************************************************
  20. C ENTREES :
  21. C ENTREES/SORTIES : -
  22. C SORTIES :
  23. C TRAVAIL : * SOUGEO (type MELEME) : maillage élémentaire.
  24. C * MLLRFS (type MLLRFS) : pointeurs sur les
  25. C éléments de référence associés aux 4 espaces de
  26. C discrétisation (géométrie, coefficient, primal,
  27. C dual) sur le maillage élémentaire.
  28. C * PGCOUR (type POGAU) : méthode d'intégration
  29. C courante.
  30. C * JCOOR (type MCHEVA) : valeurs du champ ICOOR
  31. C sur le maillage élémentaire.
  32. C Structure (cf.include SMCHAEL) :
  33. C (1, nb. ddl, 1, dim. esp. réel,
  34. C 1, nb. éléments)
  35. C * JCOEFF (type MCHEVA) : valeurs du champ ICOEFF
  36. C sur le maillage élémentaire.
  37. C Structure (cf.include SMCHAEL) :
  38. C (1, nb. ddl, nb. comp. duales,
  39. C nb. comp. primales, 1, nb. éléments)
  40. C * JMTLIN (type MCHEVA) : valeurs du champ IMTLIN
  41. C sur le maillage élémentaire.
  42. C Structure (cf.include SMCHAEL) :
  43. C (nb. ddl dual, nb. ddl primal,
  44. C nb. comp. duales, nb. comp. primales,
  45. C 1, nb. éléments)
  46. C nb. ddl primal=1 si la matrice est condensée.
  47. C * JMAJAC (type MCHEVA) : valeurs de la matrice
  48. C jacobienne aux points de Gauss sur le maillage
  49. C élémentaire.
  50. C Structure (cf.include SMCHAEL) :
  51. C (1, 1, dim. esp. réel, dim. esp. référence,
  52. C nb. poi. gauss, nb. éléments)
  53. C * JMIJAC (type MCHEVA) : valeurs de l'inverse de
  54. C la matrice jacobienne aux points de Gauss sur
  55. C le maillage élémentaire.
  56. C Structure (cf.include SMCHAEL) :
  57. C (1, 1, dim. esp. référence, dim. esp. réel,
  58. C nb. poi. gauss, nb. éléments)
  59. C JMIJAC n'existe que si dim.esp.réf=dim.esp.réel
  60. C * JDTJAC (type MCHEVA) : valeurs du déterminant
  61. C de la matrice jacobienne aux points de Gauss
  62. C sur le maillage élémentaire.
  63. C Structure (cf.include SMCHAEL) :
  64. C (1, 1, 1, 1, nb. poi. gauss, nb. éléments)
  65. C Si la matrice jacobienne n'est pas carrée, on
  66. C a calculé sqrt(det(trans(J).J))
  67. C * JCOEFG (type MCHEVA) : valeurs du coefficient
  68. C tensoriel aux points de Gauss sur le maillage
  69. C élémentaire.
  70. C Structure (cf.include SMCHAEL) :
  71. C (1, 1, nb. comp. duales, nb. comp. primales,
  72. C nb. poi. gauss, nb. éléments)
  73. C * FFPG (type MCHEVA) : valeurs des fonctions
  74. C d'interpolation aux points de gauss sur
  75. C l'élément de référence.
  76. C Structure (cf.include SMCHAEL) :
  77. C (1, nb. ddl, 1, 1, nb. poi. gauss, 1)
  78. C * DFFPG (type MCHEVA) : valeurs des dérivées
  79. C premières des fonctions d'interpolation aux
  80. C points de gauss sur l'élément de référence.
  81. C Structure (cf.include SMCHAEL) :
  82. C (1, nb. ddl, 1, dim.esp.réf, nb. poi. gauss, 1)
  83. C * JDFFPG (type MCHEVA) : valeurs des dérivées
  84. C premières des fonctions d'interpolation
  85. C primales aux points de gauss sur l'élément
  86. C réel.
  87. C Structure (cf.include SMCHAEL) :
  88. C (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss,
  89. C nb. élém.)
  90. C * JDFFDG (type MCHEVA) : valeurs des dérivées
  91. C premières des fonctions d'interpolation
  92. C duales aux points de gauss sur l'élément réel.
  93. C Structure (cf.include SMCHAEL) :
  94. C (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss,
  95. C nb. élém.)
  96. C***********************************************************************
  97. C VERSION : v3.1, 30/07/04, possiblité de travailler
  98. C dans l'espace de référence
  99. C VERSION : v1, 10/05/2004, version initiale
  100. C HISTORIQUE : v1, 10/05/2004, création
  101. C HISTORIQUE :
  102. C HISTORIQUE :
  103. C HISTORIQUE :
  104. C***********************************************************************
  105. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  106. C en cas de modification de ce sous-programme afin de faciliter
  107. C la maintenance !
  108. C***********************************************************************
  109. -INC CCOPTIO
  110. -INC CCGEOME
  111. CBEGININCLUDE SELREF
  112. SEGMENT ELREF
  113. CHARACTER*(LNNOM) NOMLRF
  114. CHARACTER*(LNFORM) FORME
  115. CHARACTER*(LNTYPL) TYPEL
  116. CHARACTER*(LNESP) ESPACE
  117. INTEGER DEGRE
  118. REAL*8 XCONOD(NDIMEL,NBNOD)
  119. INTEGER NPQUAF(NBDDL)
  120. INTEGER NUMCMP(NBDDL)
  121. INTEGER QUENOD(NBDDL)
  122. INTEGER ORDDER(NDIMEL,NBDDL)
  123. POINTEUR MBPOLY.POLYNS
  124. ENDSEGMENT
  125. SEGMENT ELREFS
  126. POINTEUR LISEL(0).ELREF
  127. ENDSEGMENT
  128. CENDINCLUDE SELREF
  129. POINTEUR ELCOUR.ELREF
  130. CBEGININCLUDE SFALRF
  131. SEGMENT FALRF
  132. CHARACTER*(LNNFA) NOMFA
  133. INTEGER NUQUAF(NBLRF)
  134. POINTEUR ELEMF(NBLRF).ELREF
  135. ENDSEGMENT
  136. SEGMENT FALRFS
  137. POINTEUR LISFA(0).FALRF
  138. ENDSEGMENT
  139. CENDINCLUDE SFALRF
  140. POINTEUR MYFALS.FALRFS
  141. CBEGININCLUDE SPOGAU
  142. SEGMENT POGAU
  143. CHARACTER*(LNNPG) NOMPG
  144. CHARACTER*(LNTPG) TYPMPG
  145. CHARACTER*(LNFPG) FORLPG
  146. INTEGER NORDPG
  147. REAL*8 XCOPG(NDLPG,NBPG)
  148. REAL*8 XPOPG(NBPG)
  149. ENDSEGMENT
  150. SEGMENT POGAUS
  151. POINTEUR LISPG(0).POGAU
  152. ENDSEGMENT
  153. CENDINCLUDE SPOGAU
  154. POINTEUR MYPGS.POGAUS
  155. POINTEUR PGCOUR.POGAU
  156. CBEGININCLUDE SFAPG
  157. SEGMENT FAPG
  158. CHARACTER*(LNNFAP) NOMFAP
  159. INTEGER NBQUAF(NBMPG)
  160. POINTEUR MPOGAU(NBMPG).POGAU
  161. ENDSEGMENT
  162. SEGMENT FAPGS
  163. POINTEUR LISFPG(0).FAPG
  164. ENDSEGMENT
  165. CENDINCLUDE SFAPG
  166. POINTEUR MYFPGS.FAPGS
  167. CBEGININCLUDE SLCOMP
  168. SEGMENT COMP
  169. CHARACTER*8 NOMCOM
  170. INTEGER DERCOF(NCOCOF)
  171. LOGICAL LTREF
  172. ENDSEGMENT
  173. SEGMENT COMPS
  174. POINTEUR LISCOM(NBCOMP).COMP
  175. ENDSEGMENT
  176. CENDINCLUDE SLCOMP
  177. POINTEUR MYCOMP.COMP
  178. POINTEUR IVCOMP.COMP
  179. POINTEUR IVCOMD.COMP
  180. -INC SMLENTI
  181. POINTEUR IPOWCO.MLENTI
  182. -INC SMELEME
  183. POINTEUR CGEOME.MELEME
  184. POINTEUR SOUGEO.MELEME
  185. *
  186. CBEGININCLUDE SMCHAEL
  187. SEGMENT MCHAEL
  188. POINTEUR IMACHE(N1).MELEME
  189. POINTEUR ICHEVA(N1).MCHEVA
  190. ENDSEGMENT
  191. SEGMENT MCHEVA
  192. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  193. ENDSEGMENT
  194. SEGMENT LCHEVA
  195. POINTEUR LISCHE(NBCHE).MCHEVA
  196. ENDSEGMENT
  197. CENDINCLUDE SMCHAEL
  198. INTEGER N1
  199. POINTEUR ICOOR.MCHAEL
  200. POINTEUR MYMCHA.MCHAEL
  201. POINTEUR JCOOR.MCHEVA,JCOEFF.MCHEVA,JCOEFG.MCHEVA
  202. POINTEUR JDCOFG.MCHEVA
  203. POINTEUR JMAJAC.MCHEVA,JMIJAC.MCHEVA,JDTJAC.MCHEVA
  204. POINTEUR JDTJA2.MCHEVA
  205. POINTEUR JMAREG.MCHEVA
  206. POINTEUR JDIAMA.MCHEVA
  207. POINTEUR JPC.MCHEVA
  208. POINTEUR IPROCO.MCHEVA
  209. POINTEUR FC.MCHEVA
  210. POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA,JDFFPG.MCHEVA
  211. POINTEUR FVPR.MCHEVA,FVDU.MCHEVA
  212. POINTEUR FCPR.MCHEVA,FCDU.MCHEVA
  213. POINTEUR JMTLIN.MCHEVA
  214. CBEGININCLUDE SMPOUET
  215. SEGMENT TABGEO
  216. CHARACTER*4 DISGEO
  217. POINTEUR IGEO.MCHAEL
  218. ENDSEGMENT
  219. SEGMENT TABVDC
  220. INTEGER VVARPR(NUMVPR)
  221. INTEGER VVARDU(NUMVDU)
  222. INTEGER VDATPR(NUMDPR)
  223. INTEGER VDATDU(NUMDDU)
  224. INTEGER VCOFPR(NUMCPR)
  225. INTEGER VCOFDU(NUMCDU)
  226. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  227. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  228. POINTEUR VLCOF(JLCOF).MLENTI
  229. POINTEUR VCOMP(JGCOF).COMP
  230. POINTEUR VLDAT(JGCOF).MLENTI
  231. INTEGER DJSVD(JGVD)
  232. POINTEUR NOMVD(JGVD).MLMOTS
  233. POINTEUR MVD(JGVD).MCHPOI
  234. REAL*8 XVD(JGVD)
  235. CHARACTER*4 DISVD(KGVD)
  236. ENDSEGMENT
  237. SEGMENT TATRAV
  238. POINTEUR VVCOF(JLCOF).MCHEVA
  239. POINTEUR VCOF(JGCOF).MCHEVA
  240. POINTEUR IVD(JGVD).MCHAEL
  241. POINTEUR VD(JGVD).MCHEVA
  242. POINTEUR DVD(JGVD).MCHEVA
  243. POINTEUR FFVD(KGVD).MCHEVA
  244. POINTEUR DFFVD(KGVD).MCHEVA
  245. LOGICAL LVCOF(JGCOF)
  246. LOGICAL LVD(JGVD)
  247. LOGICAL LDVD(JGVD)
  248. LOGICAL LFFVD(KGVD)
  249. LOGICAL LDFFVD(KGVD)
  250. ENDSEGMENT
  251. SEGMENT TABMAT
  252. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  253. ENDSEGMENT
  254. CENDINCLUDE SMPOUET
  255. INTEGER NUMVPR,NUMVDU,NUMDER,NUMOP
  256. INTEGER JGVC,KGVC
  257. CBEGININCLUDE TMPREC
  258. SEGMENT MPREC
  259. POINTEUR DAT(NDAT).MCHEVA
  260. POINTEUR PREC(NPREC).MCHEVA
  261. ENDSEGMENT
  262. CENDINCLUDE TMPREC
  263. POINTEUR METRIQ.MPREC
  264. *
  265. CHARACTER*4 METING
  266. INTEGER LAXI
  267. INTEGER LERF
  268. LOGICAL LERJ
  269. INTEGER IMPR,IRET
  270. *
  271. CHARACTER*4 MYDISC
  272. *
  273. INTEGER ISOUS
  274. INTEGER IVARPR,IVARDU,KDERPR,KDERDU,IOP
  275. INTEGER ITQUAF,NBRSOU,NBELEM
  276. LOGICAL LF,LDF,LC,LDC
  277. LOGICAL MVVPR,MVVDU,LVID
  278. *
  279. * Executable statements
  280. *
  281. * IMPR=5
  282. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans nlin'
  283. * Activation et intialisation des chapeaux
  284. SEGACT CGEOME
  285. SEGACT TABGEO
  286. SEGACT TABVDC
  287. SEGACT TATRAV*MOD
  288. NBRSOU=CGEOME.LISOUS(/1)
  289. NUMVPR=TABVDC.VVARPR(/1)
  290. NUMVDU=TABVDC.VVARDU(/1)
  291. JLCOF=TABVDC.VLCOF(/1)
  292. JGCOF=TABVDC.VCOMP(/1)
  293. JGVD=TABVDC.DJSVD(/1)
  294. KGVD=TABVDC.DISVD(/2)
  295. NUMDER=TABVDC.ILCPR(/1)-1
  296. NUMOP=TABVDC.ILCPR(/2)
  297. *
  298. N1=NBRSOU
  299. * NUMVPR et NUMVDU initialisés ci-dessus
  300. SEGINI TABMAT
  301. * Cette instruction n'a pas l'air de fonctionner
  302. * SEGINI TABMAT.VMAT(*)
  303. DO IVARPR=1,NUMVPR
  304. DO IVARDU=1,NUMVDU
  305. SEGINI,MYMCHA
  306. TABMAT.VMAT(IVARDU,IVARPR)=MYMCHA
  307. ENDDO
  308. ENDDO
  309. SEGACT MYPGS
  310. ICOOR=TABGEO.IGEO
  311. SEGACT ICOOR
  312. * SEGACT TABVDC.NOMVC(*)
  313. DO IJVD=1,JGVD
  314. MYMCHA=TATRAV.IVD(IJVD)
  315. IF (MYMCHA.NE.0) THEN
  316. SEGACT MYMCHA
  317. ENDIF
  318. ENDDO
  319. *
  320. * On travaille sur chaque sous-domaine
  321. *
  322. DO 1 ISOUS=1,NBRSOU
  323. SOUGEO=CGEOME.LISOUS(ISOUS)
  324. SEGACT SOUGEO
  325. ITQUAF=SOUGEO.ITYPEL
  326. * Détermination de la dimension de l'espace de référence
  327. CALL DIMELE(NOMS(ITQUAF),IESREF,IMPR,IRET)
  328. IF (IRET.NE.0) GOTO 9999
  329. NBELEM=SOUGEO.NUM(/2)
  330. IF (IMPR.GT.2) THEN
  331. WRITE(IOIMP,*) 'Sous-domaine :',ISOUS
  332. ENDIF
  333. SEGDES SOUGEO
  334. *
  335. * Quel est la méthode d'intégration que l'on va utiliser si on n'en a
  336. * pas précisé ?
  337. * FIPGS est là pour nous le dire.
  338. *
  339. IF (METING.EQ.' ') THEN
  340. WRITE(IOIMP,*) 'Le choix automatique de la méthode '
  341. $ ,'d''integration est désactivé'
  342. GOTO 9999
  343. * CALL FIPGS(MLLRFS,MYPGS,
  344. * $ PGCOUR,
  345. * $ IMPR,IRET)
  346. * IF (IRET.GT.0) GOTO 9999
  347. ELSE
  348. CALL KEPG(ITQUAF,METING,
  349. $ MYFPGS,
  350. $ PGCOUR,
  351. $ IMPR,IRET)
  352. IF (IRET.NE.0) GOTO 9999
  353. ENDIF
  354. *
  355. * Géométrie
  356. *
  357. MYDISC=TABGEO.DISGEO
  358. CALL KEEF(ITQUAF,MYDISC,
  359. $ MYFALS,
  360. $ ELCOUR,
  361. $ IMPR,IRET)
  362. IF (IRET.NE.0) GOTO 9999
  363. * In KFNREF : SEGINI FFPG
  364. * In KFNREF : SEGINI DFFPG
  365. CALL KFNREF(ELCOUR,PGCOUR,
  366. $ FFPG,DFFPG,
  367. $ IMPR,IRET)
  368. IF (IRET.NE.0) GOTO 9999
  369. *
  370. * Création des matrices jacobiennes et déterminants
  371. * pour la transformation : élément volumique de référence <->
  372. * élément volumique réel
  373. * Ici, on ne se servira que de l'inverse et du déterminant
  374. * de la matrice jacobienne.
  375. * In GEOLIN : SEGINI JMAJAC
  376. * In GEOLIN : SEGINI JMIJAC
  377. * In GEOLIN : SEGINI JDTJAC
  378. JCOOR=ICOOR.ICHEVA(ISOUS)
  379. CALL GEOLIK(DFFPG,JCOOR,NBELEM,
  380. $ JMAJAC,JMIJAC,JDTJAC,LERJ,IMREG,
  381. $ IMPR,IRET)
  382. IF (IRET.NE.0) THEN
  383. IF (LERJ) GOTO 9666
  384. GOTO 9999
  385. ENDIF
  386. *! SEG SUP JMAJAC
  387. SEGSUP DFFPG
  388. C Inutile normalement, on peut se débrouiller avec les coeffs
  389. C* En axi, on multiplie le determinant de la matrice
  390. C* jacobienne par 2piR (ou R est la premiere coordonnee)
  391. C IF (LAXI.GT.0) THEN
  392. C* In GEOMET : SEGINI JDTJA2
  393. C CALL GEOMET(JCOOR,FFPG,
  394. C $ JDTJAC,LAXI,
  395. C $ JDTJA2,
  396. C $ IMPR,IRET)
  397. C IF (IRET.NE.0) GOTO 9999
  398. C SEGSUP JDTJAC
  399. C JDTJAC=JDTJA2
  400. C ENDIF
  401. *
  402. * On récupère la première coordonnée si LAXI(=IFOMOD).NE.-1
  403. *
  404. IF (IFOMOD.NE.-1) THEN
  405. C* In GEOPC : SEGINI JPC
  406. CALL GEOPC(JCOOR,FFPG,
  407. $ JPC,
  408. $ IMPR,IRET)
  409. IF (IRET.NE.0) GOTO 9999
  410. ELSE
  411. JPC=0
  412. ENDIF
  413. SEGSUP FFPG
  414. *
  415. * Calcul du jacobien de la transformation :
  416. * élément volumique de référence -> élément réguliers
  417. * de côté 1
  418. * Cela sert pour l'adaptativité.
  419. * In GEOREG : SEGINI JMAREG
  420. *
  421. CALL GEOREG(ITQUAF,MYFALS,MYFPGS,
  422. $ JMAREG,
  423. $ IMPR,IRET)
  424. IF (IRET.NE.0) GOTO 9999
  425. *
  426. * Calcul d'une propriété géométrique d'un QUAF régulier de côté 1 :
  427. * ici le diamètre du cercle circonscrit.
  428. * Cela sert pour le decentrement.
  429. * In GEOQUA : SEGINI JDIAMA
  430. *
  431. CALL GEOQUA(ITQUAF,
  432. $ JDIAMA,
  433. $ IMPR,IRET)
  434. IF (IRET.NE.0) GOTO 9999
  435. C
  436. C Initialisation d'une table de préconditionnement pour l'adaptation
  437. C contenant des infos sur la métrique (fait dans les subroutines qui
  438. C utilisent METRIQ
  439. C
  440. C SEGINI METRIQ
  441. METRIQ=0
  442. *
  443. * Calcul des fonctions de forme et de leurs dérivées
  444. *
  445. DO IKVD=1,KGVD
  446. LF=TATRAV.LFFVD(IKVD).EQV..TRUE.
  447. LDF=TATRAV.LDFFVD(IKVD).EQV..TRUE.
  448. IF (LF.OR.LDF) THEN
  449. MYDISC=TABVDC.DISVD(IKVD)
  450. CALL KEEF(ITQUAF,MYDISC,
  451. $ MYFALS,
  452. $ ELCOUR,
  453. $ IMPR,IRET)
  454. IF (IRET.NE.0) GOTO 9999
  455. * In KFNREF : SEGINI FFPG
  456. * In KFNREF : SEGINI DFFPG
  457. CALL KFNREF(ELCOUR,PGCOUR,
  458. $ FFPG,DFFPG,
  459. $ IMPR,IRET)
  460. IF (IRET.NE.0) GOTO 9999
  461. IF (LF) THEN
  462. TATRAV.FFVD(IKVD)=FFPG
  463. ELSE
  464. * segini ffpg
  465. SEGSUP FFPG
  466. ENDIF
  467. IF (LDF) THEN
  468. IF (LERF.NE.0) THEN
  469. SEGINI,JDFFPG=DFFPG
  470. SEGDES JDFFPG
  471. ELSE
  472. * In DFNFR : SEGINI JDFFPG
  473. CALL DFNFR(DFFPG,JMIJAC,
  474. $ JDFFPG,
  475. $ IMPR,IRET)
  476. IF (IRET.NE.0) GOTO 9999
  477. ENDIF
  478. TATRAV.DFFVD(IKVD)=JDFFPG
  479. ENDIF
  480. SEGSUP DFFPG
  481. ENDIF
  482. ENDDO
  483. *
  484. * Calcul des champs et de leurs dérivées
  485. *
  486. DO IJVD=1,JGVD
  487. LC=TATRAV.LVD(IJVD).EQV..TRUE.
  488. LDC=TATRAV.LDVD(IJVD).EQV..TRUE.
  489. IF (LC.OR.LDC) THEN
  490. MYMCHA=TATRAV.IVD(IJVD)
  491. JCOEFF=MYMCHA.ICHEVA(ISOUS)
  492. IF (LC) THEN
  493. FFPG=TATRAV.FFVD(TABVDC.DJSVD(IJVD))
  494. * In COGAU : SEGINI JCOEFG
  495. CALL COGAU(JCOEFF,FFPG,
  496. $ JCOEFG,
  497. $ IMPR,IRET)
  498. IF (IRET.NE.0) GOTO 9999
  499. TATRAV.VD(IJVD)=JCOEFG
  500. ENDIF
  501. IF (LDC) THEN
  502. JDFFPG=TATRAV.DFFVD(TABVDC.DJSVD(IJVD))
  503. * In DCOGAU : SEGINI JDCOFG
  504. CALL DCOGAU(JCOEFF,JDFFPG,
  505. $ JDCOFG,
  506. $ IMPR,IRET)
  507. IF (IRET.NE.0) GOTO 9999
  508. TATRAV.DVD(IJVD)=JDCOFG
  509. ENDIF
  510. ENDIF
  511. ENDDO
  512. *!!! SEG DES JMIJAC
  513. *
  514. * Calcul des coefficients
  515. *
  516. DO IJGCOF=1,JGCOF
  517. LC=TATRAV.LVCOF(IJGCOF).EQV..TRUE.
  518. IF (LC) THEN
  519. IVCOMP=TABVDC.VCOMP(IJGCOF)
  520. IICOMP=TABVDC.VLDAT(IJGCOF)
  521. * In CALCGA : SEGINI FC
  522. * In CALCGA : SEGINI METRIQ.MCHEVA
  523. CALL CALCGA(IVCOMP,IICOMP,JMAJAC,JMIJAC,JDTJAC,
  524. $ JMAREG,JDIAMA,JPC,METRIQ,
  525. $ TATRAV,
  526. $ FC,IMPR,IRET)
  527. IF (IRET.NE.0) GOTO 9999
  528. TATRAV.VCOF(IJGCOF)=FC
  529. ENDIF
  530. ENDDO
  531. *
  532. * Calcul des produits de coefficients
  533. *
  534. DO IJLCOF=1,JLCOF
  535. IPOWCO=TABVDC.VLCOF(IJLCOF)
  536. * In CALPCO : SEGINI IPROCO
  537. CALL CALPCO(IPOWCO,TATRAV,
  538. $ IPROCO,IMPR,IRET)
  539. IF (IRET.NE.0) GOTO 9999
  540. TATRAV.VVCOF(IJLCOF)=IPROCO
  541. ENDDO
  542. *
  543. * On peut faire le ménage dans les coefficients
  544. *
  545. DO IJGCOF=1,JGCOF
  546. FC=TATRAV.VCOF(IJGCOF)
  547. IF (FC.NE.0) THEN
  548. SEGSUP,FC
  549. TATRAV.VCOF(IJGCOF)=0
  550. ENDIF
  551. ENDDO
  552. *
  553. * On effectue le calcul de la matrice
  554. *
  555. DO IVARPR=1,NUMVPR
  556. DO IVARDU=1,NUMVDU
  557. C WRITE(IOIMP,*) 'IVARPR= ',IVARPR,' IVARDU= ',IVARDU
  558. * Repris de nlia JMTLIN=0
  559. MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  560. JMTLIN=MYMCHA.ICHEVA(ISOUS)
  561. *
  562. IJVARP=TABVDC.VVARPR(IVARPR)
  563. IJVARD=TABVDC.VVARDU(IVARDU)
  564. IKVARP=TABVDC.DJSVD(IJVARP)
  565. IKVARD=TABVDC.DJSVD(IJVARD)
  566. MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  567. MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  568. DO IOP=1,NUMOP
  569. DO KDERPR=0,NUMDER
  570. IJLCPR=TABVDC.ILCPR(KDERPR+1,IOP,IVARPR)
  571. IF (IJLCPR.NE.0) THEN
  572. FCPR=TATRAV.VVCOF(IJLCPR)
  573. * variable primale
  574. IF (KDERPR.EQ.0) THEN
  575. IF (MVVPR) THEN
  576. FVPR=TATRAV.VD(IJVARP)
  577. ELSE
  578. FVPR=TATRAV.FFVD(IKVARP)
  579. ENDIF
  580. ELSE
  581. IF (MVVPR) THEN
  582. FVPR=TATRAV.DVD(IJVARP)
  583. ELSE
  584. FVPR=TATRAV.DFFVD(IKVARP)
  585. ENDIF
  586. ENDIF
  587. DO KDERDU=0,NUMDER
  588. IJLCDU=TABVDC.ILCDU(KDERDU+1,IOP,IVARDU)
  589. IF (IJLCDU.NE.0) THEN
  590. FCDU=TATRAV.VVCOF(IJLCDU)
  591. * Variable duale
  592. IF (KDERDU.EQ.0) THEN
  593. IF (MVVDU) THEN
  594. FVDU=TATRAV.VD(IJVARD)
  595. ELSE
  596. FVDU=TATRAV.FFVD(IKVARD)
  597. ENDIF
  598. ELSE
  599. IF (MVVDU) THEN
  600. FVDU=TATRAV.DVD(IJVARD)
  601. ELSE
  602. FVDU=TATRAV.DFFVD(IKVARD)
  603. ENDIF
  604. ENDIF
  605. C WRITE(IOIMP,*) 'FVPR=',FVPR
  606. C WRITE(IOIMP,*) 'FVDU=',FVDU
  607. C WRITE(IOIMP,*) 'FCPR=',FCPR
  608. C WRITE(IOIMP,*) 'FCDU=',FCDU
  609. C WRITE(IOIMP,*) 'KDERPR=',KDERPR
  610. C WRITE(IOIMP,*) 'KDERDU=',KDERDU
  611. C WRITE(IOIMP,*) 'LDERPR=',LDERPR
  612. C WRITE(IOIMP,*) 'LDERDU=',LDERDU
  613. C SEGPRT,PGCOUR
  614. C SEGPRT,FVPR
  615. C SEGPRT,FVDU
  616. C SEGPRT,FCPR
  617. C SEGPRT,FCDU
  618. C WRITE(IOIMP,*) 'KDERPR=',KDERPR
  619. C WRITE(IOIMP,*) 'KDERDU=',KDERDU
  620. C WRITE(IOIMP,*) 'LDERPR=',LDERPR
  621. C WRITE(IOIMP,*) 'LDERDU=',LDERDU
  622. C SEGPRT,JDTJAC
  623. C WRITE(IOIMP,*) 'NBELEM=',NBELEM
  624. CALL LINLIN(PGCOUR,
  625. $ FVPR,FVDU,FCPR,FCDU,
  626. $ KDERPR,KDERDU,
  627. $ JDTJAC,NBELEM,LERF,IESREF,
  628. $ JMTLIN,
  629. $ IMPR,IRET)
  630. IF (IRET.NE.0) GOTO 9999
  631. C WRITE(IOIMP,*) 'JMTLIN=',JMTLIN
  632. C SEGPRT,JMTLIN
  633. C* STOP 16
  634. ENDIF
  635. ENDDO
  636. ENDIF
  637. ENDDO
  638. ENDDO
  639. MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  640. MYMCHA.IMACHE(ISOUS)=SOUGEO
  641. MYMCHA.ICHEVA(ISOUS)=JMTLIN
  642. * IF (JMTLIN.NE.0) THEN
  643. * SEGPRT,JMTLIN
  644. * ENDIF
  645. C WRITE(IOIMP,*) 'IVARPR=',IVARPR
  646. C WRITE(IOIMP,*) 'IVARDU=',IVARDU
  647. C WRITE(IOIMP,*) 'JMTLIN=',JMTLIN
  648. ENDDO
  649. ENDDO
  650. * Suppression de tous les MCHEVA
  651. DO IJLCOF=1,JLCOF
  652. IPROCO=TATRAV.VVCOF(IJLCOF)
  653. SEGSUP IPROCO
  654. TATRAV.VVCOF(IJLCOF)=IPROCO
  655. ENDDO
  656. *
  657. DO IJVD=1,JGVD
  658. JCOEFG=TATRAV.VD(IJVD)
  659. IF (JCOEFG.NE.0) THEN
  660. SEGSUP JCOEFG
  661. TATRAV.VD(IJVD)=JCOEFG
  662. ENDIF
  663. JDCOFG=TATRAV.DVD(IJVD)
  664. IF (JDCOFG.NE.0) THEN
  665. SEGSUP JDCOFG
  666. TATRAV.DVD(IJVD)=JDCOFG
  667. ENDIF
  668. ENDDO
  669. *
  670. DO IKVD=1,KGVD
  671. FFPG=TATRAV.FFVD(IKVD)
  672. IF (FFPG.NE.0) THEN
  673. SEGSUP FFPG
  674. TATRAV.FFVD(IKVD)=FFPG
  675. ENDIF
  676. JDFFPG=TATRAV.DFFVD(IKVD)
  677. IF (JDFFPG.NE.0) THEN
  678. SEGSUP JDFFPG
  679. TATRAV.DFFVD(IKVD)=JDFFPG
  680. ENDIF
  681. ENDDO
  682. *
  683. * Suppression table de préconditionnement métrique
  684. *
  685. IF (METRIQ.NE.0) THEN
  686. SEGACT,METRIQ
  687. NCH=METRIQ.PREC(/1)
  688. DO ICH=1,NCH
  689. MCHEVA=METRIQ.PREC(ICH)
  690. IF (MCHEVA.NE.0) THEN
  691. SEGSUP MCHEVA
  692. ENDIF
  693. ENDDO
  694. C SEGDES METRIQ
  695. SEGSUP METRIQ
  696. ENDIF
  697. SEGSUP JMAREG
  698. SEGSUP JDIAMA
  699. IF (JPC.NE.0) THEN
  700. SEGSUP JPC
  701. ENDIF
  702. SEGSUP JDTJAC
  703. SEGSUP JMAJAC
  704. SEGSUP JMIJAC
  705. * SEGPRT,JMTLIN
  706. 1 CONTINUE
  707. *
  708. DO IJVD=1,JGVD
  709. MYMCHA=TATRAV.IVD(IJVD)
  710. IF (MYMCHA.NE.0) THEN
  711. SEGDES MYMCHA
  712. ENDIF
  713. ENDDO
  714. * SEGDES TABVDC.NOMVC(*)
  715. SEGDES ICOOR
  716. SEGDES MYPGS
  717. *
  718. * Cette instruction n'a pas l'air de fonctionner
  719. * Un peu de ménage là où il n'y a pas d'info
  720. * SEGDES TABMAT.VMAT(*)
  721. DO IVARPR=1,NUMVPR
  722. DO IVARDU=1,NUMVDU
  723. MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  724. SEGACT MYMCHA
  725. LVID=.TRUE.
  726. DO ISOUS=1,NBRSOU
  727. MCHEVA=MYMCHA.ICHEVA(ISOUS)
  728. LVID=LVID.AND.(MCHEVA.EQ.0)
  729. ENDDO
  730. IF (LVID) THEN
  731. SEGSUP MYMCHA
  732. TABMAT.VMAT(IVARDU,IVARPR)=0
  733. ELSE
  734. SEGDES,MYMCHA
  735. ENDIF
  736. ENDDO
  737. ENDDO
  738. SEGDES TATRAV
  739. SEGDES TABMAT
  740. SEGDES TABVDC
  741. SEGDES TABGEO
  742. SEGDES CGEOME
  743. *
  744. * Normal termination
  745. *
  746. IRET=0
  747. RETURN
  748. *
  749. * Format handling
  750. *
  751. *
  752. * Error handling
  753. *
  754. 9666 CONTINUE
  755. IRET=666
  756. RETURN
  757. 9999 CONTINUE
  758. IRET=1
  759. WRITE(IOIMP,*) 'An error was detected in subroutine nlin'
  760. RETURN
  761. *
  762. * End of subroutine nlin
  763. *
  764. END
  765.  
  766.  
  767.  
  768.  
  769.  
  770.  
  771.  
  772.  
  773.  
  774.  
  775.  

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