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

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