Télécharger reduaf.eso

Retour à la liste

Numérotation des lignes :

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

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