Télécharger invaca.eso

Retour à la liste

Numérotation des lignes :

invaca
  1. C INVACA SOURCE JB251061 23/05/10 21:15:12 11667
  2.  
  3. SUBROUTINE INVACA(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHE5,
  4. & IMIL,IRET)
  5.  
  6. *---------------------------------------------------------------------
  7. *
  8. * CALCUL DES 3 INVARIANTS D'UN TENSEUR D'ORDRE 2
  9. * (APPELE PAR INVARI)
  10. *
  11. * ENTREES:
  12. * --------
  13. *
  14. * IPMODL POINTEUR SUR UN MMODEL
  15. * IPCHE1 POINTEUR SUR UN CHAMELEM DE CONTRAINTES OU DEFORMATIONS
  16. * (TYPE MCHAML)
  17. * IPCHE5 POINTEUR SUR UN CHAMELEM DE CARACTERISTIQUES
  18. * (TYPE MCHAML)
  19. * IMIL INDICATEUR OU ON CALCULE LES CONTRAINTES POUR
  20. * LES COQUES
  21. *
  22. * SORTIES :
  23. * ---------
  24. *
  25. * IPCHE2 POINTEUR SUR UN CHAMELEM STRESSES ( I1)
  26. * IPCHE3 POINTEUR SUR UN CHAMELEM STRESSES ( I2 )
  27. * IPCHE4 POINTEUR SUR UN CHAMELEM STRESSES ( I3 )
  28. * IRET =1 OU 0 SUIVANT SUCCES OU PAS
  29. *
  30. * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12/90
  31. *
  32. *---------------------------------------------------------------------
  33. *
  34. IMPLICIT INTEGER(I-N)
  35. IMPLICIT REAL*8(A-H,O-Z)
  36.  
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC CCHAMP
  41.  
  42. -INC SMCHAML
  43. -INC SMMODEL
  44.  
  45. SEGMENT NOTYPE
  46. CHARACTER*16 TYPE(NBTYPE)
  47. ENDSEGMENT
  48. *
  49. SEGMENT MPTVAL
  50. INTEGER IPOS(NS) ,NSOF(NS)
  51. INTEGER IVAL(NCOSOU)
  52. CHARACTER*16 TYVAL(NCOSOU)
  53. ENDSEGMENT
  54. *
  55. PARAMETER ( NINF=3 )
  56. INTEGER INFOS(NINF)
  57. CHARACTER*(NCONCH) CONM
  58. LOGICAL lsupno
  59. *
  60. DIMENSION SIG(9)
  61.  
  62. *------ Fin des déclarations ------------------------------------
  63.  
  64. IRET = 0
  65. IPCHE2 = 0
  66. IPCHE3 = 0
  67. IPCHE4 = 0
  68. *
  69. * Reduction des MCHAMLs sur le MODELE
  70. *
  71. kerre = 0
  72. *
  73. CALL REDUAF(IPCHE1,IPMODL,ipch,0,ir,kerre)
  74. IF (ir.NE.1) CALL ERREUR(kerre)
  75. IF (IERR.NE.0) RETURN
  76. IPCHE1 = ipch
  77. *
  78. IF (IPCHE5.NE.0) THEN
  79. CALL REDUAF(IPCHE5,IPMODL,ipch,0,ir,kerre)
  80. IF (ir.NE.1) CALL ERREUR(kerre)
  81. IF (IERR.NE.0) RETURN
  82. IPCHE5 = ipch
  83. ENDIF
  84. *
  85. * Verification du type de IPCHE1 !
  86. *
  87. MCHELM = IPCHE1
  88. SEGACT,MCHELM
  89. IF (TITCHE.EQ.'CONTRAINTES') THEN
  90. ICONTR = 1
  91. W1 = 2.D0
  92. W2 = 1.D0
  93. W3 = 2.D0
  94. ELSE IF (TITCHE.EQ.'DEFORMATIONS') THEN
  95. ICONTR = 0
  96. W1 = 0.5D0
  97. W2 = 0.25D0
  98. W3 = 0.25D0
  99. ELSE
  100. MOTERR(1:24)='CONTRAINTES'
  101. MOTERR(25:48)='DEFORMATIONS'
  102. CALL ERREUR(109)
  103. GOTO 666
  104. ENDIF
  105. *
  106. * Verification du lieu support des mchamls
  107. *
  108. CALL QUESUP(IPMODL,IPCHE1,0,0,iret1,ISUP1)
  109. IF (IERR.NE.0) GOTO 666
  110. *
  111. IPCH5O = IPCHE5
  112. IF (IPCHE5.NE.0) THEN
  113. CALL QUESUP(IPMODL,IPCH5O,ISUP1,0,ISUP5,iret5)
  114. IF (ISUP5.GT.1) GOTO 666
  115. IF (IERR.NE.0) GOTO 666
  116. C Le support des caractéristiques est différent de celui de IPCHE1
  117. IF (ISUP5.NE.0) THEN
  118. CALL CHASUP(IPMODL,IPCH5O,IPCHE5,irecar,ISUP1)
  119. IF (irecar.NE.0) GOTO 666
  120. ENDIF
  121. ENDIF
  122. *
  123. * Activation et verification du modele
  124. *
  125. MMODEL = IPMODL
  126. SEGACT,MMODEL
  127. NSOUS = KMODEL(/1)
  128. KEL22 = 0
  129. DO ISOUS = 1, NSOUS
  130. IMODEL=KMODEL(ISOUS)
  131. SEGACT,IMODEL
  132. IF (FORMOD(1).NE.'MECANIQUE' .AND.
  133. & FORMOD(1).NE.'POREUX') THEN
  134. MOTERR(1:8) = FORMOD(1)
  135. CALL ERREUR(193)
  136. GOTO 666
  137. ENDIF
  138. IF ((NEFMOD.EQ.22).OR.(NEFMOD.EQ.259)) KEL22 = KEL22 + 1
  139. ENDDO
  140. *
  141. C ... Initialisation des trois nouveaux MCHELM - resultats ...
  142. N1 = NSOUS - KEL22
  143. L1 = 8
  144. N3 = 6
  145. *
  146. SEGINI MCHEL1
  147. MCHEL1.IFOCHE=IFOUR
  148. MCHEL1.TITCHE='SCALAIRE'
  149. *
  150. SEGINI MCHEL2
  151. MCHEL2.IFOCHE=IFOUR
  152. MCHEL2.TITCHE='SCALAIRE'
  153. *
  154. SEGINI MCHEL3
  155. MCHEL3.IFOCHE=IFOUR
  156. MCHEL3.TITCHE='SCALAIRE'
  157. *
  158. * Petit segment utile
  159. nbtype = 1
  160. SEGINI,notype
  161. type(1)='REAL*8'
  162. MOTYPE = notype
  163. *
  164. ISOUS = 0
  165. *
  166. * ... BOUCLE SUR LES SOUS ZONES DU MODELE ...
  167. *
  168. DO 200 JSOUS = 1, NSOUS
  169. *
  170. IMODEL = KMODEL(JSOUS)
  171. SEGACT,IMODEL
  172. *
  173. IPMAIL= IMAMOD
  174. CONM = CONMOD
  175. MELE = NEFMOD
  176. *
  177. iOK = 1
  178. IF ((MELE.EQ.22).OR.(MELE.EQ.259)) GOTO 210
  179. *
  180. iOK = 0
  181. *
  182. C ... COQUE INTEGREE OU NON ? ...
  183. IF (INFMOD(/1).NE.0) THEN
  184. NPINT = INFMOD(1)
  185. IF (NPINT.NE.0)THEN
  186. CALL ERREUR(615)
  187. GOTO 210
  188. ENDIF
  189. ELSE
  190. NPINT = 0
  191. ENDIF
  192. *
  193. * ... INITIALISATION ...
  194. *
  195. ISOUS = ISOUS + 1
  196. *
  197. IVACAR = 0
  198. IVACOM = 0
  199. MOCOMP = 0
  200. MOCARA = 0
  201. lsupno = .false.
  202. *
  203. * ... INFORMATION SUR L'ELEMENT FINI ...
  204. *
  205. MFR = INFELE(13)
  206. MINTE = INFMOD(2+ISUP1)
  207. NSTRS = INFELE(16)
  208. *
  209. * ... Verification de compatibilité des MCHAML du point de vue des
  210. * tableaux INFCHE et remplissage du tableau INFOS pour KOMCHA ...
  211. *
  212. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE5,INFOS,IRTD)
  213. IF (IRTD.EQ.0) GOTO 210
  214. *
  215. * ... RECHERCHE DES NOMS de COMPOSANTES de CONTRAINTES/DEFORMATIONS...
  216. *
  217. IF (ICONTR.EQ.1) THEN
  218. IF (lnomid(4).NE.0) THEN
  219. MOCOMP = lnomid(4)
  220. ELSE
  221. lsupno = .true.
  222. CALL IDCONT(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
  223. ENDIF
  224. ELSE
  225. IF (lnomid(5).NE.0) THEN
  226. MOCOMP = lnomid(5)
  227. ELSE
  228. lsupno = .true.
  229. CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
  230. ENDIF
  231. ENDIF
  232. nomid = MOCOMP
  233. SEGACT,nomid
  234. NCOMP = lesobl(/2)
  235. NFAC = lesfac(/2)
  236. *
  237. * ... VERIFICATION DE LEUR PRESENCE ...
  238. *
  239. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCOMP,MOTYPE,1,INFOS,3,IVACOM)
  240. IF (IERR.NE.0) GOTO 220
  241. *
  242. * ... TRAITEMENT DES CHAMPS DE CARACTERISTIQUES ...
  243. *
  244. nbrobl = 0
  245. nbrfac = 0
  246. nomid = 0
  247. * ... EPAISSEUR DANS LE CAS DES COQUES MINCES ...
  248. IF (MFR.EQ.3 .OR. MFR.EQ.9) THEN
  249. nbrobl = 1
  250. nbrfac = 0
  251. SEGINI,nomid
  252. lesobl(1) = 'EPAI'
  253. ENDIF
  254. *
  255. MOCARA = nomid
  256. NCARA = nbrobl
  257. NCARF = nbrfac
  258. NCARR = NCARA+NCARF
  259. *
  260. IF (MOCARA.NE.0 .AND. NCARA.GE.1) THEN
  261. IF (IPCHE5.NE.0) THEN
  262. C ... On vérifie si elle est présente dans le champ de
  263. C caractéristiques qui a été fourni ...
  264. CALL KOMCHA(IPCHE5,IPMAIL,CONM,MOCARA,MOTYPE,1,
  265. & INFOS,3,IVACAR)
  266. ELSE
  267. C ... S'il n'y a pas de champ de caractéristiques, on râle ...
  268. MOTERR(1:8)='CARACTER'
  269. MOTERR(9:12)=NOMTP(MELE)
  270. MOTERR(13:20)='INVA'
  271. CALL ERREUR(145)
  272. ENDIF
  273. IF (IERR.NE.0) GOTO 230
  274. ENDIF
  275. *
  276. C Creation des MELVAL de la zone élémentaire
  277. *
  278. * ... RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER ...
  279. *
  280. MPTVAL = IVACOM
  281. N1PTEL= 0
  282. N1EL = 0
  283. DO 110 ICOMP = 1, NCOMP
  284. MELVAL = IVAL(ICOMP)
  285. N1PTEL = MAX(N1PTEL,VELCHE(/1))
  286. N1EL = MAX(N1EL ,VELCHE(/2))
  287. 110 CONTINUE
  288. N2PTEL=0
  289. N2EL =0
  290. *
  291. SEGINI,MELVA1,MELVA2,MELVA3
  292. *
  293. * Création des MCHAML ...
  294. *
  295. N2 = 1
  296. SEGINI,MCHAM1
  297. SEGINI,MCHAM2
  298. SEGINI,MCHAM3
  299. *
  300. MCHAM1.NOMCHE(1)='SCAL'
  301. MCHAM1.TYPCHE(1)='REAL*8'
  302. MCHAM1.IELVAL(1)=MELVA1
  303. *
  304. MCHAM2.NOMCHE(1)='SCAL'
  305. MCHAM2.TYPCHE(1)='REAL*8'
  306. MCHAM2.IELVAL(1)=MELVA2
  307. *
  308. MCHAM3.NOMCHE(1)='SCAL'
  309. MCHAM3.TYPCHE(1)='REAL*8'
  310. MCHAM3.IELVAL(1)=MELVA3
  311. *
  312. * Remplissage des attributs de la sous-zone ...
  313. *
  314. MCHEL1.INFCHE(ISOUS,1)=0
  315. MCHEL1.INFCHE(ISOUS,2)=0
  316. MCHEL1.INFCHE(ISOUS,3)=NIFOUR
  317. MCHEL1.INFCHE(ISOUS,4)=MINTE
  318. MCHEL1.INFCHE(ISOUS,5)=0
  319. MCHEL1.INFCHE(ISOUS,6)=ISUP1
  320. MCHEL1.IMACHE(ISOUS)=IPMAIL
  321. MCHEL1.CONCHE(ISOUS)=CONMOD
  322. MCHEL1.ICHAML(ISOUS)=MCHAM1
  323. *
  324. MCHEL2.INFCHE(ISOUS,1)=0
  325. MCHEL2.INFCHE(ISOUS,2)=0
  326. MCHEL2.INFCHE(ISOUS,3)=NIFOUR
  327. MCHEL2.INFCHE(ISOUS,4)=MINTE
  328. MCHEL2.INFCHE(ISOUS,5)=0
  329. MCHEL2.INFCHE(ISOUS,6)=ISUP1
  330. MCHEL2.IMACHE(ISOUS)=IPMAIL
  331. MCHEL2.CONCHE(ISOUS)=CONMOD
  332. MCHEL2.ICHAML(ISOUS)=MCHAM2
  333. *
  334. MCHEL3.INFCHE(ISOUS,1)=0
  335. MCHEL3.INFCHE(ISOUS,2)=0
  336. MCHEL3.INFCHE(ISOUS,3)=NIFOUR
  337. MCHEL3.INFCHE(ISOUS,4)=MINTE
  338. MCHEL3.INFCHE(ISOUS,5)=0
  339. MCHEL3.INFCHE(ISOUS,6)=ISUP1
  340. MCHEL3.IMACHE(ISOUS)=IPMAIL
  341. MCHEL3.CONCHE(ISOUS)=CONMOD
  342. MCHEL3.ICHAML(ISOUS)=MCHAM3
  343. *
  344. **********************************************************************
  345. * *
  346. * BRANCHEMENT SUIVANT LA FORMULATION *
  347. * *
  348. **********************************************************************
  349. * MASSI COQUE COQEP CIST
  350. GOTO ( 30, 99, 60, 99, 80, 99, 99, 99,120, 99,
  351. & 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
  352. & 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
  353. * INCO PORE
  354. & 30, 99, 30, 99, 99, 99, 99, 99, 99, 99), MFR
  355. C XFEM : idem massif
  356. IF (MFR.EQ.63) GOTO 30
  357. C
  358. 99 CONTINUE
  359. MOTERR(1:8) = NOMFR(MFR/2+1)
  360. CALL ERREUR(193)
  361. GOTO 240
  362. *_______________________________________________________________________
  363. *
  364. * FORMULATION MASSIVE / INCOMPRESSIBLE / POREUX / XFEM
  365. *_______________________________________________________________________
  366. *
  367. 30 CONTINUE
  368. DO 31 IB=1,N1EL
  369. DO 31 IGAU=1,N1PTEL
  370. *
  371. C ... Recherche des composantes du champ des contraintes ...
  372. MPTVAL=IVACOM
  373. DO 35 ICOMP=1,NCOMP
  374. MELVAL=IVAL(ICOMP)
  375. IGMN=MIN(IGAU,VELCHE(/1))
  376. IBMN=MIN(IB ,VELCHE(/2))
  377. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  378. 35 CONTINUE
  379.  
  380. C ... Calcul des invariants ...
  381.  
  382. XI1=SIG(1)+SIG(2)+SIG(3)
  383. IF (IFOUR.LT.1.AND.IFOUR.GT.-3) THEN
  384. XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
  385. . W1*SIG(4)*SIG(4)
  386. XI3=SIG(3)*(SIG(1)*SIG(2)-W2*SIG(4)*SIG(4))
  387. ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  388. XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)
  389. XI3=SIG(1)*SIG(2)*SIG(3)
  390. ELSE
  391. XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
  392. . W1*(SIG(4)*SIG(4)+SIG(5)*SIG(5)+SIG(6)*SIG(6))
  393. XI3=SIG(1)*SIG(2)*SIG(3)-
  394. . W2*(SIG(1)*SIG(6)*SIG(6)+SIG(2)*SIG(5)*SIG(5)+
  395. . SIG(3)*SIG(4)*SIG(4))+W3*SIG(4)*SIG(5)*SIG(6)
  396. ENDIF
  397.  
  398. C ... et leur stockage ...
  399.  
  400. MELVA1.VELCHE(IGAU,IB)=XI1
  401. MELVA2.VELCHE(IGAU,IB)=XI2
  402. MELVA3.VELCHE(IGAU,IB)=XI3
  403.  
  404. 31 CONTINUE
  405. GOTO 250
  406. *_______________________________________________________________________
  407. *
  408. * FORMULATION COQUE MINCE
  409. *_______________________________________________________________________
  410. *
  411. 60 CONTINUE
  412. DO 61 IB=1,N1EL
  413. DO 61 IGAU=1,N1PTEL
  414. C ... Recherche des composantes du champ des contraintes généralisées ...
  415. MPTVAL=IVACOM
  416. DO 62 ICOMP=1,NCOMP
  417. MELVAL=IVAL(ICOMP)
  418. IGMN=MIN(IGAU,VELCHE(/1))
  419. IBMN=MIN(IB ,VELCHE(/2))
  420. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  421. 62 CONTINUE
  422. *
  423. C ... Recherche de l'épaisseur de la coque ...
  424. MPTVAL=IVACAR
  425. MELVAL=IVAL(1)
  426. IGMN=MIN(IGAU,VELCHE(/1))
  427. IBMN=MIN(IB ,VELCHE(/2))
  428. EPAIST=VELCHE(IGMN,IBMN)
  429. *
  430. * ... CALCUL DES CONTRAINTES ...
  431. *
  432. CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  433. IF(IFOUR.GT.0) THEN
  434. SIG(1)=SIG(1)+SIG(4)*IMIL
  435. SIG(2)=SIG(2)+SIG(5)*IMIL
  436. SIG(3)=SIG(3)+SIG(6)*IMIL
  437. ELSE IF(IFOUR.LE.0) THEN
  438. SIG(1)=SIG(1)+SIG(3)*IMIL
  439. SIG(2)=SIG(2)+SIG(4)*IMIL
  440. SIG(3)=0.D0
  441. ENDIF
  442. *
  443. C ... Calcul des invariants ...
  444.  
  445. XI1=SIG(1)+SIG(2)
  446. XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+W1*SIG(3)*SIG(3)
  447. XI3=0.D0
  448. *
  449. C ... et leur stockage ...
  450. MELVA1.VELCHE(IGAU,IB)=XI1
  451. MELVA2.VELCHE(IGAU,IB)=XI2
  452. MELVA3.VELCHE(IGAU,IB)=XI3
  453. *
  454. 61 CONTINUE
  455. GOTO 250
  456. *_______________________________________________________________________
  457. *
  458. * FORMULATION COQUE EPAISSE
  459. *_______________________________________________________________________
  460. *
  461. 80 CONTINUE
  462. DO 81 IB=1,N1EL
  463. DO 81 IGAU=1,N1PTEL
  464. C ... Recherche des composantes du champ des contraintes ...
  465. MPTVAL=IVACOM
  466. DO 85 ICOMP=1,NCOMP
  467. MELVAL=IVAL(ICOMP)
  468. IGMN=MIN(IGAU,VELCHE(/1))
  469. IBMN=MIN(IB ,VELCHE(/2))
  470. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  471. 85 CONTINUE
  472. *
  473. C ... Calcul des invariants ...
  474.  
  475. XI1=SIG(1)+SIG(2)
  476. XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+
  477. & W1*(SIG(3)*SIG(3)+SIG(4)*SIG(4)+SIG(5)*SIG(5))
  478. XI3=-W2*(SIG(1)*SIG(5)*SIG(5)+SIG(2)*SIG(4)*SIG(4))
  479. & +W3*SIG(3)*SIG(4)*SIG(5)
  480. *
  481. C ... et leur stockage ...
  482.  
  483. MELVA1.VELCHE(IGAU,IB)=XI1
  484. MELVA2.VELCHE(IGAU,IB)=XI2
  485. MELVA3.VELCHE(IGAU,IB)=XI3
  486. *
  487. 81 CONTINUE
  488. GOTO 250
  489. *_______________________________________________________________________
  490. *
  491. * FORMULATION COQUE AVEC CISAILLEMENT
  492. *_______________________________________________________________________
  493. *
  494. 120 CONTINUE
  495. DO 121 IB=1,N1EL
  496. DO 121 IGAU=1,N1PTEL
  497. C ... Recherche des composantes du champ des contraintes ...
  498. MPTVAL=IVACOM
  499. DO 122 ICOMP=1,NCOMP
  500. MELVAL=IVAL(ICOMP)
  501. IGMN=MIN(IGAU,VELCHE(/1))
  502. IBMN=MIN(IB ,VELCHE(/2))
  503. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  504. 122 CONTINUE
  505. *
  506. C ... Recherche de l'épaisseur de la coque ...
  507. MPTVAL=IVACAR
  508. MELVAL=IVAL(1)
  509. IGMN=MIN(IGAU,VELCHE(/1))
  510. IBMN=MIN(IB ,VELCHE(/2))
  511. EPAIST=VELCHE(IGMN,IBMN)
  512. *
  513. * ... CALCUL DES CONTRAINTES ...
  514. *
  515. CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  516. SIG(1)=SIG(1)+SIG(4)*IMIL
  517. SIG(2)=SIG(2)+SIG(5)*IMIL
  518. SIG(4)=SIG(3)+SIG(6)*IMIL
  519. SIG(3)=0.D0
  520. SIG(5)=SIG(7)
  521. SIG(6)=SIG(8)
  522.  
  523. C ... Calcul des invariants ...
  524.  
  525. XI1=SIG(1)+SIG(2)+SIG(3)
  526. XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
  527. & W1*(SIG(4)*SIG(4)+SIG(5)*SIG(5)+SIG(6)*SIG(6))
  528. XI3=SIG(1)*SIG(2)*SIG(3)-
  529. & W2*(SIG(1)*SIG(6)*SIG(6)+SIG(2)*SIG(5)*SIG(5)+
  530. & SIG(3)*SIG(4)*SIG(4))+W3*SIG(4)*SIG(5)*SIG(6)
  531. *
  532. C ... et leur stockage ...
  533. MELVA1.VELCHE(IGAU,IB)=XI1
  534. MELVA2.VELCHE(IGAU,IB)=XI2
  535. MELVA3.VELCHE(IGAU,IB)=XI3
  536. *
  537. 121 CONTINUE
  538. GOTO 250
  539. *
  540. **********************************************************************
  541. * *
  542. * FIN DU BRANCHEMENT SUIVANT LA FORMULATION *
  543. * *
  544. **********************************************************************
  545. *
  546. * ... DESACTIVATION DES SEGMENTS PROPRES A LA GEOMETRIE ISOUS ...
  547. *
  548. 250 CONTINUE
  549. iOK = 1
  550.  
  551. 240 CONTINUE
  552. SEGDES,MELVA1,MELVA2,MELVA3
  553. SEGDES,MCHAM1,MCHAM2,MCHAM3
  554. *
  555. 230 CONTINUE
  556. IF (MOCARA.NE.0) THEN
  557. nomid = MOCARA
  558. SEGSUP,nomid
  559. ENDIF
  560. *
  561. CALL DTMVAL(IVACOM,1)
  562. *
  563. 220 CONTINUE
  564. nomid = MOCOMP
  565. SEGDES,nomid
  566. IF (lsupno) SEGSUP,nomid
  567. *
  568. 210 CONTINUE
  569. SEGDES,IMODEL
  570. *
  571. * ... ERREUR DANS UNE SOUS ZONE : DESACTIVATION ET RETOUR ...
  572. IF (iOK.EQ.0) GOTO 990
  573. *
  574. 200 CONTINUE
  575.  
  576. C ... FIN DE LA GRANDE BOUCLE SUR LES ZONES ÉLÉMENTAIRES ...
  577.  
  578. IRET = 1
  579.  
  580. 990 CONTINUE
  581. SEGDES,MMODEL
  582.  
  583. IF (IRET.EQ.1) THEN
  584. SEGDES,MCHEL1,MCHEL2,MCHEL3
  585. IPCHE2 = MCHEL1
  586. IPCHE3 = MCHEL2
  587. IPCHE4 = MCHEL3
  588. ELSE
  589. SEGSUP,MCHEL1,MCHEL2,MCHEL3
  590. IPCHE2 = 0
  591. IPCHE3 = 0
  592. IPCHE4 = 0
  593. ENDIF
  594. *
  595. SEGSUP,notype
  596. IF (IPCH5O.NE.IPCHE5) THEN
  597. CALL DTCHAM(IPCHE5)
  598. IPCHE5 = IPCH5O
  599. ENDIF
  600. *
  601. 666 CONTINUE
  602. SEGDES,MCHELM
  603.  
  604. RETURN
  605. END
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  

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