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

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