Télécharger la plaquette Cast3M


fr en

Télécharger critp.eso

Retour à la liste

Numérotation des lignes : 

critp

  1. C CRITP     SOURCE    CB215821  24/04/12    21:15:33     11897          
  2.       SUBROUTINE CRITP(IPMODL,IPCHE1,IPCHE2,IPCAR,IPCHE3)
  3. *******************************************************************
  4. *
  5. *      CALCUL LE CRITERE DE PLASTICITE
  6. *
  7. **********************************************************************
  8. *
  9. *  ENTREES:
  10. *
  11. *  IPMODL = POINTEUR SUR UN OBJET MMODEL
  12. *  IPCHE1 = POINTEUR SUR UN MCHAML DE CONTRAINTES
  13. *  IPCHE2 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES
  14. *  IPCAR  =  POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  15. *
  16. * SORTIES:
  17. *
  18. *  IPCHE3 = POINTEUR SUR UN MCHAML SCALAIRE
  19. *
  20. ************************************************************************
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23. *
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMCHAML
  28. -INC SMELEME
  29. -INC SMCOORD
  30. -INC SMMODEL
  31. -INC SMINTE
  32. -INC CCHAMP
  33. C----------------------------------------------------------------------
  34. C   KERRE REGIT LES MESSAGES D'ERREUR DANS CRIT
  35. C
  36. C     =  0 TOUT OK
  37. C     =  1 ET 2   S ALIGNER SUR LES VALEURS DONNEES PAR ECOCRI
  38. C     =   7  UN ELEMENT TUYAU A UNE EPAISSEUR NULLE
  39. C
  40. C             ANOMALIES AVEC LA COURBE DE TRACTION
  41. C     =  30 LIMITE ELASTIQUE NULLE
  42. C     =  31 TROP DE POINTS
  43. C     =  32 PAS ASSEZ DE POINTS
  44. C     =  33 PENTE INCORRECTE
  45. C     =  34 MODULE D'YOUNG NUL
  46. C     =  35 MANQUE L'ORIGINE
  47. C     =  36 PENTE A L'ORIGINE NON EGALE A E
  48. C     =  37 MANQUE LA COURBE DE TRACTION
  49. C     =  48 DONNEES DRUCKER-PRAGER ERRONNEES
  50. C     =  99 CAS NON ENCORE DISPONIBLE
  51. C----------------------------------------------------------------------
  52. C
  53.       SEGMENT NOTYPE
  54.         CHARACTER*16 TYPE(NBTYPE)
  55.       ENDSEGMENT
  56. *
  57.       SEGMENT MPTVAL
  58.         INTEGER IPOS(NS)    ,NSOF(NS)
  59.         INTEGER      IVAL(NCOSOU)
  60.         CHARACTER*16 TYVAL(NCOSOU)
  61.       ENDSEGMENT
  62. *
  63.       SEGMENT WRK0
  64.        REAL*8 XMAT(NCXMAT)
  65.       ENDSEGMENT
  66. *
  67.       SEGMENT WRK1
  68.         REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),DSIGT(NSTRS)
  69.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  70.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  71.       ENDSEGMENT
  72. *
  73.       SEGMENT WRK2
  74.         REAL*8 TRAC(LTRAC)
  75.       ENDSEGMENT
  76. *
  77.       SEGMENT WRK3
  78.         REAL*8 WORK(LW),WORK2(LW2)
  79.       ENDSEGMENT
  80. *
  81.       SEGMENT WRK4
  82.         REAL*8 XE(3,NBBB)
  83.       ENDSEGMENT
  84. *
  85.         SEGMENT ECOU
  86. ***     COMMON/ECOU/TEST,ALFAH,
  87.        REAL*8 TEST,ALFAH,
  88. C      REAL*8 TEST, ALFAH,
  89.      1  HPAS, TEMPS,ecow3(6),ecow4(9),ecow5(6),
  90. C     1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  91.      2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  92.      2 ecow12(6),
  93. C     2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  94.      1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  95. C     1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  96.      2 ecow17(6),ecow18(6),ecow19,ecow20
  97. C     2 SIPLAD(6),DSIGP0(6),TET,TETI
  98.       ENDSEGMENT
  99.  
  100.       SEGMENT NECOU
  101. *      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  102.        INTEGER  NCOURB,  IPLAST,IT,IMAPLA,  ISOTRO,
  103. C      INTEGER NCOURB,IPLAST,IT,   IMAPLA,ISOTRO,
  104.      1  ITYP,  IFOURB, IFLUAG,
  105. C    . ITYP, IFOURB,IFLUAG,
  106.      2 ICINE,ITHER, IFLUPL,ICYCL, IBI,
  107. C    . ICINE,ITHER, IFLUPL,ICYCL, IBI,
  108.      3  JFLUAG,KFLUAG, LFLUAG,
  109. C    . JFLUAG,KFLUAG,LFLUAG,
  110.      4  IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEP
  111. C    . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  112.       ENDSEGMENT
  113. *     COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  114. *     . ITYP,IFOURB,IFLUAG,
  115. *     . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  116. *     . JFLUAG,KFLUAG,LFLUAG,
  117. *     . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  118.  
  119.       DIMENSION MOMAT(2)
  120.       DIMENSION XEPOU(2),YEPOU(2),ZEPOU(2)
  121.       DIMENSION BID(3)
  122. *
  123.       CHARACTER*8 CMATE
  124.       CHARACTER*(NCONCH) CONM
  125.       PARAMETER ( NINF=3 )
  126.       INTEGER INFOS(NINF)
  127.       LOGICAL LSUPVA,lsupco,lsupma
  128.       DATA IUN,IZERO/1,0/
  129.       DATA UN,XZER,UNDEMI/1.D0,0.D0,.5D0/
  130. C
  131.       NHRM=NIFOUR
  132. C
  133. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES
  134. C
  135.       CALL  QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  136.       IF (ISUP1.GT.1) RETURN
  137. C
  138. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  139. C
  140.       CALL  QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  141.       IF (ISUP2.GT.1) RETURN
  142. C
  143. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  144. C
  145.       CALL  QUESUP(IPMODL,IPCAR,5,0,ISUP3,IRET3)
  146.       IF (ISUP3.GT.1) RETURN
  147. C
  148. C     ACTIVATION DU MODELE
  149. C
  150.       MMODEL=IPMODL
  151.       SEGACT MMODEL
  152.       NSOUS=KMODEL(/1)
  153. C
  154. C     CREATION DU MCHAML
  155. C
  156.       N1=NSOUS
  157.       L1=8
  158.       N3=6
  159.       SEGINI MCHELM
  160.       TITCHE='SCALAIRE'
  161.       IFOCHE=IFOUR
  162.       IPCHE3=MCHELM
  163. C____________________________________________________________________
  164. C
  165. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  166. C____________________________________________________________________
  167. C
  168.       DO 500 ISOUS=1,NSOUS
  169. *
  170. *   INITIALISATION
  171. *
  172.       segini necou,ecou
  173.       NSTR=0
  174.       MOSTRS=0
  175.       IVASTR=0
  176.       MOVARI=0
  177.       NVARI=0
  178.       IVARI=0
  179.       NCARA=0
  180.       NCARF=0
  181.       MOCARA=0
  182.       IVACAR=0
  183.       NMATF=0
  184.       NMATR=0
  185.       MOMATR=0
  186.       IVAMAT=0
  187.       IMELCR=0
  188.       KERRE=0
  189.       KERR1=0
  190.       lsupma=.true.
  191.       lsupva=.false.
  192. C
  193. C     ON RECUPERE L INFORMATION GENERALE
  194. C
  195.       IMODEL=KMODEL(ISOUS)
  196.       SEGACT IMODEL
  197.       IPMAIL=IMAMOD
  198.       CONM  =CONMOD
  199.       IMACHE(ISOUS)=IPMAIL
  200.       CONCHE(ISOUS)=CONMOD
  201. *
  202.       MELE=NEFMOD
  203.       MELEME=IMAMOD
  204.       SEGACT MELEME
  205.       NBNN=NUM(/1)
  206.       NBELEM=NUM(/2)
  207. C
  208. C     TRAITEMENT DU MODELE
  209. C
  210. C
  211. C   COQUE INTEGREE OU PAS ?
  212. C
  213.       IF(INFMOD(/1).NE.0)THEN
  214.           NPINT=INFMOD(1)
  215.       ELSE
  216.           NPINT=0
  217.       ENDIF
  218.       IF (NPINT.NE.0)THEN
  219.         CALL ERREUR(615)
  220.         SEGDES IMODEL,MMODEL
  221.         SEGSUP MCHELM
  222.         RETURN
  223.       ENDIF
  224. C
  225. C     NATURE DU MATERIAU
  226. C
  227. C*    NFOR=FORMOD(/2)
  228. C*    NMAT=MATMOD(/2)
  229. C*    CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS)
  230.       CMATE  = CMATEE
  231.       MATE   = IMATEE
  232.       INPLAS = INATUU
  233. C*    IF (CMATE.EQ.' ')THEN
  234. C*      CALL ERREUR(251)
  235. C*      SEGDES IMODEL,MMODEL
  236. C*      SEGSUP MCHELM
  237. C*      RETURN
  238. C*    ENDIF
  239. C____________________________________________________________________
  240. C
  241. C     INFORMATION SUR L'ELEMENT FINI
  242. C____________________________________________________________________
  243. C
  244. *      CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  245. *      IF (IERR.NE.0) THEN
  246. *        SEGDES IMODEL,MMODEL
  247. *        SEGSUP MCHELM
  248. *        RETURN
  249. *      ENDIF
  250.       MFR  =INFELE(13)
  251.       NBG  =INFELE(6)
  252.       NBGS =INFELE(4)
  253.       NSTRS=INFELE(16)
  254.       LRE  =INFELE(9)
  255.       IPPORE=0
  256.       IF(MFR.EQ.33) IPPORE=NBNN
  257.       LW   =200
  258.       LW2=150
  259.       LHOOK=INFELE(10)
  260.       LHOO2=LHOOK*LHOOK
  261. *      MINTE=INFELE(11)
  262.       minte=infmod(7)
  263. *
  264.         IPMINT=MINTE
  265.         SEGACT,MINTE
  266. *
  267. *   REMPLISSAGE DES TABLEAUX INFCHE
  268. *
  269.       INFCHE(ISOUS,1)=0
  270.       INFCHE(ISOUS,2)=0
  271.       INFCHE(ISOUS,3)=NHRM
  272.       INFCHE(ISOUS,4)=MINTE
  273.       INFCHE(ISOUS,5)=0
  274.       INFCHE(ISOUS,6)=5
  275. C
  276. C     CREATION DU TABLEAU INFOS
  277. C
  278.       CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  279.       IF (IRTD.EQ.0)THEN
  280.         SEGDES IMODEL,MMODEL
  281.         SEGSUP MCHELM
  282.         RETURN
  283.       ENDIF
  284. *
  285. *       TRAITEMENT DU CHAMP DE CONTRAINTES
  286. *
  287.       if(lnomid(4).ne.0) then
  288.          nomid=lnomid(4)
  289.          segact nomid
  290.          mostrs=nomid
  291.          nstr=lesobl(/2)
  292.          nfac=lesfac(/2)
  293.          lsupco=.false.
  294.       else
  295.          lsupco=.true.
  296.          CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  297.       endif
  298.          IF (MOSTRS.EQ.0) THEN
  299.             MOTERR(1:4)='CONT'
  300.             MOTERR(5:8)=NOMTP(MELE)
  301.             CALL ERREUR (76)
  302.             SEGDES IMODEL,MMODEL
  303.             SEGSUP MCHELM
  304.             RETURN
  305.          ENDIF
  306. *
  307.          NBTYPE=1
  308.          SEGINI NOTYPE
  309.          MOTYPE=NOTYPE
  310.          TYPE(1)='REAL*8'
  311.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  312.          IF(IERR.NE.0)THEN
  313.             SEGSUP NOTYPE
  314.             KERRE=999
  315.             GOTO 9990
  316.          ENDIF
  317. *
  318.         IF (ISUP1.EQ.1) THEN
  319.            CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE)
  320.            IF(IERR.NE.0)THEN
  321.              SEGSUP NOTYPE
  322.              KERRE=999
  323.              ISUP1=0
  324.              GOTO 9990
  325.             ENDIF
  326.         ENDIF
  327. *
  328. *       TRAITEMENT DU CHAMP DE VARIABLES INTERNES
  329. *
  330.       if(lnomid(10).ne.0) then
  331.          nomid=lnomid(10)
  332.          segact nomid
  333.          movari=nomid
  334.          nvari=lesobl(/2)
  335.          nvarf=lesfac(/2)
  336.       else
  337.          lsupva=.true.
  338.          CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  339.       endif
  340.  
  341.          IF (MOVARI.EQ.0) THEN
  342.             MOTERR(1:4)='VARI'
  343.             MOTERR(5:8)=NOMTP(MELE)
  344.             CALL ERREUR (76)
  345.             KERRE=999
  346.             SEGSUP NOTYPE
  347.             GOTO 9990
  348.          ENDIF
  349. *
  350.          CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  351.          SEGSUP NOTYPE
  352.          IF(IERR.NE.0)THEN
  353.             KERRE=999
  354.             GOTO 9990
  355.          ENDIF
  356. *
  357.         IF (ISUP2.EQ.1) THEN
  358.            CALL VALCHE(IVARI,NVARI,IPMINT,IPPORE,MOVARI,MELE)
  359.            IF(IERR.NE.0)THEN
  360.              KERRE=999
  361.              ISUP2=0
  362.              GOTO 9990
  363.             ENDIF
  364.         ENDIF
  365. *
  366. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  367. *
  368.          if(lnomid(6).ne.0) then
  369.           nomid=lnomid(6)
  370.           segact nomid
  371.           momatr=nomid
  372.           nmatr=lesobl(/2)
  373.           nmatf=lesfac(/2)
  374.           lsupma=.false.
  375.          else
  376.           lsupma=.true.
  377.           CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  378.          endif
  379.          IF (MOMATR.EQ.0) THEN
  380.             MOTERR(1:4)='MATE'
  381.             MOTERR(5:8)=NOMTP(MELE)
  382.             CALL ERREUR (76)
  383.             KERRE=999
  384.             GOTO 9990
  385.          ENDIF
  386. *
  387.          NOTYPE=0
  388.          IF(INPLAS.EQ.5)THEN
  389.             NBTYPE=5
  390.             SEGINI NOTYPE
  391.             TYPE(1)='REAL*8'
  392.             TYPE(2)='REAL*8'
  393.             TYPE(3)='POINTEUREVOLUTIO'
  394.             TYPE(4)='REAL*8'
  395.             TYPE(5)='REAL*8'
  396.          ELSE IF (INPLAS.EQ.14) THEN
  397.             NBTYPE=9
  398.             SEGINI NOTYPE
  399.             TYPE(1)='REAL*8'
  400.             TYPE(2)='REAL*8'
  401.             TYPE(3)='REAL*8'
  402.             TYPE(4)='REAL*8'
  403.             TYPE(5)='REAL*8'
  404.             TYPE(6)='POINTEUREVOLUTIO'
  405.             TYPE(7)='POINTEUREVOLUTIO'
  406.             TYPE(8)='REAL*8'
  407.             TYPE(9)='REAL*8'
  408.          ELSE IF (INPLAS.EQ.26) THEN
  409.             NBTYPE=8
  410.             SEGINI NOTYPE
  411.             TYPE(1)='REAL*8'
  412.             TYPE(2)='REAL*8'
  413.             TYPE(3)='POINTEUREVOLUTIO'
  414.             TYPE(4)='REAL*8'
  415.             TYPE(5)='REAL*8'
  416.             TYPE(6)='REAL*8'
  417.             TYPE(7)='REAL*8'
  418.             TYPE(8)='REAL*8'
  419.          ELSEIF(INPLAS.EQ.29)THEN
  420.             NBTYPE=13
  421.             SEGINI NOTYPE
  422.             TYPE(1)='REAL*8'
  423.             TYPE(2)='REAL*8'
  424.             TYPE(3)='REAL*8'
  425.             TYPE(4)='REAL*8'
  426.             TYPE(5)='REAL*8'
  427.             TYPE(6)='REAL*8'
  428.             TYPE(7)='REAL*8'
  429.             TYPE(8)='REAL*8'
  430.             TYPE(9)='REAL*8'
  431.             TYPE(10)='POINTEUREVOLUTIO'
  432.             TYPE(11)='REAL*8'
  433.             TYPE(12)='REAL*8'
  434.             TYPE(13)='REAL*8'
  435.          ELSEIF(INPLAS.EQ.16)THEN
  436.             NBTYPE=7
  437.             SEGINI NOTYPE
  438.             TYPE(1)='REAL*8'
  439.             TYPE(2)='REAL*8'
  440.             TYPE(3)='POINTEUREVOLUTIO'
  441.             TYPE(4)='REAL*8'
  442.             TYPE(5)='REAL*8'
  443.             TYPE(6)='REAL*8'
  444.             TYPE(7)='REAL*8'
  445.          ELSEIF(INPLAS.EQ.2)THEN
  446.             NBTYPE=6
  447.             SEGINI NOTYPE
  448.             TYPE(1)='REAL*8'
  449.             TYPE(2)='REAL*8'
  450.             TYPE(3)='REAL*8'
  451.             TYPE(4)='POINTEUREVOLUTIO'
  452.             TYPE(5)='REAL*8'
  453.             TYPE(6)='REAL*8'
  454.          ELSE
  455.             NBTYPE=1
  456.             SEGINI NOTYPE
  457.             TYPE(1)='REAL*8'
  458.          ENDIF
  459.          MOTYPE=NOTYPE
  460.          CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  461.      &                                   INFOS,3,IVAMAT)
  462.          SEGSUP NOTYPE
  463.          IF(IERR.NE.0)THEN
  464.             KERRE=999
  465.             GOTO 9990
  466.          ENDIF
  467.          NMATT=NMATR+NMATF
  468. *
  469.         IF (ISUP3.EQ.1) THEN
  470.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  471.            IF(IERR.NE.0)THEN
  472.               KERRE=999
  473.               ISUP3=0
  474.               GOTO 9990
  475.            ENDIF
  476.         ENDIF
  477. *
  478. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  479. *
  480.          NBROBL=0
  481.          NBRFAC=0
  482.          NOMID =0
  483.          IVECT=0
  484. *
  485. *       COQUES MINCES
  486. *
  487.          IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  488.             NBROBL=1
  489.             NBRFAC=2
  490.             SEGINI NOMID
  491.             LESOBL(1)='EPAI'
  492.             LESFAC(1)='CALF'
  493.             LESFAC(2)='EXCE'
  494. *
  495.             NBTYPE=1
  496.             SEGINI NOTYPE
  497.             TYPE(1)='REAL*8'
  498.          ELSEIF (MFR.EQ.5) THEN
  499.             NBROBL=1
  500.             NBRFAC=1
  501.             SEGINI NOMID
  502.             LESOBL(1)='EPAI'
  503.             LESFAC(1)='EXCE'
  504. *
  505.             NBTYPE=1
  506.             SEGINI NOTYPE
  507.             TYPE(1)='REAL*8'
  508. *
  509. * SECTION POUR LES BARRES
  510. *
  511.          ELSE IF (MFR.EQ.27) THEN
  512.             NBROBL=1
  513.             SEGINI NOMID
  514.             LESOBL(1)='SECT'
  515. *
  516.             NBTYPE=1
  517.             SEGINI NOTYPE
  518.             TYPE(1)='REAL*8'
  519. *
  520. * CARACTERISTIQUES POUR LES POUTRES
  521. *
  522.          ELSE IF (MFR.EQ.7 ) THEN
  523.             NBROBL=4
  524.             NBRFAC=8
  525.             SEGINI NOMID
  526.             LESOBL(1)='TORS'
  527.             LESOBL(2)='INRY'
  528.             LESOBL(3)='INRZ'
  529.             LESOBL(4)='SECT'
  530.             LESFAC(1)='SECY'
  531.             LESFAC(2)='SECZ'
  532.             LESFAC(3)='DX  '
  533.             LESFAC(4)='DY  '
  534.             LESFAC(5)='DZ  '
  535.             LESFAC(6)='VX'
  536.             LESFAC(7)='VY'
  537.             LESFAC(8)='VZ'
  538.             IVECT=1
  539. *
  540.             NBTYPE=12
  541.             SEGINI NOTYPE
  542.             TYPE(1)='REAL*8'
  543.             TYPE(2)='REAL*8'
  544.             TYPE(3)='REAL*8'
  545.             TYPE(4)='REAL*8'
  546.             TYPE(5)='REAL*8'
  547.             TYPE(6)='REAL*8'
  548.             TYPE(7)='REAL*8'
  549.             TYPE(8)='REAL*8'
  550.             TYPE(9)='REAL*8'
  551.             TYPE(10)='REAL*8'
  552.             TYPE(11)='REAL*8'
  553.             TYPE(12)='REAL*8'
  554.  
  555. *
  556. * CARACTERISTIQUES POUR LES TUYAUX
  557. *
  558.          ELSE IF (MFR.EQ.13) THEN
  559.             NBROBL=2
  560.             NBRFAC=11
  561.             SEGINI NOMID
  562.             LESOBL(1)='EPAI'
  563.             LESOBL(2)='RAYO'
  564.             LESFAC(1)='RACO'
  565.             LESFAC(2)='PRES'
  566.             LESFAC(3)='CISA'
  567.             LESFAC(4)='CFFX'
  568.             LESFAC(5)='CFMX'
  569.             LESFAC(6)='CFMY'
  570.             LESFAC(7)='CFMZ'
  571.             LESFAC(8)='CFPR'
  572.             LESFAC(9)='VX'
  573.             LESFAC(10)='VY'
  574.             LESFAC(11)='VZ'
  575.             IVECT=1
  576. *
  577.             NBTYPE=13
  578.             SEGINI NOTYPE
  579.             TYPE(1)='REAL*8'
  580.             TYPE(2)='REAL*8'
  581.             TYPE(3)='REAL*8'
  582.             TYPE(4)='REAL*8'
  583.             TYPE(5)='REAL*8'
  584.             TYPE(6)='REAL*8'
  585.             TYPE(7)='REAL*8'
  586.             TYPE(8)='REAL*8'
  587.             TYPE(9)='REAL*8'
  588.             TYPE(10)='REAL*8'
  589.             TYPE(11)='REAL*8'
  590.             TYPE(12)='REAL*8'
  591.             TYPE(13)='REAL*8'
  592. *
  593. * CARACTERISTIQUES POUR LES LINESPRING
  594. *
  595.          ELSE IF (MFR.EQ.15) THEN
  596.             NBROBL=5
  597.             SEGINI NOMID
  598.             LESOBL(1)='EPAI'
  599.             LESOBL(2)='FISS'
  600.             LESOBL(3)='VX  '
  601.             LESOBL(4)='VY  '
  602.             LESOBL(5)='VZ  '
  603. *
  604.             NBTYPE=1
  605.             SEGINI NOTYPE
  606.             TYPE(1)='REAL*8'
  607. *
  608. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  609. *
  610.          ELSE IF (MFR.EQ.17) THEN
  611.             NBROBL=9
  612.             SEGINI NOMID
  613.             LESOBL(1)='RAYO'
  614.             LESOBL(2)='EPAI'
  615.             LESOBL(3)='VX  '
  616.             LESOBL(4)='VY  '
  617.             LESOBL(5)='VZ  '
  618.             LESOBL(6)='VXF '
  619.             LESOBL(7)='VYF '
  620.             LESOBL(8)='VZF '
  621.             LESOBL(9)='ANGL'
  622. *
  623.             NBTYPE=1
  624.             SEGINI NOTYPE
  625.             TYPE(1)='REAL*8'
  626. *
  627. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  628. *
  629.          ELSE IF (MFR.EQ.37) THEN
  630.             IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  631.                NBROBL=4
  632.                SEGINI NOMID
  633.                LESOBL(1)='SCEL'
  634.                LESOBL(2)='SFLU'
  635.                LESOBL(3)='EPS '
  636.                LESOBL(4)='XINE'
  637.             ELSE
  638.                NBROBL=3
  639.                SEGINI NOMID
  640.                LESOBL(1)='SCEL'
  641.                LESOBL(2)='SFLU'
  642.                LESOBL(3)='EPS '
  643.             ENDIF
  644. *
  645.             NBTYPE=1
  646.             SEGINI NOTYPE
  647.             TYPE(1)='REAL*8'
  648.          ENDIF
  649. *
  650.          MOCARA=NOMID
  651.          NCARA=NBROBL
  652.          NCARF=NBRFAC
  653.          NCARR=NCARA+NCARF
  654.  
  655.          IF(MOCARA.NE.0)THEN
  656.             MOTYPE=NOTYPE
  657.             CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  658.      &                                     INFOS,3,IVACAR)
  659.             SEGSUP NOTYPE
  660.             IF(IERR.NE.0)THEN
  661.                KERRE=999
  662.                GOTO 9990
  663.             ENDIF
  664. *
  665. ***            IF (IVECT.EQ.1) IVECT=2
  666. *
  667.            IF (ISUP3.EQ.1) THEN
  668.                CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  669.                IF(IERR.NE.0)THEN
  670.                   KERRE=999
  671.                   ISUP3=0
  672.                   GOTO 9990
  673.                ENDIF
  674.            ENDIF
  675.          ENDIF
  676.          ICARA=NCARR
  677.          IF((MFR.EQ.7.OR.MFR.EQ.13).AND.IVECT.NE.0)ICARA=NCARR+IDIM-3
  678. *
  679. *      CREATION DES MCHAMLS DE LA SOUS ZONE
  680. *
  681.        NBPTEL=NBGS
  682.        NEL=NBELEM
  683.        N1PTEL=NBPTEL
  684.        N1EL=NEL
  685. *
  686.        N2=1
  687.        SEGINI MCHAML
  688.        ICHAML(ISOUS)=MCHAML
  689.        NOMCHE(1)='SCAL'
  690.        TYPCHE(1)='REAL*8'
  691.        N2PTEL=0
  692.        N2EL=0
  693.        SEGINI MELVAL
  694.        IELVAL(1)=MELVAL
  695.        IMELCR=MELVAL
  696. C
  697. C  MISE A 0 DES VARIABLES DU COMMON NECOU SI BESOIN
  698. C    LES BONNES VALEURS SONT ATTRIBUEES SELON LES MODELES
  699. C    INITIALISATIONS SELON LES CAS
  700. C
  701.       LTRAC=0
  702.       IF(INPLAS.NE.2)THEN
  703.        IFOURB=IFOUR
  704.        NCOURB=0
  705.        IPLAST=0
  706.        IMAPLA=1
  707.        IT=1
  708.        ISOTRO=0
  709.        ITYP=0
  710. C
  711. C  CORRESPONDANCE ( MFR,IFOUR) ET ITYP FAITE DANS ECOCRI
  712. C
  713.        IFLUAG=0
  714.        ICINE=0
  715.        ITHER=0
  716.        IFLUPL=0
  717.        ICYCL=0
  718.        IBI=0
  719.        JFLUAG=0
  720.        KFLUAG=0
  721.        LFLUAG=0
  722.        IRELAX=0
  723.        JNTRIN=0
  724.        MFLUAG=0
  725.        JSOUFL=0
  726.        JGRDEF=0
  727.        LTRAC=60
  728.       ENDIF
  729. *
  730. *    INITIALISATION DES SEGMENTS DE TRAVAIL
  731. *
  732.       NCXMAT=NMATT
  733.       IF(INPLAS.EQ.3)NCXMAT=NMATT+7
  734.       SEGINI WRK0,WRK1,WRK2,WRK3
  735.       IF(MFR.EQ.7.OR.MFR.EQ.13)THEN
  736.          NBBB=NBNN
  737.          SEGINI WRK4
  738.       ENDIF
  739. *
  740. *       BOUCLE SUR LES ELEMENTS
  741. *
  742.        DO 200 IB=1,NBELEM
  743. *
  744. *       BOUCLE SUR LES POINTS DE GAUSS
  745. *
  746.          DO 300  IGAU=1,NBPTEL
  747. *
  748. *       ON RECUPERE LES CONTRAINTES
  749. *
  750.             MPTVAL=IVASTR
  751.             DO 201 IC=1,NSTRS
  752.                MELVAL=IVAL(IC)
  753.                IBMN=MIN(IB,VELCHE(/2))
  754.                IGMN=MIN(IGAU,VELCHE(/1))
  755.                SIG0(IC)=VELCHE(IGMN,IBMN)
  756.  201         CONTINUE
  757. *
  758. *     ON RECUPERE LES VARIABLES INTERNES
  759. *
  760.             MPTVAL=IVARI
  761.             DO 202 IC=1,NVARI
  762.                MELVAL=IVAL(IC)
  763.                IBMN=MIN(IB,VELCHE(/2))
  764.                IGMN=MIN(IGAU,VELCHE(/1))
  765.                VAR0(IC)=VELCHE(IGMN,IBMN)
  766.  202         CONTINUE
  767. *
  768. *     ON RECUPERE LES CONSTANTES DU MATERIAU
  769. *
  770.             MPTVAL=IVAMAT
  771.             IF(INPLAS.EQ.9 .OR.INPLAS .EQ. 28)THEN
  772. *
  773. *         POUR LE MODELE BETON ET UBIQUITOUS
  774. *
  775.                DO 203 IC=1,NMATT
  776.                   MELVAL=IVAL(IC)
  777.                   IF(MELVAL.NE.0)THEN
  778.                      IBMN=MIN(IB,VELCHE(/2))
  779.                      IGMN=MIN(IGAU,VELCHE(/1))
  780.                      XMAT(IC)=VELCHE(IGMN,IBMN)
  781.                   ELSE
  782.                      XMAT(IC)=0.D0
  783.                   ENDIF
  784.  203            CONTINUE
  785.             ELSE
  786. *
  787. *         POUR LES AUTRES MODELES
  788. *
  789.                MELVAL=IVAL(1)
  790.                IF(MELVAL.NE.0)THEN
  791.                   IF(TYVAL(1)(1:8).NE.'POINTEUR')THEN
  792.                      IBMN=MIN(IB,VELCHE(/2))
  793.                      IGMN=MIN(IGAU,VELCHE(/1))
  794.                      XMAT(1)=VELCHE(IGMN,IBMN)
  795.                   ELSE
  796.                      IBMN=MIN(IB,IELCHE(/2))
  797.                      IGMN=MIN(IGAU,IELCHE(/1))
  798.                      XMAT(1)=IELCHE(IGMN,IBMN)
  799.                   ENDIF
  800.                ELSE
  801.                   XMAT(1)=0.D0
  802.                   IF(TYVAL(1)(1:8).EQ.'POINTEUR') THEN
  803.                      XMAT(1)=0
  804.                   END IF
  805.                ENDIF
  806.                MELVAL=IVAL(2)
  807.                IF(MELVAL.NE.0)THEN
  808.                   IF(TYVAL(2)(1:8).NE.'POINTEUR')THEN
  809.                      IBMN=MIN(IB,VELCHE(/2))
  810.                      IGMN=MIN(IGAU,VELCHE(/1))
  811.                      XMAT(2)=VELCHE(IGMN,IBMN)
  812.                   ELSE
  813.                      IBMN=MIN(IB,IELCHE(/2))
  814.                      IGMN=MIN(IGAU,IELCHE(/1))
  815.                      XMAT(2)=IELCHE(IGMN,IBMN)
  816.                   ENDIF
  817.                ELSE
  818.                   XMAT(2)=0.D0
  819.                   IF(TYVAL(2)(1:8).EQ.'POINTEUR') THEN
  820.                      XMAT(2)=0
  821.                   END IF
  822.                ENDIF
  823.                DO 205 IC=3,NMATT-2
  824.                   MELVAL=IVAL(IC)
  825.                   IF(MELVAL.NE.0)THEN
  826.                      IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  827.                         IBMN=MIN(IB,VELCHE(/2))
  828.                         IGMN=MIN(IGAU,VELCHE(/1))
  829.                         XMAT(IC+2)=VELCHE(IGMN,IBMN)
  830.                      ELSE
  831.                        IBMN=MIN(IB,IELCHE(/2))
  832.                        IGMN=MIN(IGAU,IELCHE(/1))
  833.                        XMAT(IC+2)=IELCHE(IGMN,IBMN)
  834.                      ENDIF
  835.                   ELSE
  836.                      XMAT(IC+2)=0.D0
  837.                      IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  838.                         XMAT(IC+2)=0
  839.                      END IF
  840.                   ENDIF
  841.  205            CONTINUE
  842.                MELVAL=IVAL(NMATT-1)
  843.                IF(MELVAL.NE.0)THEN
  844.                   IF(TYVAL(NMATT-1)(1:8).NE.'POINTEUR')THEN
  845.                      IBMN=MIN(IB,VELCHE(/2))
  846.                      IGMN=MIN(IGAU,VELCHE(/1))
  847.                      XMAT(3)=VELCHE(IGMN,IBMN)
  848.                   ELSE
  849.                      IBMN=MIN(IB,IELCHE(/2))
  850.                      IGMN=MIN(IGAU,IELCHE(/1))
  851.                      XMAT(3)=IELCHE(IGMN,IBMN)
  852.                   ENDIF
  853.                ELSE
  854.                   XMAT(3)=0.D0
  855.                   IF(TYVAL(NMATT-1)(1:8).EQ.'POINTEUR')XMAT(3)=0
  856.                END IF
  857.                MELVAL=IVAL(NMATT)
  858.                IF(MELVAL.NE.0)THEN
  859.                   IF(TYVAL(NMATT)(1:8).NE.'POINTEUR')THEN
  860.                      IBMN=MIN(IB,VELCHE(/2))
  861.                      IGMN=MIN(IGAU,VELCHE(/1))
  862.                      XMAT(4)=VELCHE(IGMN,IBMN)
  863.                   ELSE
  864.                      IBMN=MIN(IB,IELCHE(/2))
  865.                      IGMN=MIN(IGAU,IELCHE(/1))
  866.                      XMAT(4)=IELCHE(IGMN,IBMN)
  867.                   ENDIF
  868.                ELSE
  869.                   XMAT(4)=0.D0
  870.                   IF(TYVAL(NMATT)(1:8).EQ.'POINTEUR') THEN
  871.                      XMAT(4)=0
  872.                   END IF
  873.                ENDIF
  874. *
  875. *        REARRANGEMENT POUR  CERTAINES LOIS
  876. *
  877.                IF (INPLAS.EQ.14) THEN
  878.                   IF(XMAT(8).NE.XZER.OR.XMAT(9).NE.XZER)THEN
  879.                      INPLAS=18
  880.                      XMAT(5)=XMAT(8)
  881.                      XMAT(6)=XMAT(9)
  882.                   ENDIF
  883.                ELSE IF (INPLAS.EQ.2) THEN
  884.                   IF (XMAT(6).NE.XZER) THEN
  885.                      INPLAS=27
  886.                      XMAT(5)=XMAT(6)
  887.                   ENDIF
  888.                ELSE IF (INPLAS.EQ.29)THEN
  889.                   YXMAT=XMAT(13)
  890.                   XMAT(13)=XMAT(4)
  891.                   XMAT(4)=XMAT(3)
  892.                   XMAT(3)=YXMAT
  893.                ENDIF
  894.             ENDIF
  895. *
  896. *        ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  897. *
  898.             IF(IVACAR.NE.0)THEN
  899.                MPTVAL=IVACAR
  900. *
  901. * cas des tuyaux
  902. *
  903.                IF(MFR.EQ.13)THEN
  904.                   DO 106 IC=1,5
  905.                      MELVAL=IVAL(IC)
  906.                      IF(MELVAL.NE.0)THEN
  907.                         IBMN=MIN(IB,VELCHE(/2))
  908.                         IGMN=MIN(IGAU,VELCHE(/1))
  909.                         XCAR(IC)=VELCHE(IGMN,IBMN)
  910.                      ELSE
  911.                         XCAR(IC)=0.D0
  912.                      ENDIF
  913.  106               CONTINUE
  914.                  IF(IVECT.NE.0)THEN
  915.                   DO 107 IC=6,NCARR   
  916.                      MELVAL=IVAL(IC)
  917.                      IF(MELVAL.NE.0)THEN
  918.                         IBMN=MIN(IB,VELCHE(/2))
  919.                         IGMN=MIN(IGAU,VELCHE(/1))
  920.                         XCAR(IC)=VELCHE(IGMN,IBMN)
  921.                      ELSE
  922.                         XCAR(IC)=-1.D0
  923.                      ENDIF
  924.  107               CONTINUE
  925.                  ELSE
  926.                   DO 110 IC=6,10
  927.                      MELVAL=IVAL(IC)
  928.                      IF(MELVAL.NE.0)THEN
  929.                         IBMN=MIN(IB,VELCHE(/2))
  930.                         IGMN=MIN(IGAU,VELCHE(/1))
  931.                         XCAR(IC)=VELCHE(IGMN,IBMN)
  932.                      ELSE
  933.                         XCAR(IC)=-1.D0
  934.                      ENDIF
  935.  110               CONTINUE
  936.                   DO 111 IC=11,ICARA
  937.                      MELVAL=IVAL(IC)
  938.                      IF(MELVAL.NE.0)THEN
  939.                         IBMN=MIN(IB,VELCHE(/2))
  940.                         IGMN=MIN(IGAU,VELCHE(/1))
  941.                         XCAR(IC)=VELCHE(IGMN,IBMN)
  942.                      ELSE
  943.                         XCAR(IC)=0.D0
  944.                      ENDIF
  945.  111               CONTINUE
  946.                  ENDIF
  947.                ELSE IF(MFR.EQ.7.AND.IVECT.NE.0)THEN
  948.                   DO 206 IC=1,NCARR
  949.                      MELVAL=IVAL(IC)
  950.                      IF(MELVAL.NE.0)THEN
  951.                         IBMN=MIN(IB,VELCHE(/2))
  952.                         IGMN=MIN(IGAU,VELCHE(/1))
  953.                         XCAR(IC)=VELCHE(IGMN,IBMN)
  954.                      ELSE
  955.                         XCAR(IC)=0.D0
  956.                      ENDIF
  957.  206               CONTINUE
  958.                ELSE
  959.                   DO 209 IC=1,ICARA
  960.                      MELVAL=IVAL(IC)
  961.                      IF(MELVAL.NE.0)THEN
  962.                         IBMN=MIN(IB,VELCHE(/2))
  963.                         IGMN=MIN(IGAU,VELCHE(/1))
  964.                         XCAR(IC)=VELCHE(IGMN,IBMN)
  965.                      ELSE
  966.                         XCAR(IC)=0.D0
  967.                      ENDIF
  968.  209               CONTINUE
  969.                ENDIF
  970. *
  971. *    REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  972. *    QUE L'ANCIEN  CHAMELEM
  973. *
  974.                IF(MFR.EQ.7)THEN
  975.                   IF(IDIM.EQ.2)THEN
  976.                      VX=XCAR(ICARA-3)
  977.                      VY=XCAR(ICARA-2)
  978.                      XCAR(ICARA-3)=XCAR(ICARA-1)
  979.                      XCAR(ICARA-2)=XCAR(ICARA)
  980.                      XCAR(ICARA-1)=VX
  981.                      XCAR(ICARA)=VY
  982.                   ELSEIF(IDIM.EQ.3)THEN
  983.                      VX=XCAR(ICARA-5)
  984.                      VY=XCAR(ICARA-4)
  985.                      VZ=XCAR(ICARA-3)
  986.                      XCAR(ICARA-5)=XCAR(ICARA-2)
  987.                      XCAR(ICARA-4)=XCAR(ICARA-1)
  988.                      XCAR(ICARA-3)=XCAR(ICARA)
  989.                      XCAR(ICARA-2)=VX
  990.                      XCAR(ICARA-1)=VY
  991.                      XCAR(ICARA)=VZ
  992.                   ENDIF
  993.                ELSE IF(MFR.EQ.13)THEN
  994.                   NWORK2 = 7
  995.                   DO 210 IC=4,10
  996.                   WORK2(IC-3)=XCAR(IC)
  997.  210              CONTINUE
  998.                   IF(IDIM.EQ.2)THEN
  999.                      XCAR(4)=XCAR(ICARA-1)
  1000.                      XCAR(5)=XCAR(ICARA)
  1001.                      DO 211 IC=1,NWORK2
  1002.                      XCAR(IC+5)=WORK2(IC)
  1003.  211                 CONTINUE
  1004.                   ELSE IF(IDIM.EQ.3)THEN
  1005.                      XCAR(4)=XCAR(ICARA-2)
  1006.                      XCAR(5)=XCAR(ICARA-1)
  1007.                      XCAR(6)=XCAR(ICARA)
  1008.                      DO 212 IC=1,NWORK2
  1009.                      XCAR(IC+6)=WORK2(IC)
  1010.  212                 CONTINUE
  1011.                   ENDIF
  1012.                ENDIF
  1013.             ENDIF
  1014. *
  1015.        IF(INPLAS.EQ.0) THEN
  1016.            CRITER = 0.D0
  1017.           GOTO 510
  1018. C
  1019.        ELSE
  1020. C=======================================================================
  1021. C     NUMERO DES ETIQUETTES      :
  1022. C
  1023. C     1 A 99 POUR LES MODELES DE PLASTICITE  ( INDICE INPLAS )
  1024. C
  1025. C=======================================================================
  1026.       GOTO (1, 2, 3, 4, 5,99, 7,99,99,99, 7, 7, 7,14,15,99,99,99,99,99,
  1027.      .      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  1028.      .      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  1029.      .      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99),INPLAS
  1030. C
  1031.   99  CONTINUE
  1032.       KERRE=999
  1033.       MOTERR(1:4)=NOMAC(INPLAS)
  1034.       MOTERR(5:12)=NOMFR(MFR)
  1035.       CALL ERREUR(269)
  1036.       SEGSUP WRK0,WRK1,WRK2,WRK3
  1037.       IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4
  1038.       GOTO 9990
  1039. C
  1040. C     MODELE VON MISES ISOTROPE ASSOCIE ( D'APRES INCA )
  1041. C
  1042.    1  CONTINUE
  1043. C
  1044. C    CAS DE LA PLASTICITE PARFAITE
  1045. C
  1046.       NCOURB=2
  1047.       TRAC(1)=XMAT(5)
  1048.       TRAC(2)=0.D0
  1049.       TRAC(3)=XMAT(5)
  1050.       TRAC(4)=1.D0
  1051.       IF(XMAT(5).EQ.XZER) THEN
  1052.       KERRE=33
  1053.       GO TO 510
  1054.       ENDIF
  1055.       GOTO 682
  1056. C
  1057.    3  CONTINUE
  1058. C
  1059. C    CAS DU MODELE DE DRUCKER-PRAGER PARFAIT
  1060. C  LES DONNEES SONT LES LIMITES EN TRACTION ET EN COMPRESSION
  1061. C
  1062.       IMAPLA=5
  1063.       DEN =  ABS(XMAT(6)) + XMAT(5)
  1064.       IF(DEN.EQ.0.D0) THEN
  1065.       KERRE=48
  1066.       GO TO 510
  1067.       ENDIF
  1068.       XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
  1069.       XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
  1070.       XMAT(6) = SQRT(3.D0)
  1071.       XMAT(8)=XMAT(5)
  1072.       XMAT(9)=XMAT(6)
  1073.       XMAT(10)=XMAT(5)
  1074.       XMAT(11)=XMAT(6)
  1075.       XMAT(12)=XMAT(7)
  1076.       XMAT(13)=0.D0
  1077. C          PETITS TESTS SUR LES DONNEES
  1078.       IF(XMAT(10)/(XMAT(11)+1.D-20).GT.XMAT(5)*1.01/(XMAT(6)+1.D-20)
  1079.      .   .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  1080.       KERRE=48
  1081.       GO TO 510
  1082.       ENDIF
  1083.       GOTO 682
  1084. C
  1085.    4  CONTINUE
  1086. C
  1087. C    CAS DE LA PLASTICITE CINEMATIQUE BILINEAIRE
  1088. C
  1089.       ICINE=1
  1090.       NCOURB=2
  1091.       TRAC(1)=XMAT(5)
  1092.       TRAC(2)=0.D0
  1093.       TRAC(3)=XMAT(5)+XMAT(6)
  1094.       TRAC(4)=1.D0
  1095.       IF(XMAT(5).EQ.0.D0) THEN
  1096.       KERRE=33
  1097.       GO TO 510
  1098.       ENDIF
  1099.       GOTO 682
  1100. C
  1101.    5  CONTINUE
  1102. C
  1103. C   CAS DE LA PLASTICITE ISOTROPE ECROUISSABLE
  1104. C
  1105. C  ON RECUPERE LA COURBE DE TRACTION
  1106. C
  1107.       nccor=ncourb
  1108.       CALL COTRAC(WRK0,WRK2,NCcor,KERRE)
  1109.       ncourb=nccor
  1110.       IF(KERRE.NE.0) GO TO 510
  1111.       GO TO 682
  1112. C
  1113.    7  CONTINUE
  1114. C
  1115. C    CAS DU MODELE CHABOCHE
  1116. C
  1117.       ICINE=1
  1118.       IMAPLA=4
  1119.       GOTO 682
  1120. C
  1121.   15  CONTINUE
  1122. C
  1123. C    CAS DU MODELE DE DRUCKER-PRAGER GENERAL
  1124. C
  1125.       IMAPLA=5
  1126. C       PAS D'INITIALISATIONS PAR DEFAUT  POUR LE MOMENT
  1127. C     IF(XMAT(8).EQ.0.)  XMAT(8)=XMAT(5)
  1128. C     IF(XMAT(9).EQ.0.)  XMAT(9)=XMAT(6)
  1129. C     IF(XMAT(10).EQ.0.) XMAT(10)=XMAT(5)
  1130. C     IF(XMAT(11).EQ.0.) XMAT(11)=XMAT(6)
  1131. C     IF(XMAT(12).EQ.0.) XMAT(12)=XMAT(7)
  1132. C          PETITS TESTS SUR LES DONNEES
  1133.       IF(XMAT(10)/(XMAT(11)+1.D-20).GT.XMAT(5)*1.01/(XMAT(6)+1.D-20)
  1134.      .   .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  1135.       KERRE=48
  1136.       GO TO 510
  1137.       ENDIF
  1138. C          PERMUTATIONS POUR ECOCRI
  1139.       DO 615 I=5,7
  1140.       WW=XMAT(I)
  1141.       XMAT(I)=XMAT(I+5)
  1142.       XMAT(I+5)=WW
  1143.  615  CONTINUE      
  1144.       GOTO 682
  1145. C
  1146.   682 CONTINUE
  1147.       DO 675 IC=1,ICARA
  1148.       WORK(IC)=XCAR(IC)
  1149.   675 CONTINUE              
  1150.       BID(1)=0.D00
  1151.       BID(2)=0.D00
  1152.       BID(3)=0.D00
  1153.       necobi=necou
  1154.       neecbi=ecou
  1155.       CALL ECOCRI(SIG0,VAR0,BID,XMAT,CRITER,WORK ,
  1156.      .            TRAC,KERRE,MFR,NSTRS,INPLAS,necou,ecou)
  1157.       IF(KERRE.EQ.99) GO TO 99
  1158.       GOTO 510
  1159. C
  1160. C     MODELE LINESPRING
  1161. C
  1162.    2  CONTINUE
  1163.       CALL LISCRI(SIG0,XMAT,XCAR,KERRE,CRITER)
  1164.       GOTO 510
  1165. C
  1166. C     TUYAU FISSURE
  1167. C
  1168.   14  CONTINUE
  1169.       CALL TUFCRI(SIG0,VAR0,XMAT,XCAR,KERRE,CRITER)
  1170.       GOTO 510
  1171.       ENDIF
  1172. C
  1173.   510 CONTINUE
  1174.       IF(KERRE.NE.0) THEN
  1175. C
  1176. C     IMPRESSION DE QUELQUES  MESSAGES D ERREURS
  1177. C
  1178.       INTERR(1)=IB
  1179.       INTERR(2)=IGAU
  1180.       MOTERR(1:4)=NOMTP(MELE)
  1181.       IF(KERRE.EQ.1)  CALL ERREUR(267)
  1182.       IF(KERRE.EQ.2)  CALL ERREUR(268)
  1183.       IF(KERRE.EQ.7)  CALL ERREUR(355)
  1184.       IF(KERRE.EQ.30) CALL ERREUR(270)
  1185.       IF(KERRE.EQ.31) CALL ERREUR(271)
  1186.       IF(KERRE.EQ.32) CALL ERREUR(272)
  1187.       IF(KERRE.EQ.33) CALL ERREUR(273)
  1188.       IF(KERRE.EQ.34) CALL ERREUR(325)
  1189.       IF(KERRE.EQ.35) CALL ERREUR(331)
  1190.       IF(KERRE.EQ.36) CALL ERREUR(330)
  1191.       IF(KERRE.EQ.37) CALL ERREUR(354)
  1192.       IF(KERRE.EQ.38) CALL ERREUR(360)
  1193.       IF(KERRE.EQ.48) CALL ERREUR(366)
  1194.       IF(KERRE.EQ.75) CALL ERREUR(876)
  1195.       SEGSUP WRK0,WRK1,WRK2,WRK3
  1196.       IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4
  1197.       GO TO 9990
  1198.       ENDIF
  1199. C
  1200. C     REMPLISSAGE DU SEGMENT
  1201. C
  1202.        MELVAL=IMELCR
  1203.        VELCHE(IGAU,IB)=CRITER
  1204. C
  1205.  300  CONTINUE
  1206.  200  CONTINUE
  1207.       SEGSUP WRK0,WRK1,WRK2,WRK3
  1208.       IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4
  1209.  9990 CONTINUE
  1210. *
  1211. *     DESACTIVATION DES SEGMENTS
  1212. *
  1213.          SEGDES MELEME,IMODEL
  1214.          SEGDES,MINTE
  1215. *
  1216.          IF(ISUP1.EQ.1)THEN
  1217.             CALL DTMVAL (IVASTR,3)
  1218.          ELSE
  1219.             CALL DTMVAL (IVASTR,1)
  1220.          ENDIF
  1221.          IF(ISUP2.EQ.1)THEN
  1222.             CALL DTMVAL (IVARI,3)
  1223.          ELSE
  1224.             CALL DTMVAL (IVARI,1)
  1225.          ENDIF
  1226.          IF(ISUP3.EQ.1)THEN
  1227.             CALL DTMVAL (IVAMAT,3)
  1228.          ELSE
  1229.            CALL DTMVAL (IVAMAT,1)
  1230.          ENDIF
  1231.          IF(ISUP3.EQ.1)THEN
  1232.             CALL DTMVAL (IVACAR,3)
  1233.          ELSE
  1234.             CALL DTMVAL (IVACAR,1)
  1235.          ENDIF
  1236. *
  1237.          IF (MOCARA.NE.0) THEN
  1238.             NOMID=MOCARA
  1239.             SEGSUP NOMID
  1240.          END IF
  1241. *
  1242.          IF (MOMATR.NE.0) THEN
  1243.             NOMID=MOMATR
  1244.             if(lsupma)SEGSUP NOMID
  1245.          END IF
  1246. *
  1247.          IF (MOVARI.NE.0) THEN
  1248.             NOMID=MOVARI
  1249.             if(lsupva)SEGSUP NOMID
  1250.          END IF
  1251. *
  1252.          IF (MOSTRS.NE.0) THEN
  1253.             NOMID=MOSTRS
  1254.             if(lsupco)SEGSUP NOMID
  1255.          END IF
  1256. *
  1257.         segsup necou,ecou
  1258.          IF(KERRE.EQ.0)THEN
  1259.             MELVAL=IMELCR
  1260.             SEGDES MELVAL
  1261.             SEGDES MCHAML
  1262.          ELSE
  1263.             MELVAL=IMELCR
  1264.             SEGSUP MELVAL
  1265.             SEGSUP MCHAML
  1266.             GO TO 888
  1267.          ENDIF
  1268. 500    CONTINUE
  1269. *
  1270.  888  CONTINUE
  1271.       SEGDES MMODEL
  1272.       IF(KERRE.EQ.0)THEN
  1273.          SEGDES MCHELM
  1274.       ELSE
  1275.          SEGSUP MCHELM
  1276.       ENDIF
  1277. *
  1278.       RETURN
  1279.       END
  1280.  
  1281.  
  1282.  
  1283.  
  1284.  
  1285.  
  1286.  
  1287.  
  1288.  
  1289.  

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