Télécharger ecou20.eso

Retour à la liste

Numérotation des lignes :

ecou20
  1. C ECOU20 SOURCE OF166741 25/02/21 21:16:00 12166
  2. SUBROUTINE ECOU20(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  3. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  4. 1 IVADS,IVAMAT,IVACAR,
  5. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVARI,NMATT,NCARR,
  6. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  7. 4 N2EL,N2PTEL,NBNO,NBPGAU,LW,IVASTF,IVARIF,IVADEP,KERRE)
  8. ***********************************************************************
  9. * ecoulement inelastique appele par ecoul1
  10. c ppu modif pour les materiaux unidirectionels en plastique
  11. * MATERIAUX: - VISCOPLASTIQUES ET FLUAGE INTEGRES PAR CONSTI
  12. ***********************************************************************
  13. * entrees :
  14. *
  15. * mate = numero de materiau elastique
  16. * inplas = numero de materiau inelastique
  17. * mele = numero element fini
  18. * ipmail = pointeur du maillage
  19. * nbptel = nombre de points par element
  20. * imat = pointeur sur un segment mptval de materiau (utilise par calsig)
  21. * icar = pointeur sur un segment mptval de caracteristiques
  22. * geometriques (utilise par calsig)
  23. * numat = nb de composantes du melval de imat
  24. * nucar = nb de composantes du melval de icar
  25. * ivastr =pointeur sur un segment mptval de contraintes
  26. * ivari =pointeur sur un segment mptval de variables internes
  27. * ivadef =pointeur sur un segment mptval de deformations
  28. * ivads =pointeur sur un segment mptval de contraintes (increments)
  29. * ivamat =pointeur sur un segment mptval de materiau
  30. * ivacar =pointeur sur un segment mptval de cacarteristiques geometrique
  31. * iph1 = pointeur sur un mchaml de temperatures au debut du pas
  32. * iph2 = pointeur sur un mchaml de temperatures a la fin du pas
  33. * iph3 = pointeur sur un mchaml de temperatures de reference
  34. * ithher = 0 si pas de chargement thermique
  35. * = 1 si chargement thermique mais materiau constant
  36. * = 2 si chargement thermique et mat. dependant de la temperature
  37. * ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux
  38. * endommageables de lemaitre quand ils dependent de la temperature
  39. * lhook =taille de la matrice de hooke
  40. * nstrs =nombre de composantes de contraintes
  41. * nvari =nombre de composantes de variables internes
  42. * nmatt =nombre de composnates de proprietes de materiau
  43. * ncarr =nombre de composnates de caracteristiques geometriques
  44. * cmate =nom du materiau
  45. * precis =precision dans les iterations internes
  46. * jecher =0 ou 1 pour action dans ecoule
  47. * jnoid =0 ou 1 pour action dans ecoule
  48. * ipotab =pointeur sur segment table
  49. * istep =indicateur d'action pour calcul nonlocal
  50. * =0 dans le cas d'un calcul local (normal)
  51. * =1 ou 2 dans le cas d'un calcul nonlocal
  52. * =1 pour calcul des fonctions seuil uniquement
  53. * =2 pour calcul des variables dissipatives a partir
  54. * des fonctions seuil moyennees prealablement par nloc
  55. *
  56. * sorties :
  57. * ivastf =pointeur sur un segment mptval de contraintes
  58. * ivarif =pointeur sur un segment mptval de variables internes
  59. * ivadep =pointeur sur un segment mptval de deformations inelastiques
  60. * kerre =indicateur d'erreur
  61. *
  62. * p dowlatyari fev. 1992
  63. *
  64. * c. la borderie fev 92 restructuration et reecriture de certains
  65. * passages pour une meilleure lisibilite
  66. *
  67. * avril 92 ajout istep pour le non local
  68. * dec 92 modif pour poutres timoschenko
  69. *
  70. ************************************************************************
  71. IMPLICIT INTEGER(I-N)
  72. IMPLICIT REAL*8(A-H,O-Z)
  73. *
  74.  
  75. -INC PPARAM
  76. -INC CCOPTIO
  77. -INC SMCHAML
  78. -INC SMELEME
  79. -INC SMCOORD
  80. -INC SMMODEL
  81. -INC SMINTE
  82. -INC CCHAMP
  83. -INC CECOU
  84. c=======================================================================
  85. c la variable kerre regit les impressions d erreurs dans plast
  86. c toutes erreurs de ecoule gerees dans ce sous programme
  87. c kerre=0 tout ok
  88. c de 1 a 6 s aligner sur valeurs donnees par ecoinc
  89. c = 7 un element tuyau a une epaisseur nulle
  90. c = 21 on ne trouve pas d intersection avec la surface de charge
  91. c = 22 sig0 a l exterieur de la surface de charge
  92. c
  93. c anomalies avec la courbe de traction
  94. c = 30 limite elastique nulle
  95. c = 31 trop de points
  96. c = 32 pas assez de points
  97. c = 33 pente incorrecte
  98. c = 34 module d'young nul
  99. c = 35 manque l'origine
  100. c = 36 pente a l'origine non egale a e
  101. c = 37 manque la courbe de traction
  102. c = 38 nu devrait etre nul
  103. c
  104. c = 48 donnees erronnees pour drucker-prager
  105. c = 49 matrice singuliere dans iter internes drucker-prager
  106. c = 51 pb dans drucker prager option non disponible
  107. c = 52 pb dans drucker prager donnees incompatibles
  108. c = 53 pb dans drucker prager solution impossible
  109. c = 54 les valeurs admissibles pour istep sont 0 1 ou 2
  110. c = 55 modele non implante en non local
  111. c = 56 probleme dans l'integration du modele mazars
  112. c = 57 ....
  113. c = 58 ....
  114. c = 59 ....
  115. c = 60 pb donnees du cam-clay
  116. c
  117. c = 99 cas non encore disponible
  118. c=======================================================================
  119. *
  120. SEGMENT WRK0
  121. REAL*8 XMAT(NCXMAT)
  122. ENDSEGMENT
  123. *
  124. SEGMENT WR00
  125. CHARACTER*16 TYMAT(NCXMAT)
  126. REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  127. ENDSEGMENT
  128. *
  129. SEGMENT WRK1
  130. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  131. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  132. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  133. ENDSEGMENT
  134. *
  135. SEGMENT WRK2
  136. REAL*8 TRAC(LTRAC)
  137. ENDSEGMENT
  138. *
  139. SEGMENT WRK22
  140. REAL*8 XXE(3,NBNN)
  141. ENDSEGMENT
  142. *
  143. SEGMENT WRK3
  144. REAL*8 WORK(LW),WORK2(LW2)
  145. ENDSEGMENT
  146. *
  147. SEGMENT WRK4
  148. REAL*8 XE(3,NBBB)
  149. ENDSEGMENT
  150. *
  151. SEGMENT WRK5
  152. REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  153. ENDSEGMENT
  154. *
  155. SEGMENT WRK6
  156. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  157. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  158. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  159. ENDSEGMENT
  160. *
  161. SEGMENT WRK7
  162. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  163. ENDSEGMENT
  164. *
  165. SEGMENT WRK8
  166. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  167. ENDSEGMENT
  168. *
  169. SEGMENT WRK9
  170. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  171. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  172. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  173. REAL*8 SIGY(NSIGY)
  174. INTEGER NKX(NNKX)
  175. ENDSEGMENT
  176. *
  177. SEGMENT WR10
  178. INTEGER IABLO1(NTABO1)
  179. REAL*8 TABLO2(NTABO2)
  180. ENDSEGMENT
  181. *
  182. SEGMENT WR11
  183. INTEGER IABLO3(NTABO3)
  184. REAL*8 TABLO4(NTABO4)
  185. ENDSEGMENT
  186. *
  187. SEGMENT WTRAV
  188. REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  189. REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  190. REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  191. REAL*8 XLOC(3,3),XGLOB(3,3)
  192. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  193. ENDSEGMENT
  194. *
  195. SEGMENT WPOUT
  196. REAL*8 X(2),Y(2),Z(2)
  197. ENDSEGMENT
  198. LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  199. LOGICAL LUNI1,LUNI2
  200. DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  201. *
  202. CHARACTER*72 CHARRE
  203. CHARACTER*8 CMATE
  204. c
  205. *
  206. * mise à disposition des temperatures tini tfin tref
  207. * aux points de gauss
  208. *
  209. TETA1=-1.E35
  210. TETA2=-1.E35
  211. TETREF=-1.E35
  212. TREFA=-1.E35
  213. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  214. MCHAM3=IPH1
  215. MCHAM4=IPH2
  216. MCHAM5=IPH3
  217. SEGACT MCHAM3
  218. SEGACT MCHAM4
  219. SEGACT MCHAM5
  220. MELVA3=MCHAM3.IELVAL(1)
  221. MELVA4=MCHAM4.IELVAL(1)
  222. MELVA5=MCHAM5.IELVAL(1)
  223. SEGACT MELVA3
  224. SEGACT MELVA4
  225. SEGACT MELVA5
  226. ENDIF
  227. c
  228. c Initialisations de variables
  229. c---------------------------------
  230. c - mise à zéro des variables du commun NECOU si besoin
  231. c - modèles viscoplastiques:
  232. c . on récupère le pas de temps
  233. c . on récupère le nombre maximal de sous-pas
  234. c . on met IND=1
  235. c - initialisation des dimensions des tableaux des segments
  236. c Sorties: en plus du commun NECOU, on range les autres données
  237. c initialisées dans les COMMON IECOU et XECOU
  238. c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  239. c argument de DEFINI
  240. c
  241. CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  242. . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  243. . IPMAIL,IVAMAT,
  244. . ITHHER,NUMAT,NUCAR,LOGVIS,
  245. . LUNI1,LUNI2,LW,KERRE)
  246. IF (KERRE.EQ.999) RETURN
  247. c
  248. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  249. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  250. 1 .OR.MFR.EQ.33)) THEN
  251. CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  252. MINTE2=IPTR1
  253. SEGACT MINTE2
  254. SEGINI WRK22
  255. ENDIF
  256. c
  257. IF (LOGVIS) SEGINI WRK8
  258. SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  259. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  260. SEGINI WRK4
  261. ENDIF
  262. c
  263. SEGINI WTRAV
  264. *
  265. *
  266. * boucle sur les elements
  267. *
  268. DO 1000 IB=1,NBELEM
  269.  
  270. *
  271. * Matériaux orthotropes, anisotropes et unidirectionnels
  272. * en formulation massive:
  273. * - on cherche les coordonnees des noeuds de l element ib
  274. * - calcul des axes locaux
  275. * Cas particulier de l'ACIER_UNI
  276. *
  277. CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  278. . MELEME,WRK4,WRK22,WTRAV)
  279. *
  280. *
  281. * boucle sur les points de gauss
  282. *
  283. DO 1100 IGAU=1,NBPTEL
  284. *
  285. * -recuperation de valmat et de valcar
  286. * -on recupere les contraintes initiales
  287. * -on recupere les variables internes
  288. * -on recupere les deformations inelastiques initiales si besoin
  289. * -on recupere les increments de deformations totales
  290. * -on cherche la section de l'element ib
  291. * -prise en compte de l'epaisseur et de l'excentrement
  292. * dans le cas des coques minces avec ou sans cisaillement
  293. * transverse
  294. *
  295. CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  296. . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  297. . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  298. . WTRAV,WRK1,WRK5,SECT,EPAIST)
  299. *
  300. * on recupere les constantes du materiau
  301. * calcul des contraintes effectives en milieu poreux
  302. *
  303. CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  304. . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  305. . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  306. . BID,BID2,KERR0)
  307. IF (KERR0.EQ.99) THEN
  308. KERRE=99
  309. GOTO 1000
  310. ELSE IF (KERR0.EQ.10) THEN
  311. GOTO 1000
  312. ENDIF
  313. *
  314. * >>>>>>>>>> fin du traitement du materiau
  315. *
  316. * on recupere les caracteristiques geometriques
  317. *
  318. CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  319. . WRK1)
  320. *
  321. *
  322. * quelques impressions si iimpi = 99
  323. *
  324. * IF(IIMPI.EQ.99) THEN
  325. * WRITE(IOIMP,66770) IB,IGAU
  326. *66770 format(////////2x,'element ',i6,2x,'point ',i3//)
  327. * WRITE(IOIMP,66771) MATE,INPLAS
  328. *66771 format('0 mate=',i4,2x,'inplas=',i4/)
  329. * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  330. *66772 format(2x,' sig0 '/(6(1x,1pe12.5)))
  331. * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  332. *66773 format(2x,' var0 '/(6(1x,1pe12.5)))
  333. * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  334. *66774 format(2x,' depst '/(6(1x,1pe12.5)))
  335. * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  336. *66775 format(2x,' xmat '/(6(1x,1pe12.5)))
  337. * IF(IVACAR.NE.0)THEN
  338. * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  339. *66776 format(2x,' xcar '/(6(1x,1pe12.5)))
  340. * ENDIF
  341. * ENDIF
  342. *
  343. * mise à disposition des temperatures tini tfin tref
  344. * aux points de gauss
  345. *
  346. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  347. IBMN=MIN(IB,MELVA3.VELCHE(/2))
  348. IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  349. TETA1=MELVA3.VELCHE(IGMN,IBMN)
  350. IBMN=MIN(IB,MELVA4.VELCHE(/2))
  351. IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  352. TETA2=MELVA4.VELCHE(IGMN,IBMN)
  353. IBMN=MIN(IB,MELVA5.VELCHE(/2))
  354. IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  355. TETREF=MELVA5.VELCHE(IGMN,IBMN)
  356. ENDIF
  357. *
  358. *
  359. *---------------------------------------------------------------------
  360. *
  361. * ecoulement selon les modeles
  362. *
  363. *---------------------------------------------------------------------
  364. *
  365. * modeles de viscoplasticite integres par consti
  366. *
  367. IF ( INPLAS .EQ. 17 .OR.
  368. 2 (INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR.
  369. 4 INPLAS .EQ. 61 .OR.
  370. 4 INPLAS .EQ. 63 .OR.
  371. 1 INPLAS .EQ. 53 .OR. INPLAS .EQ. 102 .OR.
  372. 8 INPLAS .EQ. 44 .OR. INPLAS .EQ. 76 .OR.
  373. 9 INPLAS .EQ. 45 .OR. INPLAS .EQ. 77 .OR.
  374. 9 INPLAS .EQ. 84 .OR. INPLAS .EQ. 85 .OR.
  375. 9 INPLAS .EQ. 86 .OR. INPLAS .EQ. 70 ) THEN
  376. *
  377. IF (INPLAS.EQ.44.AND.VAR0(NVARI).EQ.0.0) THEN
  378. VAR0(NVARI)=XMAT(20)
  379. ENDIF
  380. IF (INPLAS.EQ.45.AND.VAR0(NVARI).EQ.0.0) THEN
  381. VAR0(NVARI-2)=XMAT(20)
  382. VAR0(NVARI-1)=XMAT(21)
  383. VAR0(NVARI)=XMAT(27)
  384. ENDIF
  385. *
  386. SEGINI WRK7
  387. SEGINI WRK9
  388. CALL CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  389. 1 INPLAS,MFR1,DT,NSTRSS,NVARI,NMATT,PRECIS,MSOUPA,JECHER,DTT,
  390. 2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,NYN,
  391. 3 NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,TETA1,
  392. 5 TETA2,TREFA,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  393. 6 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
  394. c
  395. c
  396. c write(6,*) istep
  397. IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  398. IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  399. CALL ERREUR(KERREU1)
  400. ENDIF
  401. ENDIF
  402. SEGSUP WRK7
  403. SEGSUP WRK9
  404. DTOPTI = MIN(DTOPTI,DTT)
  405. NINCMA = MAX(NINCMA,NSSINC)
  406. NCOMP = NCOMP + 1
  407. TSOM = TSOM + DTT
  408. NSOM = NSOM + NSSINC
  409. NINV = NINV + INV
  410. TCAR = TCAR + DTT* DTT
  411. IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  412. KERR1=1
  413. END IF
  414. c
  415. ELSE
  416. KERRE = 99
  417. ENDIF
  418. *
  419. * Erreurs
  420. * - problèmes de convergence
  421. *
  422. CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  423. *
  424. * - autres problèmes
  425. *
  426. 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  427. . KERR1,KERRE)
  428. 1998 IF (KERRE.NE.0) THEN
  429. IF (LOGVIS) SEGSUP WRK8
  430. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  431. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  432. SEGSUP WRK4
  433. ENDIF
  434. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  435. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  436. 1 .OR.MFR.EQ.33)) THEN
  437. SEGDES MINTE2
  438. SEGSUP WRK22
  439. ENDIF
  440. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  441. SEGDES MELVA3
  442. SEGDES MELVA4
  443. SEGDES MELVA5
  444. SEGDES MCHAM3
  445. SEGDES MCHAM4
  446. SEGDES MCHAM5
  447. ENDIF
  448. RETURN
  449. ENDIF
  450. c
  451. c
  452. c remplissage du segment contenant les contraintes a la fin
  453. * ( rearrangement pour milieu poreux ),
  454. c les variables internes finales
  455. c et les increments de deformations plastiques
  456. c
  457. CALL DEFSIG(MFR,NDEF,
  458. . INPLAS,IND,WRK1,WRK5,WTRAV,
  459. . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  460. . CMATE,MATE,MELE,KERRER)
  461. IF (KERRER.NE.0) GOTO 1000
  462. c
  463. c fin de la boucle sur les points de gauss
  464. c
  465. 1100 continue
  466. c
  467. c special poutres et tuyaux sauf timoschenko
  468. c
  469. CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  470. c
  471. c fin de la boucle sur les elements
  472. c
  473. 1000 continue
  474. c
  475. * FIN: modèles visqueux, on stocke le pas de temps
  476. * optimal en indice 'dtopti'
  477. *
  478. CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  479. . TCAR,DTOPTI,IPOTAB,KERRE)
  480. IF (LOGVIS) SEGSUP WRK8
  481. *
  482. *
  483. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  484. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  485. SEGSUP WRK4
  486. END IF
  487. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  488. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  489. 1 .OR.MFR.EQ.33)) THEN
  490. SEGDES MINTE2
  491. SEGSUP WRK22
  492. ENDIF
  493. *
  494. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  495. SEGDES MELVA3
  496. SEGDES MELVA4
  497. SEGDES MELVA5
  498. SEGDES MCHAM3
  499. SEGDES MCHAM4
  500. SEGDES MCHAM5
  501. ENDIF
  502. *
  503. RETURN
  504. END
  505.  
  506.  
  507.  

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