Télécharger feqpr.eso

Retour à la liste

Numérotation des lignes :

  1. C FEQPR SOURCE MB234859 18/02/28 21:15:06 9749
  2. SUBROUTINE FEQPR(IPMODL,IPCHM1,IPCHM2,IPCHP4,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C ENTREES:
  6. C ________
  7. C
  8. C IPMODL Pointeur sur un MMODEL
  9. C IPCHM1 Pointeur sur un MCHAML de CONTRAINTES
  10. C IPCHM2 Pointeur sur un MCHAML de CARACTERISTIQUES
  11. C
  12. C SORTIES:
  13. C ________
  14. C
  15. C IPCHP4 Pointeur sur un CHPOINT de forces aux noeuds
  16. C IRET = 1 OU 0 suivant succes ou pas (Message d'erreur
  17. C imprime dans ce cas)
  18. C_______________________________________________________________________
  19. C
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. C
  23. -INC CCOPTIO
  24. -INC CCHAMP
  25. -INC SMMODEL
  26. -INC SMCHAML
  27. -INC SMCHPOI
  28. -INC SMELEME
  29. -INC SMINTE
  30. -INC SMLENTI
  31. C
  32. SEGMENT NOTYPE
  33. CHARACTER*16 TYPE(NBTYPE)
  34. ENDSEGMENT
  35. C
  36. SEGMENT MPTVAL
  37. INTEGER IPOS(NS) ,NSOF(NS)
  38. INTEGER IVAL(NCOSOU)
  39. CHARACTER*16 TYVAL(NCOSOU)
  40. ENDSEGMENT
  41. C
  42. SEGMENT LIMODL(0)
  43. C
  44. PARAMETER ( NINF=3 )
  45. INTEGER INFOS(NINF)
  46. CHARACTER*8 CMATE
  47. CHARACTER*(NCONCH) CONM
  48. C_______________________________________________________________________
  49. C
  50. C A T-ON BIEN UN MMODEL CHARGEMENT PRESSION
  51. C_______________________________________________________________________
  52. C
  53. MMODEL=IPMODL
  54. SEGACT,MMODEL
  55. NSOUS = MMODEL.KMODEL(/1)
  56. SEGINI, LIMODL
  57. DO ISOUS = 1,NSOUS
  58. IMODEL = MMODEL.KMODEL(ISOUS)
  59. SEGACT, IMODEL
  60. IF (FORMOD(1).EQ.'CHARGEMENT') THEN
  61. LIMODL(**) = IMODEL
  62. ELSE
  63. SEGDES, IMODEL
  64. ENDIF
  65. ENDDO
  66. C
  67. NSOUS = LIMODL(/1)
  68. IF (NSOUS.EQ.0) THEN
  69. SEGDES, MMODEL
  70. MOTERR(1:10)='un MMODEL '
  71. MOTERR(11:20)='CHARGEMENT'
  72. MOTERR(21:30)=' PRESSION '
  73. CALL ERREUR(881)
  74. RETURN
  75. ENDIF
  76. C
  77. C TEST DE NON REDONDANCES DES SOUS-MODELES
  78. C
  79. N1 = 1
  80. DO I = NSOUS,2,-1
  81. IMODE1 = LIMODL(I)
  82. DO J = (I-1),1,-1
  83. IMODE2 = LIMODL(J)
  84. IF (IMODE1.EQ.IMODE2) THEN
  85. LIMODL(I) = 0
  86. GOTO 10
  87. ELSE IF (IMODE1.IMAMOD.EQ.IMODE2.IMAMOD .AND.
  88. & IMODE1.CONMOD.EQ.IMODE2.CONMOD) THEN
  89. LIMODL(I) = 0
  90. GOTO 10
  91. ENDIF
  92. SEGDES,IMODE1
  93. ENDDO
  94. N1 = N1 + 1
  95. 10 CONTINUE
  96. ENDDO
  97. C
  98. C CREATION DU MMODEL
  99. C
  100. J = 0
  101. SEGINI,MMODE1
  102. DO i = 1,NSOUS
  103. IF (LIMODL(I).GT.0) THEN
  104. j = j + 1
  105. MMODE1.KMODEL(J) = LIMODL(I)
  106. ENDIF
  107. ENDDO
  108. IPMOD0 = MMODE1
  109. SEGDES, MMODE1
  110. SEGSUP, LIMODL
  111. C_______________________________________________________________________
  112. C
  113. C QUELQUES INITIALISATIONS
  114. C_______________________________________________________________________
  115. C
  116. ISUP1 = 0
  117. ISUP2 = 0
  118. IRET = 0
  119. IPCHP4 = 0
  120. MCHELM = 0
  121. MCHAML = 0
  122. IPCHE1 = 0
  123. IPCHE2 = 0
  124. C_______________________________________________________________________
  125. C
  126. C REDUCTION DES MCHAML EN ENTREE SUR LE MODELE
  127. C_______________________________________________________________________
  128. C
  129. C DEJA FAIT DANS BSIGMA
  130. IF (IPCHM1.NE.0) THEN
  131. CALL REDUAF(IPCHM1,IPMOD0,IPCHE1,0,IR,KER)
  132. IF (IR.NE.1) CALL ERREUR(KER)
  133. IF (IERR.NE.0) RETURN
  134. ENDIF
  135. C
  136. IF (IPCHM2.NE.0) THEN
  137. CALL REDUAF(IPCHM2,IPMOD0,IPCHE2,0,IR,KER)
  138. IF (IR.NE.1) CALL ERREUR(KER)
  139. IF (IERR.NE.0) RETURN
  140. ENDIF
  141. C_______________________________________________________________________
  142. C
  143. C VERIFICATION DES LIEUX SUPPORT DES MCHAML
  144. C_______________________________________________________________________
  145. C
  146. IF (IPCHE1.NE.0) THEN
  147. CALL QUESUP(IPMOD0,IPCHE1,3,0,ISUP1,IRET1C)
  148. IF (ISUP1.GT.1) RETURN
  149. ENDIF
  150. C
  151. IF (IPCHE2.NE.0) THEN
  152. CALL QUESUP(IPMOD0,IPCHE2,3,0,ISUP2,IR)
  153. IF (ISUP2.GT.1) RETURN
  154. ENDIF
  155. C_______________________________________________________________________
  156. C
  157. C ACTIVATION DU MODELE
  158. C_______________________________________________________________________
  159. C
  160. MMODEL=IPMOD0
  161. SEGACT, MMODEL
  162. NSOUS = MMODEL.KMODEL(/1)
  163. DO IM = 1, NSOUS
  164. IMODEL = MMODEL.KMODEL(IM)
  165. SEGACT, IMODEL
  166. ENDDO
  167. C
  168. C ACTIVATION DU MCHELM CONTENANT 'PRES'
  169. C
  170. IF (IPCHE1.NE.0) THEN
  171. MCHEL1 = IPCHE1
  172. ELSE
  173. MCHEL1 = IPCHE2
  174. ENDIF
  175. SEGACT, MCHEL1
  176. C
  177. C INITIALISATION DU MCHELM DE FORCES
  178. C
  179. N1 = NSOUS
  180. L1 = 6
  181. N3 = 5
  182. SEGINI, MCHELM
  183. IPCHE5 = MCHELM
  184. MCHELM.IFOCHE = IFOUR
  185. MCHELM.TITCHE = 'FORCES'
  186. C
  187. C=======================================================================
  188. C
  189. C BOUCLE SUR LES MODELES ELEMENTAIRES
  190. C
  191. C=======================================================================
  192. C
  193. ISOUS = 0
  194. C
  195. DO 200 KISOUS = 1, NSOUS
  196. C
  197. C INITIALISATION
  198. C
  199. IVAMAT=0
  200. IVACAR=0
  201. IVASTR=0
  202. IVAFOR=0
  203. MOMATR=0
  204. MOCARA=0
  205. MOSTRS=0
  206. MOFORC=0
  207. IPMINT=0
  208. IPMIN1=0
  209. C
  210. C TRAITEMENT DU MODELE
  211. C
  212. IMODEL = MMODEL.KMODEL(KISOUS)
  213. ISOUS = ISOUS+1
  214. MELE = IMODEL.NEFMOD
  215. C
  216. C PETITE VERIFICATION SUR LE TYPE D'ELEMENT
  217. C
  218. IF (MELE.EQ.0) THEN
  219. C
  220. C ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR PRESSI POUR
  221. C LES ELEMENTS DE FORMULATION MELE
  222. C
  223. MOTERR(1:8)=NOMTP(MELE)
  224. CALL ERREUR(193)
  225. GOTO 9992
  226. ENDIF
  227. IPMAIL = IMODEL.IMAMOD
  228. CONM = IMODEL.CONMOD
  229. C
  230. C CREATION DU TABLEAU INFOS
  231. C
  232. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  233. IF (IRTD.EQ.0) GOTO 9992
  234. C
  235. C NATURE DU MATERIAU
  236. C
  237. CMATE = CMATEE
  238. MATE = IMATEE
  239. INAT = INATUU
  240. C_______________________________________________________________________
  241. C
  242. C ACTIVATION DU MELEME
  243. C_______________________________________________________________________
  244. C
  245. MELEME = IPMAIL
  246. SEGACT, MELEME
  247. NBNN = MELEME.NUM(/1)
  248. NBELEM = MELEME.NUM(/2)
  249. C_______________________________________________________________________
  250. C
  251. C INFORMATIONS SUR L'ELEMENT FINI
  252. C_______________________________________________________________________
  253. C
  254. NBPGAU= INFELE(4)
  255. MINTE = INFMOD(5)
  256. MINTE1= INFMOD(8)
  257. MFR = INFELE(13)
  258. MFR2 = NUMMFR(MELE)
  259. NSTRS = INFELE(16)
  260. C
  261. IPMINT= MINTE
  262. IPMIN1= MINTE1
  263. SEGACT, MINTE
  264. IPPORE= 0
  265. IF (MFR2.EQ.33.OR.MFR2.EQ.57.OR.MFR2.EQ.59) IPPORE = NBNN
  266. C
  267. IMACHE(ISOUS) = IPMAIL
  268. INFCHE(ISOUS,1)=0
  269. INFCHE(ISOUS,2)=0
  270. INFCHE(ISOUS,3)=NIFOUR
  271. INFCHE(ISOUS,4)=0
  272. INFCHE(ISOUS,5)=0
  273. C_______________________________________________________________________
  274. C
  275. C NOMS DE COMPOSANTES DE CONTRAINTES
  276. C_______________________________________________________________________
  277. C
  278. IF (IPCHE1.NE.0) THEN
  279. MOSTRS=LNOMID(4)
  280. NOMID=MOSTRS
  281. SEGACT, NOMID
  282. NSTR=LESOBL(/2)
  283. NFAC=LESFAC(/2)
  284. C
  285. NBTYPE=1
  286. SEGINI, NOTYPE
  287. TYPE(1)='REAL*8'
  288. MOTYPE=NOTYPE
  289. C
  290. C VERIFICATION DE LEUR PRESENCE
  291. C
  292. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  293. SEGSUP, NOTYPE
  294. SEGDES, NOMID
  295. IF (IERR.NE.0) GOTO 9991
  296. C
  297. IF (ISUP1.EQ.1) THEN
  298. NSTRS = 1
  299. CALL VALCHE(IVASTR,NSTRS,IPMINT,IPPORE,MOSTRS,MELE)
  300. ENDIF
  301. ELSE
  302. MOMATR=LNOMID(6)
  303. NOMID=MOMATR
  304. SEGACT, NOMID
  305. NMATR=LESOBL(/2)
  306. NMATF=LESFAC(/2)
  307. C
  308. NBTYPE=1
  309. SEGINI, NOTYPE
  310. TYPE(1)='REAL*8'
  311. MOTYPE=NOTYPE
  312. C
  313. C VERIFICATION DE LEUR PRESENCE
  314. C
  315. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  316. SEGSUP, NOTYPE
  317. SEGDES, NOMID
  318. IF (IERR.NE.0) GOTO 9991
  319. C
  320. IF (ISUP2.EQ.1) THEN
  321. CALL VALCHE(IVAMAT,NMATR,IPMINT,IPPORE,MOMATR,MELE)
  322. ENDIF
  323. ENDIF
  324. C_______________________________________________________________________
  325. C
  326. C NOMS DE COMPOSANTES DE FORCES ET CREATION DU MCHAML DE FORCE
  327. C (CE MCHAML SERA TRANSFORME EN FIN DE SUBROUTINE EN CHPOINT)
  328. C_______________________________________________________________________
  329. C
  330. MOFORC = LNOMID(2)
  331. NOMID=MOFORC
  332. SEGACT, NOMID
  333. NFORC=LESOBL(/2)
  334. NFACF=LESFAC(/2)
  335. C
  336. N2=NFORC
  337. SEGINI, MCHAML
  338. ICHAML(ISOUS)=MCHAML
  339. C
  340. DO 110 ICOMP=1,NFORC
  341. NOMCHE(ICOMP)=LESOBL(ICOMP)
  342. TYPCHE(ICOMP)='REAL*8'
  343. 110 CONTINUE
  344. C
  345. IF (NFACF.NE.0) THEN
  346. IFAC = 0
  347. DO 111 ICOMP=(NFORC+1),N2
  348. IFAC = IFAC + 1
  349. NOMCHE(ICOMP)=LESFAC(IFAC)
  350. TYPCHE(ICOMP)='REAL*8'
  351. 111 CONTINUE
  352. ENDIF
  353. C
  354. SEGDES, NOMID
  355. C
  356. C TAILLES DE MELVAL
  357. C
  358. N1EL=NBELEM
  359. N1PTEL=NBNN
  360. NBPTEL=NBPGAU
  361. NEL =N1EL
  362. C
  363. C CREATION DU MELVAL DE FORCES
  364. C
  365. NS=1
  366. NCOSOU=NFORC+NFACF
  367. SEGINI, MPTVAL
  368. IVAFOR=MPTVAL
  369. DO 100 ICOMP=1,NCOSOU
  370. N2PTEL=0
  371. N2EL=0
  372. SEGINI, MELVAL
  373. IELVAL(ICOMP)=MELVAL
  374. IVAL(ICOMP)=MELVAL
  375. 100 CONTINUE
  376. C_______________________________________________________________________
  377. C
  378. C NOMS DE COMPOSANTES DE CARACTERISTIQUES (FACULTATIF)
  379. C_______________________________________________________________________
  380. C
  381. NBROBL=0
  382. NBRFAC=0
  383. NOMID=0
  384. IVECT=0
  385. C
  386. C EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  387. C
  388. IF(MFR.EQ.72.AND.IFOUR.EQ.-2)THEN
  389. C
  390. NBRFAC=1
  391. SEGINI, NOMID
  392. LESFAC(1)='DIM3'
  393. C
  394. NBTYPE=1
  395. SEGINI, NOTYPE
  396. TYPE(1)='REAL*8'
  397. C
  398. C EPAISSEUR DANS LE CAS DES COQUES 2D COQ2
  399. C
  400. ELSEIF(MFR.EQ.74.AND.MELE.EQ.44.AND.IFOUR.EQ.-2)THEN
  401. C
  402. NBRFAC=1
  403. SEGINI, NOMID
  404. LESFAC(1)='DIM3'
  405. C
  406. NBTYPE=1
  407. SEGINI, NOTYPE
  408. TYPE(1)='REAL*8'
  409. C
  410. C EPAISSEUR DANS LE CAS DES COQUES EPAISSES
  411. C
  412. ELSEIF (MFR.EQ.74.AND.MFR2.EQ.5) THEN
  413. NBROBL=1
  414. NBRFAC=0
  415. SEGINI, NOMID
  416. LESOBL(1)='EPAI'
  417. C
  418. NBTYPE=1
  419. SEGINI, NOTYPE
  420. TYPE(1)='REAL*8'
  421. C
  422. C EPAISSEUR ET RAYON EXTERNE DANS LE CAS DES TUYAUX
  423. C
  424. ELSEIF (MFR.EQ.74.AND.MFR2.EQ.13) THEN
  425. NBROBL=2
  426. NBRFAC=2
  427. SEGINI, NOMID
  428. LESOBL(1)='EPAI'
  429. LESOBL(2)='RAYO'
  430. LESFAC(1)='RACO'
  431. LESFAC(2)='VECT'
  432. C
  433. NBTYPE=4
  434. SEGINI, NOTYPE
  435. TYPE(1)='REAL*8'
  436. TYPE(2)='REAL*8'
  437. TYPE(3)='REAL*8'
  438. TYPE(4)='POINTEURPOINT '
  439. C
  440. ENDIF
  441. MOCARA=NOMID
  442. MOTYPE=NOTYPE
  443. C
  444. NCARA=NBROBL
  445. NCARF=NBRFAC
  446. NCARR=NCARA+NCARF
  447. C
  448. IF (IPCHE2.NE.0) THEN
  449. IF (MOCARA.NE.0) THEN
  450. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  451. + IVACAR)
  452. SEGSUP, NOTYPE
  453. SEGSUP, NOMID
  454. IF (IERR.NE.0) GOTO 9990
  455. IF (ISUP2.EQ.1) THEN
  456. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  457. IF (IERR.NE.0)THEN
  458. ISUP2=0
  459. GOTO 9990
  460. ENDIF
  461. ENDIF
  462. ELSE
  463. SEGSUP, NOTYPE
  464. SEGSUP, NOMID
  465. ENDIF
  466. ELSE IF (NCARA.GT.0) THEN
  467. SEGSUP, NOTYPE
  468. SEGSUP, NOMID
  469. MOTERR(1:8)='CARACTER'
  470. MOTERR(9:12)=NOMTP(MELE)
  471. MOTERR(13:20)='FEQPR'
  472. CALL ERREUR(145)
  473. GOTO 9990
  474. ENDIF
  475. C_______________________________________________________________________
  476. C
  477. C CALCUL DES FORCES EQUIVALENTES
  478. C_______________________________________________________________________
  479. C
  480. IF (IPCHE1.NE.0) THEN
  481. MPTVAL=IVASTR
  482. ELSE
  483. MPTVAL=IVAMAT
  484. ENDIF
  485. IVAPRE = IVAL(1)
  486. C
  487. C - ELEMENTS DE FORMULATION MASSIF
  488. C
  489. IF (MFR2.EQ.1) THEN
  490. XP=0.D0
  491. IF (MELE.EQ.2.OR.MELE.EQ.3.OR.MELE.EQ.79.OR.MELE.EQ.80) THEN
  492. CALL FPMA2D(IVAPRE,IPMAIL,IPMINT,IVAFOR,IVACAR,XP)
  493. ELSE IF(MELE.EQ.4.OR.MELE.EQ.6.OR.MELE.EQ.8.OR.
  494. + MELE.EQ.10.OR.MELE.EQ.81.OR.MELE.EQ.82.OR.
  495. + MELE.EQ.83) THEN
  496. IF (IDIM.EQ.3) THEN
  497. CALL FPMA3D(IVAPRE,IPMAIL,IPMINT,IVAFOR,XP)
  498. ELSE
  499. C ERREUR, APPLICATION PRESSION SUR SURFACE DANS UN PB 2D
  500. CALL ERREUR(820)
  501. GOTO 9990
  502. ENDIF
  503. ELSE IF (MELE.EQ.45) THEN
  504. CALL FPMA1D(IVAPRE,IPMAIL,IPMINT,IVAFOR,XP)
  505. ELSE
  506. C ERREUR, ELEMENT NON IMPLEMENTE
  507. MOTERR(1:4)=NOMTP(MELE)
  508. MOTERR(5:12)='FEQPR '
  509. CALL ERREUR(86)
  510. GOTO 9990
  511. ENDIF
  512. C
  513. C - ELEMENTS DE FORMULATION COQUES
  514. C
  515. ELSE IF (MFR2.EQ.3.OR.MFR2.EQ.5.OR.MFR2.EQ.9) THEN
  516. C
  517. IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45.OR.
  518. + MELE.EQ.93.OR.MELE.EQ.44.OR.MELE.EQ.49.OR.
  519. + MELE.EQ.41.OR.MELE.EQ.56) THEN
  520. C VERIFICATION DE L ORIENTATION DU IPMAIL
  521. CALL ECROBJ('MAILLAGE',IPMAIL)
  522. CALL VERSEN
  523. CALL LIROBJ('MAILLAGE',IPMAIL,1,IRETOU)
  524. IF (IERR.NE.0) GOTO 9990
  525. IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.45
  526. + .OR.MELE.EQ.93) THEN
  527. CALL FPCO3D(IVAPRE,IPMAIL,IVAFOR)
  528. ELSE IF (MELE.EQ.44) THEN
  529. CALL FPCO2D(IVAPRE,IPMAIL,IVAFOR,IVACAR)
  530. ELSE IF (MELE.EQ.49) THEN
  531. IPT1 = IPMAIL
  532. SEGACT, IPT1
  533. CALL FPCOQ4(IVAPRE,IPMAIL,IPMINT,IVAFOR)
  534. SEGDES, IPT1
  535. ELSE IF (MELE.EQ.41.OR.MELE.EQ.56) THEN
  536. IPT1 = IPMAIL
  537. SEGACT, IPT1
  538. CALL FPCOQ8(IVAPRE,IPMAIL,IPMINT,IVACAR,IPMIN1,IVAFOR)
  539. SEGDES, IPT1
  540. ENDIF
  541. ELSE
  542. C ERREUR, ELEMENT NON IMPLEMENTE
  543. MOTERR(1:4)=NOMTP(MELE)
  544. MOTERR(5:12)='FEQPR '
  545. CALL ERREUR(86)
  546. GOTO 9990
  547. ENDIF
  548. C
  549. ELSE IF (MFR2.EQ.13) THEN
  550. C
  551. C - ELEMENTS TUYAU
  552. C
  553. CALL FPELTU(IVAPRE,IVACAR,IPMAIL,I,IVAFOR)
  554. C
  555. C - SINON TENTATIVE D'UTILISATION D'UNE OPTION NON IMPLEMENTEE
  556. C
  557. ELSE
  558. CALL ERREUR(251)
  559. GOTO 9990
  560. ENDIF
  561. C
  562. C DESACTIVATION AVANT DE PASSER A LA SOUS ZONE SUIVANTE
  563. C
  564. SEGDES, MELEME
  565. SEGDES, MINTE
  566. C
  567. IF(ISUP1.EQ.1)THEN
  568. CALL DTMVAL(IVASTR,3)
  569. ELSE
  570. CALL DTMVAL(IVASTR,1)
  571. ENDIF
  572. C
  573. CALL DTMVAL(IVAFOR,1)
  574. C
  575. IF(ISUP2.EQ.1)THEN
  576. CALL DTMVAL(IVAMAT,3)
  577. CALL DTMVAL(IVACAR,3)
  578. ELSE
  579. CALL DTMVAL(IVAMAT,1)
  580. CALL DTMVAL(IVACAR,1)
  581. ENDIF
  582. C
  583. IF (IERR.NE.0) GO TO 9990
  584. C
  585. C=======================================================================
  586. C
  587. C FIN DE BOUCLE SUR LES MODELES ELEMENTAIRES
  588. C
  589. C=======================================================================
  590. 200 CONTINUE
  591. C_______________________________________________________________________
  592. C
  593. C TRANSFORMATION DU CHAMELEM EN CHPOINT
  594. C_______________________________________________________________________
  595. C
  596. CALL CHAMPO(IPCHE5,0,IPCHP4,IRETOU)
  597. CALL DTCHAM(IPCHE5)
  598. IF (IRETOU.EQ.0) GOTO 9000
  599. C
  600. C FIN NORMALE
  601. C
  602. IRET = 1
  603. GOTO 9000
  604. C_______________________________________________________________________
  605. C
  606. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  607. C_______________________________________________________________________
  608. C
  609. 9990 CONTINUE
  610. IF (MCHAML.NE.0) SEGSUP, MCHAML
  611. CALL DTMVAL(IVAFOR,3)
  612. C
  613. 9991 CONTINUE
  614. SEGDES, MINTE
  615. C
  616. 9992 CONTINUE
  617. IF (MCHELM.NE.0) SEGSUP, MCHELM
  618. SEGDES, MELEME
  619. C
  620. IRET = 0
  621. SEGSUP, MCHELM
  622. C_______________________________________________________________________
  623. C
  624. C DERNIERES DESACTIVATION AVANT DE QUITTER
  625. C_______________________________________________________________________
  626. C
  627. 9000 CONTINUE
  628. MMODEL = IPMOD0
  629. DO IM = 1, NSOUS
  630. IMODEL = MMODEL.KMODEL(IM)
  631. SEGDES, IMODEL
  632. ENDDO
  633. SEGDES, MCHEL1
  634. C
  635. RETURN
  636. END
  637.  
  638.  
  639.  
  640.  
  641.  
  642.  

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