Télécharger fiss.eso

Retour à la liste

Numérotation des lignes :

  1. C FISS SOURCE CB215821 16/12/05 21:39:26 9237
  2. SUBROUTINE FISS
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C__________________________________________________________________
  6. C operateur FUITE:
  7. C Calcul du debit air-vapeur dans une fissure plane
  8. C
  9. C
  10. C__________________________________________________________________
  11. -INC CCOPTIO
  12. -INC SMELEME
  13. -INC SMCHAML
  14. -INC SMCOORD
  15. -INC SMCHPOI
  16. -INC SMLENTI
  17. -INC SMMODEL
  18. -INC SMTABLE
  19. C
  20. SEGMENT MAVAL
  21. REAL*8 VAL(NVAL)
  22. ENDSEGMENT
  23. C
  24. SEGMENT PTRAV1
  25. INTEGER KASN(NNPT),KG(NNPT)
  26. REAL*8 XNC(NNPT),TP(NNPT),EP(NNPT),BP(NNPT)
  27. ENDSEGMENT
  28. SEGMENT PTRAV2
  29. REAL*8 XX(NMX)
  30. REAL*8 XP(NMX),XPV(NMX),XT(NMX),XY(NMX),XU(NMX)
  31. REAL*8 XQ(NMX),XQA(NMX),XQW(NMX),XHF(NMX),XRE(NMX),XDH(NMX)
  32. REAL*8 ZP(NNPT),ZPV(NNPT),ZT(NNPT),ZY(NNPT),ZU(NNPT)
  33. REAL*8 ZQ(NNPT),ZQA(NNPT),ZQW(NNPT),ZHF(NNPT),ZRE(NNPT),ZDH(NMX)
  34. REAL*8 ZTRA(NNPT)
  35. ENDSEGMENT
  36. C
  37. INTEGER GPARF
  38. CHARACTER*8 CMATE
  39. CHARACTER*12 CMAT1,CMAT2,CMAT3
  40. CHARACTER*(NCONCH) CONM
  41. CHARACTER*8 MOTCLE,MCO1,MCO2,MCO3,MCO4,NOM
  42. CHARACTER*8 MOT
  43. REAL*8 VALCL(5)
  44. POINTEUR MCHMAT.MCHELM
  45. POINTEUR PCHMAT.MCHAML
  46. POINTEUR DCHMAT.MELVAL
  47. POINTEUR PCOMP.MAVAL
  48. C
  49. CHARACTER*10 MOALIR
  50. CHARACTER*8 TYPOBJ
  51. CHARACTER*28 MOTTAB
  52. CHARACTER*72 CHARRE
  53. LOGICAL LOGIN,LOGRE
  54. REAL*8 XVALIN,XVALRE
  55. C
  56. TYPOBJ=' '
  57. KIMP=IIMPI
  58. QINI = -1.
  59. C***********************************************************************
  60. C lecture obligatoire de l objet modele
  61. C
  62. IPMODL=0
  63. CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  64. IF (IERR.NE.0) RETURN
  65. C
  66. C***********************************************************************
  67. C lecture obligatoire du champ de proprietes materielles
  68. C
  69. IPCHA1 = 0
  70. CALL LIROBJ('MCHAML',IPIN,1,IRET1)
  71. IF (IERR.NE.0) RETURN
  72. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  73. IF(IR .NE. 1) CALL ERREUR(KER)
  74. IF(IERR .NE. 0) RETURN
  75.  
  76. C verification de l egalite des supports du modele et du ch prop mat
  77. call rayn1(IPMODL,IPCHA1)
  78. C
  79. C***********************************************************************
  80. C lecture obligatoire de la table des conditions aux limites
  81. C
  82. IPCHE3 = 0
  83. IPCHA2 = 0
  84. IPCHA3 = 0
  85. IPCHA4 = 0
  86. CALL LIROBJ('TABLE ',IPTAB,1,IRETOU)
  87. IF(IERR.NE.0) RETURN
  88. MTABLE = IPTAB
  89. SEGACT MTABLE
  90. NDIMTAB = MLOTAB
  91. C
  92. MOTTAB='PRESSION_TOTALE_AMONT'
  93. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN,
  94. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3)
  95. PE = XVALRE
  96. MOTTAB='PRESSION_VAPEUR_AMONT'
  97. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN,
  98. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3)
  99. PVE = XVALRE
  100. MOTTAB='TEMPERATURE_AMONT'
  101. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN,
  102. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3)
  103. TE = XVALRE
  104. MOTTAB='PRESSION_TOTALE_AVAL'
  105. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN,
  106. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3)
  107. PS = XVALRE
  108. MOTTAB='TEMPERATURE_PAROI'
  109. TYPOBJ=' '
  110. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN,
  111. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA2)
  112. MOTTAB='OUVERTURE'
  113. TYPOBJ=' '
  114. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN,
  115. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA3)
  116. *
  117. IF(NDIMTAB.EQ.7) THEN
  118. MOTTAB='DEBIT_INITIAL'
  119. TYPOBJ=' '
  120. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,
  121. . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3)
  122. IF(TYPOBJ.EQ.'FLOTTANT') THEN
  123. QINI = XVALRE
  124. ELSE
  125. MOTTAB='ETENDUE'
  126. TYPOBJ=' '
  127. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,
  128. . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA4)
  129. ENDIF
  130. ENDIF
  131. *
  132. IF(NDIMTAB.EQ.8) THEN
  133. MOTTAB='DEBIT_INITIAL'
  134. TYPOBJ=' '
  135. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,
  136. . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3)
  137. QINI = XVALRE
  138. MOTTAB='ETENDUE'
  139. TYPOBJ=' '
  140. CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,
  141. . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA4)
  142. ENDIF
  143. SEGDES MTABLE
  144. C***********************************************************************
  145. C ACTIVATION DU MODELE
  146. C --------------------
  147. MMODEL = IPMODL
  148. SEGACT MMODEL
  149. C NSOUS = KMODEL(/1)
  150.  
  151. IMODEL=KMODEL(1)
  152. SEGACT IMODEL
  153. C
  154. C initialisations
  155. IPMAIL= IMAMOD
  156. NFOR = FORMOD(/2)
  157. NMAT = MATMOD(/2)
  158. C
  159. C verification de la formulation
  160. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  161. IF (CMATE.EQ.' ')THEN
  162. CALL ERREUR(251)
  163. SEGDES IMODEL,MMODEL
  164. IRET=0
  165. RETURN
  166. ENDIF
  167. C lecture de la formulation
  168. CMAT1 = CMATE(1:2)
  169. CMAT2 = CMATE(3:4)
  170. CMAT3 = CMATE(5:8)
  171. IF (CMAT1.EQ.'MA')THEN
  172. XW = 0.D0
  173. ELSE
  174. XW = 1.D0
  175. ENDIF
  176. IF (CMAT2.EQ.'PA')THEN
  177. GPARF = 1
  178. ELSE
  179. GPARF = 0
  180. ENDIF
  181. C
  182. C***********************************************************************
  183. C ACTIVATION DU MCHELM ch prop mat
  184. C --------------------
  185. MCHMAT = IPCHA1
  186. SEGACT MCHMAT
  187. C NBS = MCHMAT.IMACHE(/1)
  188. C pas de boucle sur les modeles elementaires car NSOUS=1
  189. C pas de boucle sur les maillages elementaires car NBS=1
  190. C initialilsations
  191. RUG = 0.
  192. C lecture des prop materielles
  193. PCHMAT = MCHMAT.ICHAML(1)
  194. SEGACT PCHMAT
  195. NBS2 = PCHMAT.IELVAL(/1)
  196. NVAL = NBS2
  197. SEGINI PCOMP
  198. C boucle sur le nb de composantes du ch prop mat
  199. DO 10 I =1,NBS2
  200. MOT = PCHMAT.NOMCHE(I)
  201. DCHMAT = PCHMAT.IELVAL(I)
  202. SEGACT DCHMAT
  203. C N1PTEL = DCHMAT.VELCHE(/1)
  204. C N1EL = DCHMAT.VELCHE(/2)
  205. PCOMP.VAL(I) = DCHMAT.VELCHE(1,1)
  206. IF(MOT.EQ.'RUGO') RUG = PCOMP.VAL(I)
  207. IF(MOT.EQ.'REC') RECU = PCOMP.VAL(I)
  208. IF(MOT.EQ.'FK') XKUL = PCOMP.VAL(I)
  209. IF(MOT.EQ.'FA') XKUT1 = PCOMP.VAL(I)
  210. IF(MOT.EQ.'FB') XKUT2 = PCOMP.VAL(I)
  211. IF(MOT.EQ.'FC') XKUT3 = PCOMP.VAL(I)
  212. IF(MOT.EQ.'FD') XKUT4 = PCOMP.VAL(I)
  213. SEGDES DCHMAT
  214. 10 CONTINUE
  215.  
  216. IF (CMAT3.EQ.'BLAS') THEN
  217. RECU = -1D5
  218. XKUL = 0.
  219. XKUT1 = 0.
  220. XKUT2 = 0.
  221. XKUT3 = 0.
  222. XKUT4 = 0.
  223. ELSE IF (CMAT3.EQ.'COLE')THEN
  224. RECU = -1D5
  225. XKUL = 0.
  226. XKUT1 = 0.
  227. XKUT2 = 0.
  228. XKUT3 = 0.
  229. XKUT4 = 0.
  230. * ELSE IF (CMAT3.EQ.'ENT1')THEN
  231. * RECU = PCOMP.VAL(2)
  232. ELSE IF (CMAT3.EQ.'ENT2')THEN
  233. RECU =-1D0*RECU
  234. ELSE IF (CMAT3.EQ.'ENT3')THEN
  235. RECU = -1D6
  236. XKUT1 = 0.
  237. XKUT2 = 0.
  238. XKUT3 = 0.
  239. XKUT4 = 0.
  240. ELSE IF (CMAT3.EQ.'ENT4')THEN
  241. RECU = -1D7
  242. XKUT1 = 0.
  243. XKUT2 = 0.
  244. XKUT3 = 0.
  245. XKUT4 = 0.
  246. ENDIF
  247. SEGSUP PCOMP
  248. SEGDES PCHMAT
  249. SEGDES MCHMAT
  250. C
  251. C*********************************************************************
  252. C TRAITEMENT des 2 champs ep et tp
  253. C --------------------------------
  254. IPT2=IPMAIL
  255.  
  256. SEGACT IPT2
  257. NBSO = IPT2.LISOUS(/1)
  258. IF (NBSO.NE.0) THEN
  259. CALL ERREUR(25)
  260. RETURN
  261. ENDIF
  262. NEL = IPT2.NUM(/2)
  263.  
  264. NPT2 = IPT2.NUM(/1)
  265. IF (NPT2.NE.2) THEN
  266. CALL ERREUR(16)
  267. RETURN
  268. ENDIF
  269.  
  270. C segment de travail 1
  271.  
  272. NNPT = NEL + 1
  273. SEGINI PTRAV1
  274.  
  275. XNC(1)=0.D0
  276. KG(1)= IPT2.NUM(1,1)
  277.  
  278. C calcul des abscisses curvilignes
  279.  
  280. IF (IDIM.EQ.1) THEN
  281. DO I =1,NEL
  282. KG(I+1) = IPT2.NUM(2,I)
  283. IREF1 = (IDIM+1)*(IPT2.NUM(1,I)-1)
  284. IREF2 = (IDIM+1)*(IPT2.NUM(2,I)-1)
  285. DX1 = XCOOR(IREF2+1)-XCOOR(IREF1+1)
  286. XNC(I+1) = XNC(I) + DX1
  287. ENDDO
  288. ENDIF
  289. IF (IDIM.EQ.2) THEN
  290. DO I =1,NEL
  291. KG(I+1) = IPT2.NUM(2,I)
  292. IREF1 = (IDIM+1)*(IPT2.NUM(1,I)-1)
  293. IREF2 = (IDIM+1)*(IPT2.NUM(2,I)-1)
  294. DX1 = XCOOR(IREF2+1)-XCOOR(IREF1+1)
  295. DX2 = XCOOR(IREF2+2)-XCOOR(IREF1+2)
  296. DXC = SQRT(DX1*DX1+DX2*DX2)
  297. XNC(I+1) = XNC(I) + DXC
  298. ENDDO
  299. ENDIF
  300. IF (IDIM.EQ.3) THEN
  301. DO I =1,NEL
  302. KG(I+1) = IPT2.NUM(2,I)
  303. IREF1 = (IDIM+1)*(IPT2.NUM(1,I)-1)
  304. IREF2 = (IDIM+1)*(IPT2.NUM(2,I)-1)
  305. DX1 = XCOOR(IREF2+1)-XCOOR(IREF1+1)
  306. DX2 = XCOOR(IREF2+2)-XCOOR(IREF1+2)
  307. DX3 = XCOOR(IREF2+3)-XCOOR(IREF1+3)
  308. DXC = SQRT(DX1*DX1+DX2*DX2+DX3*DX3)
  309. XNC(I+1) = XNC(I) + DXC
  310. ENDDO
  311. ENDIF
  312. XL = XNC(NNPT)
  313. DO I =1,NNPT
  314. XNC(I)=XNC(I)/XL
  315. ENDDO
  316. * recherche du plus petit DX
  317. DXMINAV = 0.01
  318. DO I =1,NNPT-1
  319. DXNC = XNC(I+1)-XNC(I)
  320. DXMIN = MIN(DXNC,DXMINAV)
  321. DXMINAV = DXMIN
  322. ENDDO
  323. DX = DXMIN/5.D0
  324. IF(KIMP.GE.1) THEN
  325. WRITE(6,*) 'fiss : taille relative de maille fluide= ',DX
  326. ENDIF
  327.  
  328. * segment de travail 2
  329. NMX=3*IDINT(1.D0/DX)
  330. SEGINI PTRAV2
  331.  
  332. IF (KIMP.EQ.2) THEN
  333. WRITE(6,*) 'fiss : XL ',XL
  334. WRITE(6,*) (XNC(I),I=1,NNPT)
  335. WRITE(6,*) 'fiss : KG(I) = ',(KG(I),I=1,NNPT)
  336. ENDIF
  337.  
  338. SEGDES IPT2
  339.  
  340. C activation segment MCHPO1 (chpoint Temperature et ouverture)
  341. CALL FUCHPO(IPCHA2,IPCHA3,IRETOU)
  342. MCHPO1=IRETOU
  343. SEGACT MCHPO1
  344. NSOUPO = MCHPO1.IPCHP(/1)
  345.  
  346. IF(NSOUPO.NE.1) THEN
  347. CALL ERREUR(25)
  348. RETURN
  349. ENDIF
  350.  
  351. MSOUP1 = MCHPO1.IPCHP(1)
  352. SEGACT MSOUP1
  353. NC = MSOUP1.NOHARM(/1)
  354.  
  355. IF(NC.NE.2) THEN
  356. CALL ERREUR(21)
  357. RETURN
  358. ENDIF
  359.  
  360. IPT1 = MSOUP1.IGEOC
  361. CALL KRIPAD(IPT1,MLENT1)
  362. SEGACT IPT1, MLENT1
  363. C NTOT = MLENT1.LECT(/1)
  364.  
  365. MPOVA1 = MSOUP1.IPOVAL
  366.  
  367. SEGACT MPOVA1
  368. NNPT1 = MPOVA1.VPOCHA(/1)
  369. C
  370. IF (NNPT1.NE.NNPT) THEN
  371. CALL ERREUR(21)
  372. RETURN
  373. ENDIF
  374.  
  375. DO I = 1,NNPT
  376. KASN(I) = MLENT1.LECT(KG(I))
  377. ENDDO
  378.  
  379. SEGDES MLENT1
  380.  
  381. C remplissage des tableaux classes
  382.  
  383. MCO1=MSOUP1.NOCOMP(1)
  384. MCO2=MSOUP1.NOCOMP(2)
  385. IF (MCO1.EQ.'T ') THEN
  386. IF (MCO2.EQ.'OUV ') THEN
  387. DO I=1,NNPT
  388. TP(I) = MPOVA1.VPOCHA(KASN(I),1)
  389. EP(I) = MPOVA1.VPOCHA(KASN(I),2)
  390. ENDDO
  391. ELSE
  392. MOTERR(1:4)= MCO2
  393. CALL ERREUR(197)
  394. RETURN
  395. ENDIF
  396. ELSEIF (MCO1.EQ.'OUV ') THEN
  397. IF (MCO2.EQ.'T ') THEN
  398. DO I=1,NNPT
  399. TP(I) = MPOVA1.VPOCHA(KASN(I),2)
  400. EP(I) = MPOVA1.VPOCHA(KASN(I),1)
  401. ENDDO
  402. ELSE
  403. MOTERR(1:4)= MCO2
  404. CALL ERREUR(197)
  405. RETURN
  406. ENDIF
  407. ELSE
  408. MOTERR(1:4)= MCO1
  409. CALL ERREUR(197)
  410. RETURN
  411. ENDIF
  412. IF (IIMPI.EQ.2) THEN
  413. write(6,*) 'fiss : TP= ',(TP(I),I=1,NNPT)
  414. write(6,*) 'fiss : EP= ',(EP(I),I=1,NNPT)
  415. ENDIF
  416. C cas etendue unite (champ d etendue non defini par utilisateur)
  417. IF (IPCHA4.EQ.0) THEN
  418. DO I=1,NNPT
  419. BP(I) = 1.
  420. ENDDO
  421. ENDIF
  422. SEGDES MPOVA1
  423. C activation segment MCHPO2 (chpoint Temperature et etendue)
  424. IF (IPCHA4.GT.0) THEN
  425. CALL FUCHPO(IPCHA2,IPCHA4,IRETOU)
  426. MCHPO2=IRETOU
  427. SEGACT MCHPO2
  428. NSOUPO = MCHPO2.IPCHP(/1)
  429.  
  430. IF(NSOUPO.NE.1) THEN
  431. CALL ERREUR(25)
  432. RETURN
  433. ENDIF
  434.  
  435. MSOUP2 = MCHPO2.IPCHP(1)
  436. SEGACT MSOUP2
  437. NC = MSOUP2.NOHARM(/1)
  438.  
  439. IF(NC.NE.2) THEN
  440. CALL ERREUR(21)
  441. RETURN
  442. ENDIF
  443.  
  444. IPT2 = MSOUP2.IGEOC
  445. CALL KRIPAD(IPT2,MLENT1)
  446. SEGACT IPT2, MLENT1
  447. C NTOT = MLENT1.LECT(/1)
  448.  
  449. MPOVA2 = MSOUP2.IPOVAL
  450.  
  451. SEGACT MPOVA2
  452. NNPT1 = MPOVA2.VPOCHA(/1)
  453. C
  454. IF (NNPT1.NE.NNPT) THEN
  455. CALL ERREUR(21)
  456. RETURN
  457. ENDIF
  458.  
  459. DO I = 1,NNPT
  460. KASN(I) = MLENT1.LECT(KG(I))
  461. ENDDO
  462.  
  463. SEGDES MLENT1
  464.  
  465. C remplissage des tableaux classes
  466.  
  467. MCO1=MSOUP2.NOCOMP(1)
  468. MCO2=MSOUP2.NOCOMP(2)
  469. IF (MCO1.EQ.'T ') THEN
  470. IF (MCO2.EQ.'ETEN') THEN
  471. DO I=1,NNPT
  472. TP(I) = MPOVA2.VPOCHA(KASN(I),1)
  473. BP(I) = MPOVA2.VPOCHA(KASN(I),2)
  474. ENDDO
  475. ELSE
  476. MOTERR(1:4)= MCO2
  477. CALL ERREUR(197)
  478. RETURN
  479. ENDIF
  480. ELSEIF (MCO1.EQ.'ETEN') THEN
  481. IF (MCO2.EQ.'T ') THEN
  482. DO I=1,NNPT
  483. TP(I) = MPOVA2.VPOCHA(KASN(I),2)
  484. BP(I) = MPOVA2.VPOCHA(KASN(I),1)
  485. ENDDO
  486. ELSE
  487. MOTERR(1:4)= MCO2
  488. CALL ERREUR(197)
  489. RETURN
  490. ENDIF
  491. ELSE
  492. MOTERR(1:4)= MCO1
  493. CALL ERREUR(197)
  494. RETURN
  495. ENDIF
  496. IF (IIMPI.EQ.2) THEN
  497. write(6,*) 'fiss : BP= ',(BP(I),I=1,NNPT)
  498. ENDIF
  499. SEGDES MPOVA2
  500. SEGDES MSOUP2
  501. SEGDES MCHPO2
  502. ENDIF
  503.  
  504. C compatibilite de la loi de frottement avec la valeur de rugosite
  505. DO I=1,NNPT
  506. RUGD = RUG/(2.*EP(I))
  507. IF (RUGD.GE.1e-4.AND.MATMOD(3).EQ.'POISEU_BLASIUS') THEN
  508. MOTERR(1:12)= 'RUGO/2e'
  509. REAERR(1) = RUGD
  510. REAERR(2) = 0.0001
  511. C %m1:18 = %r1 superieur a %r2
  512. CALL ERREUR(43)
  513. RETURN
  514. ENDIF
  515. IF (RUGD.LT.1e-4.AND.MATMOD(3).EQ.'POISEU_COLEBROOK') THEN
  516. MOTERR(1:18)= 'RUGO/2e'
  517. REAERR(1) = RUGD
  518. REAERR(2) = 0.0001
  519. C %m1:18 = %r1 inferieur a %r2
  520. CALL ERREUR(41)
  521. RETURN
  522. ENDIF
  523. ENDDO
  524. C
  525. C***********************************************************************
  526. C CALCUL
  527. C ------
  528.  
  529. IF (GPARF.EQ.1) THEN
  530.  
  531. CALL BECALC(PE,PVE,TE,PS,XL,DX,RUG,QINI,XW,NNPT,XNC,TP,EP,BP,
  532. $ KIMP,NMX,NX,XX,XP,XPV,XT,XY,XU,XHF,XQ,XQW,XQA,XRE,XDH,RECU,
  533. $ XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  534. IF (IERR.NE.0) RETURN
  535.  
  536. ELSE
  537. CALL BECALC2(PE,PVE,TE,PS,XL,DX,RUG,QINI,XW,NNPT,XNC,TP,EP,BP,
  538. $ KIMP,NMX,NX,XX,XP,XPV,XT,XY,XU,XHF,XQ,XQW,XQA,XRE,XDH,RECU,
  539. $ XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  540. IF (IERR.NE.0) RETURN
  541.  
  542. ENDIF
  543.  
  544. C creation des champs nodaux resultats
  545.  
  546. CALL BYRETO(XX,XP,NX,ZP,XNC,NNPT,KASN,ZTRA)
  547. CALL BYRETO(XX,XPV,NX,ZPV,XNC,NNPT,KASN,ZTRA)
  548. CALL BYRETO(XX,XT,NX,ZT,XNC,NNPT,KASN,ZTRA)
  549. CALL BYRETO(XX,XY,NX,ZY,XNC,NNPT,KASN,ZTRA)
  550. CALL BYRETO(XX,XU,NX,ZU,XNC,NNPT,KASN,ZTRA)
  551. CALL BYRETO(XX,XHF,NX,ZHF,XNC,NNPT,KASN,ZTRA)
  552. CALL BYRETO(XX,XQ,NX,ZQ,XNC,NNPT,KASN,ZTRA)
  553. CALL BYRETO(XX,XQA,NX,ZQA,XNC,NNPT,KASN,ZTRA)
  554. CALL BYRETO(XX,XQW,NX,ZQW,XNC,NNPT,KASN,ZTRA)
  555. CALL BYRETO(XX,XRE,NX,ZRE,XNC,NNPT,KASN,ZTRA)
  556. CALL BYRETO(XX,XDH,NX,ZDH,XNC,NNPT,KASN,ZTRA)
  557.  
  558. C ecriture du champoint multicomposante
  559.  
  560. NC = 11
  561. N = NNPT
  562. SEGINI MPOVAL
  563. DO I=1,NNPT
  564. VPOCHA(I,1) = ZP(I)
  565. VPOCHA(I,2) = ZPV(I)
  566. VPOCHA(I,3) = ZT(I)
  567. VPOCHA(I,4) = ZY(I)
  568. VPOCHA(I,5) = ZU(I)
  569. VPOCHA(I,6) = ZHF(I)
  570. VPOCHA(I,7) = ZQ(I)
  571. VPOCHA(I,8) = ZQA(I)
  572. VPOCHA(I,9) = ZQW(I)
  573. VPOCHA(I,10) = ZRE(I)
  574. VPOCHA(I,11) = ZDH(I)
  575. ENDDO
  576.  
  577. SEGSUP PTRAV1
  578. SEGSUP PTRAV2
  579. SEGINI MSOUPO
  580.  
  581. NOCOMP(1) = 'P '
  582. NOCOMP(2) = 'PV '
  583. NOCOMP(3) = 'TF '
  584. NOCOMP(4) = 'X '
  585. NOCOMP(5) = 'U '
  586. NOCOMP(6) = 'H '
  587. NOCOMP(7) = 'Q '
  588. NOCOMP(8) = 'QA '
  589. NOCOMP(9) = 'QE '
  590. NOCOMP(10) = 'RE '
  591. NOCOMP(11) = 'F '
  592.  
  593. IGEOC = IPT1
  594. IPOVAL = MPOVAL
  595.  
  596. DO I=1,NC
  597. NOHARM(I) = MSOUP1.NOHARM(1)
  598. ENDDO
  599.  
  600. SEGDES MPOVAL
  601. SEGDES IPT1
  602. SEGDES IPT2
  603. SEGDES MSOUP1
  604.  
  605. NSOUPO = 1
  606. NAT = MCHPO1.JATTRI(/1)
  607. SEGINI MCHPOI
  608.  
  609. MTYPOI = MCHPO1.MTYPOI
  610. MOCHDE = MCHPO1.MOCHDE
  611. DO I=1,NAT
  612. JATTRI(I) = MCHPO1.JATTRI(1)
  613. ENDDO
  614. IPCHP(1) = MSOUPO
  615. IFOPOI = MCHPO1.IFOPOI
  616.  
  617. CALL ECROBJ('CHPOINT',MCHPOI)
  618.  
  619. SEGDES MSOUPO, MCHPOI
  620. SEGDES MCHPO1
  621.  
  622. RETURN
  623. END
  624.  
  625.  
  626.  

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