Télécharger com443.eso

Retour à la liste

Numérotation des lignes :

  1. C COM443 SOURCE JC220346 16/11/29 21:15:05 9221
  2. C---------------------------------------------------------------------|
  3. C |
  4. SUBROUTINE COM443(II,MF1,MF2,MF3,IGAGNE)
  5. C |
  6. C CETTE SUBROUTINE TENTE DE CREER 2 PYRAMIDES ET 1 TETRAEDRE |
  7. C A PARTIR DES QUADRANGLES IF1, IF2 ET DU TRIANGLE IF3 EN |
  8. C CREANT UN POINT |
  9. C CENTRAL SUPPLEMENTAIRE |
  10. C - IGAGNE=1 EN CAS DE SUCCES |
  11. C - IGAGNE=0 EN CAS D'ECHEC |
  12. C |
  13. C---------------------------------------------------------------------|
  14. C
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8(A-H,O-Z)
  17. -INC TDEMAIT
  18. -INC CCOPTIO
  19. LOGICAL REPONS,FACET,SOLPYR,SOLTET,IN2,diago
  20. nfcini=nfcmax
  21. nptini=nptmax
  22. nvini=nvol
  23. ICTP=0
  24. ipin = 0
  25. C
  26. C METTRE LES FACES DANS L'ORDRE
  27. IF3=MF3
  28. IP=ISUCC(IF3,II)
  29. IF (IP.EQ.IPRED(MF1,II)) IF1=MF1
  30. IF (IP.EQ.IPRED(MF2,II)) IF1=MF2
  31. IP=ISUCC(IF1,II)
  32. IF (IP.EQ.IPRED(MF1,II)) IF2=MF1
  33. IF (IP.EQ.IPRED(MF2,II)) IF2=MF2
  34. * WRITE(6,1000)IF1,IF2,IF3
  35. 1000 FORMAT(' COM443 IF1=',I5,' IF2=',I5,' IF3=',I5)
  36. C
  37. ICTF=0
  38. ICTV=0
  39. C
  40. C
  41. C CREATION DU POINT CENTRAL : IP
  42. C ------------------------------
  43. IP1=II
  44. IP2=ISUCC(IF1,IP1)
  45. IP3=ISUCC(IF1,IP2)
  46. IP4=ISUCC(IF1,IP3)
  47. ICTP=1
  48. NPTMAX=NPTMAX+1
  49. IP=NPTMAX
  50. C
  51. DO 100 I=1,4
  52. * XYZ(I,IP)=(XYZ(I,IP1)+XYZ(I,IP2)+XYZ(I,IP3)
  53. * # +XYZ(I,IP4))/4.
  54. XYZ(I,IP)=(XYZ(I,IP2)+XYZ(I,IP4))/2.
  55. 100 CONTINUE
  56. JP1=II
  57. JP2=ISUCC(IF2,JP1)
  58. JP3=ISUCC(IF2,JP2)
  59. JP4=ISUCC(IF2,JP3)
  60. C
  61. DO 102 I=1,4
  62. * XYZ(I,IP)=XYZ(I,IP)+
  63. * # (XYZ(I,JP1)+XYZ(I,JP2)+XYZ(I,JP3)+XYZ(I,JP4))/4.
  64. XYZ(I,IP)=XYZ(I,IP)+
  65. # (XYZ(I,JP2)+XYZ(I,JP4))/2.
  66. 102 CONTINUE
  67. KP1=II
  68. KP2=ISUCC(IF3,KP1)
  69. KP3=ISUCC(IF3,KP2)
  70. C
  71. DO 104 I=1,4
  72. XYZ(I,IP)=(XYZ(I,IP)+
  73. # (XYZ(I,KP2)+XYZ(I,KP3))/2.)/3.
  74. 104 CONTINUE
  75. DO 103 I=1,3
  76. XYZ(I,IP)=XYZ(I,II)+expcom*(XYZ(I,IP)-XYZ(I,II))
  77. 103 CONTINUE
  78. C
  79. * WRITE(6,1010)IP,(XYZ(I,IP),I=1,4)
  80. 1010 FORMAT(' POINT:',I3,':',4F7.2)
  81. * verif des volumes
  82. if ((vol(ip,ii,ip2,ip4).gt.0).or.
  83. > (vol(ip,ii,jp2,jp4).gt.0).or.
  84. > (vol(ip,ii,kp2,kp3).gt.0)) then
  85. IF (IVERB.EQ.1) write (6,*) ' com443 volume positif '
  86. nptmax=nptini
  87. return
  88. endif
  89. C
  90. CALL DIST(IP,JP,GL,IOK,IP1,IP2,IP3,IP4,JP2,JP3,JP4,KP2,KP3,0)
  91. IF (IOK.EQ.0) THEN
  92. NPTMAX=NPTini
  93. RETURN
  94. ICTP=0
  95. NPTMAX=NPTMAX-1
  96. IP=JP
  97. * WRITE (6,*) ' COM443 POINT ASSIMILE ',JP
  98. ENDIF
  99. REPONS=IN2(ii,IP,nfcini)
  100. IF (REPONS) GOTO 110
  101. NPTMAX=NPTini
  102. RETURN
  103. C
  104. 110 CONTINUE
  105. C
  106. C CREATION D'UNE PYRAMIDE : IF1+IP
  107. C --------------------------------
  108. IP1=ISUCC(IF1,II)
  109. IP2=ISUCC(IF1,IP1)
  110. IP3=ISUCC(IF1,IP2)
  111. * recherche existence de la face
  112. jf1=IFACE3(ip,ii,ip1)
  113. * IF (jf1.ne.0) write (6,*) ' com443 facette assimilee'
  114. IF (jf1.eq.0) THEN
  115. nfcmax=nfcmax+1
  116. jf1=nfcmax
  117. NFC(1,jf1)=ip
  118. NFC(2,jf1)=ii
  119. NFC(3,jf1)=ip1
  120. NFC(4,jf1)=0
  121. elseif (NFC(4,jf1).ne.0.or.ipred(jf1,ip).ne.ii) then
  122. jf1=0
  123. endif
  124. * write (6,*) ' com443 jf1 passe ',jf1
  125. C
  126. * recherche existence de la face
  127. jf2=IFACE3(ip,ip1,ip2)
  128. * IF (jf2.ne.0) write (6,*) ' com443 facette assimilee'
  129. IF (jf2.eq.0) THEN
  130. nfcmax=nfcmax+1
  131. jf2=nfcmax
  132. NFC(1,jf2)=ip
  133. NFC(2,jf2)=ip1
  134. NFC(3,jf2)=ip2
  135. NFC(4,jf2)=0
  136. elseif (NFC(4,jf2).ne.0.or.ipred(jf2,ip).ne.ip1) then
  137. jf2=0
  138. endif
  139. * write (6,*) ' com443 jf2 passe ',jf2
  140. C
  141. * recherche existence de la face
  142. jf3=IFACE3(ip,ip2,ip3)
  143. * IF (jf3.ne.0) write (6,*) ' com443 facette assimilee'
  144. IF (jf3.eq.0) THEN
  145. nfcmax=nfcmax+1
  146. jf3=nfcmax
  147. NFC(1,jf3)=ip
  148. NFC(2,jf3)=ip2
  149. NFC(3,jf3)=ip3
  150. NFC(4,jf3)=0
  151. elseif (NFC(4,jf3).ne.0.or.ipred(jf3,ip).ne.ip2) then
  152. jf3=0
  153. endif
  154. * write (6,*) ' com443 jf3 passe ',jf3
  155. C
  156. * recherche existence de la face
  157. jf4=IFACE3(ip,ip3,ii)
  158. * IF (jf4.ne.0) write (6,*) ' com443 facette assimilee'
  159. IF (jf4.eq.0) THEN
  160. nfcmax=nfcmax+1
  161. jf4=nfcmax
  162. NFC(1,jf4)=ip
  163. NFC(2,jf4)=ip3
  164. NFC(3,jf4)=ii
  165. NFC(4,jf4)=0
  166. elseif (NFC(4,jf4).ne.0.or.ipred(jf4,ip).ne.ip3) then
  167. jf4=0
  168. endif
  169. * write (6,*) ' com443 jf4 passe ',jf4
  170. C
  171. if (diago(ip,ii,diacrd)) then
  172. jf4=0
  173. jf1=0
  174. endif
  175. if (diago(ip,ip1,diacrd)) then
  176. jf1=0
  177. jf2=0
  178. endif
  179. if (diago(ip,ip2,diacrd)) then
  180. jf2=0
  181. jf3=0
  182. endif
  183. if (diago(ip,ip3,diacrd)) then
  184. jf3=0
  185. jf4=0
  186. endif
  187. if (jf1*jf2*jf3*jf4.eq.0) then
  188. * write (6,*) 'com443 impossibilite '
  189. nfcmax=nfcini
  190. jf1=0
  191. jf2=0
  192. jf3=0
  193. jf4=0
  194. goto 131
  195. endif
  196. CALL REPSUB(IF1)
  197. CALL REPSUB(JF1)
  198. CALL REPSUB(JF2)
  199. CALL REPSUB(JF3)
  200. CALL REPSUB(JF4)
  201. C
  202. C LE VOLUME CREE EST-IL VALIDE ?
  203. C ------------------------------
  204. IF (.not.SOLPYR(IF1,JF1,JF2,JF3,JF4)) GOTO 129
  205. IF (.NOT.FACET(jF1)) GOTO 129
  206. IF (.NOT.FACET(jF2)) GOTO 129
  207. IF (.NOT.FACET(jF3)) GOTO 129
  208. IF (.NOT.FACET(jF4)) GOTO 129
  209. goto 130
  210. C
  211. C LE VOLUME EST INVALIDE
  212. C ----------------------
  213. 129 continue
  214. * write (6,*) ' solpyr 1 invalide'
  215. NFCMAX=NFCini
  216. CALL REPSUB(JF4)
  217. CALL REPSUB(JF3)
  218. CALL REPSUB(JF2)
  219. CALL REPSUB(JF1)
  220. CALL REPSUB(IF1)
  221. jf1=0
  222. jf2=0
  223. jf3=0
  224. jf4=0
  225. goto 131
  226. C
  227. 130 CONTINUE
  228. C
  229. C MEMORISATION DU VOLUME OBTENU : IF1, JF1, JF2, JF3 ET JF4
  230. C ---------------------------------------------------------
  231. ICTV=ICTV+1
  232. NVOL=NVOL+1
  233. IF (NFV(1,IF1).EQ.0) NFV(1,IF1)=NVOL
  234. IF (NFV(1,IF1).NE.NVOL) NFV(2,IF1)=NVOL
  235. IF (NFV(1,JF1).EQ.0) NFV(1,JF1)=NVOL
  236. IF (NFV(1,JF1).NE.NVOL) NFV(2,JF1)=NVOL
  237. IF (NFV(1,JF2).EQ.0) NFV(1,JF2)=NVOL
  238. IF (NFV(1,JF2).NE.NVOL) NFV(2,JF2)=NVOL
  239. IF (NFV(1,JF3).EQ.0) NFV(1,JF3)=NVOL
  240. IF (NFV(1,JF3).NE.NVOL) NFV(2,JF3)=NVOL
  241. IF (NFV(1,JF4).EQ.0) NFV(1,JF4)=NVOL
  242. IF (NFV(1,JF4).NE.NVOL) NFV(2,JF4)=NVOL
  243. IVOL(9,NVOL)=35
  244. C
  245. DO 140 I=1,4
  246. IVOL(I,NVOL)=NFC(I,IF1)
  247. 140 CONTINUE
  248. IVOL(5,NVOL)=IP
  249. *C
  250. * WRITE(6,1100)NVOL,(IVOL(I,NVOL),I=1,9)
  251. *1100 FORMAT(I4,4X,14I4)
  252. if (iimpi.eq.1) write (6,1100) nfacet,(ivol(i,nvol),i=1,5)
  253. 1100 FORMAT(' COM443-1 facettes ',i5,' PYR5 ',8i5)
  254. *C
  255. * DO 150 J=1,NPTMAX
  256. * WRITE(6,1110)J,(NPF(I,J),I=1,40)
  257. *1110 FORMAT(I4,4X,40I3)
  258. *150 CONTINUE
  259. C PV INC
  260. C
  261. 131 continue
  262. nfcini=nfcmax
  263. C 2EME VOLUME : IF2+IP
  264. C --------------------
  265. IP1=ISUCC(IF2,II)
  266. IP2=ISUCC(IF2,IP1)
  267. IP3=ISUCC(IF2,IP2)
  268. C
  269. * recherche existence de la face
  270. kf1=IFACE3(ip,ii,ip1)
  271. * IF (kf1.ne.0) write (6,*) ' com443 facette assimilee'
  272. IF (kf1.eq.0) THEN
  273. nfcmax=nfcmax+1
  274. kf1=nfcmax
  275. NFC(1,kf1)=ip
  276. NFC(2,kf1)=ii
  277. NFC(3,kf1)=ip1
  278. NFC(4,kf1)=0
  279. elseif (NFC(4,kf1).ne.0.or.ipred(kf1,ip).ne.ii) then
  280. kf1=0
  281. endif
  282. * write (6,*) ' com443 kf1 passe ',kf1
  283. C
  284. * recherche existence de la face
  285. kf2=IFACE3(ip,ip1,ip2)
  286. * IF (kf2.ne.0) write (6,*) ' com443 facette assimilee'
  287. IF (kf2.eq.0) THEN
  288. nfcmax=nfcmax+1
  289. kf2=nfcmax
  290. NFC(1,kf2)=ip
  291. NFC(2,kf2)=ip1
  292. NFC(3,kf2)=ip2
  293. NFC(4,kf2)=0
  294. elseif (NFC(4,kf2).ne.0.or.ipred(kf2,ip).ne.ip1) then
  295. kf2=0
  296. endif
  297. * write (6,*) ' com443 kf2 passe ',kf2
  298. C
  299. * recherche existence de la face
  300. kf3=IFACE3(ip,ip2,ip3)
  301. * IF (kf3.ne.0) write (6,*) ' com443 facette assimilee'
  302. IF (kf3.eq.0) THEN
  303. nfcmax=nfcmax+1
  304. kf3=nfcmax
  305. NFC(1,kf3)=ip
  306. NFC(2,kf3)=ip2
  307. NFC(3,kf3)=ip3
  308. NFC(4,kf3)=0
  309. elseif (NFC(4,kf3).ne.0.or.ipred(kf3,ip).ne.ip2) then
  310. kf3=0
  311. endif
  312. * write (6,*) ' com443 kf3 passe ',kf3
  313. C
  314. C ON RETOMBE SUR JF1 (si on ne l'a pas detruit)
  315. C
  316. kf4=IFACE3(ip,ip3,ii)
  317. * IF (kf4.ne.0) write (6,*) ' com443 facette deja existante'
  318. IF (kf4.eq.0) THEN
  319. nfcmax=nfcmax+1
  320. kf4=nfcmax
  321. NFC(1,kf4)=ip
  322. NFC(2,kf4)=ip3
  323. NFC(3,kf4)=ii
  324. NFC(4,kf4)=0
  325. elseif (NFC(4,kf4).ne.0.or.ipred(kf4,ip).ne.ip3) then
  326. kf4=0
  327. endif
  328. * write (6,*) ' com443 kf4 passe ',kf4
  329. C
  330. C
  331. if (diago(ip,ii,diacrd)) then
  332. kf4=0
  333. kf1=0
  334. endif
  335. if (diago(ip,ip1,diacrd)) then
  336. kf1=0
  337. kf2=0
  338. endif
  339. if (diago(ip,ip2,diacrd)) then
  340. kf2=0
  341. kf3=0
  342. endif
  343. if (diago(ip,ip3,diacrd)) then
  344. kf3=0
  345. kf4=0
  346. endif
  347. if (kf1*kf2*kf3*kf4.eq.0) then
  348. * write (6,*) 'com443 impossibilite '
  349. nfcmax=nfcini
  350. kf1=0
  351. kf2=0
  352. kf3=0
  353. kf4=0
  354. goto 161
  355. endif
  356. CALL REPSUB(IF2)
  357. CALL REPSUB(KF1)
  358. CALL REPSUB(KF2)
  359. CALL REPSUB(KF3)
  360. CALL REPSUB(KF4)
  361. C
  362. C LE VOLUME CREE EST-IL VALIDE ?
  363. C ------------------------------
  364. if (.not.SOLPYR(IF2,KF1,KF2,KF3,KF4)) GOTO 160
  365. IF (.NOT.FACET(KF1)) GOTO 160
  366. IF (.NOT.FACET(KF2)) GOTO 160
  367. IF (.NOT.FACET(KF3)) GOTO 160
  368. IF (.NOT.FACET(KF4)) GOTO 160
  369. goto 170
  370. C
  371. 160 CONTINUE
  372. C
  373. * write (6,*) ' solpyr 2 invalide'
  374. NFCMAX=NFCini
  375. CALL REPSUB(KF4)
  376. CALL REPSUB(KF3)
  377. CALL REPSUB(KF2)
  378. CALL REPSUB(KF1)
  379. CALL REPSUB(IF2)
  380. kf1=0
  381. kf2=0
  382. kf3=0
  383. kf4=0
  384. goto 161
  385. C
  386. 170 CONTINUE
  387. C
  388. C MEMORISATION DU VOLUME IF2, LF1, KF2, KF3 ET LF4
  389. C ------------------------------------------------
  390. ICTV=ICTV+1
  391. NVOL=NVOL+1
  392. IF (NFV(1,IF2).EQ.0) NFV(1,IF2)=NVOL
  393. IF (NFV(1,IF2).NE.NVOL) NFV(2,IF2)=NVOL
  394. IF (NFV(1,kF1).EQ.0) NFV(1,kF1)=NVOL
  395. IF (NFV(1,kF1).NE.NVOL) NFV(2,kF1)=NVOL
  396. IF (NFV(1,kF2).EQ.0) NFV(1,kF2)=NVOL
  397. IF (NFV(1,kF2).NE.NVOL) NFV(2,kF2)=NVOL
  398. IF (NFV(1,kF3).EQ.0) NFV(1,kF3)=NVOL
  399. IF (NFV(1,kF3).NE.NVOL) NFV(2,kF3)=NVOL
  400. IF (NFV(1,kF4).EQ.0) NFV(1,kF4)=NVOL
  401. IF (NFV(1,kF4).NE.NVOL) NFV(2,kF4)=NVOL
  402. IVOL(9,NVOL)=35
  403. C
  404. DO 180 I=1,4
  405. IVOL(I,NVOL)=NFC(I,IF2)
  406. 180 CONTINUE
  407. IVOL(5,NVOL)=IP
  408. * WRITE(6,1180)NVOL,(IVOL(I,NVOL),I=1,9)
  409. *1180 FORMAT(I4,4X,14I4)
  410. if (iimpi.eq.1) write (6,1180) nfacet,(ivol(i,nvol),i=1,5)
  411. 1180 FORMAT(' COM443-2 facettes ',i5,' PYR5 ',8i5)
  412. *C
  413. * DO 190 J=1,NPTMAX
  414. * WRITE(6,1190)J,(NPF(I,J),I=1,40)
  415. *1190 FORMAT(I4,4X,40I3)
  416. *190 CONTINUE
  417. C
  418. 161 continue
  419. nfcini=nfcmax
  420. C
  421. C 3EME VOLUME : IF3+IP
  422. C --------------------
  423. IP1=ISUCC(IF3,II)
  424. IP2=ISUCC(IF3,IP1)
  425. C ON RETOMBE SUR JF4 (si on ne l'a pas detruit)
  426. C
  427. lf1=IFACE3(ip,ii,ip1)
  428. * IF (lf1.ne.0) write (6,*) ' com443 facette deja existante'
  429. IF (lf1.eq.0) THEN
  430. nfcmax=nfcmax+1
  431. lf1=nfcmax
  432. NFC(1,lf1)=ip
  433. NFC(2,lf1)=ii
  434. NFC(3,lf1)=ip1
  435. NFC(4,lf1)=0
  436. elseif (NFC(4,lf1).ne.0.or.ipred(lf1,ip).ne.ii) then
  437. lf1=0
  438. endif
  439. * write (6,*) ' com443 lf1 passe ',lf1
  440. C
  441. C
  442. * recherche existence de la face
  443. lf2=IFACE3(ip,ip1,ip2)
  444. * IF (lf2.ne.0) write (6,*) ' com443 facette assimilee'
  445. IF (lf2.eq.0) THEN
  446. nfcmax=nfcmax+1
  447. lf2=nfcmax
  448. NFC(1,lf2)=ip
  449. NFC(2,lf2)=ip1
  450. NFC(3,lf2)=ip2
  451. NFC(4,lf2)=0
  452. elseif (NFC(4,lf2).ne.0.or.ipred(lf2,ip).ne.ip1) then
  453. lf2=0
  454. endif
  455. * write (6,*) ' com443 lf2 passe ',lf2
  456. C
  457. C ON RETOMBE SUR KF1 (si on ne l'a pas detruit)
  458. C
  459. lf3=IFACE3(ip,ip2,ii)
  460. * IF (lf3.ne.0) write (6,*) ' com443 facette deja existante'
  461. IF (lf3.eq.0) THEN
  462. nfcmax=nfcmax+1
  463. lf3=nfcmax
  464. NFC(1,lf3)=ip
  465. NFC(2,lf3)=ip2
  466. NFC(3,lf3)=ii
  467. NFC(4,lf3)=0
  468. elseif (NFC(4,lf3).ne.0.or.ipred(lf3,ip).ne.ip2) then
  469. lf3=0
  470. endif
  471. * write (6,*) ' com443 lf3 passe ',lf3
  472. C
  473. if (diago(ip,ii,diacrd)) then
  474. lf3=0
  475. lf1=0
  476. endif
  477. if (diago(ip,ip1,diacrd)) then
  478. lf1=0
  479. lf2=0
  480. endif
  481. if (diago(ip,ip2,diacrd)) then
  482. lf2=0
  483. lf3=0
  484. endif
  485. if (lf1*lf2*lf3.eq.0) then
  486. * write (6,*) 'com443 impossibilite '
  487. NFCMAX=NFCini
  488. goto 201
  489. endif
  490. C
  491. C
  492. CALL REPSUB(IF3)
  493. CALL REPSUB(LF1)
  494. CALL REPSUB(LF2)
  495. CALL REPSUB(LF3)
  496. C
  497. C LE VOLUME CREE EST-IL VALIDE ?
  498. C ------------------------------
  499. IF (.NOT.SOLTET(IF3,LF1,LF2,LF3,ipin)) GOTO 200
  500. IF (.NOT.FACET(LF1)) GOTO 200
  501. IF (.NOT.FACET(LF2)) GOTO 200
  502. IF (.NOT.FACET(LF3)) GOTO 200
  503. GOTO 210
  504. C
  505. 200 CONTINUE
  506. * write (6,*) ' soltet 3 invalide'
  507. C
  508. NFCMAX=NFCini
  509. CALL REPSUB(LF3)
  510. CALL REPSUB(LF2)
  511. CALL REPSUB(LF1)
  512. CALL REPSUB(IF3)
  513. goto 201
  514. C
  515. 210 CONTINUE
  516. C
  517. C MEMORISATION DU VOLUME IF3, JF2, KF1, LF1 ET LF2
  518. C ------------------------------------------------
  519. ICTV=ICTV+1
  520. NVOL=NVOL+1
  521. IF (NFV(1,IF3).EQ.0) NFV(1,IF3)=NVOL
  522. IF (NFV(1,IF3).NE.NVOL) NFV(2,IF3)=NVOL
  523. IF (NFV(1,lF1).EQ.0) NFV(1,lF1)=NVOL
  524. IF (NFV(1,lF1).NE.NVOL) NFV(2,lF1)=NVOL
  525. IF (NFV(1,lF2).EQ.0) NFV(1,lF2)=NVOL
  526. IF (NFV(1,lF2).NE.NVOL) NFV(2,lF2)=NVOL
  527. IF (NFV(1,lF3).EQ.0) NFV(1,lF3)=NVOL
  528. IF (NFV(1,lF3).NE.NVOL) NFV(2,lF3)=NVOL
  529. IVOL(9,NVOL)=25
  530. C
  531. DO 220 I=1,3
  532. IVOL(I,NVOL)=NFC(I,IF3)
  533. 220 CONTINUE
  534. IVOL(4,NVOL)=IP
  535. * WRITE(6,1240)NVOL,(IVOL(I,NVOL),I=1,9)
  536. *1240 FORMAT(I4,4X,14I4)
  537. if (iimpi.eq.1) write (6,1240) nfacet,(ivol(i,nvol),i=1,4)
  538. 1240 FORMAT(' COM443-3 facettes ',i5,' TET4 ',8i5)
  539. C
  540. * DO 230 J=1,NPTMAX
  541. * WRITE(6,1250)J,(NPF(I,J),I=1,40)
  542. *1250 FORMAT(I4,4X,40I3)
  543. *230 CONTINUE
  544. C
  545. 201 continue
  546. if (nvol.eq.nvini) then
  547. nptmax=nptini
  548. return
  549. endif
  550. C
  551. 290 CONTINUE
  552. C
  553. * if (iimpi.ne.0) write (6,*) ' comm443 point ',nptmax
  554. IGAGNE=1
  555. * CALL CONS33(IPRED(KF3,IP),IP,KF3,JF2,IGAG,1)
  556. RETURN
  557. C
  558. C FIN DE LA SUBROUTINE COM443
  559. END
  560.  
  561.  
  562.  
  563.  
  564.  

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