Télécharger reduaf.eso

Retour à la liste

Numérotation des lignes :

reduaf
  1. C REDUAF SOURCE PV090527 23/05/11 21:15:03 11668
  2.  
  3. C Reduction du champ par element jchelm sur le modele mmodtm
  4. C Le resultat est le champ par element mchel2 pour iret = 1 (KERRE=0),
  5. C sinon en cas d'erreur mchel2 = 0 pour iret = 0 (KERRE = num. erreur)
  6. C En sortie le champ mchel2 est un champ entierement actif.
  7. C (kich) en sortie mmodel deroule
  8.  
  9. SUBROUTINE REDUAF (jchelm,mmodtm,mchel2,istri,iret,KERRE)
  10.  
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. IMPLICIT INTEGER (I-N)
  13.  
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.  
  18. -INC SMCHAML
  19. -INC SMMODEL
  20.  
  21. -INC SMCOORD
  22. -INC SMELEME
  23. -INC SMLENTI
  24. -INC CCPRECO
  25. -INC CCASSIS
  26.  
  27. EXTERNAL LONG
  28.  
  29. segment izone(NZ,NSMOD)
  30. segment ismel(NZ,NSMOD)
  31.  
  32. segment icpr(nbpt)
  33. segment inde(jg)
  34.  
  35. CHARACTER*(NCONCH) conloc,MO24
  36. CHARACTER*(LOCOMP) nomloc
  37. CHARACTER*(16) typloc
  38. CHARACTER*(50) typ1
  39.  
  40.  
  41. LOGICAL BVALID,OOOVP1,dmopa
  42.  
  43.  
  44. melpv = 0
  45. ith1 = oothrd + 1
  46.  
  47. CG if (iimpi.eq.7203) then
  48. CG write(ioimp,*) 'Entree dans reduaf',mmodtm,jchelm
  49. CG call zpchel(jchelm,1)
  50. CG endif
  51. c write(6,*) 'Entree dans reduaf',jchelm,istri,mmodtm
  52. CALL oooho2(ihcour)
  53. iret = 1
  54. KERRE = 0
  55. mchel2 = 0
  56. MO24 =' '
  57.  
  58. IF(istri .EQ. 0)THEN
  59. C Extension du MMODEL en cas de modele de MELANGE et NON-STRICT
  60. CALL MODETE(mmodtm,mmodel,IMELAN)
  61. ELSEIF(istri .EQ. 1)THEN
  62. mmodel = mmodtm
  63. ELSE
  64. CALL ERREUR(5)
  65. ENDIF
  66.  
  67. NSMOD = mmodel.kmodel(/1)
  68. DO is = 1, NSMOD
  69. imodel = mmodel.kmodel(is)
  70. C Verification si on a un modele de DARCY actuellement incompatible
  71. C Car il se servent du MAILLAGE dans la TABLE DOMAINE et pas celui
  72. C contenu dans le MMODEL
  73. CALL PLACE(imodel.FORMOD,imodel.FORMOD(/2),IDARC,'DARCY')
  74. IF (IDARC .NE. 0) THEN
  75. mchel2=jchelm
  76. RETURN
  77. ENDIF
  78. ENDDO
  79.  
  80. C ---------------------------------------------------------------------
  81. C Preconditionnement de REDU
  82. C Verification que le resultat n'est pas deja dans le CCPRECO
  83. C ---------------------------------------------------------------------
  84. ITAILL = NBPRRE(ith1)
  85. CALL oooho1(mmodel,IHOmmo)
  86. CALL oooho1(jchelm,IHOjch)
  87. DO 201 IPREC1 = 1, ITAILL
  88. IF (PRECMO(IPREC1,ith1) .NE. mmodel) GOTO 201
  89. IF ((PRECM1(IPREC1,ith1) .NE. jchelm) .AND.
  90. & (PRECM2(IPREC1,ith1) .NE. jchelm)) GOTO 201
  91. IF (PRECM3(IPREC1,ith1) .NE. istri ) GOTO 201
  92.  
  93. C Ajout test horodatage du MMODEL et MCHAML d'entree (il a pu etre supprime puis recree avec le meme descripteur)
  94. IF (PRECM4(IPREC1,ith1) .NE. IHOmmo) GOTO 201
  95. IF (PRECM5(IPREC1,ith1) .NE. IHOjch) GOTO 201
  96.  
  97. mchel2 = PRECM2(IPREC1,ith1)
  98. IF(mchel2 .NE. jchelm) CALL ACTOBJ('MCHAML ',mchel2,1)
  99. C IF (IPREC1 .EQ. NPREDU) THEN
  100. C PRINT *,' CCPRECO trop petit :',IPREC1
  101. C CALL ERREUR(5)
  102. C ENDIF
  103.  
  104. C Mise a jour du preconditionnement dans CCPRECO : Deplacement en position 1 du REDU deja fait
  105. IF (IPREC1 .EQ. 1) THEN
  106. RETURN
  107. ELSE
  108. DO IPREC2 = IPREC1,2,-1
  109. PRECMO(IPREC2,ith1) = PRECMO(IPREC2 - 1,ith1)
  110. PRECM1(IPREC2,ith1) = PRECM1(IPREC2 - 1,ith1)
  111. PRECM2(IPREC2,ith1) = PRECM2(IPREC2 - 1,ith1)
  112. PRECM3(IPREC2,ith1) = PRECM3(IPREC2 - 1,ith1)
  113. PRECM4(IPREC2,ith1) = PRECM4(IPREC2 - 1,ith1)
  114. PRECM5(IPREC2,ith1) = PRECM5(IPREC2 - 1,ith1)
  115. ENDDO
  116. PRECMO(1,ith1) = mmodel
  117. PRECM1(1,ith1) = jchelm
  118. PRECM2(1,ith1) = mchel2
  119. PRECM3(1,ith1) = istri
  120. PRECM4(1,ith1) = IHOmmo
  121. PRECM5(1,ith1) = IHOjch
  122. RETURN
  123. ENDIF
  124. 201 CONTINUE
  125.  
  126. C 1 CONTINUE
  127.  
  128. C Mise a jour du preconditionnement dans CCPRECO : Deplacement pour ecrire le nouveau REDU en 1ere position
  129. ITAILL = MIN(ITAILL + 1, NPREDU)
  130. NBPRRE(ith1) = ITAILL
  131. DO IPRECO = ITAILL,2,-1
  132. PRECMO(IPRECO,ith1) = PRECMO(IPRECO - 1,ith1)
  133. PRECM1(IPRECO,ith1) = PRECM1(IPRECO - 1,ith1)
  134. PRECM2(IPRECO,ith1) = PRECM2(IPRECO - 1,ith1)
  135. PRECM3(IPRECO,ith1) = PRECM3(IPRECO - 1,ith1)
  136. PRECM4(IPRECO,ith1) = PRECM4(IPRECO - 1,ith1)
  137. PRECM5(IPRECO,ith1) = PRECM5(IPRECO - 1,ith1)
  138. ENDDO
  139. PRECMO(1,ith1) = mmodel
  140. PRECM1(1,ith1) = jchelm
  141. C PRECM2 doit etre mis a jour plus loin avant chaque RETURN
  142. PRECM3(1,ith1) = istri
  143. PRECM4(1,ith1) = IHOmmo
  144. PRECM5(1,ith1) = IHOjch
  145.  
  146. mchelm = jchelm
  147. NZ = mchelm.imache(/1)
  148. L1 = mchelm.titche(/1)
  149. N3 = mchelm.infche(/2)
  150.  
  151. C -----------------------------------------
  152. C Cas tres particulier de MCHELM resultat :
  153. C -----------------------------------------
  154. IF (NZ.EQ.0) THEN
  155. CG if (iimpi.eq.7203) write(ioimp,*) 'CAS PARTICULIER NZ = 0'
  156. C Mise a jour du preconditionnement dans CCPRECO
  157. mchel2 = jchelm
  158. PRECM2(1,ith1) = jchelm
  159. RETURN
  160. ENDIF
  161.  
  162. C Quelques initialisations :
  163. C mlent2 contient le nombre d'elements du maillage de chaque sous-modele.
  164. jg = NSMOD
  165. call oooprl(1)
  166. SEGINI,mlent2,izone,ismel
  167.  
  168. C mlent3 contient les intersections entre les maillages determinees :
  169. C mlent3.lect(i3) avec ismel(iz,is) = i3 correspond a l'intersection
  170. C entre le maillage du sous-modele is et la sous-zone iz du champ si
  171. C la valeur de i3 n'est pas nulle !
  172.  
  173. jg = NSMOD * NZ
  174. SEGINI,mlent3
  175. call oooprl(0)
  176. NL3 = 0
  177. ISOZM = 0
  178.  
  179. icpr = 0
  180. inde = 0
  181. C
  182. C Regroupement des zones directement appariees avec un sous-modele
  183. C Recherche des zones pouvant intersecter le maillage d'un sous-modele
  184. DO 100 is = 1, NSMOD
  185. imodel = mmodel.kmodel(is)
  186. IF (imodel.nefmod.EQ.259) GOTO 100
  187. meleme = imodel.imamod
  188. CALL oooho1(meleme,IHO1)
  189. itypm = meleme.itypel
  190. mlent2.lect(is) = meleme.num(/2)
  191. C On parcourt tous les NZ chamelem elementaires.
  192. DO 101 iz = 1, NZ
  193. conloc = mchelm.conche(iz)
  194.  
  195. IF (conloc.NE.MO24 .AND.
  196. & conloc .NE.imodel.conmod(1:LCONMO)) GOTO 101
  197. C PRINT *,'REDUAF:',is,iz,':',conloc,':',imodel.conmod,':'
  198. ixx = 0
  199. ipt1 = mchelm.imache(iz)
  200. C Correspondance maillage sous-zone et sous-modele
  201. IF (ipt1.EQ.meleme) THEN
  202. ixx = 1
  203. C Pas de correspondance directe, recherche intersection potentielle
  204. ELSE
  205. IF (ipt1.itypel.NE.itypm) GOTO 102
  206.  
  207. CALL oooho1(ipt1,IHO2)
  208. C Verification dans le PRECONDITIONNEMENT si deja evaluee
  209. DO 400 III=1,NINTSA(ith1)
  210. IF(PMAMOD(III,ith1) .NE. meleme) GOTO 400
  211. IF(PMAMOH(III,ith1) .NE. IHO1 ) GOTO 400
  212. IF(PMACHA(III,ith1) .NE. ipt1 ) GOTO 400
  213. IF(PMACHH(III,ith1) .NE. IHO2 ) GOTO 400
  214. mlenti=PMLENT(III,ith1)
  215. C PRINT *,'REDUAF_PRECONDITION',oothrd,meleme,ipt1,mlenti
  216.  
  217. C IF(mlenti .EQ. 0) THEN
  218. C ixx = 0
  219. C ismel(iz,is) = 0
  220. C
  221. C ELSE
  222. NL3 = NL3 + 1
  223. mlent3.lect(NL3) = mlenti
  224. ixx = -1
  225. ismel(iz,is) = NL3
  226. C ENDIF
  227. GOTO 102
  228. 400 CONTINUE
  229.  
  230. C PRINT *,'REDUAF_INTERSECTION',oothrd,meleme,ipt1
  231.  
  232. C On va regarder si on n a pas deja evalue l'intersection :
  233. C (meme sous-modele is et sous-zone precedente ia<iz)
  234. DO ia = 1, iz-1
  235. IF (ipt1.EQ.mchelm.imache(ia)) THEN
  236. IF (ismel(ia,is).GT.0) THEN
  237. ixx = -2
  238. ismel(iz,is) = ismel(ia,is)
  239. GOTO 102
  240. ENDIF
  241. ENDIF
  242. ENDDO
  243. C (meme sous-zone iz et sous-modele ia<is)
  244. DO 103 ia = 1, is-1
  245. imode2 = mmodel.kmodel(ia)
  246. IF (imode2.nefmod.EQ.259) GOTO 103
  247. ipt2 = imode2.imamod
  248. IF (ipt2.EQ.meleme) THEN
  249. IF (ismel(iz,ia).GT.0) THEN
  250. ixx = -3
  251. ismel(iz,is) = ismel(iz,ia)
  252. GOTO 102
  253. ENDIF
  254. ENDIF
  255. 103 CONTINUE
  256.  
  257.  
  258. C Détermination de l'intersection de ipt1 et meleme :
  259. C Creation d'un tableau (LISTENTI) de correspondance des
  260. C elements de IPT1 qui sont dans MELEME
  261. nbno1 = ipt1.num(/1)
  262. nbel1 = ipt1.num(/2)
  263. IF (icpr.EQ.0) THEN
  264. nbpt = nbpts + 1
  265. np1 = nbpt - 1
  266. SEGINI,icpr
  267. ELSE
  268. DO j = 1, nbpt
  269. icpr(j) = 0
  270. ENDDO
  271. ENDIF
  272. DO j = 1, nbel1
  273. DO m = 1, nbno1
  274. ib = ipt1.num(m,j)
  275. icpr(ib) = icpr(ib) + 1
  276. ENDDO
  277. ENDDO
  278. iprec = icpr(1)
  279. DO j = 2, np1
  280. iprec = iprec + icpr(j)
  281. icpr(j) = iprec
  282. ENDDO
  283. jg = icpr(np1)
  284. icpr(nbpt) = jg
  285. IF (inde.EQ.0) THEN
  286. SEGINI,inde
  287. ELSE
  288. IF (jg.GT.inde(/1)) THEN
  289. SEGADJ,inde
  290. ENDIF
  291. DO j = 1, jg
  292. inde(j) = 0
  293. ENDDO
  294. ENDIF
  295. DO j = 1, nbel1
  296. DO m = 1, nbno1
  297. ib = ipt1.num(m,j)
  298. ia = icpr(ib)
  299. inde(ia) = j
  300. icpr(ib) = ia - 1
  301. ENDDO
  302. ENDDO
  303.  
  304.  
  305. C Fin du travail preparatoire pour le maillage ipt1
  306. ipt2 = imodel.imamod
  307. nbno2 = ipt2.num(/1)
  308. nbel2 = ipt2.num(/2)
  309. c* ipt2 = imodel.imamod = meleme
  310. c* nbno2 = ipt2.num(/1) = nbno1
  311. c* nbel2 = ipt2.num(/2) = mlent2.lect(is)
  312.  
  313.  
  314. C on fabrique le mlenti de correspondance
  315. C on dimensionne au nombre d elements de ipt2 = sous-modele is
  316. jg = nbel2
  317. SEGINI,mlenti
  318. ibon = 0
  319. DO 110 iel2 = 1, nbel2
  320. ia = ipt2.num(1,iel2)
  321. ideb = icpr(ia)+1
  322. ifin = icpr(ia+1)
  323. IF (ifin.LT.ideb) GOTO 110
  324. DO 111 ib = ideb, ifin
  325. iel1 = inde(ib)
  326. DO j = 1, nbno1
  327. IF (ipt2.num(j,iel2).NE.ipt1.num(j,iel1)) GOTO 111
  328. ENDDO
  329. ibon = ibon + 1
  330. mlenti.lect(iel2) = iel1
  331. GOTO 110
  332. 111 CONTINUE
  333. 110 CONTINUE
  334.  
  335. IF (ibon .EQ. 0) THEN
  336. C Intersection VIDE entre MELEME et IPT1
  337. ixx = 0
  338. ismel(iz,is) = 0
  339. SEGSUP,mlenti
  340.  
  341. ELSE
  342. C Intersection NON VIDE entre MELEME et IPT1
  343. IF (ibon.GT.nbel1) THEN
  344. C Si on a plus d'elements dans l'intersection que dans ipt1 !
  345. write(ioimp,*) 'REDUAF : Etiquette 11x intersection ?'
  346. ENDIF
  347. NL3 = NL3 + 1
  348. mlent3.lect(NL3) = mlenti
  349. ixx = -1
  350. ismel(iz,is) = NL3
  351. ENDIF
  352.  
  353. C Ajout dans le PRECONDITIONNEMENT : Ajout a la suite
  354. IF(mlenti .NE. 0)THEN
  355. IPLACE=MOD(NINTSA(ith1),MIN(NTRIPL,NBESCR))+1
  356. C PRINT *,'REDUAF_AJOUT',oothrd,IPLACE,meleme,ipt1,mlenti
  357. PMAMOD(IPLACE,ith1) = meleme
  358. PMAMOH(IPLACE,ith1) = IHO1
  359. PMACHA(IPLACE,ith1) = ipt1
  360. PMACHH(IPLACE,ith1) = IHO2
  361. PMLENT(IPLACE,ith1) = mlenti
  362. NINTSA(ith1) = IPLACE
  363. ENDIF
  364. ENDIF
  365. CG write(*,*) ' -',iz,is,ixx,ismel(iz,is)
  366.  
  367.  
  368. 102 CONTINUE
  369. C Sous-zone du mchelm a traiter
  370. IF (ixx .NE. 0) THEN
  371. DO 105 ia = 1, iz-1
  372. ib = izone(ia,is)
  373. IF (ib.EQ.0) GOTO 105
  374. IF (conche(ia)(1:NCONCH).NE.conloc) GOTO 105
  375. DO k = 1, N3
  376. IF (k.NE.4) THEN
  377. IF (infche(ia,k).NE.infche(iz,k)) GOTO 105
  378. ENDIF
  379. ENDDO
  380. izone(iz,is) = ib
  381. GOTO 106
  382. 105 CONTINUE
  383. ISOZM = ISOZM + 1
  384. izone(iz,is) = ISOZM
  385. 106 CONTINUE
  386. ENDIF
  387. CG write(*,*) ' -',iz,is,ixx,izone(iz,is)
  388. 101 CONTINUE
  389. 100 CONTINUE
  390.  
  391. IF (icpr.NE.0) SEGSUP,icpr
  392. IF (inde.NE.0) SEGSUP,inde
  393.  
  394.  
  395.  
  396.  
  397. C ---------------------------------
  398. C Construction du MCHELM resultat :
  399. C ---------------------------------
  400. C Grace au traitement ci-dessus (boucle 105), ISOZM correspond a N1 :
  401. N1 = ISOZM
  402. L1 = mchelm.titche(/1)
  403. N3 = mchelm.infche(/2)
  404.  
  405. CALL oooprl(1)
  406. SEGINI,mchel2
  407. mchel2.titche = mchelm.titche
  408. mchel2.ifoche = mchelm.ifoche
  409.  
  410. C Pour chaque sous-modele "is", on regroupe les sous-zones du mchelm "iz"
  411. C associees (izone(iz,is) > 0) :
  412. DO 200 is = 1, NSMOD
  413. imodel = kmodel(is)
  414. IF (imodel.nefmod.EQ.259) GOTO 200
  415. ipt2 = imodel.imamod
  416. nbel2 = mlent2.lect(is)
  417.  
  418. DO 210 iz = 1, NZ
  419. in1 = izone(iz,is)
  420. IF (in1.LE.0) GOTO 210
  421. mchaml = mchelm.ichaml(iz)
  422. n21 = mchaml.ielval(/1)
  423.  
  424. C Cas particulier du mchaml sans composante (on ne fait rien) :
  425. IF (n21.EQ.0) GOTO 210
  426.  
  427. IF (mchel2.imache(in1).EQ.0) THEN
  428. CG write(ioimp,*) ' Cas 1 :',mchel2.imache(in1)
  429. mchel2.conche(in1) = mchelm.conche(iz)
  430. mchel2.imache(in1) = ipt2
  431. DO k = 1, N3
  432. mchel2.infche(in1,k) = mchelm.infche(iz,k)
  433. ENDDO
  434. n22 = 0
  435. n2 = n22 + n21
  436. SEGINI,mcham2
  437. mchel2.ichaml(in1) = mcham2
  438. ELSE
  439. CG write(ioimp,*) ' Cas 2 :',mchel2.imache(in1)
  440. mcham2 = mchel2.ichaml(in1)
  441. n22 = mcham2.ielval(/1)
  442. n2 = n22 + n21
  443. SEGADJ,mcham2
  444. ENDIF
  445.  
  446. mlenti = ismel(iz,is)
  447. IF (mlenti.GT.0) mlenti = mlent3.lect(mlenti)
  448. CG write(ioimp,*) ' :',iz,is,mlenti,n22,n21,n2
  449. DO i = 1, n21
  450. nomloc = mchaml.nomche(i)
  451. iplac = 0
  452. IF (n22.NE.0) THEN
  453. CALL PLACE(mcham2.nomche(1),n22,iplac,nomloc)
  454. ENDIF
  455. typloc = mchaml.typche(i)
  456. melval = mchaml.ielval(i)
  457. if (melval.ne.melpv) then
  458. melpv=melval
  459. endif
  460. nbpi1 = MAX(melval.velche(/1),melval.ielche(/1))
  461. nbel1 = MAX(melval.velche(/2),melval.ielche(/2))
  462. IF (nbel1.GT.1) nbel1 = nbel2
  463.  
  464. IF (iplac.EQ.0) THEN
  465. iplac = n22 + i
  466. mcham2.nomche(iplac) = nomloc
  467. mcham2.typche(iplac) = typloc
  468. IF (typloc.EQ.'REAL*8 ') THEN
  469. n1ptel = nbpi1
  470. n1el = nbel2
  471. n2ptel = 0
  472. n2el = 0
  473. ELSE
  474. n1ptel = 0
  475. n1el = 0
  476. n2ptel = nbpi1
  477. n2el = nbel2
  478. ENDIF
  479. SEGINI,melva2
  480. mcham2.ielval(iplac) = melva2
  481. ELSE
  482. C incompatibilite du type de composante entre champs
  483. IF (mcham2.typche(iplac).NE.typloc) THEN
  484. KERRE = 917
  485. MOTERR(1:4) = nomloc
  486. MOTERR(5:21) = typloc
  487. MOTERR(22:38) = mcham2.typche(iplac)
  488. GOTO 9000
  489. ENDIF
  490. melva2 = mcham2.ielval(iplac)
  491. ENDIF
  492.  
  493. C On ajoute melval a melva2 en tenant compte de l'intersection entre
  494. C les maillages (mlenti = 0 si maillage identique, >0 sinon)
  495. C "Extension" de melva2 si besoin par rapport a melval (appel a MELEXT)
  496. C sera effectuee en prealable de l'addition des valeurs dans MELADD.
  497. CALL MELADD(melva2,melval,typloc,mlenti,KERRE)
  498. IF (KERRE.NE.0) GOTO 9000
  499. ENDDO
  500. C
  501. 210 CONTINUE
  502. 200 CONTINUE
  503.  
  504. C Compactage du champ resultat :
  505. C ------------------------------
  506. n1max = n1
  507. n1 = 0
  508. DO 310 i = 1, n1max
  509. mcham2 = mchel2.ichaml(i)
  510. IF (mcham2.EQ.0) GOTO 310
  511. C on compacte les composantes (s'il y en a bien sur !)
  512. n22 = mcham2.ielval(/1)
  513. IF (n22.EQ.0) GOTO 312
  514. n2 = 0
  515. DO 311 j = 1, n22
  516. melva2 = mcham2.ielval(j)
  517. IF (melva2.EQ.0) GOTO 311
  518. CALL oooho1(melva2,ihmelv)
  519. IF(ihmelv .EQ. ihcour)THEN
  520. C Reduction seulement pour les SEGMENTS nouveaux !
  521. CALL COMRED(melva2)
  522. ENDIF
  523. n2 = n2 + 1
  524. mcham2.nomche(n2) = mcham2.nomche(j)
  525. mcham2.typche(n2) = mcham2.typche(j)
  526. mcham2.ielval(n2) = melva2
  527. 311 CONTINUE
  528. IF (n2.EQ.0) GOTO 310
  529. IF (n2.NE.n22) SEGADJ,mcham2
  530. 312 CONTINUE
  531. n1 = n1 + 1
  532. mchel2.conche(n1) = mchel2.conche(i)
  533. mchel2.imache(n1) = mchel2.imache(i)
  534. mchel2.ichaml(n1) = mcham2
  535.  
  536. DO j = 1, N3
  537. mchel2.infche(n1,j) = mchel2.infche(i,j)
  538. ENDDO
  539. 310 CONTINUE
  540. IF (n1.NE.n1max) SEGADJ,mchel2
  541. CALL oooprl(0)
  542.  
  543.  
  544. C Definition du type du MCHAML
  545. C typ1 contient le nom du type identifie
  546. C ltyp1 la longueur de la chaine de caractere
  547. C
  548. CALL TYPCHL(mchel2,mmodtm,typ1,ltyp1)
  549. IF (IERR.NE.0) RETURN
  550. C Cas particuliers des modeles de modele (melange)
  551. IF(ltyp1.NE.-2 .AND. ltyp1.GT.0 .and. mchel2.titche.eq.' ')THEN
  552. IF (ltyp1 .NE. L1 ) THEN
  553. L1=ltyp1
  554. SEGADJ, mchel2
  555. ENDIF
  556. mchel2.titche=typ1
  557. ENDIF
  558. C On sort un champ vide s'il n'y a pas de zone commune :
  559. c* IF (n1.EQ.0) THEN
  560. c**G if (iimpi.eq.7203) write(ioimp,*) 'N1 = 0 apres traitement'
  561. c* KERRE = 21
  562. c* ENDIF
  563.  
  564. 9000 CONTINUE
  565. C Destruction des segments de travail devenus inutiles :
  566. SEGSUP,izone,ismel,mlent3,mlent2
  567.  
  568. 9010 CONTINUE
  569. IF (KERRE.NE.0) THEN
  570. iret = 0
  571. mchel2 = 0
  572. ENDIF
  573.  
  574. CG if (iimpi.eq.7203) then
  575. CG write(ioimp,*) 'Sortie de reduaf',mchel2,kerre
  576. CG if (kerre.eq.0) call zpchel(mchel2,1)
  577. CG endif
  578.  
  579. C Mise a jour du preconditionnement dans CCPRECO (Nouveau champ mchel2)
  580. CALL ACTOBJ('MCHAML ',mchel2,1)
  581. PRECM2(1,ith1) = mchel2
  582.  
  583. END
  584.  
  585.  
  586.  

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