Télécharger prlin3.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLIN3 SOURCE GOUNAND 06/01/18 21:15:45 5293
  2. SUBROUTINE PRLIN3(CGEOME,LGDISC,TABCPR,TABCDU,LERF,
  3. $ MYFALS,MYCOMS,
  4. $ TABGEO,TABVDC,TATRAV,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : PRLIN3
  10. C DESCRIPTION : Initialisations, tests et formatage des données et des
  11. C résultats pour nlin
  12. C base sur prls93
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES :
  19. C APPELE PAR : PRLIN2
  20. C***********************************************************************
  21. C ENTREES :
  22. C SORTIES :
  23. C TRAVAIL :
  24. C
  25. C***********************************************************************
  26. C VERSION : v1, 10/05/2004, version initiale
  27. C HISTORIQUE : v1, 10/05/2004, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. -INC CCOPTIO
  36. -INC SMELEME
  37. POINTEUR CGEOME.MELEME
  38. -INC SMTABLE
  39. POINTEUR TABCPR.MTABLE
  40. POINTEUR TABCDU.MTABLE
  41. POINTEUR TABLC.MTABLE
  42. POINTEUR TAVAPR.MTABLE
  43. POINTEUR TAVADU.MTABLE
  44. POINTEUR TADAPR.MTABLE
  45. POINTEUR TADADU.MTABLE
  46. POINTEUR TAVDPD.MTABLE
  47. POINTEUR TACOPR.MTABLE
  48. POINTEUR TACODU.MTABLE
  49. POINTEUR TABCOF.MTABLE
  50. POINTEUR TABI.MTABLE
  51. POINTEUR TABJ.MTABLE
  52. POINTEUR TABK.MTABLE
  53. -INC SMLMOTS
  54. POINTEUR MYLMOT.MLMOTS
  55. -INC SMLENTI
  56. POINTEUR MYLENT.MLENTI
  57. POINTEUR LDAT.MLENTI
  58. POINTEUR LDAT3.MLENTI
  59. POINTEUR LCOF.MLENTI
  60. POINTEUR LCOF3.MLENTI
  61. POINTEUR POWCOF.MLENTI
  62. POINTEUR POWCO2.MLENTI
  63. POINTEUR KREP.MLENTI
  64. * Segments à moi
  65. CBEGININCLUDE SFALRF
  66. SEGMENT FALRF
  67. CHARACTER*(LNNFA) NOMFA
  68. INTEGER NUQUAF(NBLRF)
  69. POINTEUR ELEMF(NBLRF).ELREF
  70. ENDSEGMENT
  71. SEGMENT FALRFS
  72. POINTEUR LISFA(0).FALRF
  73. ENDSEGMENT
  74. CENDINCLUDE SFALRF
  75. POINTEUR MYFALS.FALRFS
  76. CBEGININCLUDE SLCOMP
  77. SEGMENT COMP
  78. CHARACTER*8 NOMCOM
  79. INTEGER DERCOF(NCOCOF)
  80. LOGICAL LTREF
  81. ENDSEGMENT
  82. SEGMENT COMPS
  83. POINTEUR LISCOM(NBCOMP).COMP
  84. ENDSEGMENT
  85. CENDINCLUDE SLCOMP
  86. POINTEUR MYCOMS.COMPS
  87. POINTEUR MYCOM.COMP
  88. -INC SMCHPOI
  89. POINTEUR MYCHPO.MCHPOI
  90. CBEGININCLUDE SMCHAEL
  91. SEGMENT MCHAEL
  92. POINTEUR IMACHE(N1).MELEME
  93. POINTEUR ICHEVA(N1).MCHEVA
  94. ENDSEGMENT
  95. SEGMENT MCHEVA
  96. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  97. ENDSEGMENT
  98. SEGMENT LCHEVA
  99. POINTEUR LISCHE(NBCHE).MCHEVA
  100. ENDSEGMENT
  101. CENDINCLUDE SMCHAEL
  102. POINTEUR ICOOR.MCHAEL
  103. POINTEUR MYMCHA.MCHAEL
  104. CBEGININCLUDE SMPOUET
  105. SEGMENT TABGEO
  106. CHARACTER*4 DISGEO
  107. POINTEUR IGEO.MCHAEL
  108. ENDSEGMENT
  109. SEGMENT TABVDC
  110. INTEGER VVARPR(NUMVPR)
  111. INTEGER VVARDU(NUMVDU)
  112. INTEGER VDATPR(NUMDPR)
  113. INTEGER VDATDU(NUMDDU)
  114. INTEGER VCOFPR(NUMCPR)
  115. INTEGER VCOFDU(NUMCDU)
  116. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  117. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  118. POINTEUR VLCOF(JLCOF).MLENTI
  119. POINTEUR VCOMP(JGCOF).COMP
  120. POINTEUR VLDAT(JGCOF).MLENTI
  121. INTEGER DJSVD(JGVD)
  122. POINTEUR NOMVD(JGVD).MLMOTS
  123. POINTEUR MVD(JGVD).MCHPOI
  124. REAL*8 XVD(JGVD)
  125. CHARACTER*4 DISVD(KGVD)
  126. ENDSEGMENT
  127. SEGMENT TATRAV
  128. POINTEUR VVCOF(JLCOF).MCHEVA
  129. POINTEUR VCOF(JGCOF).MCHEVA
  130. POINTEUR IVD(JGVD).MCHAEL
  131. POINTEUR VD(JGVD).MCHEVA
  132. POINTEUR DVD(JGVD).MCHEVA
  133. POINTEUR FFVD(KGVD).MCHEVA
  134. POINTEUR DFFVD(KGVD).MCHEVA
  135. LOGICAL LVCOF(JGCOF)
  136. LOGICAL LVD(JGVD)
  137. LOGICAL LDVD(JGVD)
  138. LOGICAL LFFVD(KGVD)
  139. LOGICAL LDFFVD(KGVD)
  140. ENDSEGMENT
  141. SEGMENT TABMAT
  142. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  143. ENDSEGMENT
  144. CENDINCLUDE SMPOUET
  145. INTEGER NUMOP,NUMDER,NUMVPR,NUMVDU
  146. INTEGER NUMOP2,NUMDE2
  147. INTEGER JGVC,KGVC
  148. *
  149. INTEGER IMPR,IRET
  150. *
  151. CHARACTER*4 LGDISC
  152. CHARACTER*4 MYDISC
  153. CHARACTER*8 CNCOM
  154. REAL*8 MYREAL
  155. CHARACTER*8 TYP0,TYP1,TYP2,BLAN,TYPE
  156. CHARACTER*8 TYTABL,TYLMOT,TYCHPO,TYMOT,TYENT,TYFLO,TYLENT
  157. *
  158. INTEGER IBID,IVAL,IOBJ
  159. REAL*8 XBID,XVAL
  160. CHARACTER*8 CBID,CVD,CPD
  161. LOGICAL LBID
  162. INTEGER IOP,JVARPR,JVARDU,KDER
  163. INTEGER IJVC,IKGVD
  164. INTEGER LNMOTS
  165. LOGICAL LFOUND,LEGDAT,LEGCOF
  166. INTEGER LERF
  167. *
  168. * Executable statements
  169. *
  170. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin3'
  171. BLAN=' '
  172. TYTABL='TABLE '
  173. TYLMOT='LISTMOTS'
  174. TYLENT='LISTENTI'
  175. TYCHPO='CHPOINT '
  176. TYMOT ='MOT '
  177. TYENT ='ENTIER '
  178. TYFLO ='FLOTTANT'
  179. * Récupération des dimensions
  180. CALL ACME(TABCPR,'NUMDER',NUMDER)
  181. IF (IERR.NE.0) GOTO 9999
  182. *
  183. * Si les dérivées se font sur les éléments de référence, il
  184. * faut vérifier que tous les éléments de CGEOME
  185. * sont de la meme dimension et avoir sa valeur
  186. *
  187. IF (LERF.NE.0) THEN
  188. CALL DIMESH(CGEOME,IDMESH,IMPR,IRET)
  189. IF (IRET.NE.0) GOTO 9999
  190. IESDER=IDMESH
  191. ELSE
  192. IESDER=IDIM
  193. ENDIF
  194. *
  195. IF (NUMDER.NE.IESDER) THEN
  196. WRITE(IOIMP,*) 'NUMDER=',NUMDER,' incorrect'
  197. GOTO 9999
  198. ENDIF
  199. CALL ACME(TABCPR,'NUMOP',NUMOP)
  200. IF (IERR.NE.0) GOTO 9999
  201. CALL ACME(TABCPR,'NUMVAR',NUMVPR)
  202. IF (IERR.NE.0) GOTO 9999
  203. CALL ACME(TABCPR,'NUMDAT',NUMDPR)
  204. IF (IERR.NE.0) GOTO 9999
  205. CALL ACME(TABCPR,'NUMCOF',NUMCPR)
  206. IF (IERR.NE.0) GOTO 9999
  207. *
  208. CALL ACME(TABCDU,'NUMDER',NUMDE2)
  209. IF (IERR.NE.0) GOTO 9999
  210. IF (NUMDE2.NE.IESDER) THEN
  211. WRITE(IOIMP,*) 'NUMDE2=',NUMDE2,' incorrect'
  212. GOTO 9999
  213. ENDIF
  214. CALL ACME(TABCDU,'NUMOP',NUMOP2)
  215. IF (IERR.NE.0) GOTO 9999
  216. IF (NUMOP2.NE.NUMOP) THEN
  217. WRITE(IOIMP,*) 'NUMOP2.NE.NUMOP'
  218. GOTO 9999
  219. ENDIF
  220. CALL ACME(TABCDU,'NUMVAR',NUMVDU)
  221. IF (IERR.NE.0) GOTO 9999
  222. CALL ACME(TABCDU,'NUMDAT',NUMDDU)
  223. IF (IERR.NE.0) GOTO 9999
  224. CALL ACME(TABCDU,'NUMCOF',NUMCDU)
  225. IF (IERR.NE.0) GOTO 9999
  226. *
  227. CALL ACMO(TABCPR,'VAR',TYTABL,TAVAPR)
  228. IF (IERR.NE.0) GOTO 9999
  229. CALL ACMO(TABCDU,'VAR',TYTABL,TAVADU)
  230. IF (IERR.NE.0) GOTO 9999
  231. CALL ACMO(TABCPR,'DAT',TYTABL,TADAPR)
  232. IF (IERR.NE.0) GOTO 9999
  233. CALL ACMO(TABCDU,'DAT',TYTABL,TADADU)
  234. IF (IERR.NE.0) GOTO 9999
  235. CALL ACMO(TABCPR,'COF',TYTABL,TACOPR)
  236. IF (IERR.NE.0) GOTO 9999
  237. CALL ACMO(TABCDU,'COF',TYTABL,TACODU)
  238. IF (IERR.NE.0) GOTO 9999
  239. * Initialisation du gros objet de données
  240. SEGINI,TABGEO
  241. JLCOF=(NUMDER+1)*NUMOP*(NUMVPR+NUMVDU)
  242. JGCOF=NUMCPR+NUMCDU
  243. JGVD=NUMVPR+NUMVDU+NUMDPR+NUMDDU
  244. KGVD=JGVD
  245. IJLCOF=0
  246. IJGCOF=0
  247. IJGVD=0
  248. IKGVD=0
  249. SEGINI,TABVDC
  250. * géométrie
  251. LNMOTS=LEN(LGDISC)
  252. IF (LNMOTS.NE.4) THEN
  253. WRITE(IOIMP,*) 'Erreur esp. discr. geometrie'
  254. GOTO 9999
  255. ENDIF
  256. TABGEO.DISGEO=LGDISC
  257. * Pointeur bidon négatif
  258. IPBID=0
  259. *
  260. * Lecture des variables et des données primales et duales
  261. *
  262. DO IVADA=1,2
  263. DO IPRDU=1,2
  264. IF (IVADA.EQ.1) THEN
  265. CVD='VARIABLE'
  266. IF (IPRDU.EQ.1) THEN
  267. NUMVAR=NUMVPR
  268. CPD='PRIMAL '
  269. ELSE
  270. NUMVAR=NUMVDU
  271. CPD='DUAL '
  272. ENDIF
  273. ELSE
  274. CVD='DATA '
  275. IF (IPRDU.EQ.1) THEN
  276. NUMVAR=NUMDPR
  277. CPD='PRIMAL '
  278. ELSE
  279. NUMVAR=NUMDDU
  280. CPD='DUAL '
  281. ENDIF
  282. ENDIF
  283. *
  284. DO JVAR=1,NUMVAR
  285. IJGVD=IJGVD+1
  286. IKGVD=IKGVD+1
  287. IF (IVADA.EQ.1) THEN
  288. IF (IPRDU.EQ.1) THEN
  289. TABVDC.VVARPR(JVAR)=IJGVD
  290. TAVDPD=TAVAPR
  291. ELSE
  292. TABVDC.VVARDU(JVAR)=IJGVD
  293. TAVDPD=TAVADU
  294. ENDIF
  295. ELSE
  296. IF (IPRDU.EQ.1) THEN
  297. TABVDC.VDATPR(JVAR)=IJGVD
  298. TAVDPD=TADAPR
  299. ELSE
  300. TABVDC.VDATDU(JVAR)=IJGVD
  301. TAVDPD=TADADU
  302. ENDIF
  303. ENDIF
  304. TYPE=TYTABL
  305. CALL ACCTAB(TAVDPD,'ENTIER',JVAR,XBID,CBID,LBID,IBID,
  306. $ TYPE,IBID,XBID,CBID,LBID,TABJ)
  307. IF (IERR.NE.0) GOTO 9999
  308. **
  309. TYPE=TYMOT
  310. CALL ACCTAB(TABJ,'MOT',IBID,XBID,'DISC',LBID,IBID,
  311. $ TYPE,IBID,XBID,MYDISC,LBID,IBID)
  312. IF (IERR.NE.0) GOTO 9999
  313. TABVDC.DISVD(IKGVD)=MYDISC
  314. TABVDC.DJSVD(IJGVD)=IKGVD
  315. *
  316. TYPE=TYLMOT
  317. CALL ACCTAB(TABJ,'MOT',IBID,XBID,'NOMDDL',LBID,IBID,
  318. $ TYPE,IBID,XBID,CBID,LBID,MYLMOT)
  319. IF (IERR.NE.0) GOTO 9999
  320. TABVDC.NOMVD(IJGVD)=MYLMOT
  321. *
  322. TYPE=BLAN
  323. CALL ACCTAB(TABJ,'MOT',IBID,XBID,'VALEUR',LBID,IBID,
  324. $ TYPE,IVAL,XVAL,CBID,LBID,IOBJ)
  325. * Seules les variables sont autorisées à ne pas avoir de valeur.
  326. IF ((TYPE.EQ.BLAN).AND.(IVADA.EQ.1)) THEN
  327. TABVDC.MVD(IJGVD)=0
  328. TABVDC.XVD(IJGVD)=0.D0
  329. ELSEIF (TYPE.EQ.TYCHPO) THEN
  330. TABVDC.MVD(IJGVD)=IOBJ
  331. TABVDC.XVD(IJGVD)=0.D0
  332. ELSEIF (TYPE.EQ.TYENT) THEN
  333. IPBID=IPBID-1
  334. TABVDC.MVD(IJGVD)=IPBID
  335. TABVDC.XVD(IJGVD)=DBLE(IVAL)
  336. ELSEIF (TYPE.EQ.TYFLO) THEN
  337. IPBID=IPBID-1
  338. TABVDC.MVD(IJGVD)=IPBID
  339. TABVDC.XVD(IJGVD)=XVAL
  340. ELSE
  341. WRITE(IOIMP,*) CPD,' ',CVD,' number ',JVAR
  342. WRITE(IOIMP,*) 'wrong type = ',TYPE
  343. WRITE(IOIMP,*) 'should be = ',TYENT, ' or '
  344. $ ,TYFLO, ' or ',TYCHPO
  345. GOTO 9999
  346. ENDIF
  347. ENDDO
  348. ENDDO
  349. ENDDO
  350. *
  351. JGVD=IJGVD
  352. KGVD=IKGVD
  353. SEGADJ,TABVDC
  354. *
  355. * Lecture des coefficients primaux et duaux
  356. *
  357. SEGACT MYCOMS
  358. CVD='COEFF. '
  359. DO IPRDU=1,2
  360. IF (IPRDU.EQ.1) THEN
  361. NUMCOF=NUMCPR
  362. NUMDAT=NUMDPR
  363. CPD='PRIMAL '
  364. ELSE
  365. NUMCOF=NUMCDU
  366. NUMDAT=NUMDDU
  367. CPD='DUAL '
  368. ENDIF
  369. DO JCOF=1,NUMCOF
  370. IJGCOF=IJGCOF+1
  371. IF (IPRDU.EQ.1) THEN
  372. TABVDC.VCOFPR(JCOF)=IJGCOF
  373. TABCOF=TACOPR
  374. ELSE
  375. TABVDC.VCOFDU(JCOF)=IJGCOF
  376. TABCOF=TACODU
  377. ENDIF
  378. TYPE=TYTABL
  379. CALL ACCTAB(TABCOF,'ENTIER',JCOF,XBID,CBID,LBID,IBID,
  380. $ TYPE,IBID,XBID,CBID,LBID,TABJ)
  381. IF (IERR.NE.0) GOTO 9999
  382. **
  383. TYP0=BLAN
  384. CALL ACCTAB(TABJ,'MOT',IBID,XBID,'COMPOR',LBID,IBID,
  385. $ TYP0,IBID,XBID,CNCOM,LBID,IBID)
  386. IF (IERR.NE.0) GOTO 9999
  387. *
  388. TYP1=BLAN
  389. CALL ACCTAB(TABJ,'MOT',IBID,XBID,'LDAT',LBID,IBID,
  390. $ TYP1,IBID,XBID,CBID,LBID,MYLENT)
  391. IF (IERR.NE.0) GOTO 9999
  392. *
  393. C TYP2=BLAN
  394. C CALL ACCTAB(TABJ,'MOT',IBID,XBID,'FACMUL',LBID,IBID,
  395. C $ TYP2,IVAL,XVAL,CBID,LBID,IBID)
  396. IF (.NOT.(TYP0.EQ.BLAN)) THEN
  397. IF (TYP0.EQ.TYMOT) THEN
  398. CALL FICOMP(CNCOM,MYCOMS,MYCOM,IMPR,IRET)
  399. IF (IRET.NE.0) GOTO 9999
  400. SEGACT MYCOM
  401. NCOCO1=MYCOM.DERCOF(/1)
  402. SEGDES MYCOM
  403. TABVDC.VCOMP(IJGCOF)=MYCOM
  404. ELSE
  405. WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF,' . COMPOR'
  406. $
  407. WRITE(IOIMP,*) 'wrong type = ',TYP0
  408. WRITE(IOIMP,*) 'should be = ',TYMOT
  409. GOTO 9999
  410. ENDIF
  411. IF (TYP1.EQ.BLAN) THEN
  412. JG=0
  413. SEGINI MYLENT
  414. SEGDES MYLENT
  415. TYP1=TYLENT
  416. ENDIF
  417. IF (TYP1.EQ.TYLENT) THEN
  418. SEGACT MYLENT
  419. NCOCO2=MYLENT.LECT(/1)
  420. JG=NCOCO2
  421. SEGINI LDAT
  422. LBID=.TRUE.
  423. DO ICOCO2=1,NCOCO2
  424. IBID=MYLENT.LECT(ICOCO2)
  425. IF (IBID.LT.1.OR.IBID.GT.NUMDAT) LBID=.FALSE.
  426. IF (IPRDU.EQ.1) THEN
  427. LDAT.LECT(ICOCO2)=TABVDC.VDATPR(IBID)
  428. ELSE
  429. LDAT.LECT(ICOCO2)=TABVDC.VDATDU(IBID)
  430. ENDIF
  431. ENDDO
  432. SEGDES MYLENT
  433. SEGDES LDAT
  434. IF (.NOT.NCOCO1.EQ.NCOCO2) THEN
  435. WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF
  436. $ ,' . LDAT'
  437. WRITE(IOIMP,*) 'wrong length = ',NCOCO2
  438. WRITE(IOIMP,*) 'should be = ',NCOCO1
  439. GOTO 9999
  440. ENDIF
  441. IF (.NOT.LBID) THEN
  442. WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF
  443. $ ,' . LDAT'
  444. WRITE(IOIMP,*) 'some values out of range [1,',
  445. $ NUMDAT,']'
  446. SEGPRT,MYLENT
  447. GOTO 9999
  448. ENDIF
  449. TABVDC.VLDAT(IJGCOF)=LDAT
  450. ELSE
  451. WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF
  452. $ ,' . LDAT'
  453. WRITE(IOIMP,*) 'wrong type = ',TYP1
  454. WRITE(IOIMP,*) 'should be = ',TYLENT
  455. GOTO 9999
  456. ENDIF
  457. C IF (TYP2.EQ.TYENT) THEN
  458. C XCOF=DBLE(IVAL)
  459. C ELSEIF (TYP2.EQ.TYFLO) THEN
  460. C XCOF=XVAL
  461. C ELSEIF (TYP2.EQ.BLAN) THEN
  462. C XCOF=1.D0
  463. C ELSE
  464. C WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF
  465. C $ ,' . FACMUL'
  466. C WRITE(IOIMP,*) 'wrong type = ',TYP2
  467. C WRITE(IOIMP,*) 'should be = ',TYENT, ' or ',TYFLO
  468. C GOTO 9999
  469. C ENDIF
  470. C IF (IPRDU.EQ.1) THEN
  471. C TABVDC.XCOFPR(JCOF)=XCOF
  472. C ELSE
  473. C TABVDC.XCOFDU(JCOF)=XCOF
  474. C ENDIF
  475. ENDIF
  476. ENDDO
  477. ENDDO
  478. SEGDES MYCOMS
  479. JGCOF=IJGCOF
  480. SEGADJ,TABVDC
  481. *
  482. * Lecture des listes de coefficients (pour la table primale et
  483. * et la table duale)
  484. *
  485. CVD='LISTCOEF'
  486. DO IPRDU=1,2
  487. IF (IPRDU.EQ.1) THEN
  488. NUMVAR=NUMVPR
  489. TABLC=TABCPR
  490. CPD='PRIMAL '
  491. ELSE
  492. NUMVAR=NUMVDU
  493. TABLC=TABCDU
  494. CPD='DUAL '
  495. ENDIF
  496. DO IOP=1,NUMOP
  497. TYPE=TYTABL
  498. CALL ACCTAB(TABLC,'ENTIER',IOP,XBID,CBID,LBID,IBID,
  499. $ TYPE,IBID,XBID,CBID,LBID,TABI)
  500. IF (IERR.NE.0) GOTO 9999
  501. DO JVAR=1,NUMVAR
  502. TYPE=TYTABL
  503. CALL ACCTAB(TABI,'ENTIER',JVAR,XBID,CBID,LBID,IBID,
  504. $ TYPE,IBID,XBID,CBID,LBID,TABJ)
  505. DO KDER=0,NUMDER
  506. TYPE=BLAN
  507. CALL ACCTAB(TABJ,'ENTIER',KDER,XBID,CBID,LBID,IBID,
  508. $ TYPE,IBID,XBID,CBID,LBID,MYLENT)
  509. **
  510. IF (.NOT.(TYPE.EQ.BLAN)) THEN
  511. IF (TYPE.EQ.TYLENT) THEN
  512. IJLCOF=IJLCOF+1
  513. SEGACT MYLENT
  514. NLCOF=MYLENT.LECT(/1)
  515. JG=JGCOF
  516. SEGINI POWCOF
  517. DO ILCOF=1,NLCOF
  518. INUC=MYLENT.LECT(ILCOF)
  519. IAINUC=ABS(INUC)
  520. IF (IPRDU.EQ.1) THEN
  521. IF ((IAINUC.LE.0).OR.(IAINUC.GT.NUMCPR))
  522. $ THEN
  523. WRITE(IOIMP,*) CPD,' ',CVD,' operator '
  524. $ ,IOP
  525. WRITE(IOIMP,*) 'variable ',JVAR,
  526. $ ' derivative ',KDER
  527. WRITE(IOIMP,*)
  528. $ 'some values out of range [1,'
  529. $ ,NUMCPR,']U[-',NUMCPR,',-1]'
  530. SEGPRT,MYLENT
  531. GOTO 9999
  532. ENDIF
  533. IGCOF=TABVDC.VCOFPR(IAINUC)
  534. ELSE
  535. IF ((IAINUC.LE.0).OR.(IAINUC.GT.NUMCDU))
  536. $ THEN
  537. WRITE(IOIMP,*) CPD,' ',CVD,' operator '
  538. $ ,IOP
  539. WRITE(IOIMP,*) 'variable ',JVAR,
  540. $ ' derivative ',KDER
  541. WRITE(IOIMP,*)
  542. $ 'some values out of range [1,'
  543. $ ,NUMCDU,']',']U[-',NUMCDU,',-1]'
  544. SEGPRT,MYLENT
  545. GOTO 9999
  546. ENDIF
  547. IGCOF=TABVDC.VCOFDU(IAINUC)
  548. ENDIF
  549. IF (INUC.GT.0) THEN
  550. POWCOF.LECT(IGCOF)=POWCOF.LECT(IGCOF)+1
  551. ELSEIF(INUC.LT.0) THEN
  552. POWCOF.LECT(IGCOF)=POWCOF.LECT(IGCOF)-1
  553. ELSE
  554. WRITE(IOIMP,*) 'Programming error 1'
  555. GOTO 9999
  556. ENDIF
  557. ENDDO
  558. SEGDES MYLENT
  559. SEGDES POWCOF
  560. TABVDC.VLCOF(IJLCOF)=POWCOF
  561. IF (IPRDU.EQ.1) THEN
  562. TABVDC.ILCPR(KDER+1,IOP,JVAR)=IJLCOF
  563. ELSE
  564. TABVDC.ILCDU(KDER+1,IOP,JVAR)=IJLCOF
  565. ENDIF
  566. ELSE
  567. WRITE(IOIMP,*) CPD,' ',CVD,' operator ',IOP
  568. WRITE(IOIMP,*) 'variable ',JVAR,
  569. $ ' derivative ',KDER
  570. WRITE(IOIMP,*) 'wrong type = ',TYPE
  571. WRITE(IOIMP,*) 'should be = ',TYLENT
  572. GOTO 9999
  573. ENDIF
  574. ELSE
  575. IF (IPRDU.EQ.1) THEN
  576. TABVDC.ILCPR(KDER+1,IOP,JVAR)=0
  577. ELSE
  578. TABVDC.ILCDU(KDER+1,IOP,JVAR)=0
  579. ENDIF
  580. ENDIF
  581. ENDDO
  582. ENDDO
  583. ENDDO
  584. ENDDO
  585. JLCOF=IJLCOF
  586. SEGADJ,TABVDC
  587. *
  588. * On supprime les doublons dans les listes d'espaces de discrétisation
  589. * et on corrige les pointeurs sur cette liste
  590. *
  591. JG=KGVD
  592. JG=KGVD
  593. SEGINI KREP
  594. IKGVD2=1
  595. KREP.LECT(1)=IKGVD2
  596. DO IKGVD=2,KGVD
  597. LFOUND=.FALSE.
  598. IKGVD3=0
  599. 12 CONTINUE
  600. IKGVD3=IKGVD3+1
  601. IF (TABVDC.DISVD(IKGVD3).EQ.TABVDC.DISVD(IKGVD)) THEN
  602. LFOUND=.TRUE.
  603. ELSE
  604. IF (IKGVD3.LT.IKGVD2) THEN
  605. GOTO 12
  606. ENDIF
  607. ENDIF
  608. IF (.NOT.LFOUND) THEN
  609. IKGVD2=IKGVD2+1
  610. KREP.LECT(IKGVD)=IKGVD2
  611. TABVDC.DISVD(IKGVD2)=TABVDC.DISVD(IKGVD)
  612. ELSE
  613. KREP.LECT(IKGVD)=IKGVD3
  614. ENDIF
  615. ENDDO
  616. KGVD=IKGVD2
  617. SEGADJ,TABVDC
  618. *
  619. DO IJGVD=1,JGVD
  620. TABVDC.DJSVD(IJGVD)=KREP.LECT(TABVDC.DJSVD(IJGVD))
  621. ENDDO
  622. SEGSUP KREP
  623. *
  624. * On supprime les doublons dans les listes d'espaces de champs
  625. * et on corrige les pointeurs sur cette liste
  626. *
  627. JG=JGVD
  628. SEGINI KREP
  629. IJGVD2=1
  630. KREP.LECT(1)=IJGVD2
  631. DO IJGVD=2,JGVD
  632. LFOUND=.FALSE.
  633. IJGVD3=0
  634. 22 CONTINUE
  635. IJGVD3=IJGVD3+1
  636. IF (TABVDC.DJSVD(IJGVD3).EQ.TABVDC.DJSVD(IJGVD)
  637. $ .AND.TABVDC.NOMVD(IJGVD3).EQ.TABVDC.NOMVD(IJGVD)
  638. $ .AND.TABVDC.MVD(IJGVD3).EQ.TABVDC.MVD(IJGVD)
  639. $ ) THEN
  640. LFOUND=.TRUE.
  641. ELSE
  642. IF (IJGVD3.LT.IJGVD2) THEN
  643. GOTO 22
  644. ENDIF
  645. ENDIF
  646. IF (.NOT.LFOUND) THEN
  647. IJGVD2=IJGVD2+1
  648. KREP.LECT(IJGVD)=IJGVD2
  649. TABVDC.DJSVD(IJGVD2)=TABVDC.DJSVD(IJGVD)
  650. TABVDC.NOMVD(IJGVD2)=TABVDC.NOMVD(IJGVD)
  651. TABVDC.MVD(IJGVD2)=TABVDC.MVD(IJGVD)
  652. TABVDC.XVD(IJGVD2)=TABVDC.XVD(IJGVD)
  653. ELSE
  654. KREP.LECT(IJGVD)=IJGVD3
  655. ENDIF
  656. ENDDO
  657. JGVD=IJGVD2
  658. SEGADJ,TABVDC
  659. *
  660. DO JVARPR=1,NUMVPR
  661. TABVDC.VVARPR(JVARPR)=KREP.LECT(TABVDC.VVARPR(JVARPR))
  662. ENDDO
  663. DO JVARDU=1,NUMVDU
  664. TABVDC.VVARDU(JVARDU)=KREP.LECT(TABVDC.VVARDU(JVARDU))
  665. ENDDO
  666. DO JDATPR=1,NUMDPR
  667. TABVDC.VDATPR(JDATPR)=KREP.LECT(TABVDC.VDATPR(JDATPR))
  668. ENDDO
  669. DO JDATDU=1,NUMDDU
  670. TABVDC.VDATDU(JDATDU)=KREP.LECT(TABVDC.VDATDU(JDATDU))
  671. ENDDO
  672. DO IJGCOF=1,JGCOF
  673. LDAT=TABVDC.VLDAT(IJGCOF)
  674. SEGACT LDAT*MOD
  675. NLDAT=LDAT.LECT(/1)
  676. DO ILDAT=1,NLDAT
  677. LDAT.LECT(ILDAT)=KREP.LECT(LDAT.LECT(ILDAT))
  678. ENDDO
  679. SEGDES LDAT
  680. ENDDO
  681. SEGSUP KREP
  682. * On supprime les doublons dans les coefficients
  683. * et on corrige les pointeurs sur cette liste
  684. IF (JGCOF.GT.1) THEN
  685. JG=JGCOF
  686. SEGINI KREP
  687. IJGCO2=1
  688. KREP.LECT(1)=IJGCO2
  689. DO IJGCOF=2,JGCOF
  690. LFOUND=.FALSE.
  691. LDAT=TABVDC.VLDAT(IJGCOF)
  692. IJGCO3=0
  693. 32 CONTINUE
  694. IJGCO3=IJGCO3+1
  695. IF (TABVDC.VCOMP(IJGCO3).EQ.TABVDC.VCOMP(IJGCOF)) THEN
  696. LDAT3=TABVDC.VLDAT(IJGCO3)
  697. CALL EGLENT(LDAT3,LDAT,LEGDAT,IMPR,IRET)
  698. IF (IRET.NE.0) GOTO 9999
  699. IF (LEGDAT) THEN
  700. LFOUND=.TRUE.
  701. ENDIF
  702. ELSE
  703. IF (IJGCO3.LT.IJGCO2) THEN
  704. GOTO 32
  705. ENDIF
  706. ENDIF
  707. IF (.NOT.LFOUND) THEN
  708. IJGCO2=IJGCO2+1
  709. KREP.LECT(IJGCOF)=IJGCO2
  710. TABVDC.VCOMP(IJGCO2)=TABVDC.VCOMP(IJGCOF)
  711. C Je ne suis pas arrivé à savoir quand il faut supprimmer les segments
  712. C LDAT=TABVDC.VLDAT(IJGCO2)
  713. C* SEGACT LDAT*MOD
  714. C SEGSUP LDAT
  715. TABVDC.VLDAT(IJGCO2)=TABVDC.VLDAT(IJGCOF)
  716. ELSE
  717. KREP.LECT(IJGCOF)=IJGCO3
  718. C LDAT=TABVDC.VLDAT(IJGCO3)
  719. C* SEGACT LDAT*MOD
  720. C SEGSUP LDAT
  721. ENDIF
  722. ENDDO
  723. C DO IJGCOF=IJGCO2+1,JGCOF
  724. C LDAT=TABVDC.VLDAT(IJGCOF)
  725. C* SEGACT LDAT*MOD
  726. C SEGSUP LDAT
  727. C ENDDO
  728. JGCOF=IJGCO2
  729. SEGADJ,TABVDC
  730. *
  731. DO JCOFPR=1,NUMCPR
  732. TABVDC.VCOFPR(JCOFPR)=KREP.LECT(TABVDC.VCOFPR(JCOFPR))
  733. ENDDO
  734. DO JCOFDU=1,NUMCDU
  735. TABVDC.VCOFDU(JCOFDU)=KREP.LECT(TABVDC.VCOFDU(JCOFDU))
  736. ENDDO
  737. *
  738. DO IJLCOF=1,JLCOF
  739. POWCOF=TABVDC.VLCOF(IJLCOF)
  740. SEGACT POWCOF
  741. JG=JGCOF
  742. SEGINI POWCO2
  743. DO IPC=1,POWCOF.LECT(/1)
  744. IPC2=KREP.LECT(IPC)
  745. POWCO2.LECT(IPC2)=POWCO2.LECT(IPC2)+POWCOF.LECT(IPC)
  746. ENDDO
  747. SEGDES POWCO2
  748. SEGSUP POWCOF
  749. TABVDC.VLCOF(IJLCOF)=POWCO2
  750. ENDDO
  751. SEGSUP KREP
  752. ENDIF
  753.  
  754. * On supprime les doublons dans les listes de coefficients
  755. * et on corrige les pointeurs sur cette liste
  756. IF (JLCOF.GT.1) THEN
  757. JG=JLCOF
  758. SEGINI KREP
  759. IJLCO2=1
  760. KREP.LECT(1)=IJLCO2
  761. DO IJLCOF=2,JLCOF
  762. LFOUND=.FALSE.
  763. LCOF=TABVDC.VLCOF(IJLCOF)
  764. IJLCO3=0
  765. 42 CONTINUE
  766. IJLCO3=IJLCO3+1
  767. LCOF3=TABVDC.VLCOF(IJLCO3)
  768. CALL EGLENT(LCOF3,LCOF,LEGCOF,IMPR,IRET)
  769. IF (LEGCOF) THEN
  770. LFOUND=.TRUE.
  771. ELSE
  772. IF (IJLCO3.LT.IJLCO2) THEN
  773. GOTO 42
  774. ENDIF
  775. ENDIF
  776. IF (.NOT.LFOUND) THEN
  777. IJLCO2=IJLCO2+1
  778. KREP.LECT(IJLCOF)=IJLCO2
  779. C Je ne suis pas arrivé à savoir quand il faut supprimmer les segments
  780. C LCOF=TABVDC.VLCOF(IJLCO2)
  781. C* SEGACT LCOF*MOD
  782. C SEGSUP LCOF
  783. TABVDC.VLCOF(IJLCO2)=TABVDC.VLCOF(IJLCOF)
  784. ELSE
  785. KREP.LECT(IJLCOF)=IJLCO3
  786. C LCOF=TABVDC.VLCOF(IJLCO3)
  787. C* SEGACT LCOF*MOD
  788. C SEGSUP LCOF
  789. ENDIF
  790. ENDDO
  791. C DO IJLCOF=IJLCO2+1,JLCOF
  792. C LCOF=TABVDC.VLCOF(IJLCOF)
  793. C* SEGACT LCOF*MOD
  794. C SEGSUP LCOF
  795. C ENDDO
  796. JLCOF=IJLCO2
  797. SEGADJ,TABVDC
  798. *
  799. DO IOP=1,NUMOP
  800. DO IDER=1,NUMDER+1
  801. DO JVARPR=1,NUMVPR
  802. IJLCOF=TABVDC.ILCPR(IDER,IOP,JVARPR)
  803. IF (IJLCOF.NE.0) THEN
  804. TABVDC.ILCPR(IDER,IOP,JVARPR)=
  805. $ KREP.LECT(IJLCOF)
  806. ENDIF
  807. ENDDO
  808. DO JVARDU=1,NUMVDU
  809. IJLCOF=TABVDC.ILCDU(IDER,IOP,JVARDU)
  810. IF (IJLCOF.NE.0) THEN
  811. TABVDC.ILCDU(IDER,IOP,JVARDU)=
  812. $ KREP.LECT(IJLCOF)
  813. ENDIF
  814. ENDDO
  815. ENDDO
  816. ENDDO
  817. SEGSUP KREP
  818. ENDIF
  819. *
  820. * On crée le champ par éléments contenant les coordonnées
  821. * des points servant pour la transformation géométrique
  822. * (ddl de la transformation géométrique)...
  823. *
  824. MYDISC=TABGEO.DISGEO
  825. CALL MKCOOR(CGEOME,MYDISC,
  826. $ MYFALS,
  827. $ ICOOR,
  828. $ IMPR,IRET)
  829. IF (IRET.NE.0) GOTO 9999
  830. TABGEO.IGEO=ICOOR
  831. *
  832. * On teste les noms des ddls des variables et des coefficients
  833. *
  834. DO IJGVD=1,JGVD
  835. MYDISC=TABVDC.DISVD(TABVDC.DJSVD(IJGVD))
  836. MYLMOT=TABVDC.NOMVD(IJGVD)
  837. CALL KECOM6(CGEOME,MYLMOT,MYDISC,
  838. $ MYFALS,
  839. $ IMPR,IRET)
  840. IF (IRET.NE.0) GOTO 9999
  841. ENDDO
  842. *
  843. * On crée les champs par éléments correspondant aux éventuels
  844. * champs de variables et aux champs coefficients (globaux)
  845. *
  846. SEGINI,TATRAV
  847. DO IJGVD=1,JGVD
  848. MYDISC=TABVDC.DISVD(TABVDC.DJSVD(IJGVD))
  849. MYLMOT=TABVDC.NOMVD(IJGVD)
  850. MYCHPO=TABVDC.MVD(IJGVD)
  851. MYREAL=TABVDC.XVD(IJGVD)
  852. * segprt,mychpo
  853. CALL CP2CV7(CGEOME,MYLMOT,MYDISC,MYCHPO,MYREAL,
  854. $ MYFALS,
  855. $ MYMCHA,
  856. $ IMPR,IRET)
  857. IF (IRET.NE.0) GOTO 9999
  858. * segprt,mymcha
  859. TATRAV.IVD(IJGVD)=MYMCHA
  860. ENDDO
  861. *
  862. * Fin...
  863. *
  864. SEGDES,TATRAV
  865. SEGDES,TABVDC
  866. SEGDES,TABGEO
  867. * SEGPRT,TABGEO
  868. * SEGPRT,TABVDC
  869. *
  870. * Normal termination
  871. *
  872. IRET=0
  873. RETURN
  874. *
  875. * Format handling
  876. *
  877. *
  878. * Error handling
  879. *
  880. 9999 CONTINUE
  881. IRET=1
  882. WRITE(IOIMP,*) 'An error was detected in subroutine prlin3'
  883. RETURN
  884. *
  885. * End of subroutine PRLIN3
  886. *
  887. END
  888.  
  889.  
  890.  
  891.  

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