Télécharger la plaquette Cast3M


fr en

Télécharger ecou60.eso

Retour à la liste

Numérotation des lignes : 

ecou60

  1. C ECOU60    SOURCE    OF166741  25/02/21    21:16:06     12166          
  2.       SUBROUTINE ECOU60(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: -PLASTIQUES NON INTEGRES PAR ECOINC
  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. -INC PPARAM
  75. -INC CCOPTIO
  76. -INC CCHAMP
  77. -INC CECOU
  78.  
  79. -INC SMCHAML
  80. -INC SMELEME
  81. -INC SMCOORD
  82. -INC SMMODEL
  83. -INC SMINTE
  84.  
  85. c=======================================================================
  86. c  la variable kerre regit les impressions d erreurs dans plast
  87. c      toutes erreurs de ecoule gerees dans ce sous programme
  88. c   kerre=0 tout ok
  89. c        de 1 a 6  s aligner sur valeurs donnees par ecoinc
  90. c     =   7  un element tuyau a une epaisseur nulle
  91. c     =  21  on ne trouve pas d intersection avec la surface de charge
  92. c     =  22  sig0 a l exterieur de la surface de charge
  93. c
  94. c             anomalies avec la courbe de traction
  95. c     =  30 limite elastique nulle
  96. c     =  31 trop de points
  97. c     =  32 pas assez de points
  98. c     =  33 pente incorrecte
  99. c     =  34 module d'young nul
  100. c     =  35 manque l'origine
  101. c     =  36 pente a l'origine non egale a e
  102. c     =  37 manque la courbe de traction
  103. c     =  38 nu devrait etre nul
  104. c
  105. c     =  48 donnees erronnees pour drucker-prager
  106. c     =  49 matrice singuliere dans iter internes drucker-prager
  107. c     =  51 pb dans drucker prager option non disponible
  108. c     =  52 pb dans drucker prager donnees incompatibles
  109. c     =  53 pb dans drucker prager solution impossible
  110. c     =  54 les valeurs admissibles pour istep sont 0 1 ou 2
  111. c     =  55 modele non implante en non local
  112. c     =  56 probleme dans l'integration du modele mazars
  113. c     =  57  ....
  114. c     =  58  ....
  115. c     =  59  ....
  116. c     =  60 pb donnees du cam-clay
  117. c
  118. c     =  99 cas non encore disponible
  119. c=======================================================================
  120.  
  121. -INC TMPTVAL
  122.  
  123.       SEGMENT WRK0
  124.        REAL*8 XMAT(NCXMAT)
  125.       ENDSEGMENT
  126. *
  127.       SEGMENT WR00
  128.        CHARACTER*16 TYMAT(NCXMAT)
  129.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  130.       ENDSEGMENT
  131. *
  132.       SEGMENT WRK1
  133.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  134.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  135.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  136.       ENDSEGMENT
  137. *
  138.       SEGMENT WRK2
  139.         REAL*8 TRAC(LTRAC)
  140.       ENDSEGMENT
  141. *
  142.       SEGMENT WRK22
  143.       REAL*8 XXE(3,NBNN)
  144.       ENDSEGMENT
  145. *
  146.       SEGMENT WRK3
  147.         REAL*8 WORK(LW),WORK2(LW2)
  148.       ENDSEGMENT
  149. *
  150.       SEGMENT WRK4
  151.         REAL*8 XE(3,NBBB)
  152.       ENDSEGMENT
  153. *
  154.       SEGMENT WRK5
  155.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  156.       ENDSEGMENT
  157. *
  158.       SEGMENT WRK6
  159.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  160.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  161.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  162.       ENDSEGMENT
  163. *
  164.       SEGMENT WRK7
  165.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  166.       ENDSEGMENT
  167. *
  168.       SEGMENT WRK8
  169.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  170.       ENDSEGMENT
  171. *
  172.       SEGMENT WRK9
  173.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  174.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  175.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  176.         REAL*8 SIGY(NSIGY)
  177.         INTEGER NKX(NNKX)
  178.       ENDSEGMENT
  179. *
  180.       SEGMENT WR10
  181.         INTEGER IABLO1(NTABO1)
  182.         REAL*8  TABLO2(NTABO2)
  183.       ENDSEGMENT
  184. *
  185.       SEGMENT WR11
  186.         INTEGER IABLO3(NTABO3)
  187.         REAL*8  TABLO4(NTABO4)
  188.       ENDSEGMENT
  189. *
  190.       SEGMENT WTRAV
  191.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  192.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  193.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  194.         REAL*8 XLOC(3,3),XGLOB(3,3)
  195.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  196.       ENDSEGMENT
  197. *
  198.       SEGMENT WPOUT
  199.          REAL*8  X(2),Y(2),Z(2)
  200.       ENDSEGMENT
  201.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  202.       LOGICAL LUNI1,LUNI2
  203.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  204. *
  205.       CHARACTER*72 CHARRE
  206.       CHARACTER*8  CMATE
  207. c
  208. *
  209. *   mise à disposition des temperatures tini tfin tref
  210. *   aux points de gauss
  211. *
  212.          TETA1=-1.E35
  213.          TETA2=-1.E35
  214.          TETREF=-1.E35
  215.          TREFA=-1.E35
  216.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  217.             MCHAM3=IPH1
  218.             MCHAM4=IPH2
  219.             MCHAM5=IPH3
  220.             SEGACT MCHAM3
  221.             SEGACT MCHAM4
  222.             SEGACT MCHAM5
  223.             MELVA3=MCHAM3.IELVAL(1)
  224.             MELVA4=MCHAM4.IELVAL(1)
  225.             MELVA5=MCHAM5.IELVAL(1)
  226.             SEGACT MELVA3
  227.             SEGACT MELVA4
  228.             SEGACT MELVA5
  229.          ENDIF
  230. c
  231. c   Initialisations de variables
  232. c---------------------------------
  233. c      - mise à zéro des variables du commun NECOU si besoin
  234. c      - modèles viscoplastiques:
  235. c                  . on récupère le pas de temps
  236. c                  . on récupère le nombre maximal de sous-pas
  237. c                  . on met IND=1
  238. c      - initialisation des dimensions des tableaux des segments
  239. c   Sorties: en plus du commun NECOU, on range les autres données
  240. c   initialisées dans les COMMON IECOU et XECOU
  241. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  242. c   argument de DEFINI
  243. c
  244.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  245.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  246.      .           IPMAIL,IVAMAT,
  247.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  248.      .           LUNI1,LUNI2,LW,KERRE)
  249.       IF (KERRE.EQ.999) RETURN
  250. c
  251. c  Initialisations des segments de travail
  252. c
  253. c
  254.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  255.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  256.      1     .OR.MFR.EQ.33)) THEN
  257.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  258.         MINTE2=IPTR1
  259.         SEGACT MINTE2
  260.         SEGINI WRK22
  261.       ENDIF
  262. c
  263.       IF (LOGVIS) SEGINI WRK8
  264.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  265.       IF(MFR.EQ.7.OR.MFR.EQ.13)THEN
  266.          NBBB=NBNN
  267.          SEGINI WRK4
  268.       ENDIF
  269. c
  270.       SEGINI WTRAV
  271. *
  272. *
  273. *       boucle sur les elements
  274. *
  275.       DO 1000 IB=1,NBELEM
  276. *
  277. *  Matériaux orthotropes, anisotropes et unidirectionnels
  278. *  en formulation massive:
  279. *     - on cherche  les coordonnees des noeuds de l element ib
  280. *     - calcul des axes locaux
  281. *  Cas particulier de l'ACIER_UNI
  282. *
  283.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  284.      .     MELEME,WRK4,WRK22,WTRAV)
  285. *
  286. *
  287. *       boucle sur les points de gauss
  288. *
  289.          DO 1100 IGAU=1,NBPTEL
  290. *
  291. *  -recuperation de valmat et de valcar
  292. *  -on recupere les contraintes initiales
  293. *  -on recupere les variables internes
  294. *  -on recupere les deformations inelastiques initiales si besoin
  295. *  -on recupere les increments de deformations totales
  296. *  -on cherche la section de l'element ib
  297. *  -prise en compte de l'epaisseur et de l'excentrement
  298. *  dans le cas des coques minces avec ou sans cisaillement
  299. *  transverse
  300. *
  301.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  302.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  303.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  304.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  305. *
  306. *     on recupere les constantes du materiau
  307. *     calcul des contraintes effectives en milieu poreux
  308. *
  309.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  310.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  311.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  312.      .        BID,BID2,KERR0)
  313.       IF (KERR0.EQ.99) THEN
  314.          KERRE=99
  315.          GOTO 1000
  316.       ELSE IF (KERR0.EQ.10) THEN
  317.          GOTO 1000
  318.       ENDIF
  319. *
  320. * >>>>>>>>>>   fin du traitement du materiau
  321. *
  322. *        on recupere les caracteristiques geometriques
  323. *
  324.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  325.      .           WRK1)
  326. *
  327. *
  328. *          quelques impressions si iimpi = 99
  329. *
  330. *      IF(IIMPI.EQ.99) THEN
  331. *         WRITE(IOIMP,66770) IB,IGAU
  332. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  333. *         WRITE(IOIMP,66771) MATE,INPLAS
  334. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  335. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  336. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  337. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  338. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  339. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  340. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  341. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  342. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  343. *         IF(IVACAR.NE.0)THEN
  344. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  345. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  346. *         ENDIF
  347. *      ENDIF
  348. *
  349. *   mise à disposition des temperatures tini tfin tref
  350. *   aux points de gauss
  351. *
  352.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  353.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  354.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  355.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  356.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  357.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  358.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  359.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  360.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  361.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  362.          ENDIF
  363. *
  364. *
  365. *---------------------------------------------------------------------
  366. *
  367. *                  ecoulement selon les modeles
  368. *
  369. *---------------------------------------------------------------------
  370. *
  371. c
  372. c
  373. c     modele linespring
  374. c
  375.             IF (INPLAS.EQ.2.OR.INPLAS.EQ.27) THEN
  376.                CALL LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS,KERRE,
  377.      1            NSTRSS,CMATE,N2EL,N2PTEL,MFR,IFOUR,IB,IGAU,EPAIST,
  378.      2             MELE,NPINT,NBGMAT,NBPGAU,NELMAT,SECT,LHOOK,CRIGI)
  379. c
  380. c     modele beton
  381. c
  382.             ELSE IF (INPLAS.EQ.9) THEN
  383.               MPTVAL=IVAMAT
  384.               iecou=0
  385.               inecou=0
  386.               iiecou=0
  387. **            CALL BETON(SIG0       ,DEPST,VAR0,XMAT,IVAL,NMATT,XCAR,
  388. **   1  DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,IFOURB,IB,IGAU,EPAIST,
  389. **   2  MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  390. **   3    ROTHOO,DDHOMU,CRIGI,DSIGT,SIGF,VARF,DEFP,MFR1,NBPGAU,KERRE,
  391. **   4    iecou,inecou,iiecou)
  392.               IF(KERRE.GT.200) THEN
  393.                  KERR1=1
  394.               END IF
  395. c
  396. c     tuyau fissure
  397. c
  398.             ELSE IF (INPLAS.EQ.14.OR.INPLAS.EQ.18) THEN
  399.                CALL TUFPLA(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS,
  400.      1                   NSTRSS,CMATE,N2EL,N2PTEL,MFR1,IFOURB,
  401.      2                       IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,
  402.      3                   NELMAT,NBPGAU,SECT,LHOOK,CRIGI,KERRE)
  403. c
  404. c     modele gauvain
  405. c
  406.             ELSE IF (INPLAS.EQ.16) THEN
  407. c
  408. c              on recupere les courbes moment-courbure
  409. c
  410.                CALL COTRA2(WRK0,WRK2,NCOURB,KERRE)
  411.                IF(KERRE.EQ.0) THEN
  412.                   CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  413.      1 MFR1,IFOURB,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,
  414.      2 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,NSTRS,DEPST,VAR0,
  415.      3  XMAT,NCOMAT,XCAR,TRAC,NCOURB,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE)
  416.                   IF(KERRE.GT.200) THEN
  417.                      KERR1=1
  418.                   END IF
  419.                END IF
  420. c
  421. c     modele ubiquitous
  422. c
  423.             ELSE IF (INPLAS .EQ.28) THEN
  424.                iecou=0
  425.                inecou=0
  426.                iiecou=0
  427. **             CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  428. **   1 IFOURB,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  429. **   2 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,NSTRSS,DEPST,VAR0,
  430. **   3        XMAT,NBPGAU,NMATT,XCAR,DSIGT,SIGF,VARF,DEFP,MFR1,KERRE,
  431. **   4        iecou,inecou,iiecou)
  432.                IF(KERRE.GT.200) THEN
  433.                   KERR1=1
  434.                END IF
  435. c
  436. c     modele global
  437. c
  438.             ELSE IF(INPLAS.EQ.32)THEN
  439.               CALL COTRA3(KERRE,NSTRSS,CMATE,WTRAV,N2EL,N2PTEL,
  440.      1            MFR1,IFOURB,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,
  441.      2          NBPGAU,NELMAT,SECT,LHOOK,CRIGI,NMATT,WRK0,WRK1)
  442.                   IF(KERRE.LT.0) THEN
  443.                      INTERR(1)=IB
  444.                      INTERR(2)=IGAU
  445.                      IF(KERRE.LE.(-4)) THEN
  446.                         MOTERR(5:16) = 'CISAILLEMENT'
  447.                         CALL ERREUR(-283)
  448.                         KERRE = KERRE + 4
  449.                      END IF
  450.                      IF(KERRE.LE.(-2)) THEN
  451.                         MOTERR(5:16) = 'FLEXION'
  452.                         CALL ERREUR(-283)
  453.                         KERRE = KERRE + 2
  454.                      END IF
  455.                      IF(KERRE.LT.0) THEN
  456.                         MOTERR(5:16) = 'COMPRESSION'
  457.                         CALL ERREUR(-283)
  458.                         KERRE = 0
  459.                      END IF
  460.                   END IF
  461. c
  462. c     modele cam-clay
  463. c
  464.             ELSE IF (INPLAS.EQ.33) THEN
  465.               CALL CAMCLA(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NCOMAT,XCAR,
  466.      .                    SIGF,VARF,DEFP,PRECIS,MFR1,KERRE)
  467. c
  468.             ELSE IF (INPLAS .EQ. 34) THEN
  469. c
  470. c      modele de mohr coulomb pour les joints
  471. c
  472.               MPTVAL=IVAMAT
  473.                IF (IFOUR.EQ.2) THEN
  474. c
  475. c --------------------joints 3d
  476. c
  477.                  CALL COUL3(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  478.      &     DEPST,IFOURB,XMAT,NMATT,IVAL,DD,SIGF,DEFP,VARF,KERRE)
  479.                ELSE
  480. c
  481. c --------------------joints 2d
  482. c
  483.                  CALL COUL2(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  484.      &      DEPST,IFOURB,XMAT,NMATT,IVAL,DD,SIGF,DEFP,VARF,KERRE)
  485.                ENDIF
  486. c
  487.             ELSE IF (INPLAS .EQ. 35) THEN
  488. c
  489. c      modele de coulomb_dilatant  pour les joints 2d
  490. c
  491.                IF (IFOUR.NE.2) THEN
  492.                  CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,
  493.      &                       DEFP,KERRE)
  494.                ENDIF
  495. c
  496. c     modele de gurson
  497. c
  498.             ELSE IF (INPLAS .EQ. 38) THEN
  499.               iwrgur=0
  500.               CALL PRGURS(SIG0,NSTRSS,DEPST,VAR0,XMAT,NMATT,XCAR,
  501.      &           ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,iwrgur)
  502. c
  503.             ELSE IF (INPLAS .EQ. 36) THEN
  504. c
  505. c      modele beton_axi
  506. c
  507.               MPTVAL=IVAMAT
  508.               iecou=0
  509.               inecou=0
  510.               CALL BETAXI(SIG0,NSTRSS,DSIGT,VAR0,XMAT,IVAL,NMATT,XCAR,
  511.      &                      SIGF,VARF,DEFP,MFR1,KERRE,iecou,inecou)
  512.               IF(KERRE.GT.200) THEN
  513.                  KERR1=1
  514.               END IF
  515. c
  516.             ELSE IF ((INPLAS .EQ. 39) .AND. (MFR .EQ. 27)) THEN
  517. c
  518. c      modele beton_uni pour les elements unidirectionels (barre ..)
  519. c
  520.               KERR1=0
  521.               CALL BARBET(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  522. c
  523.             ELSE IF ((INPLAS .EQ. 40) .AND. (MFR .EQ. 27)) THEN
  524. c
  525. c      modele acier_uni pour les elements unidirectionels (barre ..)
  526. c
  527.               KERR1=0
  528.               CALL BARSTE(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  529. *
  530. c
  531.             ELSE IF ((INPLAS .EQ. 93) .AND. (MFR .EQ. 27)) THEN
  532. c
  533. c
  534. c      modele ancrage_acier pour les elements unidirectionels (barre ..)
  535. c
  536.               KERR1=0
  537.               CALL BARSTA(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  538. *
  539.             ELSE IF ((INPLAS .EQ. 78) .AND. (MFR .EQ. 27)) THEN
  540. c
  541. c      modele fragile_uni pour les elements unidirectionels (barre ..)
  542. c
  543.               KERR1=0
  544.               CALL BARFRA(XMAT,XCAR,DEPST,VAR0,SIGF,VARF,DEFP)
  545. *
  546.             ELSE IF ((INPLAS .EQ. 79) .AND. (MFR .EQ. 27)) THEN
  547. c
  548. c      modele beton_bael pour les elements unidirectionels (barre ..)
  549. c
  550.               KERR1=0
  551.               CALL BABAEL(XMAT,XCAR,DEPST,VAR0,SIGF,VARF,DEFP)
  552. c
  553.             ELSE IF ((INPLAS .EQ. 92) .AND. (MFR .EQ. 27)) THEN
  554. c
  555. c
  556. c      modele ancrage_parfait pour les elements unidirectionels (barre ..)
  557. c
  558.               KERR1=0
  559.               CALL BARPAA(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  560. *
  561. *
  562.             ELSE IF ((INPLAS .EQ. 80) .AND. (MFR .EQ. 27)) THEN
  563. c
  564. c      modele parfait_uni pour les elements unidirectionels (barre ..)
  565. c
  566.               KERR1=0
  567.               CALL BARPAR(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  568. *
  569.               IF(KERRE.NE.0) THEN
  570.                 GOTO 1990
  571.               ENDIF
  572. c
  573. c      modele acier_uni pour les materiau unidirectionel
  574. c
  575.             ELSE IF (INPLAS .EQ. 40 .AND. MATE.EQ.4) THEN
  576.               CALL UNIACI(WRK0,WRK1,NSTRSS,MFR1,KERRE)
  577. c
  578. c
  579. c     modele poutre en formulation section
  580. c
  581.             ELSE IF (INPLAS.EQ.41.AND.MFR.EQ.7) THEN
  582. *
  583.                CALL BIFLEX(WRK0,WRK1,NSTRSS,NVARI,NMATT,
  584.      1                                                  CMATE,KERRE)
  585. c
  586.             ELSE IF ( INPLAS .EQ. 50 ) THEN
  587. c
  588. c   cas du modele de zerilli armstrong
  589. c
  590. c   on recupere le pas de temps
  591. c
  592.                 CALL ACCTAB(IPOTAB,'MOT     ',IVALIN,XVALIN,
  593.      1                     'DT',LOGIN,IOBIN,
  594.      2                     'FLOTTANT',IVALRE,DT,CHARRE,LOGRE,IOBRE)
  595. c
  596.             IF (KERRE .EQ. 0) THEN
  597.               DO 1114 IC=1,ICARA
  598.                  WORK(IC)=XCAR(IC)
  599. 1114          continue
  600.               BID(1)=0.D00
  601.               BID(2)=0.D00
  602.               BID(3)=0.D00
  603.               mfr1=mfr
  604.               CALL ZERILI(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  605.      1        N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  606.      2        SIGF,VARF,DEFP,KERRE,     IB,IGAU,NSTRSS,EPAIST,MELE,
  607.      3        NPINT,NBPGAU,              SECT,LHOOK,TXR,XLOC,
  608.      4        XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT   )
  609.             END IF
  610. c
  611. c     modele de steinberg cochran guinan
  612. c
  613.             ELSE IF (INPLAS.EQ.49) THEN
  614.                CALL STEINB(DEPST,NSTRSS,
  615.      1              MFR1,IB,IGAU,
  616.      4              DSIGT,NMATT,SIG0,VAR0,XMAT,XCAR,NVARI,
  617.      5              ICARA,SIGF,VARF,DEFP,TETA1,TETA2,KERRE)
  618.                   IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  619.                      KERR1=1
  620.                   END IF
  621. c
  622. c     modele hujeux
  623. c
  624.             ELSE IF (INPLAS.EQ.48) THEN
  625.               CALL HUJEUX(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NCOMAT,XCAR,
  626.      .                    SIGF,VARF,DEFP,PRECIS,MFR1,KERRE)
  627. c
  628. c     modele ottosen
  629. c
  630.             ELSE IF (INPLAS.EQ.42) THEN
  631.               MPTVAL=IVAMAT
  632.               CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  633.      &           NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  634.      &           IB,IGAU)
  635. c
  636.             ELSE IF (INPLAS.EQ.47) THEN
  637. c
  638. c      modele de amadei-saeb pour les joints
  639. c
  640. C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi
  641.                MPTVAL=IVAMAT
  642.                IF (IFOUR.EQ.2) THEN
  643. c
  644. c --------------------joints 3d
  645. c
  646.                 CALL AMADE3(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  647.      &     DEPST,IFOURB,XMAT,NMATT,IVAL,SIGF,DEFP,VARF,KERRE)
  648.                ELSE
  649. c
  650. c --------------------joints 2d
  651. c
  652.                 CALL AMADE2(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  653.      &     DEPST,IFOURB,XMAT,NMATT,IVAL,SIGF,DEFP,VARF,KERRE)
  654.                ENDIF
  655. c
  656.             ELSE IF (INPLAS.EQ.52) THEN
  657. c
  658. c  modèle Preston-Tonks-Wallace
  659. c
  660. c   on recupere le pas de temps
  661. c
  662.                 CALL ACCTAB(IPOTAB,'MOT     ',IVALIN,XVALIN,
  663.      1                     'DT',LOGIN,IOBIN,
  664.      2                     'FLOTTANT',IVALRE,DT,CHARRE,LOGRE,IOBRE)
  665. c
  666.                CALL PRESTO(DEPST,NSTRSS,
  667.      1              MFR1,IB,IGAU,
  668.      4              DSIGT,NMATT,SIG0,VAR0,XMAT,XCAR,NVARI,
  669.      5              ICARA,SIGF,VARF,DEFP,TETA1,TETA2,KERRE,DT)
  670.                   IF(KERRE.NE.0) THEN
  671.                      KERR1=1
  672.                   END IF
  673. c
  674.             ELSE IF (INPLAS.EQ.54) THEN
  675. c
  676. c     modele BETOCYCL
  677. c
  678. C
  679. C     ON VERIFIE LES CONTRAINTES PLANES
  680. C
  681.               IF (IFOUR.EQ.-2)THEN
  682. C
  683. C     ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION
  684. C
  685.                 IPOS1=1
  686.                 CALL COTRAI(WRK0,WRK2,12,IPOS1,0, NPOINT,KERRE)
  687.                 NTRAT=NPOINT/2
  688.                 IPOS2=IPOS1+NPOINT
  689.                 CALL COTRAI(WRK0,WRK2,13,IPOS2,0, NPOINT,KERRE)
  690.                 NTRAC=NPOINT/2
  691.                 IF(KERRE.EQ.0) THEN
  692.                   CALL BETOCY(WRK0,WRK1,WRK2,NTRAT,NTRAC,KERRE)
  693.                 END IF
  694.               ELSE
  695.                 KERRE = 99
  696.               ENDIF
  697. *
  698.             ELSE IF (INPLAS.EQ.55) THEN
  699. C
  700. C    MODELE ROTATING CRACK
  701. C
  702. C     ON VERIFIE LES CONTRAINTES PLANES
  703. C
  704.               IF (IFOUR.EQ.-2)THEN
  705.                 IF(KERRE.EQ.0) THEN
  706.                   CALL ROTATJ (WRK0,WRK1,KERRE)
  707.                 END IF
  708.               ELSE
  709.                 KERRE = 99
  710.               ENDIF
  711. c
  712.             ELSE IF (INPLAS.EQ.56)THEN
  713. C
  714. C    MODELE JOINT_SOFT
  715. C
  716.  
  717. C     ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR
  718. C
  719. C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est
  720. C       6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  721. C       'ALFA' a la place 3 et 4 dans defmat.eso
  722. C
  723.               IPOS1=1
  724.               CALL COTRAI(WRK0,WRK2,8,IPOS1,1, NPOINT,KERRE)
  725.               NTRAC=NPOINT/2
  726.               IPOS2=IPOS1+NPOINT
  727.               CALL COTRAI(WRK0,WRK2,9,IPOS2,1, NPOINT,KERRE)
  728.               NTRAS=NPOINT/2
  729.               IPOS3=IPOS2+NPOINT
  730.               CALL COTRAI(WRK0,WRK2,10,IPOS3,1, NPOINT,KERRE)
  731.               NTRAT=NPOINT/2
  732. C
  733.               IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  734.                IF(KERRE.EQ.0) THEN
  735. C
  736.                  CALL SJONL2(SIG0,DEPST,VAR0,XMAT,
  737.      .                       TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS,
  738.      .                       TRAC(IPOS3),NTRAT,
  739.      .                       SIGF,VARF,DEFP,KERRE)
  740.                END IF
  741.               ELSEIF(IFOUR.EQ.2)THEN
  742.                IF(KERRE.EQ.0) THEN
  743. C
  744.                  CALL SJONL3(SIG0,DEPST,VAR0,XMAT,
  745.      .                       TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT,
  746.      .                       TRAC(IPOS3),NTRAC,
  747.      .                       SIGF,VARF,DEFP,KERRE)
  748.                END IF
  749. C
  750.               END IF
  751. C
  752. c
  753.             ELSE IF (INPLAS.EQ.119)THEN
  754. C
  755. C    MODELE JOINT_COAT
  756. C
  757. C     ON RECUPERE LA COURBE DE SHEAR
  758. C
  759. C Note: La courbe a maintenant l'indices 4 alors que c'est
  760. C       2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  761. C       'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...)
  762. C
  763.               IPOS1=1
  764.               CALL COTRAI(WRK0,WRK2,4,IPOS1,1, NPOINT,KERRE)
  765.               NTRAS=NPOINT/2
  766. C
  767.               IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  768.                IF(KERRE.EQ.0) THEN
  769. C
  770.                  CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS,
  771.      .                       SIGF,VARF,DEFP,KERRE)
  772.                END IF
  773.               ELSEIF(IFOUR.EQ.2)THEN
  774.                IF(KERRE.EQ.0) THEN
  775.                END IF
  776. C
  777.               END IF
  778.  
  779. C+PPm
  780. c
  781.             ELSE IF (INPLAS.EQ.126)THEN
  782. C
  783. C    MODELE MUR_SHEAR
  784. C    pour le moment, element de poutre
  785. C
  786.              IF(MFR.EQ.7)THEN
  787. C
  788. C     ON RECUPERE LES COURBES
  789. C
  790. C Note: Les courbes ont maintenant les indices 5 a 10 alors que
  791. C       c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a
  792. C       incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso
  793. C
  794.                IPOS1=1
  795.                CALL COTRAI(WRK0,WRK2, 5,IPOS1,0, NPOINT,KERRE)
  796.                NCURFP=NPOINT/2
  797.                IPOS2=IPOS1+NPOINT
  798.                CALL COTRAI(WRK0,WRK2, 6,IPOS2,0, NPOINT,KERRE)
  799.                NCURKP=NPOINT/2
  800.                IPOS3=IPOS2+NPOINT
  801.                CALL COTRAI(WRK0,WRK2, 7,IPOS3,0, NPOINT,KERRE)
  802.                NCURLP=NPOINT/2
  803.                IPOS4=IPOS3+NPOINT
  804.                CALL COTRAI(WRK0,WRK2, 8,IPOS4,0, NPOINT,KERRE)
  805.                NCURFM=NPOINT/2
  806.                IPOS5=IPOS4+NPOINT
  807.                CALL COTRAI(WRK0,WRK2, 9,IPOS5,0, NPOINT,KERRE)
  808.                NCURKM=NPOINT/2
  809.                IPOS6=IPOS5+NPOINT
  810.                CALL COTRAI(WRK0,WRK2,10,IPOS6,0, NPOINT,KERRE)
  811.                NCURLM=NPOINT/2
  812. C
  813.                IF(KERRE.EQ.0) THEN
  814.                  CALL   MSHETI(WRK0,WRK1,WRK2,
  815.      >                  NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  816.      >                  IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6 ,
  817.      >                  KERRE)
  818.                END IF
  819.  
  820. C
  821.              END IF
  822. C+PPm
  823.  
  824. C
  825. C
  826.             ELSE IF (INPLAS.EQ.91)THEN
  827. C
  828. C    MODELE ANCRAGE_ELIGEHAUSEN
  829. C
  830.               IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  831. C
  832.                  CALL ANCREL(SIG0,DEPST,VAR0,XMAT,
  833.      .                       SIGF,VARF,DEFP,KERRE)
  834.                END IF
  835. c
  836.             ELSE IF (INPLAS.EQ.57)THEN
  837. C
  838. C     MODELE BILI_MOMY
  839. C
  840.               KERRE=0
  841.               CALL BILIPO(SIG0,DEPST,VAR0,XMAT,XCAR,SIGF,VARF,DEFP)
  842. c
  843.             ELSE IF (INPLAS.EQ.58)THEN
  844. C
  845. C     MODELE BILI_EFFZ
  846. C
  847.               KERRE=0
  848.               CALL BILIFO(SIG0,DEPST,VAR0,XMAT,XCAR,SIGF,VARF,DEFP)
  849. c
  850.             ELSE IF (INPLAS.EQ.59)THEN
  851. C
  852. C     MODELE TAKEMO_MOMY
  853. C
  854. C     ON RECUPERE LES COURBES MOMENT-COURBURE
  855. C
  856.                CALL COTRAD(WRK0,WRK2,NCOURB,KERRE)
  857.                IF(KERRE.EQ.0) THEN
  858. C
  859.                  IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  860.                    CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  861.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  862.                  ELSE
  863.                    CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  864.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  865.                  ENDIF
  866.                END IF
  867. c
  868.             ELSE IF (INPLAS.EQ.60)THEN
  869. C
  870. C     MODELE TAKEMO_EFFZ
  871. C
  872. C
  873. C     ON RECUPERE LES COURBES MOMENT-COURBURE
  874. C
  875.                CALL COTRAD(WRK0,WRK2,NCOURB,KERRE)
  876.                IF(KERRE.EQ.0) THEN
  877. C
  878.                  IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  879.                    CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  880.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  881.                  ELSE
  882.                    CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  883.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  884.                  ENDIF
  885. C
  886.                END IF
  887. c
  888.             ELSE
  889.                KERRE=99
  890.             ENDIF
  891. *
  892. *   Erreurs
  893. *      - problèmes de convergence
  894. *
  895.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  896. *
  897. *      - autres problèmes
  898. *
  899.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  900.      .           KERR1,KERRE)
  901.  1998 IF (KERRE.NE.0) THEN
  902.          IF (LOGVIS) SEGSUP WRK8
  903.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  904.          IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  905.             SEGSUP WRK4
  906.          ENDIF
  907.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  908.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  909.      1     .OR.MFR.EQ.33)) THEN
  910.            SEGDES MINTE2
  911.            SEGSUP WRK22
  912.          ENDIF
  913.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  914.             SEGDES MELVA3
  915.             SEGDES MELVA4
  916.             SEGDES MELVA5
  917.             SEGDES MCHAM3
  918.             SEGDES MCHAM4
  919.             SEGDES MCHAM5
  920.          ENDIF
  921.          RETURN
  922.       ENDIF
  923. c
  924. c     remplissage du segment contenant les contraintes a la fin
  925. *     ( rearrangement pour milieu poreux ),
  926. c     les variables internes finales
  927. c     et les increments de deformations plastiques
  928. c
  929.       CALL DEFSIG(MFR,NDEF,
  930.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  931.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  932.      .     CMATE,MATE,MELE,KERRER)
  933.       IF (KERRER.NE.0) GOTO 1000
  934. c
  935. c    fin de la boucle sur les points de gauss
  936. c
  937. 1100     continue
  938. c
  939. c    special poutres et tuyaux  sauf timoschenko
  940. c
  941.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  942. c
  943. c     fin de la boucle sur les elements
  944. c
  945. 1000  continue
  946. *
  947. *  FIN: modèles visqueux, on stocke le pas de temps
  948. *  optimal en indice 'dtopti'
  949. *
  950.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  951.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  952.       IF (LOGVIS) SEGSUP WRK8
  953. *
  954.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  955.       IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  956.          SEGSUP WRK4
  957.       END IF
  958.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  959.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  960.      1     .OR.MFR.EQ.33)) THEN
  961.         SEGDES MINTE2
  962.         SEGSUP WRK22
  963.       ENDIF
  964. *
  965.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  966.             SEGDES MELVA3
  967.             SEGDES MELVA4
  968.             SEGDES MELVA5
  969.             SEGDES MCHAM3
  970.             SEGDES MCHAM4
  971.             SEGDES MCHAM5
  972.       ENDIF
  973. *
  974.       RETURN
  975.       END
  976.  
  977.  
  978.  
  979.  
  980.  
  981.  
  982.  
  983.  
  984.  
  985.  
  986.  
  987.  
  988.  
  989.  
  990.  
  991.  
  992.  
  993.  
  994.  
  995.  
  996.  
  997.  
  998.  
  999.  
  1000.  
  1001.  
  1002.  
  1003.  
  1004.  
  1005.  
  1006.  
  1007.  
  1008.  
  1009.  
  1010.  
  1011.  
  1012.  
  1013.  
  1014.  
  1015.  
  1016.  
  1017.  
  1018.  
  1019.  
  1020.  

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