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

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