Télécharger prcont.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCONT SOURCE GOUNAND 17/12/05 21:17:05 9645
  2. ************************************************************************
  3. * NOM : PRCONT
  4. * DESCRIPTION : Construit le contour d'un objet maillage
  5. * (fonctionne suivant un principe inspire de TRAC)
  6. ************************************************************************
  7. * APPELE PAR : pilot.eso
  8. ************************************************************************
  9. * ENTREES :: aucune
  10. * SORTIES :: aucune
  11. ************************************************************************
  12. * SYNTAXE (GIBIANE) :
  13. *
  14. * GEO1 = CONTOUR ('NOID') (|'EXTE'|) GEO2 ;
  15. * |'INTE'|
  16. * |'TOUT'|
  17. *
  18. ************************************************************************
  19. SUBROUTINE PRCONT
  20.  
  21. IMPLICIT INTEGER(I-N)
  22.  
  23. -INC CCOPTIO
  24. -INC CCGEOME
  25. -INC SMELEME
  26. -INC SMCOORD
  27. -INC CCASSIS
  28.  
  29. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  30. SEGMENT IDCP(ITE)
  31. SEGMENT KON(NBCON,NMAX,3)
  32.  
  33. CHARACTER*8 CHAIN1
  34.  
  35. PARAMETER(NMOT1=3,NMOT2=1)
  36. CHARACTER*4 LMOT1(NMOT1),LMOT2(NMOT2)
  37. DATA LMOT1/'EXTE','INTE','TOUT'/
  38. DATA LMOT2/'NOID'/
  39.  
  40.  
  41. * +---------------------------------------------------------------+
  42. * | L E C T U R E D E S A R G U M E N T S |
  43. * +---------------------------------------------------------------+
  44.  
  45. * LECTURE DES MOTS-CLES FACULTATIFS
  46. CALL LIRMOT(LMOT1,NMOT1,IMOT1,0)
  47. IF (IMOT1.EQ.0) IMOT1=1
  48. CALL LIRMOT(LMOT2,NMOT2,IMOT2,0)
  49.  
  50. * LECTURE DU MAILLAGE
  51. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  52. IF (IERR.NE.0) RETURN
  53. IPT8=MELEME
  54.  
  55. * ON VA VERIFIER QUE LE CONTOUR DEMANDE N'A PAS DEJA ETE CONSTRUIT
  56. SEGACT,MELEME
  57. IF (LISREF(/1).EQ.1.AND.IMOT1.EQ.1) THEN
  58. IPT1=LISREF(1)
  59. CALL ECROBJ('MAILLAGE',IPT1)
  60. SEGDES,MELEME
  61. RETURN
  62. ENDIF
  63.  
  64. * +---------------------------------------------------------------+
  65. * | C O N N E C T I V I T E D U M A I L L A G E |
  66. * +---------------------------------------------------------------+
  67. *
  68. * REMPLISSAGE DES TABLEAUX DE CORRESPONDANCE LOCALE/GLOBALE AVEC
  69. * SEULEMENT LES NOEUDS SOMMETS (i.e. PAS DE NOEUDS MILIEUX)
  70. * **************************************************************
  71.  
  72. SEGACT,MCOORD
  73. igr=xcoor(/1)/(idim+1)+1
  74. SEGINI,ICPR
  75. ITE=0
  76. IPT1=MELEME
  77. DO 3 I=1,MAX(1,LISOUS(/1))
  78. IF (LISOUS(/1).NE.0) THEN
  79. IPT1=LISOUS(I)
  80. SEGACT,IPT1
  81. ENDIF
  82. K=IPT1.ITYPEL
  83.  
  84. * Le test ci-dessous filtre les elements non surfaciques
  85. IF (K.NE.KSURF(K)) GOTO 8
  86.  
  87. * Parcours des noeuds situes aux sommets de tous les elements
  88. IDEP=NSPOS(K)
  89. IF (NBSOM(K).GT.0) THEN
  90. IFEP=IDEP+NBSOM(K)-1
  91. ELSE
  92. * Cas particulier de l'element POLYgone
  93. IFEP=IDEP+IPT1.NUM(/1)-1
  94. ENDIF
  95. IF (IFEP.LT.IDEP) GOTO 8
  96. DO 4 JJ=IDEP,IFEP
  97. J=IBSOM(JJ)
  98. DO 401 K=1,IPT1.NUM(/2)
  99. IPOIT=IPT1.NUM(J,K)
  100. IF (ICPR(IPOIT).NE.0) GOTO 7
  101. ITE=ITE+1
  102. ICPR(IPOIT)=ITE
  103. 7 CONTINUE
  104. 401 CONTINUE
  105. 4 CONTINUE
  106. 8 CONTINUE
  107. 3 CONTINUE
  108. *
  109. IF (ITE.EQ.0) THEN
  110. SEGSUP,ICPR
  111. CALL ERREUR(16)
  112. RETURN
  113. ENDIF
  114. *
  115. SEGINI,IDCP
  116. DO 40 I=1,ICPR(/1)
  117. IF (ICPR(I).EQ.0) GOTO 40
  118. IDCP(ICPR(I))=I
  119. 40 CONTINUE
  120.  
  121.  
  122. * REMPLISSAGE DU TABLEAU DE CONNECTIVITE VIA LES ARETES KON(I,J,K)
  123. * ******************************************************************
  124. * => KON(I,J,K) CONTIENT LES INFORMATIONS ASSOCIEES A LA I-EME
  125. * ARETE CONNECTEE AU J-EME NOEUD (NUMEROTATION LOCALE)
  126. * K=1 NOEUD A L'AUTRE EXTREMITE DE L'ARETE
  127. * K=2 NOEUD MILIEU (=1 POUR LES ELT D'ORDRE 1)
  128. * K=3 DESIGNE LA COULEUR DE L'ARETE + 1
  129. *
  130. * => I EST COMPRIS ENTRE 1 ET NBCON=7, OR IL PEUT Y AVOIR BEAUCOUP
  131. * PLUS D'ARETES CONNECTEES A UN NOEUD J DONNE
  132. * SOLUTION : LA 7EME ARETE EST STOCKEE DANS DANS KON(1,L,K) AVEC
  133. * L=KON(7,J,1) ET AINSI DE SUITE POUR LES SUIVANTES
  134. * (CE QUI EXPLIQUE QUE J VARIE DE 1 A NMAX>ITE)
  135. *
  136. * => LE SIGNE DEVANT LE NUMERO DU NOEUD MILIEU (K=2) PEUT ETRE
  137. * POSITIF OU NEGATIF SELON LE SENS DE PARCOURS DU CONTOUR
  138. *
  139. * => LA DEUXIEME FOIS QU'UNE ARETE EST RENCONTREE, LE NUMERO DU
  140. * NOEUD D'EXTREMITE (K=1) DEVIENT NEGATIF => ARETE HORS CONTOUR
  141. *
  142. * => LA TROISIEME FOIS QU'UNE ARETE EST RECONTREE, LE NUMERO DE LA
  143. * COULEUR (K=3) DEVIENT NEGATIF => CONTOUR INTERNE DETECTE
  144. * ******************************************************************
  145. NBCON=7
  146. NBCONR=NBCON-1
  147. NMAX=(10*ITE)/NBCON
  148. SEGINI,KON
  149.  
  150. * NBNN designe le nombre de noeuds par arete (type = SEG2 ou SEG3)
  151. * COMPT est incremente des qu'on recontre un nouveau type de segment
  152. NBNN=0
  153. COMPT=0
  154.  
  155. * ICHAIN est l'indice J "apres debordement" permettant de definir
  156. * plus de 6 aretes pour un meme noeud
  157. ICHAIN=ITE
  158.  
  159. * BOUCLE SUR LES SOUS-MAILLAGES ELEMENTAIRES
  160. IPT1=MELEME
  161. DO 30 IO=1,MAX(1,LISOUS(/1))
  162. IF (LISOUS(/1).NE.0) IPT1=LISOUS(IO)
  163.  
  164. K=IPT1.ITYPEL
  165.  
  166. * Le test ci-dessous filtre les sous-maillages non surfaciques
  167. IF (K.NE.KSURF(K)) GOTO 21
  168.  
  169. * Reperage des indices de debut/fin de parcours de tous les
  170. * noeuds de la face (tableau LFAC)
  171. KK=LTEL(2,K)
  172. ITYP=LDEL(1,KK)
  173. IF (NBNN.NE.KDEGRE(K)) THEN
  174. NBNN=KDEGRE(K)
  175. COMPT=COMPT+1
  176. ENDIF
  177. IPAS=NBNN-1
  178. IDEP=LDEL(2,KK)
  179. IF (ITYP.NE.6) THEN
  180. IFEP=IDEP+KDFAC(1,ITYP)-1
  181. * [SG 2016-07-11] Pour les faces TRI7 et QUA9, on ignore le
  182. * dernier point (centre de la face)
  183. IF (ITYP.EQ.7.OR.ITYP.EQ.8) IFEP=IFEP-1
  184. ELSE
  185. * Cas particulier de l'element POLYgone
  186. IFEP= IDEP+IPT1.NUM(/1)-1
  187. ENDIF
  188.  
  189. * PARCOURS DES NOEUDS SOMMETS DE TOUS LES ELEMENTS
  190. DO 22 I=1,IPT1.NUM(/2)
  191. DO 221 J=IDEP,IFEP,IPAS
  192.  
  193. * DETERMINATION DES CARACTERISTIQUES DE L'ARETE
  194. * => NI=sommet courant
  195. * => NJ=sommet a l'autre extremite de l'arete
  196. * => NMIL=noeud milieu si existant (ou alors IGR)
  197. * => KSCOL=couleur+1
  198. NMIL=IGR
  199. * (VALEUR QUI PERMET DE DISTINGUER SEG2 ET SEG3 CAR LE
  200. * igr n'est pas un numero de noeud possible
  201. N1=ICPR(IPT1.NUM(LFAC(J),I))
  202. JSUIV=J+IPAS
  203. IF (JSUIV.GT.IFEP) JSUIV=IDEP
  204. N2=ICPR(IPT1.NUM(LFAC(JSUIV),I))
  205. IF (IPAS.EQ.2) NMIL=IPT1.NUM(LFAC(J+1),I)
  206. NI=N1
  207. NJ=N2
  208. IF (N1*N2.EQ.0) THEN
  209. CALL ERREUR(26)
  210. SEGSUP,KON,ICPR,IDCP
  211. SEGDES,MELEME
  212. RETURN
  213. ENDIF
  214. KSCOL=IPT1.ICOLOR(I)+1
  215.  
  216. * PARCOURS DU TABLEAU KON POUR Y AJOUTER L'ARETE COURANTE,
  217. * OU POUR INDIQUER QU'ON L'A VUE 2 OU 3 FOIS
  218. * (en cas d'ajout, IPO permet d'ajouter aussi dans KON
  219. * l'arete parcourue en sens inverse)
  220. IPO=0
  221. 23 CONTINUE
  222.  
  223. * On cherche si l'arete existe deja, ou bien sinon la
  224. * premiere place libre pour l'ajouter
  225. 24 DO 25 K=1,NBCONR
  226. IF (KON(K,NI,1).EQ.0) GOTO 26
  227. IF (ABS(KON(K,NI,1)).EQ.NJ.AND.
  228. > ABS(KON(K,NI,2)).EQ.abs(NMIL)) GOTO 27
  229. 25 CONTINUE
  230. * Au-dela de I=6 : soit on a trouve une place libre, soit
  231. * on continue a parcourir KON a l'indice J de "debordement"
  232. * (car il y a deja au moins 7 aretes associees a NI)
  233. IF (KON(NBCON,NI,1).EQ.0) GOTO 28
  234. NI=KON(NBCON,NI,1)
  235. GOTO 24
  236.  
  237. * ON AVAIT DEJA RENCONTRE CETTE ARETE...
  238. 27 CONTINUE
  239. IF (KON(K,NI,1).GT.0) THEN
  240. * ...UNE SEULE FOIS => ON L'EXCLUT DU CONTOUR
  241. KON(K,NI,1)=-NJ
  242. ELSE
  243. * ...AU MOINS 2 FOIS => ON L'AJOUTE AU CONTOUR INTERNE
  244. KON(K,NI,3)=-KSCOL
  245. ENDIF
  246. GOTO 29
  247.  
  248. * ARETE JAMAIS RENCONTREE : AJOUT A LA PREMIERE PLACE LIBRE
  249. 26 KON(K,NI,1)=NJ
  250. KON(K,NI,2)=NMIL
  251. KON(K,NI,3)=KSCOL
  252. GOTO 29
  253.  
  254. * ARETE JAMAIS RENCONTREE, MAIS LA PREMIERE PLACE LIBRE
  255. * SE TROUVE DANS LE PROCHAIN BLOC DE 6
  256. 28 ICHAIN=ICHAIN+1
  257. IF (ICHAIN.GE.NMAX) THEN
  258. NMAX=NMAX*2
  259. SEGADJ,KON
  260. ENDIF
  261. KON(NBCON,NI,1)=ICHAIN
  262. K=1
  263. NI=ICHAIN
  264. GOTO 26
  265.  
  266. * A CHAQUE FOIS QU'UNE NOUVELLE ARETE EST RENCONTREE, ON
  267. * AJOUTE AUSSI DANS KON CELLE PARCOURUE EN SENS INVERSE
  268. 29 IF (IPO.EQ.1) GOTO 221
  269. NMIL=-NMIL
  270. NI=N2
  271. NJ=N1
  272. IPO=1
  273. GOTO 23
  274. 221 CONTINUE
  275. 22 CONTINUE
  276.  
  277. 21 CONTINUE
  278. IF (LISOUS(/1).NE.0) SEGDES,IPT1
  279.  
  280. 30 CONTINUE
  281.  
  282. * WARNING : contour complexe detecte (SEG2 et SEG3)
  283. IF (COMPT.GT.1) CALL ERREUR(-333)
  284.  
  285. * ####################################################
  286. * IMPRESSIONS POUR DEBUGAGE (OPTI 'IMPI')
  287. IF (IIMPI.NE.0) THEN
  288.  
  289. * CONTENU DU TABLEAU ICPR
  290. WRITE(IOIMP,FMT='("ICPR(",I7,")=",I7)')(I,ICPR(I),I=1,ICPR(/1))
  291. WRITE(IOIMP,*) '********************'
  292.  
  293. * CONTENU DU TABLEAU IDCP
  294. WRITE(IOIMP,FMT='("IDCP(",I7,")=",I7)')(I,IDCP(I),I=1,IDCP(/1))
  295. WRITE(IOIMP,*) '********************'
  296.  
  297. * CONTENU DU TABLEAU KON
  298. IF (IIMPI.EQ.2) THEN
  299. DO J=1,NMAX
  300. WRITE(IOIMP,FMT='(A,I7,A,I7)') 'J=',J,'/',NMAX
  301. WRITE(IOIMP,FMT='(3I7)') ((KON(I,J,K),K=1,3),I=1,NBCON)
  302. ENDDO
  303. ENDIF
  304.  
  305. * ON VERIFIE SI CHAQUE NOEUD DU CONTOUR EST BIEN RELIE UNIQUEMENT
  306. * A DEUX ELEMENTS
  307. NNOEUD=0
  308. CHAIN1='NODE'
  309. DO 70 NI=1,ITE
  310. NINTT=NI
  311. NKON=0
  312. 72 CONTINUE
  313. DO 71 J=1,NBCONR
  314. IF (KON(J,NINTT,1).EQ.0) GOTO 71
  315. IF (KON(J,NINTT,1).GT.0) NKON=NKON+1
  316. 71 CONTINUE
  317. IF (KON(NBCON,NINTT,1).NE.0) THEN
  318. NINTT=KON(NBCON,NINTT,1)
  319. GOTO 72
  320. ENDIF
  321. IF (NKON.GT.2) THEN
  322. NNOEUD=NNOEUD+1
  323. JP1=IDCP(NI)
  324. NNO=NNOEUD
  325. IF (NNO.LE.9) THEN
  326. WRITE(CHAIN1(5:5),FMT='(I1)') NNO
  327. ELSEIF(NNO.LE.99) THEN
  328. WRITE(CHAIN1(5:6),FMT='(I2)') NNO
  329. ELSEIF(NNO.LE.999) THEN
  330. WRITE(CHAIN1(5:7),FMT='(I3)') NNO
  331. ELSEIF(NNO.LE.9999) THEN
  332. WRITE(CHAIN1(5:8),FMT='(I4)') NNO
  333. ELSEIF(NNO.LE.99999) THEN
  334. WRITE(CHAIN1(4:8),FMT='(I5)') NNO
  335. ELSEIF(NNO.LE.999999) THEN
  336. WRITE(CHAIN1(3:8),FMT='(I6)') NNO
  337. ENDIF
  338. CALL NOMOBJ('POINT',CHAIN1,JP1)
  339. MOTERR(1:8)=CHAIN1
  340. INTERR(1)=NKON
  341. CALL ERREUR(-335)
  342. ENDIF
  343. 70 CONTINUE
  344.  
  345. ENDIF
  346. * ####################################################
  347.  
  348. SEGDES,MELEME
  349. SEGSUP,ICPR
  350.  
  351.  
  352. * CREATION DU MAILLAGE CONTENANT LE CONTOUR
  353. * *****************************************
  354.  
  355.  
  356. * ON COMMENCE PAR COMPTER LE NOMBRE D'ELEMENTS DU CONTOUR
  357. NBELEM2=0
  358. NBELEM3=0
  359. DO 41 J=1,ITE
  360. JJ=J
  361. 43 DO 42 I=1,NBCONR
  362. KON1=KON(I,JJ,1)
  363. KON3=KON(I,JJ,3)
  364. if (kon1.eq.0) goto 42
  365. IF ((IMOT1.EQ.3.AND.KON1.LT.0.AND.KON3.GT.0)
  366. & .OR.(IMOT1.EQ.2.AND.(KON1.GT.0.OR.KON3.GT.0))
  367. & .OR.(IMOT1.EQ.1.AND.KON1.LT.0)) GOTO 42
  368. * noeud milieu or not noeud milieu?
  369. if (abs(kon(i,jj,2)).eq.igr) then
  370. nbelem2=nbelem2+1
  371. else
  372. nbelem3=nbelem3+1
  373. endif
  374. 42 CONTINUE
  375. IF (KON(NBCON,JJ,1).EQ.0) GOTO 41
  376. JJ=KON(NBCON,JJ,1)
  377. GOTO 43
  378. 41 CONTINUE
  379. * on a compte les aretes une fois dans chaque sens
  380. NBELEM2=NBELEM2/2
  381. NBELEM3=NBELEM3/2
  382. IF (IIMPI.NE.0) WRITE(IOIMP,1111) NBELEM2,nbelem3
  383. 1111 FORMAT(' NOMBRE D''ELEMENTS DU CONTOUR : ',2I6)
  384.  
  385. IF (NBELEM2+nbelem3.EQ.0) THEN
  386. IF (IMOT2.EQ.0) THEN
  387. MELEME=0
  388. CALL ERREUR(26)
  389. GOTO 64
  390. ELSE
  391. NBELEM=0
  392. NBNN=2
  393. NBSOUS=0
  394. NBREF=0
  395. SEGINI MELEME
  396. ITYPEL=NBNN
  397. GOTO 66
  398. ENDIF
  399. ENDIF
  400.  
  401. * CREATION DES meleme elementaires
  402. NBELem=nbelem2
  403. NBNN=2
  404. NBSOUS=0
  405. NBREF=0
  406. if (nbelem.ne.0) then
  407. SEGINI,IPT2
  408. ipt2.ITYPEL=NBNN
  409. endif
  410. NBELem=nbelem3
  411. NBNN=3
  412. if (nbelem.ne.0) then
  413. SEGINI,IPT3
  414. ipt3.ITYPEL=NBNN
  415. endif
  416.  
  417. * REMPLISSAGE SELON L'OPTION IMOT1 DEMANDEE (EXTE, INTE, TOUT)
  418. IEL2=0
  419. IEL3=0
  420.  
  421. * Recherche d'une arete pas encore ajoutee au contour
  422. KAUX=0
  423. 53 KAUX=KAUX+1
  424. IF (KAUX.EQ.ITE+1) GOTO 63
  425. KPRESS=KAUX
  426. ideb=1
  427. * Recherche de l'arete suivante
  428. 57 CONTINUE
  429. DO 56 L=1,NBCONR
  430. M=KON(L,K,1)
  431. IF (M.EQ.0) GOTO 56
  432. M2=KON(L,K,2)
  433. ** IF (M2.LT.0) GOTO 56
  434. M3=KON(L,K,3)
  435. IF ((IMOT1.EQ.1.AND.M.LT.0) .OR.
  436. & (IMOT1.EQ.2.AND.(M.GT.0.OR.M3.GT.0)))GOTO 56
  437. IF (IMOT1.EQ.3.AND.M.LT.0.AND.M3.GT.0) GOTO 56
  438. GOTO 58
  439. 56 CONTINUE
  440. K=KON(NBCON,K,1)
  441. IF (K.EQ.0) GOTO 53
  442. GOTO 57
  443.  
  444. * Ajout d'un element SEG2 ou SEG3 joignant KPRESS a M
  445. 58 CONTINUE
  446. IF (ABS(M2).eq.IGR) then
  447. iel2=iel2+1
  448. ** write (6,*) 'iel2 nbelem2 ',iel2,nbelem2,m,m2,m3
  449. if (iel2.GT.nbelem2) then
  450. call erreur(5)
  451. return
  452. endif
  453. ipt2.NUM(1,IEL2)=IDCP(KPRESS)
  454. ipt2.NUM(2,IEL2)=IDCP(abs(m))
  455. ipt2.icolor(iel2)=abs(m3)-1
  456. ELSE
  457. iel3=iel3+1
  458. ** write (6,*) 'iel3 nbelem3 ',iel3,nbelem3,m,m2,m3
  459. if (iel3.GT.nbelem3) then
  460. call erreur(5)
  461. return
  462. endif
  463. ipt3.NUM(1,IEL3)=IDCP(KPRESS)
  464. IPT3.NUM(2,IEL3)=ABS(M2)
  465. ipt3.NUM(3,IEL3)=IDCP(abs(m))
  466. ipt3.icolor(iel3)=abs(m3)-1
  467. ENDIF
  468.  
  469. * On met a 0 KON(*,*,1) pour indiquer que l'element
  470. * a deja ete ajoute au contour
  471.  
  472. KON(L,K,1)=0
  473. ** write (6,*) 'mise a zero directe ',l,k
  474. * Idem, pour l'arete parcourue en sens inverse...
  475. M1=ABS(M)
  476. 59 DO 60 L=1,NBCONR
  477. IF (ABS(KON(L,M1,2)).NE.ABS(M2)) GOTO 60
  478. IF (KON(L,M1,1).EQ.0) GOTO 60
  479. IF (ABS(KON(L,M1,1)).EQ.KPRESS) GOTO 61
  480. 60 CONTINUE
  481. M1=KON(NBCON,M1,1)
  482. IF (M1.EQ.0) then
  483. ** write (6,*) ' rien a mettre a zero apres 60 '
  484. GOTO 62
  485. endif
  486. GOTO 59
  487. 61 KON(L,M1,1)=0
  488. ** write (6,*) 'mise a zero inverse ',l,m1
  489. 62 CONTINUE
  490. * si on est en debut de chaine, on inverse eventuellement l'arete
  491. if (ideb.eq.1.and.m2.lt.0) then
  492. if (abs(m2).eq.IGR) then
  493. it=ipt2.num(1,iel2)
  494. ipt2.num(1,iel2)=ipt2.num(2,iel2)
  495. ipt2.num(2,iel2)=it
  496. else
  497. it=ipt3.num(1,iel3)
  498. ipt3.num(1,iel3)=ipt3.num(3,iel3)
  499. ipt3.num(3,iel3)=it
  500. endif
  501. else
  502. KPRESS=abs(m)
  503. endif
  504. * ...puis on continue de suivre le contour
  505. ideb=0
  506. GOTO 57
  507. 63 CONTINUE
  508. *
  509. * on cree le chapeau correct si il y a lieu
  510. *
  511. if (nbelem2.eq.0) then
  512. meleme=ipt3
  513. elseif(nbelem3.eq.0) then
  514. meleme=ipt2
  515. else
  516. nbnn=0
  517. nbelem=0
  518. nbsous=2
  519. nbref=0
  520. segini meleme
  521. lisous(1)=ipt2
  522. lisous(2)=ipt3
  523. segdes ipt2,ipt3
  524. endif
  525. 66 continue
  526. segdes meleme
  527. CALL ECROBJ('MAILLAGE',MELEME)
  528.  
  529. * ON INSCRIT SEULEMENT LE CONTOUR EXTERIEUR DANS LES
  530. * REFERENCES DU MAILLAGE INITIAL
  531. SEGACT,IPT8
  532. IF (IPT8.LISREF(/1).EQ.0.AND.IMOT1.EQ.1) THEN
  533. NBREF=1
  534. NBNN=IPT8.NUM(/1)
  535. NBELEM=IPT8.NUM(/2)
  536. NBSOUS=IPT8.LISOUS(/1)
  537. SEGADJ,IPT8
  538. IPT8.LISREF(1)=MELEME
  539. ENDIF
  540. SEGDES,IPT8
  541.  
  542.  
  543.  
  544. 64 CONTINUE
  545. SEGSUP,KON,IDCP
  546. RETURN
  547. END
  548.  
  549.  
  550.  
  551.  
  552.  

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