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

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