Télécharger trialu.eso

Retour à la liste

Numérotation des lignes :

  1. C TRIALU SOURCE PV 16/11/17 22:01:36 9180
  2. SUBROUTINE TRIALU(MATRIK,AMORS,AISA,
  3. $ IDMAT,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C************************************************************************
  8. C
  9. C Triangulation d'une matrice symetrique ou non
  10. C On decoupe la matrice en bloc
  11. C Si IDMAT ne 0 la matrice est deja triangulee on saute
  12. C
  13. C HISTORIQUE : 22/03/00 gounand
  14. C Amélioration de la détection des pivots nulles (pas encore parfaite)
  15. C HISTORIQUE : 13/01/00 Adaptation au nouvel assemblage :
  16. C Modifications cosmétiques.
  17. C Correction sur la détection des diagonales nulles (pas encore
  18. C parfaite).
  19. C Modification de la taille des paquets pour tenir dans le cache
  20. C (dépendant machine).
  21. C Inlining manuel des produits scalaires de vecteurs (sdot) qui
  22. C sont appelés de nombreuses fois...
  23. C Gestion correcte des allocations mémoire.
  24. C HISTORIQUE :
  25. C HISTORIQUE :
  26. C************************************************************************
  27. * REAL*8 SDOT
  28. -INC CCOPTIO
  29. -INC CCREEL
  30. INTEGER NTT,NPT,NBLK,KTRING
  31. INTEGER NBVA
  32. POINTEUR ISAU.IZA,ISAL.IZA
  33. POINTEUR ISAU0.IZA,ISAL0.IZA
  34. POINTEUR ISAU00.IZA,ISAL00.IZA
  35. POINTEUR AMORS.PMORS
  36. POINTEUR AISA.IZA
  37. POINTEUR PMTRAN.PMORS
  38. POINTEUR MYMINC.MINC
  39. -INC SMELEME
  40. POINTEUR MYPTS.MELEME
  41. -INC SMLREEL
  42. POINTEUR GGIS.MLREEL
  43. *STAT-INC SMSTAT
  44. INTEGER IMPR,IRET
  45. *
  46. INTEGER NBVD
  47. SEGMENT IZD
  48. REAL*8 D(NBVD)
  49. ENDSEGMENT
  50. INTEGER IBLSIZ
  51. * REAL*8 GGIS
  52. LOGICAL LACTL,LACTU
  53. * Le logique LISDDL indique si l'on est capable de faire
  54. * la correspondance numéro DDL <-> numéro de point, nom d'inconnue
  55. LOGICAL LISDDL
  56. INTEGER TRAMIN
  57. INTEGER I,ISTRT,ISTOP
  58. INTEGER J,JSTRT,JSTOP
  59. INTEGER NTTDDL
  60. REAL*8 TNORM,YZPREC,US
  61. C*******************************************************************
  62. C
  63. C
  64. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans trialu'
  65. IKOMPT=0
  66. * GGIS=XZPREC
  67. SEGACT MATRIK
  68. KTRING=MATRIK.KIDMAT(9)
  69. KSIM=MATRIK.KSYM
  70. IDMAT=MATRIK.KIDMAT(1)
  71. MYMINC=MATRIK.KMINC
  72. MYPTS=MATRIK.KISPGT
  73. SEGDES MATRIK
  74. IF(KTRING.NE.2) THEN
  75. *STAT CALL INMSTA(MSTAT,1)
  76. SEGACT MATRIK*MOD
  77. MATRIK.KIDMAT(9)=2
  78. SEGDES MATRIK
  79. SEGACT IDMAT*MOD
  80. C Initialisation des KZA
  81. SEGACT AMORS
  82. NTT=AMORS.IA(/1)-1
  83. NPT=IDMAT.NUAN(/1)
  84. LISDDL=(MYMINC.NE.0.AND.MYPTS.NE.0.AND.NPT.GT.0)
  85. NBLK=0
  86. SEGADJ,IDMAT
  87. DO 9 ITT=1,NTT
  88. IDMAT.KZA(ITT)=ITT-AMORS.JA(AMORS.IA(ITT))+1
  89. 9 CONTINUE
  90. SEGDES AMORS
  91. C On construit la transposée du profil
  92. C (La matrice Skyline est supposée avoir une structure symétrique)
  93. C La transposée du profil n'a pas ses colonnes ordonnées...
  94. CALL MAKPMT(AMORS,
  95. $ PMTRAN,
  96. $ IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. SEGACT PMTRAN
  99. DO 91 ITT=1,NTT
  100. JSTRT=PMTRAN.IA(ITT)
  101. JSTOP=PMTRAN.IA(ITT+1)-1
  102. TRAMIN=PMTRAN.JA(JSTRT)
  103. DO 912 J=JSTRT+1,JSTOP
  104. TRAMIN=MIN(TRAMIN,PMTRAN.JA(J))
  105. 912 CONTINUE
  106. TRAMIN=DIM(ITT,TRAMIN)+1
  107. IDMAT.KZA(ITT)=MAX(IDMAT.KZA(ITT),TRAMIN)
  108. 91 CONTINUE
  109. SEGSUP PMTRAN
  110. *STAT CALL PRMSTA('Init. KZA',MSTAT,1)
  111. C
  112. C On cree les blocs
  113. C
  114. C La matrice est stockée par blocs de plusieurs lignes. En effet, il faut
  115. C l'équivalent de 900 opérations pour activer/désactiver un segment. Si
  116. C une ligne de la matrice comprend 50 éléments, on fait 100 opérations
  117. C utiles et 900 inutiles lors de la résolution.
  118. C La taille des blocs est fixée par le paramètre IBLSIZ. La diagonale est
  119. C stockée dans un segment à part.
  120. C
  121. C Il nous faut constituer un certain nombre de tableaux. Le premier segment
  122. C décrit la matrice. Il contient un tableau donnant les numéros des premières
  123. C lignes de chaque bloc et un tableau de pointeurs sur des segments
  124. C descripteurs de bloc.
  125. C
  126. C Calcul de la longueur des blocs, on choisit ce qu'il faut
  127. C
  128. C Attention !! il y a au moins deux blocs activés en même temps et au plus 4
  129. C Peut-être qu'une bonne formule fait intervenir la taille du cache...
  130. C (Cache-Place(KZA,NUIA,DESCL...)) / 4 (blocs simultanés)
  131. * IBLSIZ=OOOVAL(1,1)/100000
  132. * Pour 128Ko de cache => 8 KMots
  133. IBLSIZ=8000
  134. C
  135. C Il faut d'abord déterminer le nombre de blocs.
  136. C
  137. LONG=0
  138. NTT=KZA(/1)
  139. DO 96 I=1,NTT
  140. LONG=LONG+KZA(I)
  141. 96 CONTINUE
  142. NBLK=1
  143. IF(LONG-NTT.GT.IBLSIZ) THEN
  144. ILBL=0
  145. DO 12 KK=2,NTT
  146. LA=KZA(KK)-1
  147. IF(LA.GT.IBLSIZ) THEN
  148. NBLK=NBLK+2
  149. ILBL=0
  150. ELSE
  151. ILBL=ILBL+LA
  152. IF(ILBL.GT.IBLSIZ) THEN
  153. NBLK=NBLK+1
  154. ILBL=LA
  155. ENDIF
  156. ENDIF
  157. 12 CONTINUE
  158. ENDIF
  159. C
  160. C On peut allouer le segment descripteur de la matrice. On va pouvoir
  161. C remplir des numéros de ligne des débuts de bloc.
  162. C
  163. NTT=KZA(/1)
  164. NPT=NUAN(/1)
  165. SEGADJ IDMAT
  166. IF(NBLK.EQ.1) THEN
  167. NLDBLK(1)=1
  168. NLDBLK(2)=NTT+1
  169. ELSE
  170. IBLK=1
  171. ILBL=0
  172. NLDBLK(1)=1
  173. NLDBLK(NBLK+1)=NTT+1
  174. DO 13 KK=2,NTT
  175. LA=KZA(KK)-1
  176. IF(LA.GT.IBLSIZ) THEN
  177. NLDBLK(IBLK+1)=KK
  178. NLDBLK(IBLK+2)=KK+1
  179. IBLK=IBLK+2
  180. ILBL=0
  181. ELSE
  182. ILBL=ILBL+LA
  183. IF(ILBL.GT.IBLSIZ) THEN
  184. NLDBLK(IBLK+1)=KK
  185. ILBL=LA
  186. IBLK=IBLK+1
  187. ENDIF
  188. ENDIF
  189. 13 CONTINUE
  190. ENDIF
  191. IF(IMPR.GE.2) THEN
  192. IF(KSIM.EQ.0) THEN
  193. WRITE(IOIMP,*) '* NOMBRE DE BLOCS DE ',IBLSIZ,
  194. $ ' MOTS : ',NBLK
  195. ELSE
  196. WRITE(IOIMP,*)'* NOMBRE DE BLOCS DE ',IBLSIZ,
  197. $ ' MOTS : 2 X ',NBLK
  198. ENDIF
  199. ENDIF
  200. C
  201. C On Remplit les blocs
  202. C
  203. SEGACT AMORS
  204. SEGACT AISA
  205. * On construit le vecteurs des normes des lignes
  206. NTTDDL=AMORS.IA(/1)-1
  207. JG=NTTDDL
  208. SEGINI GGIS
  209. YZPREC=XZPREC**(0.9D0)
  210. * YZPREC=1.D-9
  211. DO 152 ITTDDL=1,NTTDDL
  212. * Calcul de la norme de la ittème ligne
  213. ISTRT=AMORS.IA(ITTDDL)
  214. ISTOP=AMORS.IA(ITTDDL+1)-1
  215. TNORM=XZERO
  216. DO 1521 IJA=ISTRT,ISTOP
  217. TNORM=TNORM+ABS(AISA.A(IJA))
  218. 1521 CONTINUE
  219. * WRITE(IOIMP,*) 'ITTDDL=',ITTDDL,' TNORM=',TNORM
  220. *
  221. C IF (TNORM.EQ.0.D0) THEN
  222. C WRITE(IOIMP,*) 'The ',ITTDDL,'th line is zero'
  223. CC Résolution impossible détectée au noeud %i1 pour l'inconnue %m1:4
  224. C SEGACT MYMINC
  225. C SEGACT MYPTS
  226. C N2=IDMAT.NUNA(ITTDDL)
  227. C CALL DDL2PI(N2,MYMINC,
  228. C $ IPT,IBI,
  229. C $ IMPR,IRET)
  230. C IF (IRET.NE.0) GOTO 9999
  231. C INTERR(1)=MYPTS.NUM(1,IPT)
  232. C MOTERR(1:8)=MYMINC.LISINC(IBI)
  233. C CALL ERREUR(143)
  234. C SEGDES MYPTS
  235. C SEGDES MYMINC
  236. C GOTO 9999
  237. C ENDIF
  238. GGIS.PROG(ITTDDL)=(TNORM/DBLE(ISTOP-ISTRT+1))*YZPREC
  239. 152 CONTINUE
  240. NBVD=KZA(/1)
  241. SEGINI IZD
  242. IDMAT.IDIAG=IZD
  243. ISAU=0
  244. DO 601 IBLK=1,NBLK
  245. C NUMÉROS DES LIGNES DE DÉBUT ET DE FIN DE BLOC KJD,KJF
  246. KJD=NLDBLK(IBLK)
  247. KJF=NLDBLK(IBLK+1)-1
  248. KA=0
  249. KA=KA+KZA(1)-1
  250. NUIA(1,1)=1
  251. DO 600 KJ=KJD,KJF
  252. NUIA(KJ,1)=IBLK
  253. NUIA(KJ,2)=KA
  254. KA=KA+KZA(KJ)-1
  255. 600 CONTINUE
  256. C ALLOCATION DE LA MÉMOIRE POUR LE BLOC
  257. NBVA=KA
  258. * WRITE(IOIMP,*) '* BLOC LOWER NUMERO : ',IBLK,' TAILLE = '
  259. * $ ,NBVA,' MOTS'
  260. SEGINI IZA
  261. IDESCL(IBLK)=IZA
  262. IDESCU(IBLK)=IZA
  263. IF(KSIM.EQ.2)IDESCU(IBLK)=NBVA
  264. IF(IBLK.EQ.1)THEN
  265. KJD=1
  266. D(1)=AISA.A(1)
  267. ENDIF
  268. DO 602 LI=KJD,KJF
  269. NBK=AMORS.IA(LI+1)-AMORS.IA(LI)
  270. I1=AMORS.IA(LI)
  271. DO 603 K=1,NBK
  272. MA=I1+K-1
  273. KO=AMORS.JA(MA)
  274. IF(LI.GT.KO)THEN
  275. NA=KO-LI+KZA(LI)+NUIA(LI,2)
  276. A(NA)=AISA.A(MA)
  277. ELSEIF(LI.EQ.KO.AND.LI.NE.1)THEN
  278. D(LI)=AISA.A(MA)
  279. ELSE
  280. GO TO 602
  281. ENDIF
  282. 603 CONTINUE
  283. 602 CONTINUE
  284. SEGDES IZA
  285. 601 CONTINUE
  286. IF(KSIM.EQ.2)THEN
  287. DO 604 IBLK=1,NBLK
  288. KJD=NLDBLK(IBLK)
  289. KJF=NLDBLK(IBLK+1)-1
  290. NBVA=IDESCU(IBLK)
  291. SEGINI IZA
  292. IDESCU(IBLK)=IZA
  293. IF(IBLK.EQ.1)THEN
  294. KJD=1
  295. ENDIF
  296. LDEB=KJD
  297. DO 605 KO=KJD,KJF
  298. L0=KO-KZA(KO)+1
  299. IF(LDEB.GT.L0)LDEB=L0
  300. 605 CONTINUE
  301. DO 606 LI=LDEB,KJF
  302. NBK=AMORS.IA(LI+1)-AMORS.IA(LI)
  303. I1=AMORS.IA(LI)
  304. DO 607 K=NBK,1,-1
  305. MA=I1+K-1
  306. KO=AMORS.JA(MA)
  307. IF(KO.GT.KJF)GO TO 607
  308. IF(KO.LT.KJD)GO TO 606
  309. IF(LI.LT.KO)THEN
  310. NA=LI-KO+KZA(KO)+NUIA(KO,2)
  311. A(NA)=AISA.A(MA)
  312. ELSE
  313. GO TO 606
  314. ENDIF
  315. 607 CONTINUE
  316. 606 CONTINUE
  317. SEGDES IZA
  318. 604 CONTINUE
  319. ENDIF
  320. SEGDES AISA
  321. SEGDES AMORS
  322. *STAT CALL PRMSTA('Remplissage des blocs',MSTAT,1)
  323. IF(KSIM.EQ.0.OR.KSIM.EQ.2)THEN
  324. DO 200 IBLK=1,NBLK
  325. KJD=NLDBLK(IBLK)
  326. KJF=NLDBLK(IBLK+1)-1
  327. ISAU=IDESCU(IBLK)
  328. ISAL=IDESCL(IBLK)
  329. SEGACT ISAU*MOD
  330. SEGACT ISAL*MOD
  331. IF(IBLK.NE.1)THEN
  332. ISAL0=0
  333. ISAU0=0
  334. C SEGACT ISAL0
  335. C SEGACT ISAU0
  336. ISAL00=0
  337. ISAU00=0
  338. LACTL=.FALSE.
  339. LACTU=.FALSE.
  340. KJD0=KJD-KZA(KJD)+1
  341. DO 304 I=KJD+1,KJF
  342. KLD=I-KZA(I)+1
  343. IF(KLD.LT.KJD0)KJD0=KLD
  344. 304 CONTINUE
  345. DO 302 I=KJD0,KJD-1
  346. LDEB=I-KZA(I)+1
  347. DO 301 N=KJD,KJF
  348. KDEB=N-KZA(N)+1
  349. IF(KDEB.LE.I) THEN
  350. C Calcul colonne n
  351. K1=MAX(KDEB,LDEB)
  352. LG=I-K1
  353. KL=NUIA(I,2)+K1-LDEB+1
  354. KU=NUIA(N,2)+K1-KDEB+1
  355. ISAL00=IDESCL(NUIA(I,1))
  356. LACTL=(ISAL00.NE.ISAL0.AND.ISAL00.NE.ISAL)
  357. IF (LACTL) THEN
  358. IF (ISAL0.NE.0) THEN
  359. SEGDES ISAL0
  360. ENDIF
  361. SEGACT ISAL00
  362. ENDIF
  363. ISAL0=ISAL00
  364. * US=SDOT(LG,ISAL00.A(KL),1,ISAU.A(KU),1)
  365. US=0.D0
  366. DO ILG=0,LG-1
  367. US=US+ISAL00.A(KL+ILG)*ISAU.A(KU+ILG)
  368. ENDDO
  369. KU=NUIA(N,2)+I-KDEB+1
  370. ISAU.A(KU)=(ISAU.A(KU)-US)
  371. C WRITE(IOIMP,*)' KU=',KU,' I=',I,' A(KU)=',ISAU.A(KU)
  372. IF(KSIM.NE.0)THEN
  373. C Calcul ligne n
  374. KU=NUIA(I,2)+K1-LDEB+1
  375. KL=NUIA(N,2)+K1-KDEB+1
  376. ISAU00=IDESCU(NUIA(I,1))
  377. LACTU=(ISAU00.NE.ISAU0.AND.ISAU00.NE.ISAU)
  378. IF (LACTU) THEN
  379. IF (ISAU0.NE.0) THEN
  380. SEGDES ISAU0
  381. ENDIF
  382. SEGACT ISAU00
  383. ENDIF
  384. ISAU0=ISAU00
  385. * US=SDOT(LG,ISAL.A(KL),1,ISAU00.A(KU),1)
  386. US=0.D0
  387. DO ILG=0,LG-1
  388. US=US+ISAL.A(KL+ILG)*ISAU00.A(KU+ILG)
  389. ENDDO
  390. KL=NUIA(N,2)+I-KDEB+1
  391. ISAL.A(KL)=(ISAL.A(KL)-US)
  392. ENDIF
  393. ENDIF
  394. 301 CONTINUE
  395. 302 CONTINUE
  396. IF (ISAL00.NE.ISAL.AND.ISAL00.NE.0) THEN
  397. SEGDES ISAL00
  398. ENDIF
  399. IF (ISAU00.NE.ISAU.AND.ISAU00.NE.0) THEN
  400. SEGDES ISAU00
  401. ENDIF
  402. ENDIF
  403. DO 202 I=KJD,KJF
  404. LDEB=I-KZA(I)+1
  405. KL=NUIA(I,2)
  406. DO 2011 II=LDEB,I-1
  407. ISAL.A(KL+II-LDEB+1)=ISAL.A(KL+II-LDEB+1)/D(II)
  408. 2011 CONTINUE
  409. IF(KSIM.EQ.2)THEN
  410. KL=NUIA(I,2)
  411. DO 2012 II=LDEB,I-1
  412. ISAU.A(KL+II-LDEB+1)=ISAU.A(KL+II-LDEB+1)/D(II)
  413. 2012 CONTINUE
  414. ENDIF
  415. C Calcul diagonale
  416. N=I
  417. IF(N.NE.1) THEN
  418. LG=N-LDEB
  419. KK=NUIA(N,2)+1
  420. US=0.D0
  421. DO 3003 II=1,LG
  422. US=US+
  423. $ ISAL.A(KK+II-1)
  424. $ *D(II+LDEB-1)*ISAU.A(KK+II-1)
  425. 3003 CONTINUE
  426. D(N)=D(N)-US
  427. ENDIF
  428. C! DEBUT
  429. ADK=ABS(D(N))
  430. * WRITE(IOIMP,*) 'N=',N,' ADK=',ADK
  431. IF(ADK.LE.GGIS.PROG(N))THEN
  432. IKOMPT=IKOMPT+1
  433. *
  434. * Désactivation temporaire, sinon des cas-tests (mal conçus !) plantent
  435. *
  436. C Résolution impossible détectée au noeud %i1 pour l'inconnue %m1:4
  437. * INTERR(1)=N
  438. * MOTERR(1: 8) = ' '
  439. * CALL ERREUR(143)
  440. IF (IKOMPT.EQ.1) THEN
  441. WRITE(IOIMP,*) '!!!!!!!!!!!!! WARNING !!!!!!!!!'
  442. IF (LISDDL) THEN
  443. SEGACT MYMINC
  444. SEGACT MYPTS
  445. DO IDDL=1,MIN(10,NTTDDL)
  446. N2=IDMAT.NUNA(IDDL)
  447. CALL DDL2PI(N2,MYMINC,
  448. $ IPT,IBI,
  449. $ IMPR,IRET)
  450. IF (IRET.NE.0) GOTO 9999
  451. WRITE(IOIMP,*) 'ddl ',IDDL
  452. $ ,' = point numero ',MYPTS.NUM(1,IPT),
  453. $ ' inconnue ',MYMINC.LISINC(IBI)
  454. ENDDO
  455. SEGDES MYPTS
  456. SEGDES MYMINC
  457. ENDIF
  458. ENDIF
  459. IF (IKOMPT.LE.10.OR.ADK.EQ.0.D0) THEN
  460. WRITE(IOIMP,*) 'Au ddl ',N,'le pivot vaut ',ADK,
  461. $ ' ; norme de la ligne =',GGIS.PROG(N)
  462. $ /YZPREC
  463. IF (LISDDL) THEN
  464. N2=IDMAT.NUNA(N)
  465. CALL DDL2PI(N2,MYMINC,
  466. $ IPT,IBI,
  467. $ IMPR,IRET)
  468. IF (IRET.NE.0) GOTO 9999
  469. SEGACT MYMINC
  470. SEGACT MYPTS
  471. IF (ADK.EQ.0.D0) THEN
  472. INTERR(1)=MYPTS.NUM(1,IPT)
  473. MOTERR(1:8)=MYMINC.LISINC(IBI)
  474. CALL ERREUR(143)
  475. GOTO 9999
  476. ELSE
  477. WRITE(IOIMP,*) 'ddl ',N,' = point numero '
  478. $ ,MYPTS.NUM(1,IPT),' inconnue ',MYMINC
  479. $ .LISINC(IBI)
  480. ENDIF
  481. SEGDES MYPTS
  482. SEGDES MYMINC
  483. ELSE
  484. IF (ADK.EQ.0.D0) THEN
  485. INTERR(1)=N
  486. * 49 2
  487. *Matrice singulière. Numéro de ligne =%i1
  488. CALL ERREUR(49)
  489. GOTO 9999
  490. ENDIF
  491. ENDIF
  492. IF (ADK.EQ.0.D0) RETURN
  493. ELSE IF (IKOMPT.EQ.11) THEN
  494. WRITE(IOIMP,*) 'Plus de 10 pivots petits'
  495. ELSE
  496. * Temporairement désactivé pour cause de mauvais cas-tests : difasyk2Dax.dgibi
  497. * GOTO 9999
  498. ENDIF
  499. D(N)=GGIS.PROG(N)
  500. * D(N)=1.D-200
  501. ENDIF
  502. C! FIN
  503. I1=I+1
  504. DO 201 N=I1,KJF
  505. KDEB=N-KZA(N)+1
  506. IF(KDEB.LE.I) THEN
  507. C Calcul colonne n
  508. K1=MAX(KDEB,LDEB)
  509. LG=I-K1
  510. KL=NUIA(I,2)+K1-LDEB+1
  511. KU=NUIA(N,2)+K1-KDEB+1
  512. * US=SDOT(LG,ISAL.A(KL),1,ISAU.A(KU),1)
  513. US=0.D0
  514. DO ILG=0,LG-1
  515. US=US+ISAL.A(KL+ILG)*ISAU.A(KU+ILG)
  516. ENDDO
  517. *
  518. KU=NUIA(N,2)+I-KDEB+1
  519. ISAU.A(KU)=(ISAU.A(KU)-US)
  520. IF(KSIM.NE.0) THEN
  521. C Calcul ligne n
  522. KU=NUIA(I,2)+K1-LDEB+1
  523. KL=NUIA(N,2)+K1-KDEB+1
  524. * US=SDOT(LG,ISAL.A(KL),1,ISAU.A(KU),1)
  525. US=0.D0
  526. DO ILG=0,LG-1
  527. US=US+ISAL.A(KL+ILG)*ISAU.A(KU+ILG)
  528. ENDDO
  529. *
  530. KL=NUIA(N,2)+I-KDEB+1
  531. ISAL.A(KL)=(ISAL.A(KL)-US)
  532. ENDIF
  533. ENDIF
  534. 201 CONTINUE
  535. 202 CONTINUE
  536. SEGDES ISAL
  537. SEGDES ISAU
  538. 200 CONTINUE
  539. SEGSUP GGIS
  540. ELSE
  541. WRITE(IOIMP,*)' TRIALU : KSIM=',KSIM,' Cas non prevu '
  542. GOTO 9999
  543. ENDIF
  544. *STAT CALL PRMSTA('Triangulation',MSTAT,1)
  545. SEGDES IZD
  546. SEGDES IDMAT
  547. ENDIF
  548. *
  549. * Normal termination
  550. *
  551. IRET=0
  552. RETURN
  553. *
  554. * Format handling
  555. *
  556. *
  557. * Error handling
  558. *
  559. 9999 CONTINUE
  560. IRET=1
  561. WRITE(IOIMP,*) 'An error was detected in subroutine trialu.eso'
  562. RETURN
  563. *
  564. * End of subroutine TRIALU
  565. *
  566. END
  567.  
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  

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