Télécharger la plaquette Cast3M


fr en

Télécharger motana.eso

Retour à la liste

Numérotation des lignes : 

motana

  1. C MOTANA    SOURCE    CB215821  24/04/12    21:16:46     11897          
  2.       SUBROUTINE MOTANA(IPMODL,IPCHE1,IPCHE2,IPCHE3,PRECIS,IPSCAL,IRET)
  3. *______________________________________________________________________
  4. *
  5. *
  6. *
  7. *   ENTREES :
  8. *   ---------
  9. *     IPMODL   pointeur sur un MMODEL
  10. *     IPCHE1   pointeur sur un MCHAML de sous type CONTRAINTES
  11. *     IPCHE2   pointeur sur un MCHAML de sous type VARIABLES INTERNES
  12. *     IPCHE3   pointeur sur le MCHAML de sous type CARACTARISTIQUE
  13. *     PRECIS    flottant
  14. *
  15. *   SORTIES :
  16. *   ---------
  17. *     IPSCAL   pointeur sur l'objet  de  type RIGIDITE
  18. *     IRET   =  1  si succes 0 sinon
  19. *
  20. *     passage aux nouveaux  CHAMELEMs par JM CAMPENON LE 06/91
  21. *
  22. *______________________________________________________________________
  23. *
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26. *
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC SMINTE
  31. -INC SMMODEL
  32. -INC SMELEME
  33. -INC SMCHAML
  34. -INC SMCOORD
  35. -INC SMLREEL
  36. -INC SMEVOLL
  37. *______________________________________________________________________
  38. *
  39. *  LA VARIABLE KERRE REGIT LES IMPRESSIONS D ERREURS DANS MOTAN
  40. *      TOUTES ERREURS DE PLASTICITE GEREES DANS CE SOUS PROGRAMME
  41. *   KERRE=0 TOUT OK
  42. *        DE 1 A 7  S ALIGNER SUR VALEURS DONNEES PAR ECOINC
  43. *     =  21  ON NE TROUVE PAS D INTERSECTION AVEC LA SURFACE DE CHARGE
  44. *     =  22  SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  45. *
  46. *     =  30 31 32 ANOMALIES AVEC LA COURBE DE TRACTION
  47. *     =  33 LIMITE ELASTIQUE NULLE
  48. *     =  99 CAS NON ENCORE DISPONIBLE
  49. *----------------------------------------------------------------------
  50. *
  51.       SEGMENT WRK0
  52.        REAL*8 XMAT(NCXMAT)
  53.       ENDSEGMENT
  54. *
  55.       SEGMENT WRK1
  56.          REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),
  57.      .          DSIGT(NSTRS),SIGF(NSTRS),VAR0(NVARI),
  58.      .          VARF(NVARI),DEFP(NSTRS),XCAR(ICARA)
  59.       ENDSEGMENT
  60. *
  61.        SEGMENT WRK2
  62.           REAL*8 TRAC(LTRAC)
  63.        ENDSEGMENT
  64. *
  65.        SEGMENT WRK3
  66.           REAL*8 WORK(LW)
  67.        ENDSEGMENT
  68. *
  69.        SEGMENT WRK4
  70.           REAL *8 XE(3,NBBB)
  71.        ENDSEGMENT
  72. *
  73.        SEGMENT WRK5
  74.           REAL*8 SIG(LSIG),EPS(LSIG)
  75.        ENDSEGMENT
  76. *
  77.        SEGMENT WRK6
  78.           REAL*8 COVNMS(6)
  79.        ENDSEGMENT
  80. *
  81.       SEGMENT MPTVAL
  82.         INTEGER IPOS(NS)    ,NSOF(NS)
  83.         INTEGER      IVAL(NCOSOU)
  84.         CHARACTER*16 TYVAL(NCOSOU)
  85.       ENDSEGMENT
  86. *
  87.       SEGMENT NOTYPE
  88.         CHARACTER*16 TYPE(NBTYPE)
  89.       ENDSEGMENT
  90. *
  91.       CHARACTER*8 CMATE
  92.       CHARACTER*(NCONCH) CONM
  93.       PARAMETER ( NINF=3 )
  94.       INTEGER INFOS(NINF)
  95.       LOGICAL lsupva,lsupco
  96. *
  97.       DIMENSION XEPOU(2),YEPOU(2),ZEPOU(2),DIV(7)
  98.       DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  99.  
  100.       IRET = 0
  101.       NHRM=NIFOUR
  102. *
  103. *     Verification du lieu support du MCHAML de contraintes
  104. *
  105.       CALL  QUESUP(IPMODL,IPCHE1,3,0,ISUPCO,IRETCO)
  106.       IF (ISUPCO.GT.1) RETURN
  107. *
  108. *     Verification du lieu support du MCHAML de variables internes
  109. *
  110.       CALL  QUESUP(IPMODL,IPCHE2,3,0,ISUPVA,IRETVA)
  111.       IF (ISUPVA.GT.1) RETURN
  112. *
  113. *     Verification du lieu support du MCHAML de materiau
  114. *
  115.       CALL  QUESUP(IPMODL,IPCHE3,3,0,ISUPMA,IRETMA)
  116.       IF (ISUPMA.GT.1) RETURN
  117. *
  118. *     Activation du MMODEL
  119. *
  120.       MMODEL=IPMODL
  121.       SEGACT MMODEL
  122.       NSOUS=KMODEL(/1)
  123. *
  124. *     Creation du MCHELM
  125. *
  126.       N1=NSOUS
  127.       L1=8
  128.       N3=6
  129.       SEGINI MCHELM
  130.       TITCHE='SCALAIRE'
  131.       IFOCHE=IFOUR
  132.       IPSCAL=MCHELM
  133. *
  134.       DO 500 ISOUS=1,NSOUS
  135. *
  136. *   INITIALISATION
  137. *
  138.        NSTR=0
  140.        IVACON=0
  141.        MOVARI=0
  142.        NVARI=0
  143.        IVAVAR=0
  144.        NCARA=0
  145.        NCARF=0
  146.        MOCARA=0
  147.        IVACAR=0
  148.        NMATF=0
  149.        NMATR=0
  150.        MOMATR=0
  151.        IVAMAT=0
  152.        KERRE=0
  153. *
  154.          IMODEL=KMODEL(ISOUS)
  155.          IPMOD1=IMODEL
  156.          SEGACT IMODEL
  157.          IPMAIL=IMAMOD
  158.          CONM  =CONMOD
  159. C
  160. C   COQUE INTEGREE OU PAS ?
  161. C
  162.          IF(INFMOD(/1).NE.0)THEN
  163.            NPINT=INFMOD(1)
  164.          ELSE
  165.            NPINT=0
  166.          ENDIF
  167.          IF (NPINT.NE.0)THEN
  168.             CALL ERREUR(615)
  169.             SEGDES IMODEL,MMODEL
  170.             SEGSUP MCHELM
  171.             RETURN
  172.          ENDIF
  173. C
  174.          IMACHE(ISOUS)=IPMAIL
  175.          CONCHE(ISOUS)=CONMOD
  176. *
  177.          MELE=NEFMOD
  178.          MELEME=IMAMOD
  179. *
  180. *        Nature du materiau
  181. *
  182.          NFOR=FORMOD(/2)
  183.          NMAT=MATMOD(/2)
  184.          CALL NOMATE (FORMOD,NFOR,MATMOD,NMAT,CMATE,INELAS,INPLAS)
  185.          IF (CMATE.EQ.' '.OR.CMATE.NE.'ISOTROPE') THEN
  186.             CALL ERREUR(251)
  187.             GOTO 9900
  188.          ENDIF
  189. *
  190. *        Information sur l'element fini
  191. *
  192. *         CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  193. *         IF (IERR.NE.0) GOTO 9900
  194. *         INFO =IPINF
  195.          MFR  =INFELE(13)
  196.          NBG  =INFELE(6)
  197.          NBGS =INFELE(4)
  198.          NSTRS=INFELE(16)
  199.          LW   =200
  200.          LHOOK=INFELE(10)
  201. *         MINTE=INFELE(11)
  202.          minte=infmod(5)
  203.          IPMIN1=MINTE
  204. *
  205.          INFCHE(ISOUS,1)=0
  206.          INFCHE(ISOUS,2)=0
  207.          INFCHE(ISOUS,3)=NHRM
  208.          INFCHE(ISOUS,4)=MINTE
  209.          INFCHE(ISOUS,5)=0
  210.          INFCHE(ISOUS,6)=3
  211. *
  212.          SEGACT MINTE
  213.          NBPGAU=POIGAU(/1)
  214.          NBNO  =SHPTOT(/2)
  215. *
  216.          SEGACT MELEME
  217.          NBNN  =NUM(/1)
  218.          NBELEM=NUM(/2)
  219.          IPPORE=0
  220.          IF(MFR.EQ.33) IPPORE=NBNN
  221.  
  222. *         INFO=IPINF
  223. *         SEGSUP INFO
  224. *
  225. *        Creation du tableau INFOS
  226. *
  227.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  228.          IF (IRTD.EQ.0) GOTO 9901
  229. *
  230. *        Verification du MCHAML de contraintes
  231. *
  232.          if(lnomid(4).ne.0) then
  233.           nomid=lnomid(4)
  234.           segact nomid
  235.           mocont=nomid
  236.           nstr=lesobl(/2)
  237.           nfac=lesfac(/2)
  238.           lsupco=.false.
  239.          else
  240.           lsupco=.true.
  241.           CALL IDCONT(IMODEL,IFOUR,MOCONT,NSTR,NFAC)
  242.          endif
  243. *
  244.          NBTYPE=1
  245.          SEGINI NOTYPE
  246.          TYPE(1)='REAL*8'
  247.          MOTYPE=NOTYPE
  248.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCONT,MOTYPE,
  249.      .                                1,INFOS,3,IVACON)
  250.          SEGSUP NOTYPE
  251.          IF (IERR.NE.0) GOTO 9910
  252. *
  253.          IF (ISUPCO.EQ.1) THEN
  254.            CALL VALCHE(IVACON,NSTRS,IPMIN1,IPPORE,MOCONT,MELE)
  255.         ENDIF
  256. *
  257. *        Verification du MCHAML de variables internes
  258. *
  259.         if(lnomid(10).ne.0) then
  260.          nomid=lnomid(10)
  261.          segact nomid
  262.          movari=nomid
  263.          nvari=lesobl(/2)
  264.          nfac=lesfac(/2)
  265.          lsupva=.false.
  266.         else
  267.          lsupva=.true.
  268.          CALL IDVARI(MFR,IPMOD1,MOVARI,NVARI,NFAC)
  269.         endif
  270. *
  271.          NBTYPE=1
  272.          SEGINI NOTYPE
  273.          TYPE(1)='REAL*8'
  274.          MOTYPE=NOTYPE
  275.          CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,
  276.      .                                1,INFOS,3,IVAVAR)
  277.          SEGSUP NOTYPE
  278.          IF(IERR.NE.0)GOTO 9920
  279. *
  280.          IF (ISUPVA.EQ.1) THEN
  281.            CALL VALCHE(IVAVAR,NVARI,IPMIN1,IPPORE,MOVARI,MELE)
  282.         ENDIF
  283. *
  284. *        Creation du tableau INFOS
  285. *
  286.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE3,INFOS,IRTD)
  287.          IF (IRTD.EQ.0) GOTO 9920
  288. *
  289. *        Verification du MCHAML de materiau
  290. *
  291.          NBROBL=0
  292.          NBRFAC=0
  293.          MOMATR=0
  294. *
  295.          IF (INPLAS.EQ.1) THEN
  296.             NBROBL=2
  297.             SEGINI NOMID
  298.             MOMATR=NOMID
  299.             LESOBL(1)='YOUN'
  300.             LESOBL(2)='SIGY'
  301. *
  302.             NBTYPE=1
  303.             SEGINI NOTYPE
  304.             MOTYPE=NOTYPE
  305.             TYPE(1)='REAL*8'
  306.          ELSE IF (INPLAS.EQ.4) THEN
  307.             NBROBL=3
  308.             SEGINI NOMID
  309.             MOMATR=NOMID
  310.             LESOBL(1)='YOUN'
  311.             LESOBL(2)='SIGY'
  312.             LESOBL(3)='H   '
  313. *
  314.             NBTYPE=1
  315.             SEGINI NOTYPE
  316.             MOTYPE=NOTYPE
  317.             TYPE(1)='REAL*8'
  318.          ELSE IF (INPLAS.EQ.5) THEN
  319.             NBROBL=2
  320.             SEGINI NOMID
  321.             MOMATR=NOMID
  322.             LESOBL(1)='YOUN'
  323.             LESOBL(2)='TRAC'
  324. *
  325.             NBTYPE=2
  326.             SEGINI NOTYPE
  327.             MOTYPE=NOTYPE
  328.             TYPE(1)='REAL*8'
  329.             TYPE(2)='POINTEUREVOLUTIO'
  330.          ELSE
  331.             NBROBL=1
  332.             SEGINI NOMID
  333.             MOMATR=NOMID
  334.             LESOBL(1)='YOUN'
  335. *
  336.             NBTYPE=1
  337.             SEGINI NOTYPE
  338.             MOTYPE=NOTYPE
  339.             TYPE(1)='REAL*8'
  340.          ENDIF
  341. *
  342.          NMATR=NBROBL
  343.          NMATF=NBRFAC
  344.          NMATT=NMATR+NMATF
  345.          CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOMATR,MOTYPE,
  346.      .                                 1,INFOS,3,IVAMAT)
  347.          SEGSUP NOTYPE
  348.          IF (IERR.NE.0) GOTO 9930
  349.  
  350.          IF (ISUPMA.EQ.1) THEN
  351.            CALL VALCHE(IVAMAT,NMATT,IPMIN1,IPPORE,MOMATR,MELE)
  352.            IF(IERR.NE.0)THEN
  353.              ISUPMA=0
  354.              GOTO 9930
  355.            ENDIF
  356.          ENDIF
  357. *
  358. *        Verification du MCHAML de caracteristiques
  359. *
  360.          NBROBL=0
  361.          NBRFAC=0
  362.          MOCARA=0
  363.          IVECT=0
  364.          IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  365.             NBROBL=2
  366.             SEGINI NOMID
  367.             MOCARA=NOMID
  368.             LESOBL(1)='EPAI'
  369.             LESOBL(2)='CALF'
  370. *
  371.             NBTYPE=1
  372.             SEGINI NOTYPE
  373.             MOTYPE=NOTYPE
  374.             TYPE(1)='REAL*8'
  375.          ENDIF
  376. *
  377. * POUR LES POUTRES
  378. *
  379.          IF (MFR.EQ.7 ) THEN
  380.            NBROBL=4
  381.            NBRFAC=8
  382.            SEGINI NOMID
  383.            MOCARA=NOMID
  384.            LESOBL(1)='TORS'
  385.            LESOBL(2)='INRY'
  386.            LESOBL(3)='INRZ'
  387.            LESOBL(4)='SECT'
  388.            LESFAC(1)='SECY'
  389.            LESFAC(2)='SECZ'
  390.            LESFAC(3)='DX  '
  391.            LESFAC(4)='DY  '
  392.            LESFAC(5)='DZ  '
  393.            LESFAC(6)='VX'
  394.            LESFAC(6)='VY'
  395.            LESFAC(6)='VZ'
  396.            IVECT=1
  397. *
  398.            NBTYPE=12
  399.            SEGINI NOTYPE
  400.            MOTYPE=NOTYPE
  401.            TYPE(1)='REAL*8'
  402.            TYPE(2)='REAL*8'
  403.            TYPE(3)='REAL*8'
  404.            TYPE(4)='REAL*8'
  405.            TYPE(5)='REAL*8'
  406.            TYPE(6)='REAL*8'
  407.            TYPE(7)='REAL*8'
  408.            TYPE(8)='REAL*8'
  409.            TYPE(9)='REAL*8'
  410.            TYPE(10)='REAL*8'
  411.            TYPE(11)='REAL*8'
  412.            TYPE(12)='REAL*8'
  413. *
  414. * POUR LES TUYAUX
  415. *
  416.          ELSE IF (MFR.EQ.13) THEN
  417.            NBROBL=2
  418.            NBRFAC=11
  419.            SEGINI NOMID
  420.            MOCARA=NOMID
  421.            LESOBL(1)='EPAI'
  422.            LESOBL(2)='RAYO'
  423.            LESFAC(1)='RACO'
  424.            LESFAC(2)='PRES'
  425.            LESFAC(3)='CISA'
  426.            LESFAC(4)='CFFX'
  427.            LESFAC(5)='CFMX'
  428.            LESFAC(6)='CFMY'
  429.            LESFAC(7)='CFMZ'
  430.            LESFAC(8)='CFPR'
  431.            LESFAC(9)='VX'
  432.            LESFAC(10)='VY'
  433.            LESFAC(11)='VZ'
  434.            IVECT=1
  435. *
  436.            NBTYPE=13
  437.            SEGINI NOTYPE
  438.            MOTYPE=NOTYPE
  439.            TYPE(1)='REAL*8'
  440.            TYPE(2)='REAL*8'
  441.            TYPE(3)='REAL*8'
  442.            TYPE(4)='REAL*8'
  443.            TYPE(5)='REAL*8'
  444.            TYPE(6)='REAL*8'
  445.            TYPE(7)='REAL*8'
  446.            TYPE(8)='REAL*8'
  447.            TYPE(9)='REAL*8'
  448.            TYPE(10)='REAL*8'
  449.            TYPE(11)='REAL*8'
  450.            TYPE(12)='REAL*8'
  451.            TYPE(13)='REAL*8'
  452.          ENDIF
  453. *
  454.          IF (MOCARA.NE.0) THEN
  455.             CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE,
  456.      .                                     1,INFOS,3,IVACAR)
  457.             SEGSUP NOTYPE
  458.             IF (IERR.NE.0) GOTO 9940
  459. *
  460.          ENDIF
  461.          NCARA=NBROBL
  462.          NCARF=NBRFAC
  463.          NCARR=NCARA+NCARF
  464.          IF (ISUPMA.EQ.1.AND.MOCARA.NE.0) THEN
  465.             CALL VALCHE(IVACAR,NCARR,IPMIN1,IPPORE,MOCARA,MELE)
  466.             IF(IERR.NE.0)THEN
  467.               ISUPMA=0
  468.               GOTO 9940
  469.             ENDIF
  470.          ENDIF
  471.          ICARA=NCARR
  472. **         IF((MFR.EQ.7.OR.MFR.EQ.13).AND.IVECT.EQ.1)ICARA=NCARR+IDIM-1
  473. *
  474. *        Creation du MCHAML de la sous zone
  475. *
  476.          N2=1
  477.          SEGINI MCHAML
  478.          ICHAML(ISOUS)=MCHAML
  479.          NOMCHE(1)='SCAL'
  480.          TYPCHE(1)='REAL*8'
  481. *
  482. *        Creation du MELVAL de la composante SCAL
  483. *
  484.          N1PTEL=NBG
  485.          N1EL=NBELEM
  486.          N2PTEL=0
  487.          N2EL=0
  488.          SEGINI MELVAL
  489.          IELVAL(1)=MELVAL
  490.          IPMELV=MELVAL
  491. *
  492. *        Mise a 0 des variables du COMMON NECOU si besoin
  493. *        Les bonnes valeurs sont attribuees selon le materiaux
  494. *         ( initialisation selon les cas )
  495. *
  496.          IF(INPLAS.EQ.2) GO TO 681
  497.          IFOURB=IFOUR
  498.          NCOURB=0
  499.          IPLAST=0
  500.          IMAPLA=1
  501.          IT=1
  502.          ISOTRO=0
  503.          ITYP=0
  504. *
  505. *        Correspondance MFR,IFOUR et ITYP faite dans ECOINC
  506. *
  507. *        Correspondance MFR,IFOUR et ITYP
  508. *         a completer
  509. *
  510.          IF(MFR.EQ.1.AND.IFOUR.EQ.-2) ITYP=6
  511.          IF(MFR.EQ.1.AND.IFOUR.GE.-1) ITYP=1
  512.          IF(MFR.EQ.3) ITYP=2
  513.          IF(MFR.EQ.5) ITYP=13
  514.          IF(MFR.EQ.7) ITYP=11
  515.          IF(MFR.EQ.9) ITYP= 2
  516. *
  517. *        cas du coq4 - on ne travaille que sur les 6 eres composantes
  518. *
  519.          IF(MFR.EQ.13) ITYP=12
  520.          IF(MFR.EQ.25) ITYP=3
  521.          IF(MFR.EQ.27) ITYP=4
  522. *
  523.          IFLUAG=0
  524.          ICINE=0
  525.          ITHER=0
  526.          IFLUPL=0
  527.          ICYCL=0
  528.          IBI=0
  529.          JFLUAG=0
  530.          KFLUAG=0
  531.          LFLUAG=0
  532.          IRELAX=0
  533.          JNTRIN=0
  534.          MFLUAG=0
  535.          JSOUFL=0
  536.          JGRDEF=0
  537.          LTRAC=600
  538. *
  539.  681     CONTINUE
  540. *
  541.          NCXMAT=NMATT
  542.          IF(INPLAS.EQ.5)NCXMAT=NMATT+3
  543.          SEGINI WRK0,WRK1,WRK2,WRK3
  544.          IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  545.             NBBB=NBNN
  546.             SEGINI WRK4
  547.             SEGINI WRK6
  548.          ENDIF
  549. *
  550. *        Boucle sur les elements
  551. *
  552.          DO 3004  IB=1,NBELEM
  553. *
  554. *           Boucle sur les points de gauss
  555. *
  556.             DO 5004  IGAU=1,N1PTEL
  557. *
  558. *              On remplit les differentes quantites necessaires a
  559. *              ECOULE
  560. *
  561. *              Contraintes initiales
  562. *
  563.                MPTVAL=IVACON
  564.                DO 4004 ICOMP=1,NSTR
  565.                   MELVAL=IVAL(ICOMP)
  566.                   IGMN=MIN(IGAU,VELCHE(/1))
  567.                   IBMN=MIN(IB  ,VELCHE(/2))
  568.                   SIG0(ICOMP)=VELCHE(IGMN,IBMN)
  569.  4004          CONTINUE
  570. *
  571. *              Variables internes initiales
  572. *
  573.                MPTVAL=IVAVAR
  574.                DO 4005 ICOMP=1,NVARI
  575.                   MELVAL=IVAL(ICOMP)
  576.                   IGMN=MIN(IGAU,VELCHE(/1))
  577.                   IBMN=MIN(IB  ,VELCHE(/2))
  578.                   VAR0(ICOMP)=VELCHE(IGMN,IBMN)
  579.  4005          CONTINUE
  580.                IEPS=1
  581.                EPSPL=VAR0(IEPS)
  582. *
  583. *              Les constantes du materiaux
  584. *
  585.                MPTVAL=IVAMAT
  586.                IF(INPLAS.EQ.5)THEN
  587.                  MELVAL=IVAL(1)
  588.                  IBMN=MIN(IB,VELCHE(/2))
  589.                  IGMN=MIN(IGAU,VELCHE(/1))
  590.                  XMAT(1)=VELCHE(IGMN,IBMN)
  591.                  MELVAL=IVAL(2)
  592.                  IBMN=MIN(IB,IELCHE(/2))
  593.                  IGMN=MIN(IGAU,IELCHE(/1))
  594.                  MEVOLL = IELCHE(IGMN,IBMN)
  595. *--------
  596.                  SEGACT MEVOLL
  597.                  KEVOLL=IEVOLL(1)
  598.                  SEGACT KEVOLL
  599.                  MLREEL = IPROGY
  600.                  SEGACT MLREEL
  601.                  LTR2 = PROG(/1)
  602.                  SEGDES MLREEL,KEVOLL,MEVOLL
  603.                  IF(LTR2.GT.LTRAC) THEN
  604.                  LTRAC = LTR2
  605.                  SEGADJ WRK0
  606.                  ENDIF
  607.                  XMAT(5)=MEVOLL
  608.                ELSE
  609.                DO 4007 ICOMP=1,NMATR
  610.                   MELVAL=IVAL(ICOMP)
  611.                   IF(TYVAL(ICOMP)(1:8).NE.'POINTEUR')THEN
  612.                    IBMN=MIN(IB,VELCHE(/2))
  613.                    IGMN=MIN(IGAU,VELCHE(/1))
  614.                    XMAT(ICOMP)=VELCHE(IGMN,IBMN)
  615.                   ELSE
  616.                    IBMN=MIN(IB,IELCHE(/2))
  617.                    IGMN=MIN(IGAU,IELCHE(/1))
  618. *                   XMAT(ICOMP)=IELCHE(IGMN,IBMN)
  619.                  MEVOLL = IELCHE(IGMN,IBMN)
  620.                  SEGACT MEVOLL
  621.                  KEVOLL=IEVOLL(1)
  622.                  SEGACT KEVOLL
  623.                  MLREEL = IPROGY
  624.                  SEGACT MLREEL
  625.                  LTR2 = PROG(/1)
  626.                  SEGDES MLREEL,KEVOLL,MEVOLL
  627.                  IF(LTR2.GT.LTRAC) THEN
  628.                  LTRAC = LTR2
  629.                  SEGADJ WRK0
  630.                  ENDIF
  631.                  XMAT(5)=MEVOLL
  632. *---------------
  633.                   ENDIF
  634.  4007          CONTINUE
  635.                ENDIF
  636.                IYUNG=1
  637.                ETANG=XMAT(IYUNG)
  638. *
  639. *              Les caracteristiques si besoin
  640. *
  641.                IF (ITYP.EQ.2) THEN
  642.                  ALFAH=1.
  643.                  IF(MOCARA.NE.0) THEN
  644.                     MPTVAL=IVACAR
  645.                     DO 6029 ICOMP=1,NCARR
  646.                      MELVAL=IVAL(ICOMP)
  647.                      IBMN=MIN(IB  ,VELCHE(/2))
  648.                      XCAR(ICOMP)=VELCHE(1,IBMN)
  649. 6029                CONTINUE
  650.                     IALF=2
  651.                     ALFAH=XCAR(IALF)*XCAR(IALF)
  652.                  ENDIF
  653. *
  654. *              On transforme les efforts en contraintes pour les
  655. *              coques minces
  656. *
  657.                   CALL EFCONT(XCAR(1),0.D0,NSTRS,SIG0)
  658.                   IF (NVARI.EQ.NSTRS+1) THEN
  659.                      CALL EFCONT(XCAR(1),0.D0,NSTRS,VAR0(2))
  660.                   ENDIF
  661.                ENDIF
  662. *
  663. * cas des tuyaux
  664. *
  665.                IF (ITYP.EQ.12) THEN
  666.                 IF(MOCARA.NE.0) THEN
  667.                   MPTVAL=IVACAR
  668.                     DO 5129 ICOMP=1,5
  669.                        MELVAL=IVAL(ICOMP)
  670.                        IF (MELVAL.NE.0) THEN
  671.                           IGMN=MIN(IGAU,VELCHE(/1))
  672.                           IBMN=MIN(IB  ,VELCHE(/2))
  673.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  674.                        ELSE
  675.                           XCAR(ICOMP)=0.D0
  676.                        ENDIF
  677.  5129               CONTINUE
  678.                   IF(IVECT.EQ.1) THEN
  679.                     DO 5130 ICOMP=6,NCARR
  680.                        MELVAL=IVAL(ICOMP)
  681.                        IF (MELVAL.NE.0) THEN
  682.                           IGMN=MIN(IGAU,VELCHE(/1))
  683.                           IBMN=MIN(IB  ,VELCHE(/2))
  684.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  685.                        ELSE
  686.                           XCAR(ICOMP)=-1.D0
  687.                        ENDIF
  688.  5130               CONTINUE
  689.                   ELSE
  690.                     DO 5330 ICOMP=6,10
  691.                        MELVAL=IVAL(ICOMP)
  692.                        IF (MELVAL.NE.0) THEN
  693.                           IGMN=MIN(IGAU,VELCHE(/1))
  694.                           IBMN=MIN(IB  ,VELCHE(/2))
  695.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  696.                        ELSE
  697.                           XCAR(ICOMP)=-1.D0
  698.                        ENDIF
  699.  5330               CONTINUE
  700.                     DO 5339 ICOMP=11,ICARA
  701.                        MELVAL=IVAL(ICOMP)
  702.                        IF (MELVAL.NE.0) THEN
  703.                           IGMN=MIN(IGAU,VELCHE(/1))
  704.                           IBMN=MIN(IB  ,VELCHE(/2))
  705.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  706.                        ELSE
  707.                           XCAR(ICOMP)=0.D0
  708.                        ENDIF
  709.  5339               CONTINUE
  710.                   ENDIF
  711. *
  712. *    REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  713. *    QUE L'ANCIEN  CHAMELEM
  714. *
  715.                   NWORK = 7
  716.                   DO 5349 IC=4,10
  717.                   WORK(IC-3)=XCAR(IC)
  718.  5349             CONTINUE
  719.                   IF(IDIM.EQ.2)THEN
  720.                      XCAR(4)=XCAR(ICARA-1)
  721.                      XCAR(5)=XCAR(ICARA)
  722.                      DO 5359 IC=1,NWORK
  723.                      XCAR(IC+5)=WORK(IC)
  724.  5359                CONTINUE
  725.                   ELSE IF(IDIM.EQ.3)THEN
  726.                      XCAR(4)=XCAR(ICARA-2)
  727.                      XCAR(5)=XCAR(ICARA-1)
  728.                      XCAR(6)=XCAR(ICARA)
  729.                      DO 5369 IC=1,NWORK
  730.                      XCAR(IC+6)=WORK(IC)
  731.  5369                CONTINUE
  732.                   ENDIF
  733.                ENDIF
  734.              ENDIF
  735. *
  736. * cas des poutres
  737. *
  738.                IF (ITYP.EQ.11) THEN
  739.                 IF(MOCARA.NE.0) THEN
  740.                   MPTVAL=IVACAR
  741.                   IF(IVECT.EQ.1) THEN
  742.                     DO 6129 ICOMP=1,NCARR
  743.                        MELVAL=IVAL(ICOMP)
  744.                        IF (MELVAL.NE.0) THEN
  745.                           IGMN=MIN(IGAU,VELCHE(/1))
  746.                           IBMN=MIN(IB  ,VELCHE(/2))
  747.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  748.                        ELSE
  749.                           XCAR(ICOMP)=0.D0
  750.                        ENDIF
  751.  6129               CONTINUE
  752.                   ELSE
  753.                     DO 6339 ICOMP=1,ICARA
  754.                        MELVAL=IVAL(ICOMP)
  755.                        IF (MELVAL.NE.0) THEN
  756.                           IGMN=MIN(IGAU,VELCHE(/1))
  757.                           IBMN=MIN(IB  ,VELCHE(/2))
  758.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  759.                        ELSE
  760.                           XCAR(ICOMP)=0.D0
  761.                        ENDIF
  762.  6339               CONTINUE
  763.                   ENDIF
  764. *
  765. *    REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  766. *    QUE L'ANCIEN  CHAMELEM
  767. *
  768.                   IF(IDIM.EQ.2)THEN
  769.                      VX=XCAR(ICARA-3)
  770.                      VY=XCAR(ICARA-2)
  771.                      XCAR(ICARA-3)=XCAR(ICARA-1)
  772.                      XCAR(ICARA-2)=XCAR(ICARA)
  773.                      XCAR(ICARA-1)=VX
  774.                      XCAR(ICARA)=VY
  775.                   ELSEIF(IDIM.EQ.3)THEN
  776.                      VX=XCAR(ICARA-5)
  777.                      VY=XCAR(ICARA-4)
  778.                      VZ=XCAR(ICARA-3)
  779.                      XCAR(ICARA-5)=XCAR(ICARA-2)
  780.                      XCAR(ICARA-4)=XCAR(ICARA-1)
  781.                      XCAR(ICARA-3)=XCAR(ICARA)
  782.                      XCAR(ICARA-2)=VX
  783.                      XCAR(ICARA-1)=VY
  784.                      XCAR(ICARA)=VZ
  785.                   ENDIF
  786.              ENDIF
  787.            ENDIF
  788. C
  789.                IF(ITYP.EQ.11) THEN
  790.                  DIV(1)=1.D0/XCAR(4)
  791.                  DIV(2)=1.D0
  792.                  DIV(3)=1.D0
  793.                  DIV(4)=XCAR(5)/XCAR(1)
  794.                  DIV(5)=XCAR(6)/XCAR(2)
  795.                  DIV(6)=XCAR(7)/XCAR(3)
  796.                  IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(XCAR(1)*XCAR(4))
  797.                  IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(XCAR(2)*XCAR(4))
  798.                  IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(XCAR(3)*XCAR(4))
  799.                ENDIF
  800. C
  801.                IF(ITYP.EQ.12) THEN
  802.                  EPAIS=XCAR(1)
  803.                  REXT =XCAR(2)
  804.                  RMOY =REXT-EPAIS*0.5D0
  805.                  RACO =XCAR(3)
  806.                  PRES =XCAR(4)
  807.                  CISA =XCAR(5)
  808. C
  809.                  GAM=1.D0
  810.                  IF(RACO.EQ.0.D0) GO TO 6429
  811.                    XLAM=RMOY*RMOY/EPAIS/RACO
  812.                    GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  813.                    IF(GAM.LT.1.D0) GAM=1.D0
  814.  6429            CONTINUE
  815. C
  816. C         NB 23/09/98
  817. C         VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  818. C         CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  819. C         CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  820. C         DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  821. C         DUE A LA PRESSION )
  822. C         POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE
  823. C         DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7)
  824. C
  825. C
  826.                  DIV(1)=1.D0
  827.                  DIV(2)=1.D0
  828.                  DIV(3)=1.D0
  829.                  DIV(4)=R33
  830.                  DIV(5)=PI4*GAM
  831.                  DIV(6)=DIV(5)
  832.                  DIV(7)=0.D0
  833. C
  834.                  IF(IDIM.EQ.2) THEN
  835.                   PRES1=XCAR(6)
  836.                   CISA1=XCAR(7)
  837.                   IDEB1=8
  838.                  ELSE IF(IDIM.EQ.3) THEN
  839.                   PRES1=XCAR(7)
  840.                   CISA1=XCAR(8)
  841.                   IDEB1=9
  842.                  ENDIF
  843. C
  844.                  JDIV1=2
  845.                  DO 6529 ICOMP=IDEB1,ICARA
  846.                    JDIV1=JDIV1+1
  847.                    VCAR1=XCAR(ICOMP)
  848.                    IF (VCAR1.NE.-1.D0) DIV(JDIV1)=XCAR(ICOMP)
  849.  6529            CONTINUE
  850. C
  851. C         NB 23/09/98
  852. C         TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  853. C         1.D0 DE DIV(3)
  854. C
  855.                  DIV(1) = DIV(3)
  856.                  DIV(3)=1.D0
  857. C
  858.                  IF(IDIM.EQ.2) CISA=XCAR(7)
  859.                  IF(IDIM.EQ.3) CISA=XCAR(8)
  860.                  VX=XCAR(4)
  861.                  VY=XCAR(5)
  862.                  VZ=XCAR(6)
  863.                  CALL TUYCAR(XCAR,CISA,VX,VY,VZ,KERRE,1)
  864.                  DIV(1)=DIV(1)/XCAR(4)
  865.                  DIV(4)=DIV(4)*RMOY/XCAR(1)
  866.                  DIV(5)=DIV(5)*RMOY/XCAR(2)
  867.                  DIV(6)=DIV(6)*RMOY/XCAR(3)
  868.                ENDIF
  869. *
  870. *              On transforme les efforts en contraintes pour les
  871. *              poutres et tuyaux
  872. *
  873.                IF (ITYP.EQ.11.OR.ITYP.EQ.12) THEN
  874.                   DO 6629 ICOMP=1,NSTR
  875.                   SIG0(ICOMP)=SIG0(ICOMP)*DIV(ICOMP)
  876.  6629             CONTINUE
  877.                ENDIF
  878. *______________________________________________________________________
  879. *
  880. *              MATERIAU PUREMENT ELASTIQUE
  881. *_____________________________________________________________________
  882. *
  883.                IF(INPLAS.EQ.0) THEN
  884.                   GO TO 510
  885.                ENDIF
  886. *======================================================================
  887. *
  888. *     NUMERO DES ETIQUETTES      :
  889. *
  890. *     1 A 99 POUR LES MODELES DE PLASTICITE  ( INDICE INPLAS )
  891. *
  892. *======================================================================
  893. *
  894.       GOTO (1, 2,99, 4, 5,99, 7,99,99,99, 7, 7, 7,99,99,99,99,99,99,99,
  895.      &      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  896.      &      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  897.      &      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99),INPLAS
  898. *
  899.   99  CONTINUE
  900.       MOTERR(1:4)=NOMAC(INPLAS)
  901.       MOTERR(5:12)=NOMFR(MFR)
  902.       CALL ERREUR(269)
  903.       SEGSUP MCHAML
  904.       MELVAL=IPMELV
  905.       SEGSUP MELVAL
  906.       GOTO 9940
  907. *_______________________________________________________________________
  908. *
  909. *     MODELE VON MISES ISOTROPE ASSOCIE ( D'APRES INCA )
  910. *_______________________________________________________________________
  911. *
  912.    1  CONTINUE
  913. *
  914. *     Cas de la plasticite parfaite
  915. *
  916.       NCOURB=2
  917.       TRAC(1)=XMAT(2)
  918.       TRAC(2)=0.D0
  919.       TRAC(3)=XMAT(2)
  920.       TRAC(4)=1.D0
  921.       IF(XMAT(2).EQ.0.D0) THEN
  922.          KERRE=33
  923.          GO TO 510
  924.       ENDIF
  925. *
  926. *     On cherche si on est sur la surface de charge
  927. *
  928.       IF(EPSPL.EQ.0.) GO TO 682
  929.       SIGVM=VONMIS(SIG0,ITYP,ALFAH,COVNMS)
  930.       IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682
  931.       ETANG=0.
  932.       GOTO 682
  933. *
  934.    4  CONTINUE
  935. *
  936. *     Cas de la plasticite cinematique bilineaire
  937. *
  938.       ICINE=1
  939.       NCOURB=2
  940.       TRAC(1)=XMAT(2)
  941.       TRAC(2)=0.D0
  942.       TRAC(3)=XMAT(2)+XMAT(3)
  943.       TRAC(4)=1.D0
  944.       IF(XMAT(2).EQ.0.D0) THEN
  945.          KERRE=33
  946.          GO TO 510
  947.       ENDIF
  948. *
  949. *     On cherche si on est sur la surface de charge
  950. *
  951.       IF(EPSPL.EQ.0.) GO TO 682
  952.       ISPHER=2
  953.       CALL AEQBPC(SIG0,SIG0,VAR0(ISPHER),1.D0,-1.D0,NSTRS)
  954. *
  955.       SIGVM=VONMIS(SIG0,ITYP,ALFAH,COVNMS)
  956.       IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682
  957.       H=TRAC(3)
  958.       ETANG=ETANG*H/(ETANG+H)
  959.       GOTO 682
  960. C
  961.    5  CONTINUE
  962. *
  963. *     Cas de la plasticite isotrope ecrouissable
  964. *
  965. *     On recupere la courbe de traction
  966. *
  967.       CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  968.       IF(KERRE.GT.0) GO TO 510
  969.       IF(EPSPL.EQ.0.) GO TO 682
  970.       LSIG=NCOURB
  971.       SEGINI WRK5
  972. *
  973.       DO 7000 IZ=1,LSIG
  974.          SIG(IZ)=TRAC(2*(IZ-1)+1)
  975.          EPS(IZ)=TRAC(2*IZ)
  976.  7000 CONTINUE
  977. *
  978.       CALL TRACTI(SELAS,EPSPL,SIG,EPS,NCOURB,2,IBI)
  979.       IF(IBI.NE.0) THEN
  980.         KERRE=75
  981.         GO TO 510
  982.       ENDIF
  983.       SIGVM=VONMIS(SIG0,ITYP,ALFAH,COVNMS)
  984. *
  985.       IF(SIGVM.LT.PRECIS*SELAS) GO TO 7001
  986.       CALL TRACTI(H,EPSPL,SIG,EPS,NCOURB,1,IBI)
  987.       IF(IBI.NE.0) THEN
  988.         KERRE=75
  989.         GO TO 510
  990.       ENDIF
  991.       ETANG=ETANG*H/(ETANG+H)
  992. *
  993.  7001 CONTINUE
  994.       SEGSUP WRK5
  995.       GO TO 682
  996. *
  997.    7  CONTINUE
  998. *
  999. *     Cas du modele CHABOCHE
  1000. *
  1001.       ICINE=1
  1002.       IMAPLA=4
  1003.       GOTO 682
  1004. *
  1005.   682 CONTINUE
  1006.       DO 675 IC=1,NCARR
  1007.          WORK(IC)=XCAR(IC)
  1008.   675 CONTINUE
  1009.       GOTO 510
  1010. *
  1011. *     Modele LINESPRING
  1012. *
  1013.    2  CONTINUE
  1014.       GOTO 510
  1015. *
  1016.   510 CONTINUE
  1017. *
  1018. *
  1019. *        Remplissage du segment contenant les contraintes a la fin
  1020. *
  1021.       IF (KERRE.EQ.0)  THEN
  1022.          MELVAL=IPMELV
  1023.          VELCHE(IGAU,IB)=ETANG
  1024. *
  1025. *     Impression des message d'erreurs
  1026. *
  1027.       ELSE IF(KERRE.NE.0) THEN
  1028.          IRT0=0
  1029.          IRT6=0
  1030.          IRT7=0
  1031.          INTERR(1)=IB
  1032.          INTERR(2)=IGAU
  1033.          MOTERR(1:4)=NOMTP(MELE)
  1034.          IF(KERRE.EQ.1) THEN
  1035.          CALL ERREUR(267)
  1036.          ELSE IF(KERRE.EQ.2) THEN
  1037.             CALL ERREUR(268)
  1038.          ELSE IF(KERRE.EQ.30) THEN
  1039.             CALL ERREUR(270)
  1040.          ELSE IF(KERRE.EQ.31) THEN
  1041.          CALL ERREUR(271)
  1042.          ELSE IF(KERRE.EQ.32) THEN
  1043.             CALL ERREUR(272)
  1044.          ELSE IF(KERRE.EQ.33) THEN
  1045.             CALL ERREUR(273)
  1046.          ELSE IF(KERRE.EQ.34) THEN
  1047.              CALL ERREUR(325)
  1048.          ELSE IF(KERRE.EQ.35) THEN
  1049.               CALL ERREUR(331)
  1050.          ELSE IF(KERRE.EQ.36) THEN
  1051.               CALL ERREUR(330)
  1052.          ELSE IF(KERRE.EQ.37) THEN
  1053.               CALL ERREUR(354)
  1054.          ELSE IF(KERRE.EQ.21) THEN
  1055.             CALL ERREUR(276)
  1056.          ELSE IF(KERRE.EQ.22) THEN
  1057.             CALL ERREUR(275)
  1058.          ELSE IF(KERRE.EQ.75) THEN
  1059.             CALL ERREUR(876)
  1060.          ENDIF
  1061.          GOTO 444
  1062.       ENDIF
  1063. *
  1064.  5004 CONTINUE
  1065.  3004 CONTINUE
  1066. *
  1067.   444 CONTINUE
  1068.       SEGSUP WRK0,WRK1,WRK2,WRK3
  1069.       IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  1070.          SEGSUP WRK4,WRK6
  1071.       ENDIF
  1072. *
  1073.       IF (ISUPCO.EQ.1) THEN
  1074.          CALL DTMVAL (IVACON,3)
  1075.       ELSE
  1076.          CALL DTMVAL (IVACON,1)
  1077.       ENDIF
  1078. *
  1079.       IF (ISUPVA.EQ.1) THEN
  1080.          CALL DTMVAL (IVAVAR,3)
  1081.       ELSE
  1082.          CALL DTMVAL (IVAVAR,1)
  1083.       ENDIF
  1084. *
  1085.       IF (ISUPMA.EQ.1) THEN
  1086.          CALL DTMVAL (IVAMAT,3)
  1087.       ELSE
  1088.          CALL DTMVAL (IVAMAT,1)
  1089.       ENDIF
  1090. *
  1091.       IF (ISUPMA.EQ.1) THEN
  1092.          CALL DTMVAL (IVACAR,3)
  1093.       ELSE
  1094.          CALL DTMVAL (IVACAR,1)
  1095.       ENDIF
  1096. *
  1097.       SEGDES,MINTE
  1098.       SEGDES MELEME
  1099.       NOMID=MOCONT
  1100.       if(lsupco)SEGSUP NOMID
  1101.       NOMID=MOVARI
  1102.       if(lsupva)SEGSUP NOMID
  1103.       NOMID=MOMATR
  1104.       SEGSUP NOMID
  1105.       IF (MOCARA.NE.0) THEN
  1106.          NOMID=MOCARA
  1107.          SEGSUP NOMID
  1108.       ENDIF
  1109. *      INFO=IPINF
  1110. *      SEGSUP INFO
  1111.       SEGDES IMODEL
  1112. *
  1113.       IF(KERRE.NE.0)THEN
  1114.        SEGSUP MCHAML
  1115.        MELVAL=IPMELV
  1116.        SEGSUP MELVAL
  1117.        GOTO 888
  1118.       ELSE
  1119.        SEGDES MCHAML
  1120.        MELVAL=IPMELV
  1121.        SEGDES MELVAL
  1122.       ENDIF
  1123. *
  1124.   500 CONTINUE
  1125. *
  1126.   888 CONTINUE
  1127.       SEGDES MMODEL
  1128.       IF(KERRE.NE.0) THEN
  1129.          IRET=0
  1130.          SEGSUP MCHELM
  1131.       ELSE
  1132.          IRET=1
  1133.          SEGDES MCHELM
  1134.       ENDIF
  1135. C
  1136.       RETURN
  1137. *______________________________________________________________________
  1138. *
  1139. *     Erreurs dans une sous zone desactivation et retour
  1140. *______________________________________________________________________
  1141. *
  1142.  9940 CONTINUE
  1143.       IF (ISUPMA.EQ.1) THEN
  1144.          CALL DTMVAL (IVACAR,3)
  1145.       ELSE
  1146.          CALL DTMVAL (IVACAR,1)
  1147.       ENDIF
  1148.       NOMID=MOCARA
  1149.       IF(NOMID.NE.0)SEGSUP NOMID
  1150. *
  1151.  9930 CONTINUE
  1152.       IF (ISUPMA.EQ.1) THEN
  1153.          CALL DTMVAL (IVAMAT,3)
  1154.       ELSE
  1155.          CALL DTMVAL (IVAMAT,1)
  1156.       ENDIF
  1157.       NOMID=MOMATR
  1158.       IF(NOMID.NE.0)SEGSUP NOMID
  1159. *
  1160.  9920 CONTINUE
  1161.       IF (ISUPVA.EQ.1) THEN
  1162.          CALL DTMVAL (IVAVAR,3)
  1163.       ELSE
  1164.          CALL DTMVAL (IVAVAR,1)
  1165.       ENDIF
  1166.       NOMID=MOVARI
  1167.       IF(lsupva.and.NOMID.NE.0)SEGSUP NOMID
  1168. *
  1169.  9910 CONTINUE
  1170.       IF (ISUPCO.EQ.1) THEN
  1171.          CALL DTMVAL (IVACON,3)
  1172.       ELSE
  1173.          CALL DTMVAL (IVACON,1)
  1174.       ENDIF
  1175.       NOMID=MOCONT
  1176.       IF(lsupco.and.NOMID.NE.0)SEGSUP NOMID
  1177. *
  1178.  9901 CONTINUE
  1179.       SEGDES,MELEME,MINTE
  1180.  9900 CONTINUE
  1181.       SEGDES IMODEL,MMODEL
  1182.       SEGSUP MCHELM
  1183.       IRET = 0
  1184.  
  1185.       RETURN
  1186.       END
  1187.  
  1188.  
  1189.  
  1190.  
  1191.  
  1192.  
  1193.  
  1194.  
  1195.  
  1196.  
  1197.  
  1198.  

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