Télécharger reduaf.eso

Retour à la liste

Numérotation des lignes :

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

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