Télécharger la plaquette Cast3M


fr en

Télécharger ecoul1.eso

Retour à la liste

Numérotation des lignes : 

ecoul1

  1. C ECOUL1    SOURCE    OF166741  25/02/21    21:16:07     12166          
  2.       SUBROUTINE ECOUL1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHE6,
  3.      &   IPCAR,IPCH1,IPCH2,IPCH3,IPCH4,IPCH5,ITHHER,IFI,PRECIS,
  4.      &   IPOTAB,JECHER,ISTEP,JNOID,LOGSUC,IPCHE7,IPCHE8,IPCHE9)
  5. **********************************************************************
  6. *
  7. *                    ecoulement inelastique
  8. *
  9. **********************************************************************
  10. *
  11. *  entrees:
  12. *
  13. *  ipmodl = pointeur sur un objet mmodel
  14. *  ipche1 = pointeur sur un mchaml de contraintes initiales
  15. *  ipche2 = pointeur sur un mchaml de variables internes initiales
  16. *  ipche3 = pointeur sur un mchaml de deformations inelastiques initiale
  17. *  ipche4 = pointeur sur un mchaml d'increment elastique de deformations
  18. *  ipche5 = pointeur sur un mchaml de deformations
  19. *  ipcar  =  pointeur sur un mchaml de caracteristiques
  20. *  ipch1  = pointeur sur un mchaml de temperatures au debut du pas
  21. *  ipch2  = pointeur sur un mchaml de temperatures a la fin du pas
  22. *  ipch3  = pointeur sur un mchaml de temperatures de reference
  23. c mistral :
  24. *  ipch4  = pointeur sur un mchaml de flux neutronique au debut du pas pou
  25. *  ipch5  = pointeur sur un mchaml de flux neutronique a la fin du pas pou
  26. *    ifi  = 0 pas de flux neutronique; = 1 existence de flux neutronique (
  27. c mistral.
  28. *  ithher = 0 si pas de chargement thermique
  29. *         = 1 si chargement thermique mais materiau constant
  30. *         = 2 si chargement thermique et mat. dependant de la temperature
  31. *  ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux
  32. *        endommageables de lemaitre quand ils dependent de la temperature
  33. *  precis =  precision des iterations internes
  34. *  ipotab =  pointeur sur une table
  35. *  jecher =  flag valant 0 ou 1(pour action dans ecoule)
  36. *  istep  =indicateur d'action pour calcul nonlocal
  37. *         =0 dans le cas d'un calcul local (normal)
  38. *         =1 ou 2 dans le cas d'un calcul nonlocal
  39. *         =1 pour calcul des fonctions seuil uniquement
  40. *         =2 pour calcul des variables dissipatives a partir
  41. *           des fonctions seuil moyennees prealablement par nloc
  42. *  jnoid  =  flag valant 0 ou 1(pour action dans ecoul1)
  43. *
  44. * sorties:
  45. *
  46. *  logsuc = logique pour indication de pb de convergence
  47. *  ipche7 = pointeur sur un mchaml de contraintes
  48. *  ipche8 = pointeur sur un mchaml de variables internes
  49. *  ipche9 = pointeur sur un mchaml de deformations
  50. *
  51. ************************************************************************
  52.       IMPLICIT INTEGER(I-N)
  53.       IMPLICIT REAL*8(A-H,O-Z)
  54.  
  55. -INC PPARAM
  56. -INC CCOPTIO
  57. -INC CCGEOME
  58. -INC CCHAMP
  59.  
  60. -INC SMCHAML
  61. c mistral :
  62.           POINTEUR MCHEL7.MCHELM,MCHEL8.MCHELM
  63. c mistral.
  64. -INC SMELEME
  65. -INC SMCOORD
  66. -INC SMMODEL
  67.       Pointeur nomid1.nomid
  68. -INC SMINTE
  69.  
  70. -INC TMPTVAL
  71.  
  72.       SEGMENT NOTYPE
  73.         CHARACTER*16 TYPE(NBTYPE)
  74.       ENDSEGMENT
  75.  
  76.       CHARACTER*8 CMATE
  77.       CHARACTER*(NCONCH) CONM
  78.       LOGICAL LOGSUC,lsupva,lsupco,lsupde,lsupma,lsupdd
  79.       PARAMETER ( NINF=3 )
  80.       INTEGER INFOS(NINF)
  81.  
  82.          lsupva=.false.
  83.          lsupde=.false.
  84.          lsupdd=.false.
  85. c
  86.       NHRM=NIFOUR
  87. c
  88. c     verification du lieu support du mchaml de contraintes
  89. c
  90.       CALL  QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  91.       IF (ISUP1.GT.1) RETURN
  92. *
  93. *     verification du lieu support du mchaml de variables internes
  94. *
  95.       CALL  QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  96.       IF (ISUP2.GT.1) RETURN
  97. c
  98. c     verification du lieu support du mchaml de defor. inelastique init.
  99. c
  100.       IF(IPCHE3.NE.0)THEN
  101.          CALL  QUESUP(IPMODL,IPCHE3,5,0,ISUP3,IRET3)
  102.          IF (ISUP3.GT.1) RETURN
  103.       ELSE
  104.          ISUP3=0
  105.       ENDIF
  106. c
  107. c     verification du lieu support du mchaml de defor. totales
  108. c
  109.       IF(IPCHE6.NE.0)THEN
  110.          CALL  QUESUP(IPMODL,IPCHE6,5,0,ISUP6,IRET6)
  111.          IF (ISUP6.GT.1) RETURN
  112.       ELSE
  113.          ISUP6=0
  114.       ENDIF
  115. c
  116. c     verification du lieu support du mchaml des incr. deformat totales
  117. c
  118.       CALL  QUESUP(IPMODL,IPCHE4,5,0,ISUP4,IRET4)
  119.       IF (ISUP4.GT.1) RETURN
  120. c
  121. c     verification du lieu support du mchaml de caracteristiques
  122. c
  123.       CALL  QUESUP(IPMODL,IPCAR,3,0,ISUP5,IRET5)
  124.       IF (ISUP5.GT.1) RETURN
  125. c
  126. c     activation du modele
  127. c
  128.       MMODEL=IPMODL
  129.       SEGACT MMODEL
  130.       NSOUS=KMODEL(/1)
  131. c
  132. c     creation des 3 mchelms
  133. c
  134.       N1=NSOUS
  135.       L1=11
  136.       N3=6
  137.       SEGINI MCHELM
  138.       TITCHE='CONTRAINTES'
  139.       IFOCHE=IFOUR
  140.       IPCHE7=MCHELM
  141.       L1=18
  142.       SEGINI MCHEL1
  143.       MCHEL1.TITCHE='VARIABLES INTERNES'
  144.       MCHEL1.IFOCHE=IFOUR
  145.       IPCHE8=MCHEL1
  146.       L1=12
  147.       SEGINI MCHEL2
  148.       MCHEL2.TITCHE='DEFORMATIONS INELASTIQUES'
  149.       MCHEL2.IFOCHE=IFOUR
  150.       IPCHE9=MCHEL2
  151. c
  152. c    traitement des champs de temperature pour les materiaux
  153. c                endommageables de lemaitre
  154. c
  155.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  156.             MCHEL3=IPCH1
  157.             MCHEL4=IPCH2
  158.             MCHEL5=IPCH3
  159.             SEGACT MCHEL3
  160.             SEGACT MCHEL4
  161.             SEGACT MCHEL5
  162.          ENDIF
  163. ***********************
  164. *  SPECIAL SUCCION
  165. *
  166.          IF (ITHHER.EQ.3) THEN
  167.             MCHEL3=IPCH1
  168.             MCHEL4=IPCH2
  169.             SEGACT MCHEL3
  170.             SEGACT MCHEL4
  171.          ENDIF
  172. ***********************
  173. c mistral :
  174.          IF (IFI.EQ.1) THEN
  175.             MCHEL7=IPCH4
  176.             MCHEL8=IPCH5
  177.             SEGACT MCHEL7
  178.             SEGACT MCHEL8
  179.          ENDIF
  180. c mistral.
  181. *
  182. *     deformations totales
  183. *
  184.             IF(IPCHE6.NE.0) THEN
  185.               MCHEL6=IPCHE6
  186.               SEGACT MCHEL6
  187.             ENDIF
  188. c____________________________________________________________________
  189. c
  190. c     debut de la boucle sur les differentes zones
  191. c____________________________________________________________________
  192. c
  193.       DO 1000 ISOUS=1,NSOUS
  194. *
  195. *   initialisation
  196. *
  197.          NSTR=0
  198.          MOSTRS=0
  199.          IVASTR=0
  200.          MOVARI=0
  201.          NVARI=0
  202.          NVARF=0
  203.          IVARI=0
  204.          MOEPSI=0
  205.          MODEIN=0
  206.          NDEF=0
  207.          NDEIN=0
  208.          IVADEF=0
  209.          IVADET=0
  210.          IVADS=0
  211.          NCARA=0
  212.          NCARF=0
  213.          MOCARA=0
  214.          IVACAR=0
  215.          NMATF=0
  216.          NMATR=0
  217.          MOMATR=0
  218.          IVAMAT=0
  219.          IVASTF=0
  220.          IVARIF=0
  221.          IVADEP=0
  222.          KERRE=0
  223.          KERR1=0
  224.          MCHAML=0
  225.          MCHAM1=0
  226.          MCHAM2=0
  227.          lsupma=.true.
  228. c
  229. c     on recupere l information generale
  230. c
  231.          IMODEL=KMODEL(ISOUS)
  232.          SEGACT IMODEL
  233.          IPMAIL=IMAMOD
  234.          CONM  =CONMOD
  235.          IMACHE(ISOUS)=IPMAIL
  236.          CONCHE(ISOUS)=CONMOD
  237.          MCHEL1.IMACHE(ISOUS)=IPMAIL
  238.          MCHEL1.CONCHE(ISOUS)=CONMOD
  239.          MCHEL2.IMACHE(ISOUS)=IPMAIL
  240.          MCHEL2.CONCHE(ISOUS)=CONMOD
  241. *
  242.          MELE=NEFMOD
  243.          MELEME=IMAMOD
  244.          SEGACT MELEME
  245.          NBNN=NUM(/1)
  246.          NBELEM=NUM(/2)
  247. c
  248. c   coque integree ou pas ?
  249.          NPINT=INFMOD(1)
  250. c
  251. c     traitement du modele
  252. c
  253.          NFOR=FORMOD(/2)
  254.          NMAT=MATMOD(/2)
  255. c
  256. c     nature du materiau
  257. c
  258.          CMATE  = CMATEE
  259.          MATE   = IMATEE
  260.          INPLAS = INATUU
  261. c____________________________________________________________________
  262. c
  263. c     information sur l'element fini
  264. c____________________________________________________________________
  265. c
  266.          MFR  =INFELE(13)
  267.          NBG  =INFELE(6)
  268.          NBGS =INFELE(4)
  269.          NSTRS=INFELE(16)
  270.          LRE  =INFELE(9)
  271.          IPPORE=0
  272.          IF(MFR.EQ.33) IPPORE=NBNN
  273.          LW   =200
  274.          LW2  =150
  275.          LHOOK=INFELE(10)
  276. *
  277.          IF (MFR.EQ.3.AND.NPINT.NE.0)  LHOOK=4
  278. *
  279.          LHOO2=LHOOK*LHOOK
  280. *         MINTE=INFELE(11)
  281.          minte=infmod(7)
  282.          IPMINT=MINTE
  283.  
  284.          IPORE=INFELE(8)
  285.          NBNO=NBNNE(NUMGEO(MELE))
  286.          IF (MELE.EQ.96) NBNO = INFELE(8)
  287.          IF (MFR.EQ.33)  NBNO=IPORE
  288. *
  289. *   remplissage des tableaux infche
  290. *
  291.          INFCHE(ISOUS,1)=0
  292.          INFCHE(ISOUS,2)=0
  293.          INFCHE(ISOUS,3)=NHRM
  294.          INFCHE(ISOUS,4)=MINTE
  295.          INFCHE(ISOUS,5)=0
  296.          INFCHE(ISOUS,6)=5
  297. *
  298.          MCHEL1.INFCHE(ISOUS,1)=0
  299.          MCHEL1.INFCHE(ISOUS,2)=0
  300.          MCHEL1.INFCHE(ISOUS,3)=NHRM
  301.          MCHEL1.INFCHE(ISOUS,4)=MINTE
  302.          MCHEL1.INFCHE(ISOUS,5)=0
  303.          MCHEL1.INFCHE(ISOUS,6)=5
  304. *
  305.          MCHEL2.INFCHE(ISOUS,1)=0
  306.          MCHEL2.INFCHE(ISOUS,2)=0
  307.          MCHEL2.INFCHE(ISOUS,3)=NHRM
  308.          MCHEL2.INFCHE(ISOUS,4)=MINTE
  309.          MCHEL2.INFCHE(ISOUS,5)=0
  310.          MCHEL2.INFCHE(ISOUS,6)=5
  311. c
  312. c     creation du tableau infos
  313. c
  314.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  315.          IF (IRTD.EQ.0)THEN
  316.             SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  317.             SEGSUP MCHELM,MCHEL1,MCHEL2
  318.             RETURN
  319.          ENDIF
  320. *
  321. *       traitement du champ de contraintes
  322. *
  323.         if(lnomid(4).ne.0) then
  324.          nomid=lnomid(4)
  325.          segact nomid
  326.          mostrs=nomid
  327.          nstr=lesobl(/2)
  328.          nfac=lesfac(/2)
  329.          lsupco=.false.
  330.         else
  331.          lsupco=.true.
  332.          CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  333.         endif
  334.          IF (MOSTRS.EQ.0) THEN
  335.             MOTERR(1:4)='CONT'
  336.             MOTERR(5:8)=NOMTP(MELE)
  337.             CALL ERREUR (76)
  338.             SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  339.             SEGSUP MCHELM,MCHEL1,MCHEL2
  340.             RETURN
  341.          ENDIF
  342.  
  343.          NBTYPE=1
  344.          SEGINI NOTYPE
  345.          MOTYPE=NOTYPE
  346.          TYPE(1)='REAL*8'
  347.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  348.          IF(IERR.NE.0)THEN
  349.             SEGSUP NOTYPE
  350.             KERRE=999
  351.             GOTO 9990
  352.          ENDIF
  353. *
  354.         IF (ISUP1.EQ.1) THEN
  355.            CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE)
  356.            IF(IERR.NE.0)THEN
  357.              SEGSUP NOTYPE
  358.              KERRE=999
  359.              ISUP1=0
  360.              GOTO 9990
  361.             ENDIF
  362.         ENDIF
  363. *
  364. *       traitement du champ de variables internes
  365. *
  366.          MOTYVA=NOTYPE
  367. *
  368. *        cas particulier poutre a fibres
  369. *
  370.          IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN
  371.            NBTYPE=1
  372.            SEGINI NOTYPE
  373.            MOTYVA=NOTYPE
  374.            TYPE(1)='POINTEURMCHAML  '
  375. *
  376. *       cas particulier modele de maxwell
  377. *
  378.           ELSE IF(INPLAS.EQ.74) THEN
  379.            NBTYPE=10
  380.            SEGINI NOTYPE
  381.            MOTYVA=NOTYPE
  382.            TYPE(1)='REAL*8'
  383.            DO IC=2,10
  384.              TYPE(IC)='POINTEURLISTREEL'
  385.            END DO
  386.         ENDIF
  387.         if(lnomid(10).ne.0) then
  388.          nomid=lnomid(10)
  389.          segact nomid
  390.          movari=nomid
  391.          nvari=lesobl(/2)
  392.          nvarf=lesfac(/2)
  393.          lsupva=.false.
  394.         else
  395.          lsupva=.true.
  396.          CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  397.         endif
  398.          IF (MOVARI.EQ.0) THEN
  399.             MOTERR(1:4)='VARI'
  400.             MOTERR(5:8)=NOMTP(MELE)
  401.             CALL ERREUR (76)
  402.             KERRE=999
  403.             SEGSUP NOTYPE
  404.             GOTO 9990
  405.          ENDIF
  406. *
  407.          CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYVA,1,INFOS,3,IVARI)
  408.          IF(IERR.NE.0)THEN
  409.             NOTYPE=MOTYVA
  410.             SEGSUP NOTYPE
  411.             KERRE=999
  412.             GOTO 9990
  413.          ENDIF
  414. *
  415.         NVART=NVARI+NVARF
  416. *
  417.         IF (ISUP2.EQ.1) THEN
  418.            CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE)
  419.            IF(IERR.NE.0)THEN
  420.              SEGSUP NOTYPE
  421.              KERRE=999
  422.              ISUP2=0
  423.              GOTO 9990
  424.             ENDIF
  425.         ENDIF
  426. *
  427. *       traitement du champ de deformations inelastiques
  428. *
  429.          if(lnomid(5).ne.0)then
  430.           nomid1=lnomid(5)
  431.           segini,nomid=nomid1
  432.           ndef=lesobl(/2)
  433.           nfac=lesfac(/2)
  434.           moepsi=nomid
  435.           lsupde=.false.
  436.          else
  437.           lsupde=.true.
  438.          CALL IDDEFO(IMODEL,IFOUR,MOEPSI,NDEF,NFAC)
  439.          endif
  440.          if(lnomid(13).ne.0) then
  441.           nomid=lnomid(13)
  442.           segact nomid
  443.           modein=nomid
  444.           ndein=lesobl(/2)
  445.           nfac=lesfac(/2)
  446.           lsupdd=.false.
  447.          else
  448.           lsupdd=.true.
  449.           CALL IDDEIN(IMODEL,IFOUR,MODEIN,NDEIN,NFAC)
  450.          endif
  451.          if (NDEF.NE.NDEIN) then
  452. c.. en principe meme nombre de composantes pour deformations et def inelas
  453.            call erreur(5)
  454.            return
  455.          endif
  456.          IF (MODEIN.EQ.0) THEN
  457.             MOTERR(1:4)='DEIN'
  458.             MOTERR(5:8)=NOMTP(MELE)
  459.             CALL ERREUR (76)
  460.             KERRE=999
  461.             SEGSUP NOTYPE
  462.             GOTO 9990
  463.          ENDIF
  464. *
  465.          IF(IPCHE3.NE.0)THEN
  466.             CALL KOMCHA(IPCHE3,IPMAIL,CONM,MODEIN,MOTYPE
  467.      &                                     ,1,INFOS,3,IVADEF)
  468.             IF(IERR.NE.0)THEN
  469.                SEGSUP NOTYPE
  470.                KERRE=999
  471.                GOTO 9990
  472.             ENDIF
  473. *
  474.            IF (ISUP3.EQ.1) THEN
  475.               CALL VALCHE(IVADEF,NDEF,IPMINT,IPPORE,MODEIN,MELE)
  476.               IF(IERR.NE.0)THEN
  477.                 SEGSUP NOTYPE
  478.                 KERRE=999
  479.                 ISUP3=0
  480.                 GOTO 9990
  481.               ENDIF
  482.            ENDIF
  483.          ENDIF
  484. *
  485. *       traitement du champ de deformations totales
  486. *
  487.          IF(IPCHE6.NE.0)THEN
  488.             CALL KOMCHA(IPCHE6,IPMAIL,CONM,MOEPSI,MOTYPE
  489.      &                                     ,1,INFOS,3,IVADET)
  490.             IF(IERR.NE.0)THEN
  491.                SEGSUP NOTYPE
  492.                KERRE=999
  493.                GOTO 9990
  494.             ENDIF
  495. *
  496.            IF (ISUP6.EQ.1) THEN
  497.               CALL VALCHE(IVADET,NDEF,IPMINT,IPPORE,MOEPSI,MELE)
  498.               IF(IERR.NE.0)THEN
  499.                 SEGSUP NOTYPE
  500.                 KERRE=999
  501.                 ISUP6=0
  502.                 GOTO 9990
  503.               ENDIF
  504.            ENDIF
  505.          ENDIF
  506. *
  507. *      traitement du champ d'increments de deformations
  508. *
  509.          CALL KOMCHA(IPCHE4,IPMAIL,CONM,MOEPSI,
  510.      1                    MOTYPE,1,INFOS,3,IVADS)
  511. *********SEGSUP NOTYPE
  512.          IF(IERR.NE.0)THEN
  513.           SEGSUP NOTYPE
  514.           KERRE=999
  515.           GOTO 9990
  516.          ENDIF
  517. *
  518.          IF (ISUP4.EQ.1) THEN
  519.            CALL VALCHE(IVADS,NDEF,IPMINT,IPPORE,MOEPSI,MELE)
  520.            IF(IERR.NE.0)THEN
  521.                SEGSUP NOTYPE
  522.                KERRE=999
  523.                ISUP4=0
  524.                GOTO 9990
  525.            ENDIF
  526.          ENDIF
  527. *
  528. *   traitement du champ de caracteristiques materielles
  529. *
  530.          if(lnomid(6).ne.0) then
  531.            nomid=lnomid(6)
  532.            segact nomid
  533.            momatr=nomid
  534.            nmatr=lesobl(/2)
  535.            nmatf=lesfac(/2)
  536.            lsupma=.false.
  537.          else
  538.            lsupma=.true.
  539.            CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  540.          endif
  541.          IF (MOMATR.EQ.0) THEN
  542.             MOTERR(1:4)='MATE'
  543.             MOTERR(5:8)=NOMTP(MELE)
  544.             CALL ERREUR (76)
  545.             KERRE=999
  546.             GOTO 9990
  547.          ENDIF
  548.  
  549. *
  550.          IF(MATE.EQ.1.AND.(INPLAS.EQ.5.OR.INPLAS.EQ.87))THEN
  551.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  552.      +       EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  553.                    NBTYPE=6
  554.             ELSE
  555.                    NBTYPE=5
  556.             ENDIF
  557.             SEGINI NOTYPE
  558.             MOTYPE=NOTYPE
  559.             TYPE(1)='REAL*8'
  560.             TYPE(2)='REAL*8'
  561.             TYPE(3)='POINTEUREVOLUTIO'
  562.             TYPE(4)='REAL*8'
  563.             TYPE(5)='REAL*8'
  564.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  565.      +          AND.IFOUR.EQ.-2) TYPE(6)='REAL*8'
  566. C
  567.          ELSE IF(MATE.EQ.4.AND.INPLAS.EQ.5)THEN
  568.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  569.      +       EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  570.                    NBTYPE=7
  571.             ELSE
  572.                    NBTYPE=6
  573.             ENDIF
  574.             SEGINI NOTYPE
  575.             MOTYPE=NOTYPE
  576.             TYPE(1)='REAL*8'
  577.             TYPE(2)='REAL*8'
  578.             TYPE(3)='REAL*8'
  579.             TYPE(4)='POINTEUREVOLUTIO'
  580.             TYPE(5)='REAL*8'
  581.             TYPE(6)='REAL*8'
  582.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  583.      +          AND.IFOUR.EQ.-2) TYPE(7)='REAL*8'
  584. C
  585.          ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.51)THEN
  586.            IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  587.      +       EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  588.                    NBTYPE=8
  589.             ELSE
  590.                    NBTYPE=7
  591.             ENDIF
  592.             SEGINI NOTYPE
  593.             MOTYPE=NOTYPE
  594.             TYPE(1)='REAL*8'
  595.             TYPE(2)='REAL*8'
  596.             TYPE(3)='POINTEUREVOLUTIO'
  597.             TYPE(4)='POINTEUREVOLUTIO'
  598.             TYPE(5)='POINTEUREVOLUTIO'
  599.             TYPE(6)='REAL*8'
  600.             TYPE(7)='REAL*8'
  601.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  602.      +          AND.IFOUR.EQ.-2) TYPE(8)='REAL*8'
  603. C
  604.          ELSE IF(MATE.EQ.4.AND.INPLAS.EQ.51)THEN
  605.            IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  606.      +       EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  607.                    NBTYPE=9
  608.             ELSE
  609.                    NBTYPE=8
  610.             ENDIF
  611.             SEGINI NOTYPE
  612.             MOTYPE=NOTYPE
  613.             TYPE(1)='REAL*8'
  614.             TYPE(2)='REAL*8'
  615.             TYPE(3)='REAL*8'
  616.             TYPE(4)='POINTEUREVOLUTIO'
  617.             TYPE(5)='POINTEUREVOLUTIO'
  618.             TYPE(6)='POINTEUREVOLUTIO'
  619.             TYPE(7)='REAL*8'
  620.             TYPE(8)='REAL*8'
  621.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  622.      +          AND.IFOUR.EQ.-2) TYPE(9)='REAL*8'
  623. C
  624.          ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.62)THEN
  625.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  626.      +       EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  627.                    NBTYPE=6
  628.             ELSE
  629.                    NBTYPE=5
  630.             ENDIF
  631.             SEGINI NOTYPE
  632.             MOTYPE=NOTYPE
  633.             TYPE(1)='REAL*8'
  634.             TYPE(2)='REAL*8'
  635.             TYPE(3)='POINTEUREVOLUTIO'
  636.             TYPE(4)='REAL*8'
  637.             TYPE(5)='REAL*8'
  638.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  639.      +          AND.IFOUR.EQ.-2) TYPE(6)='REAL*8'
  640. C
  641.          ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.64)THEN
  642.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  643.      +       EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  644.                    NBTYPE=15
  645.             ELSE
  646.                    NBTYPE=14
  647.             ENDIF
  648.             SEGINI NOTYPE
  649.             MOTYPE=NOTYPE
  650.             TYPE(1)='REAL*8'
  651.             TYPE(2)='REAL*8'
  652.             TYPE(3)='POINTEUREVOLUTIO'
  653.             TYPE(4)='REAL*8'
  654.             TYPE(5)='REAL*8'
  655.             TYPE(6)='REAL*8'
  656.             TYPE(7)='REAL*8'
  657.             TYPE(8)='REAL*8'
  658.             TYPE(9)='REAL*8'
  659.             TYPE(10)='REAL*8'
  660.             TYPE(11)='REAL*8'
  661.             TYPE(12)='REAL*8'
  662.             TYPE(13)='REAL*8'
  663.             TYPE(14)='REAL*8'
  664.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  665.      +          AND.IFOUR.EQ.-2) TYPE(15)='REAL*8'
  666. C
  667.          ELSE IF (MATE.EQ.1.AND.INPLAS.EQ.14) THEN
  668.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  669.      +       EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  670.                    NBTYPE=10
  671.             ELSE
  672.                    NBTYPE=9
  673.             ENDIF
  674.             NBTYPE=9
  675.             SEGINI NOTYPE
  676.             MOTYPE=NOTYPE
  677.             TYPE(1)='REAL*8'
  678.             TYPE(2)='REAL*8'
  679.             TYPE(3)='REAL*8'
  680.             TYPE(4)='REAL*8'
  681.             TYPE(5)='REAL*8'
  682.             TYPE(6)='POINTEUREVOLUTIO'
  683.             TYPE(7)='POINTEUREVOLUTIO'
  684.             TYPE(8)='REAL*8'
  685.             TYPE(9)='REAL*8'
  686.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  687.      +          AND.IFOUR.EQ.-2) TYPE(10)='REAL*8'
  688. C
  689.          ELSE IF (MATE.EQ.1.AND.INPLAS.EQ.26) THEN
  690.             IF (ITHHER.EQ.2) THEN
  691.              NBTYPE=0
  692.              SEGINI NOTYPE
  693.              MOTYPE=NOTYPE
  694.             ELSE
  695.              IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  696.      +        EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  697.                    NBTYPE=9
  698.              ELSE
  699.                    NBTYPE=8
  700.              ENDIF
  701.              SEGINI NOTYPE
  702.              MOTYPE=NOTYPE
  703.              TYPE(1)='REAL*8'
  704.              TYPE(2)='REAL*8'
  705.              TYPE(3)='POINTEUREVOLUTIO'
  706.              TYPE(4)='REAL*8'
  707.              TYPE(5)='REAL*8'
  708.              TYPE(6)='REAL*8'
  709.              TYPE(7)='REAL*8'
  710.              TYPE(8)='REAL*8'
  711.              IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  712.      +          AND.IFOUR.EQ.-2) TYPE(9)='REAL*8'
  713.             ENDIF
  714. C
  715.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.29)THEN
  716.             IF (ITHHER.EQ.2) THEN
  717.              NBTYPE=0
  718.              SEGINI NOTYPE
  719.              MOTYPE=NOTYPE
  720.             ELSE
  721.              IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  722.      +           EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  723.                    NBTYPE=14
  724.              ELSE
  725.                    NBTYPE=13
  726.              ENDIF
  727.              SEGINI NOTYPE
  728.              MOTYPE=NOTYPE
  729.              TYPE(1)='REAL*8'
  730.              TYPE(2)='REAL*8'
  731.              TYPE(3)='REAL*8'
  732.              TYPE(4)='REAL*8'
  733.              TYPE(5)='REAL*8'
  734.              TYPE(6)='REAL*8'
  735.              TYPE(7)='REAL*8'
  736.              TYPE(8)='REAL*8'
  737.              TYPE(9)='REAL*8'
  738.              TYPE(10)='POINTEUREVOLUTIO'
  739.              TYPE(11)='REAL*8'
  740.              TYPE(12)='REAL*8'
  741.              TYPE(13)='REAL*8'
  742.              IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  743.      +          AND.IFOUR.EQ.-2)   TYPE(14)='REAL*8'
  744.             ENDIF
  745. C
  746.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.16)THEN
  747.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  748.      +          EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  749.                    NBTYPE=8
  750.             ELSE
  751.                    NBTYPE=7
  752.             ENDIF
  753.             SEGINI NOTYPE
  754.             MOTYPE=NOTYPE
  755.             TYPE(1)='REAL*8'
  756.             TYPE(2)='REAL*8'
  757.             TYPE(3)='POINTEUREVOLUTIO'
  758.             TYPE(4)='REAL*8'
  759.             TYPE(5)='REAL*8'
  760.             TYPE(6)='REAL*8'
  761.             TYPE(7)='REAL*8'
  762. C
  763.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.2)THEN
  764.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  765.      +          EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  766.                    NBTYPE=7
  767.             ELSE
  768.                    NBTYPE=6
  769.             ENDIF
  770.             SEGINI NOTYPE
  771.             MOTYPE=NOTYPE
  772.             TYPE(1)='REAL*8'
  773.             TYPE(2)='REAL*8'
  774.             TYPE(3)='REAL*8'
  775.             TYPE(4)='POINTEUREVOLUTIO'
  776.             TYPE(5)='REAL*8'
  777.             TYPE(6)='REAL*8'
  778.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  779.      +          AND.IFOUR.EQ.-2) TYPE(7)='REAL*8'
  780. C
  781.          ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.32)THEN
  782.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  783.      +          EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  784.                    NBTYPE=10
  785.             ELSE
  786.                    NBTYPE=19
  787.             ENDIF
  788.             SEGINI NOTYPE
  789.             MOTYPE=NOTYPE
  790.             TYPE(1)='REAL*8'
  791.             TYPE(2)='REAL*8'
  792.             TYPE(3)='REAL*8'
  793.             TYPE(4)='REAL*8'
  794.             TYPE(5)='POINTEUREVOLUTIO'
  795.             TYPE(6)='POINTEUREVOLUTIO'
  796.             TYPE(7)='POINTEUREVOLUTIO'
  797.             TYPE(8)='POINTEUREVOLUTIO'
  798.             TYPE(9)='POINTEUREVOLUTIO'
  799.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  800.      +          AND.IFOUR.EQ.-2) TYPE(10)='REAL*8'
  801. C
  802.          ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.44)THEN
  803.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  804.      +          EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  805.                    NBTYPE=21
  806.             ELSE
  807.                    NBTYPE=20
  808.             ENDIF
  809.             SEGINI NOTYPE
  810.             MOTYPE=NOTYPE
  811.             TYPE(1)='REAL*8'
  812.             TYPE(2)='REAL*8'
  813.             TYPE(3)='REAL*8'
  814.             TYPE(4)='REAL*8'
  815.             TYPE(5)='REAL*8'
  816.             TYPE(6)='REAL*8'
  817.             TYPE(7)='REAL*8'
  818.             TYPE(8)='REAL*8'
  819.             TYPE(9)='REAL*8'
  820.             TYPE(10)='REAL*8'
  821.             TYPE(11)='REAL*8'
  822.             TYPE(12)='REAL*8'
  823.             TYPE(13)='REAL*8'
  824.             TYPE(14)='REAL*8'
  825.             TYPE(15)='REAL*8'
  826.             TYPE(16)='REAL*8'
  827.             TYPE(17)='REAL*8'
  828.             TYPE(18)='REAL*8'
  829.             TYPE(19)='REAL*8'
  830.             TYPE(20)='REAL*8'
  831.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  832.      +          AND.IFOUR.EQ.-2) TYPE(21)='REAL*8'
  833. C
  834.          ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.45)THEN
  835.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  836.      +          EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  837.                    NBTYPE=28
  838.             ELSE
  839.                    NBTYPE=27
  840.             ENDIF
  841.             SEGINI NOTYPE
  842.             MOTYPE=NOTYPE
  843.             TYPE(1)='REAL*8'
  844.             TYPE(2)='REAL*8'
  845.             TYPE(3)='REAL*8'
  846.             TYPE(4)='REAL*8'
  847.             TYPE(5)='REAL*8'
  848.             TYPE(6)='REAL*8'
  849.             TYPE(7)='REAL*8'
  850.             TYPE(8)='REAL*8'
  851.             TYPE(9)='REAL*8'
  852.             TYPE(10)='REAL*8'
  853.             TYPE(11)='REAL*8'
  854.             TYPE(12)='REAL*8'
  855.             TYPE(13)='REAL*8'
  856.             TYPE(14)='REAL*8'
  857.             TYPE(15)='REAL*8'
  858.             TYPE(16)='REAL*8'
  859.             TYPE(17)='REAL*8'
  860.             TYPE(18)='REAL*8'
  861.             TYPE(19)='REAL*8'
  862.             TYPE(20)='REAL*8'
  863.             TYPE(21)='REAL*8'
  864.             TYPE(22)='REAL*8'
  865.             TYPE(23)='REAL*8'
  866.             TYPE(24)='REAL*8'
  867.             TYPE(25)='REAL*8'
  868.             TYPE(26)='REAL*8'
  869.             TYPE(27)='REAL*8'
  870.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  871.      +          AND.IFOUR.EQ.-2) TYPE(28)='REAL*8'
  872. C
  873.          ELSE IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION')THEN
  874.             NBTYPE=3
  875.             SEGINI NOTYPE
  876.             MOTYPE=NOTYPE
  877.             TYPE(1)='POINTEURMMODEL  '
  878.             TYPE(2)='POINTEURMCHAML  '
  879.             TYPE(3)='POINTEURLISTREEL'
  880. C
  881.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.54)THEN
  882.             NBTYPE=15
  883.             SEGINI NOTYPE
  884.             MOTYPE=NOTYPE
  885.             DO I=1,NBTYPE
  886.               TYPE(I)='REAL*8'
  887.             ENDDO
  888.             TYPE(10)='POINTEUREVOLUTIO'
  889.             TYPE(11)='POINTEUREVOLUTIO'
  890. C
  891. C JOINT_SOFT
  892. C
  893.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.56)THEN
  894.             NBTYPE=10
  895.             SEGINI NOTYPE
  896.             MOTYPE=NOTYPE
  897.             DO I=1,NBTYPE
  898.               TYPE(I)='REAL*8'
  899.             ENDDO
  900.             TYPE(6)='POINTEUREVOLUTIO'
  901.             TYPE(7)='POINTEUREVOLUTIO'
  902.             TYPE(8)='POINTEUREVOLUTIO'
  903. C
  904. C Note: Il s'agit des parametres obligatoires. 1 et 2 sont par defaut
  905. C       YOUN et NU, 3, 4 et 5 (d'apres idplas.eso modele plastique 35)
  906. C       PNOR, CPLG, BETA, puis viennent les 3 courbes 6, 7 et 8, c.a.d
  907. C
  908. C
  909.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.119)THEN
  910. C
  911. C JOINT_COAT
  912. C
  913.             NBTYPE=2+3
  914.             SEGINI NOTYPE
  915.             MOTYPE=NOTYPE
  916.             DO I=1,NBTYPE
  917.               TYPE(I)='REAL*8'
  918.             ENDDO
  919.             TYPE(2)='POINTEUREVOLUTIO'
  920. C
  921. C Note: Il s'agit des parametres obligatoires. 1 est par defaut
  922. C       KS, 2 (d'apres idplas.eso modele plastique 49) la courbe SJSB
  923. C           SJCB, SJSB et SJTB.
  924. C
  925. C+PPm
  926.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.126)THEN
  927. C
  928. C MUR_SHEAR
  929. C
  930. C 2004      NBTYPE=13+4
  931.             NBTYPE=14+4
  932.             SEGINI NOTYPE
  933.             MOTYPE=NOTYPE
  934.             DO I=1,NBTYPE
  935.               TYPE(I)='REAL*8'
  936.             ENDDO
  937.             DO I=3,8
  938.               TYPE(I)='POINTEUREVOLUTIO'
  939.             ENDDO
  940.  
  941. C Note: Il s'agit des parametres obligatoires. 1 et 2 sont par defaut
  942. C       YOUN et NU, 3 a 8 (d'apres idplas.eso modele plastique 63) les
  943. C       courbes CUFP, CUKP, CULP, CUFM, CUKM, CULM
  944. C+PPm
  945. C
  946. C
  947. C ANCRAGE_ELIGEHAUSEN
  948.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.91)THEN
  949.             NBTYPE=11
  950.             SEGINI NOTYPE
  951.             MOTYPE=NOTYPE
  952.             DO I=1,NBTYPE
  953.               TYPE(I)='REAL*8'
  954.             ENDDO
  955. C
  956. C PARFAIT_ANCRAGE
  957. C
  958.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.92)THEN
  959.             NBTYPE=14
  960.             SEGINI NOTYPE
  961.             MOTYPE=NOTYPE
  962.             DO I=1,NBTYPE
  963.               TYPE(I)='REAL*8'
  964.             ENDDO
  965. C
  966. C ACIER_ANCRAGE
  967. C
  968.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.93)THEN
  969.             NBTYPE=24
  970.             SEGINI NOTYPE
  971.             MOTYPE=NOTYPE
  972.             DO I=1,NBTYPE
  973.               TYPE(I)='REAL*8'
  974.             ENDDO
  975. C
  976. C TAKEDA
  977. C
  978.          ELSEIF(MATE.EQ.1.AND.(INPLAS.EQ.59.OR.INPLAS.EQ.60))THEN
  979.             NBTYPE=11
  980.             SEGINI NOTYPE
  981.             MOTYPE=NOTYPE
  982.             DO I=1,NBTYPE
  983.               TYPE(I)='REAL*8'
  984.             ENDDO
  985.             TYPE(3)='POINTEUREVOLUTIO'
  986. C
  987. C INFILL_UNI
  988. C
  989.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.72)THEN
  990.             NBTYPE=12
  991.             SEGINI NOTYPE
  992.             MOTYPE=NOTYPE
  993.             DO I=1,NBTYPE
  994.               TYPE(I)='REAL*8'
  995.             ENDDO
  996.             TYPE(10)='POINTEUREVOLUTIO'
  997. C
  998. C CISAIL_NL
  999. C
  1000.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.73)THEN
  1001.             NBTYPE=13
  1002.             SEGINI NOTYPE
  1003.             MOTYPE=NOTYPE
  1004.             DO I=1,NBTYPE
  1005.               TYPE(I)='REAL*8'
  1006.             ENDDO
  1007.             TYPE(10)='POINTEUREVOLUTIO'
  1008.             TYPE(11)='POINTEUREVOLUTIO'
  1009. C
  1010.          ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.74)THEN
  1011.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1012.      +        EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  1013.                    NBTYPE=22
  1014.                    SEGINI NOTYPE
  1015.                    MOTYPE=NOTYPE
  1016.                    TYPE(1)='REAL*8'
  1017.                    TYPE(2)='REAL*8'
  1018.                    TYPE(3)='POINTEUREVOLUTIO'
  1019.                    TYPE(4)='POINTEUREVOLUTIO'
  1020.                    TYPE(5)='REAL*8'
  1021.                    TYPE(6)='POINTEUREVOLUTIO'
  1022.                    TYPE(7)='REAL*8'
  1023.                    TYPE(8)='POINTEUREVOLUTIO'
  1024.                    TYPE(9)='REAL*8'
  1025.                    TYPE(10)='POINTEUREVOLUTIO'
  1026.                    TYPE(11)='REAL*8'
  1027.                    TYPE(12)='REAL*8'
  1028.                    TYPE(13)='REAL*8'
  1029.                    TYPE(14)='REAL*8'
  1030.                    TYPE(15)='POINTEUREVOLUTIO'
  1031.                    TYPE(16)='REAL*8'
  1032.                    TYPE(17)='POINTEUREVOLUTIO'
  1033.                    TYPE(18)='REAL*8'
  1034.                    TYPE(19)='POINTEUREVOLUTIO'
  1035.                    TYPE(20)='REAL*8'
  1036.                    TYPE(21)='POINTEUREVOLUTIO'
  1037.                    TYPE(22)='REAL*8'
  1038.             ELSE
  1039.                    NBTYPE=21
  1040.                    SEGINI NOTYPE
  1041.                    MOTYPE=NOTYPE
  1042.                    TYPE(1)='REAL*8'
  1043.                    TYPE(2)='REAL*8'
  1044.                    TYPE(3)='POINTEUREVOLUTIO'
  1045.                    TYPE(4)='POINTEUREVOLUTIO'
  1046.                    TYPE(5)='REAL*8'
  1047.                    TYPE(6)='POINTEUREVOLUTIO'
  1048.                    TYPE(7)='REAL*8'
  1049.                    TYPE(8)='POINTEUREVOLUTIO'
  1050.                    TYPE(9)='REAL*8'
  1051.                    TYPE(10)='POINTEUREVOLUTIO'
  1052.                    TYPE(11)='REAL*8'
  1053.                    TYPE(12)='REAL*8'
  1054.                    TYPE(13)='REAL*8'
  1055.                    TYPE(14)='POINTEUREVOLUTIO'
  1056.                    TYPE(15)='REAL*8'
  1057.                    TYPE(16)='POINTEUREVOLUTIO'
  1058.                    TYPE(17)='REAL*8'
  1059.                    TYPE(18)='POINTEUREVOLUTIO'
  1060.                    TYPE(19)='REAL*8'
  1061.                    TYPE(20)='POINTEUREVOLUTIO'
  1062.                    TYPE(21)='REAL*8'
  1063.              ENDIF
  1064. C
  1065.          ELSEIF(MATE.EQ.4.AND.INPLAS.EQ.74)THEN
  1066.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1067.      +        EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  1068.                    NBTYPE=23
  1069.                    SEGINI NOTYPE
  1070.                    MOTYPE=NOTYPE
  1071.                    TYPE(1)='REAL*8'
  1072.                    TYPE(2)='REAL*8'
  1073.                    TYPE(3)='REAL*8'
  1074.                    TYPE(4)='POINTEUREVOLUTIO'
  1075.                    TYPE(5)='POINTEUREVOLUTIO'
  1076.                    TYPE(6)='REAL*8'
  1077.                    TYPE(7)='POINTEUREVOLUTIO'
  1078.                    TYPE(8)='REAL*8'
  1079.                    TYPE(9)='POINTEUREVOLUTIO'
  1080.                    TYPE(10)='REAL*8'
  1081.                    TYPE(11)='POINTEUREVOLUTIO'
  1082.                    TYPE(12)='REAL*8'
  1083.                    TYPE(13)='REAL*8'
  1084.                    TYPE(14)='REAL*8'
  1085.                    TYPE(15)='REAL*8'
  1086.                    TYPE(16)='POINTEUREVOLUTIO'
  1087.                    TYPE(17)='REAL*8'
  1088.                    TYPE(18)='POINTEUREVOLUTIO'
  1089.                    TYPE(19)='REAL*8'
  1090.                    TYPE(20)='POINTEUREVOLUTIO'
  1091.                    TYPE(21)='REAL*8'
  1092.                    TYPE(22)='POINTEUREVOLUTIO'
  1093.                    TYPE(23)='REAL*8'
  1094.             ELSE IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1095.      +        EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.2) THEN
  1096.                    NBTYPE=26
  1097.                    SEGINI NOTYPE
  1098.                    MOTYPE=NOTYPE
  1099.                    TYPE(1)='REAL*8'
  1100.                    TYPE(2)='REAL*8'
  1101.                    TYPE(3)='REAL*8'
  1102.                    TYPE(4)='REAL*8'
  1103.                    TYPE(5)='REAL*8'
  1104.                    TYPE(6)='REAL*8'
  1105.                    TYPE(7)='REAL*8'
  1106.                    TYPE(8)='POINTEUREVOLUTIO'
  1107.                    TYPE(9)='POINTEUREVOLUTIO'
  1108.                    TYPE(10)='REAL*8'
  1109.                    TYPE(11)='POINTEUREVOLUTIO'
  1110.                    TYPE(12)='REAL*8'
  1111.                    TYPE(13)='POINTEUREVOLUTIO'
  1112.                    TYPE(14)='REAL*8'
  1113.                    TYPE(15)='POINTEUREVOLUTIO'
  1114.                    TYPE(16)='REAL*8'
  1115.                    TYPE(17)='REAL*8'
  1116.                    TYPE(18)='REAL*8'
  1117.                    TYPE(19)='POINTEUREVOLUTIO'
  1118.                    TYPE(20)='REAL*8'
  1119.                    TYPE(21)='POINTEUREVOLUTIO'
  1120.                    TYPE(22)='REAL*8'
  1121.                    TYPE(23)='POINTEUREVOLUTIO'
  1122.                    TYPE(24)='REAL*8'
  1123.                    TYPE(25)='POINTEUREVOLUTIO'
  1124.                    TYPE(26)='REAL*8'
  1125.             ELSE
  1126.                    NBTYPE=22
  1127.                    SEGINI NOTYPE
  1128.                    MOTYPE=NOTYPE
  1129.                    TYPE(1)='REAL*8'
  1130.                    TYPE(2)='REAL*8'
  1131.                    TYPE(3)='REAL*8'
  1132.                    TYPE(4)='POINTEUREVOLUTIO'
  1133.                    TYPE(5)='POINTEUREVOLUTIO'
  1134.                    TYPE(6)='REAL*8'
  1135.                    TYPE(7)='POINTEUREVOLUTIO'
  1136.                    TYPE(8)='REAL*8'
  1137.                    TYPE(9)='POINTEUREVOLUTIO'
  1138.                    TYPE(10)='REAL*8'
  1139.                    TYPE(11)='POINTEUREVOLUTIO'
  1140.                    TYPE(12)='REAL*8'
  1141.                    TYPE(13)='REAL*8'
  1142.                    TYPE(14)='REAL*8'
  1143.                    TYPE(15)='POINTEUREVOLUTIO'
  1144.                    TYPE(16)='REAL*8'
  1145.                    TYPE(17)='POINTEUREVOLUTIO'
  1146.                    TYPE(18)='REAL*8'
  1147.                    TYPE(19)='POINTEUREVOLUTIO'
  1148.                    TYPE(20)='REAL*8'
  1149.                    TYPE(21)='POINTEUREVOLUTIO'
  1150.                    TYPE(22)='REAL*8'
  1151.              ENDIF
  1152. C
  1153.          ELSEIF(INPLAS.EQ.67) THEN
  1154.             NBTYPE=NMATR+NMATF
  1155.             SEGINI NOTYPE
  1156.             MOTYPE=NOTYPE
  1157.             IM2=NMATR-2
  1158.             DO IC=1,IM2
  1159.                 TYPE(IC)='REAL*8'
  1160.             ENDDO
  1161.             TYPE(NMATR-1)='POINTEUREVOLUTIO'
  1162.             TYPE(NMATR)  ='POINTEUREVOLUTIO'
  1163.             DO IC=NMATR+1,NBTYPE
  1164.                TYPE(IC)='REAL*8'
  1165.             ENDDO
  1166. C
  1167.          ELSEIF(MATE.EQ.4.AND.INPLAS.EQ.5)THEN
  1168.             NBTYPE=6
  1169.             SEGINI NOTYPE
  1170.             MOTYPE=NOTYPE
  1171.             TYPE(1)='REAL*8'
  1172.             TYPE(2)='REAL*8'
  1173.             TYPE(3)='REAL*8'
  1174.             TYPE(4)='POINTEUREVOLUTIO'
  1175.             TYPE(5)='REAL*8'
  1176.             TYPE(6)='REAL*8'
  1177. C
  1178. c mistral :
  1179.          ELSEIF (INPLAS.EQ.94) THEN
  1180.             NBTYPE=NMATR+NMATF
  1181.             SEGINI NOTYPE
  1182.             MOTYPE=NOTYPE
  1183.             DO 11 ITYP=1,NBTYPE
  1184.               TYPE(ITYP)='REAL*8'
  1185.   11        CONTINUE
  1186. c pour le modèle mistral il y a 10 composantes non linéaires qui sont des listes de réels
  1187.             NLDEB=NMATR-9
  1188.             DO 13 ITYP=NLDEB,NMATR
  1189.               TYPE(ITYP)='POINTEURLISTREEL'
  1190.   13        CONTINUE
  1191. c mistral.
  1192. C
  1193.          ELSE
  1194.             IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.
  1195.      +          EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  1196.                    NBTYPE=2
  1197.             ELSE
  1198.                    NBTYPE=1
  1199.             ENDIF
  1200.             SEGINI NOTYPE
  1201.             MOTYPE=NOTYPE
  1202.             TYPE(1)='REAL*8'
  1203.              IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33).
  1204.      +          AND.IFOUR.EQ.-2) TYPE(2)='REAL*8'
  1205. C
  1206.          ENDIF
  1207.  
  1208.          CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  1209.      &                                   INFOS,3,IVAMAT)
  1210.  
  1211.          SEGSUP NOTYPE
  1212. C
  1213.          IF(IERR.NE.0)THEN
  1214.             KERRE=999
  1215.             GOTO 9990
  1216.          ENDIF
  1217.          NMATT=NMATR+NMATF
  1218. *
  1219.         IF (ISUP5.EQ.1) THEN
  1220.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  1221.            IF(IERR.NE.0)THEN
  1222.               KERRE=999
  1223.               ISUP5=0
  1224.               GOTO 9990
  1225.            ENDIF
  1226.         ENDIF
  1227. *
  1228. *      traitement du champ de caracteristiques geometriques
  1229. *
  1230.          NBROBL=0
  1231.          NBRFAC=0
  1232.          MOCARA=0
  1233. *
  1234. *       coques minces
  1235. *
  1236.          IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  1237.             NBROBL=1
  1238.             NBRFAC=2
  1239.             SEGINI NOMID
  1240.             MOCARA=NOMID
  1241.             LESOBL(1)='EPAI'
  1242.             LESFAC(1)='CALF'
  1243.             LESFAC(2)='EXCE'
  1244. *
  1245.             NBTYPE=1
  1246.             SEGINI NOTYPE
  1247.             MOTYPE=NOTYPE
  1248.             TYPE(1)='REAL*8'
  1249.          ELSEIF (MFR.EQ.5) THEN
  1250.             NBROBL=1
  1251.             NBRFAC=1
  1252.             SEGINI NOMID
  1253.             MOCARA=NOMID
  1254.             LESOBL(1)='EPAI'
  1255.             LESFAC(1)='EXCE'
  1256. *
  1257.             NBTYPE=1
  1258.             SEGINI NOTYPE
  1259.             MOTYPE=NOTYPE
  1260.             TYPE(1)='REAL*8'
  1261. *
  1262. * section pour les barres
  1263. *
  1264.          ELSE IF (MFR.EQ.27) THEN
  1265.             NBROBL=1
  1266.             SEGINI NOMID
  1267.             MOCARA=NOMID
  1268.             LESOBL(1)='SECT'
  1269. *
  1270.             NBTYPE=1
  1271.             SEGINI NOTYPE
  1272.             MOTYPE=NOTYPE
  1273.             TYPE(1)='REAL*8'
  1274. *
  1275. * section, excentrements et orientation pour les barres excentrees
  1276. *
  1277.          ELSE IF (MFR.EQ.49) THEN
  1278.                   NBROBL=6
  1279.                   SEGINI NOMID
  1280.                   MOCARA=NOMID
  1281.                   LESOBL(1)='SECT'
  1282.                   LESOBL(2)='EXCZ'
  1283.                   LESOBL(3)='EXCY'
  1284.                   LESOBL(4)='VX  '
  1285.                   LESOBL(5)='VY  '
  1286.                   LESOBL(6)='VZ  '
  1287. *
  1288.                   NBTYPE=1
  1289.                   SEGINI NOTYPE
  1290.                   MOTYPE=NOTYPE
  1291.                   TYPE(1)='REAL*8'
  1292. *
  1293. * raideurs locales pour l'element LIA2 de liaison a 2 noeuds
  1294. *
  1295.                ELSE IF (MFR.EQ.51) THEN
  1296.                   NBROBL=9
  1297.                   SEGINI NOMID
  1298.                   MOCARA=NOMID
  1299.                   LESOBL(1)='RLUX'
  1300.                   LESOBL(2)='RLUY'
  1301.                   LESOBL(3)='RLUZ'
  1302.                   LESOBL(4)='RLRX'
  1303.                   LESOBL(5)='RLRY'
  1304.                   LESOBL(6)='RLRZ'
  1305.                   LESOBL(7)='VX  '
  1306.                   LESOBL(8)='VY  '
  1307.                   LESOBL(9)='VZ  '
  1308. *
  1309.                   NBTYPE=1
  1310.                   SEGINI NOTYPE
  1311.                   MOTYPE=NOTYPE
  1312.                   TYPE(1)='REAL*8'
  1313. *
  1314.          ELSE IF (MFR.EQ.7 ) THEN
  1315. *
  1316. *     cas des poutres en formulation section
  1317. *
  1318.            IF (CMATE.EQ.'SECTION') THEN
  1319.             NBROBL=0
  1320.             NBRFAC=3
  1321.             SEGINI NOMID
  1322.             MOCARA=NOMID
  1323.             LESFAC(1)='VX'
  1324.             LESFAC(2)='VY'
  1325.             LESFAC(3)='VZ'
  1326. *
  1327.             NBTYPE=3
  1328.             SEGINI NOTYPE
  1329.             MOTYPE=NOTYPE
  1330.             TYPE(1)='REAL*8'
  1331.             TYPE(2)='REAL*8'
  1332.             TYPE(3)='REAL*8'
  1333. *
  1334. * Cas des poutres 2D
  1335. *
  1336.            ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  1337.              NBRFAC=1
  1338.              NBROBL=2
  1339.              SEGINI NOMID
  1340.              MOCARA=NOMID
  1341.              LESOBL(1)= 'SECT'
  1342.              LESOBL(2)= 'INRZ'
  1343.              LESFAC(1)= 'SECY'
  1344. *
  1345.              NBTYPE=1
  1346.              SEGINI NOTYPE
  1347.              MOTYPE=NOTYPE
  1348.              TYPE(1)='REAL*8'
  1349. *
  1350. * cas des poutres 3D
  1351. *
  1352.            ELSE
  1353. *
  1354. * cas des autres poutres
  1355. *
  1356.             NBROBL=4
  1357.             NBRFAC=8
  1358.             SEGINI NOMID
  1359.             MOCARA=NOMID
  1360.             LESOBL(1)='TORS'
  1361.             LESOBL(2)='INRY'
  1362.             LESOBL(3)='INRZ'
  1363.             LESOBL(4)='SECT'
  1364.             LESFAC(1)='SECY'
  1365.             LESFAC(2)='SECZ'
  1366.             LESFAC(3)='DX  '
  1367.             LESFAC(4)='DY  '
  1368.             LESFAC(5)='DZ  '
  1369.             LESFAC(6)='VX'
  1370.             LESFAC(7)='VY'
  1371.             LESFAC(8)='VZ'
  1372. *
  1373.             NBTYPE=12
  1374.             SEGINI NOTYPE
  1375.             MOTYPE=NOTYPE
  1376.             TYPE(1)='REAL*8'
  1377.             TYPE(2)='REAL*8'
  1378.             TYPE(3)='REAL*8'
  1379.             TYPE(4)='REAL*8'
  1380.             TYPE(5)='REAL*8'
  1381.             TYPE(6)='REAL*8'
  1382.             TYPE(7)='REAL*8'
  1383.             TYPE(8)='REAL*8'
  1384.             TYPE(9)='REAL*8'
  1385.             TYPE(9)='REAL*8'
  1386.             TYPE(10)='REAL*8'
  1387.             TYPE(11)='REAL*8'
  1388.             TYPE(11)='REAL*8'
  1389.             TYPE(12)='REAL*8'
  1390.            ENDIF
  1391. *
  1392. * caracteristiques pour les tuyaux
  1393. *
  1394.          ELSE IF (MFR.EQ.13) THEN
  1395.             NBROBL=2
  1396.             NBRFAC=11
  1397.             SEGINI NOMID
  1398.             MOCARA=NOMID
  1399.             LESOBL(1)='EPAI'
  1400.             LESOBL(2)='RAYO'
  1401.             LESFAC(1)='RACO'
  1402.             LESFAC(2)='PRES'
  1403.             LESFAC(3)='CISA'
  1404.             LESFAC(4)='CFFX'
  1405.             LESFAC(5)='CFMX'
  1406.             LESFAC(6)='CFMY'
  1407.             LESFAC(7)='CFMZ'
  1408.             LESFAC(8)='CFPR'
  1409.             LESFAC(9)='VX'
  1410.             LESFAC(10)='VY'
  1411.             LESFAC(11)='VZ'
  1412. *
  1413.             NBTYPE=13
  1414.             SEGINI NOTYPE
  1415.             MOTYPE=NOTYPE
  1416.             TYPE(1)='REAL*8'
  1417.             TYPE(2)='REAL*8'
  1418.             TYPE(3)='REAL*8'
  1419.             TYPE(4)='REAL*8'
  1420.             TYPE(5)='REAL*8'
  1421.             TYPE(6)='REAL*8'
  1422.             TYPE(7)='REAL*8'
  1423.             TYPE(8)='REAL*8'
  1424.             TYPE(9)='REAL*8'
  1425.             TYPE(10)='REAL*8'
  1426.             TYPE(11)='REAL*8'
  1427.             TYPE(12)='REAL*8'
  1428.             TYPE(13)='REAL*8'
  1429. *
  1430. * caracteristiques pour les linespring
  1431. *
  1432.          ELSE IF (MFR.EQ.15) THEN
  1433.             NBROBL=5
  1434.             SEGINI NOMID
  1435.             MOCARA=NOMID
  1436.             LESOBL(1)='EPAI'
  1437.             LESOBL(2)='FISS'
  1438.             LESOBL(3)='VX  '
  1439.             LESOBL(4)='VY  '
  1440.             LESOBL(5)='VZ  '
  1441. *
  1442.             NBTYPE=1
  1443.             SEGINI NOTYPE
  1444.             MOTYPE=NOTYPE
  1445.             TYPE(1)='REAL*8'
  1446. *
  1447. * caracteristiques pour les tuyaux fissures
  1448. *
  1449.          ELSE IF (MFR.EQ.17) THEN
  1450.             NBROBL=9
  1451.             SEGINI NOMID
  1452.             MOCARA=NOMID
  1453.             LESOBL(1)='RAYO'
  1454.             LESOBL(2)='EPAI'
  1455.             LESOBL(3)='VX  '
  1456.             LESOBL(4)='VY  '
  1457.             LESOBL(5)='VZ  '
  1458.             LESOBL(6)='VXF '
  1459.             LESOBL(7)='VYF '
  1460.             LESOBL(8)='VZF '
  1461.             LESOBL(9)='ANGL'
  1462. *
  1463.             NBTYPE=1
  1464.             SEGINI NOTYPE
  1465.             MOTYPE=NOTYPE
  1466.             TYPE(1)='REAL*8'
  1467. *
  1468. * caracteristiques des elements homogeneises
  1469. *
  1470.          ELSE IF (MFR.EQ.37) THEN
  1471.             IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  1472.                NBROBL=4
  1473.                SEGINI NOMID
  1474.                MOCARA=NOMID
  1475.                LESOBL(1)='SCEL'
  1476.                LESOBL(2)='SFLU'
  1477.                LESOBL(3)='EPS '
  1478.                LESOBL(4)='XINE'
  1479.             ELSE
  1480.                NBROBL=3
  1481.                SEGINI NOMID
  1482.                MOCARA=NOMID
  1483.                LESOBL(1)='SCEL'
  1484.                LESOBL(2)='SFLU'
  1485.                LESOBL(3)='EPS '
  1486.             ENDIF
  1487. *
  1488.             NBTYPE=1
  1489.             SEGINI NOTYPE
  1490.             MOTYPE=NOTYPE
  1491.             TYPE(1)='REAL*8'
  1492.          ENDIF
  1493. *
  1494.          IF(MOCARA.NE.0)THEN
  1495.             CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  1496.      &                                     INFOS,3,IVACAR)
  1497.             SEGSUP NOTYPE
  1498.             IF(IERR.NE.0)THEN
  1499.                KERRE=999
  1500.                GOTO 9990
  1501.             ENDIF
  1502.          ENDIF
  1503.          NCARA=NBROBL
  1504.          NCARF=NBRFAC
  1505.          NCARR=NCARA+NCARF
  1506. *
  1507.          IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  1508.                CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  1509.                IF(IERR.NE.0)THEN
  1510.                   KERRE=999
  1511.                   ISUP5=0
  1512.                   GOTO 9990
  1513.                ENDIF
  1514.          ENDIF
  1515. *
  1516. *-------------------------------------------------
  1517. *      creation des mchamls de la sous zone
  1518. *-------------------------------------------------
  1519. *
  1520.          NBPTEL=NBGS
  1521.          NEL=NBELEM
  1522. *
  1523.          N1PTEL=NBPTEL
  1524.          N1EL=NEL
  1525.          N2PTEL=0
  1526.          N2EL=0
  1527. *
  1528. *   contraintes
  1529. *
  1530.          N2=NSTRS
  1531.          SEGINI MCHAML
  1532.          ICHAML(ISOUS)=MCHAML
  1533.          NSR=1
  1534.          NCOSOR=NSTRS
  1535.          SEGINI MPTVAL
  1536.          IVASTF=MPTVAL
  1537.          NOMID=MOSTRS
  1538.          SEGACT NOMID
  1539.          DO 1100 ICOMP=1,NSTRS
  1540.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  1541.             TYPCHE(ICOMP)='REAL*8'
  1542.             SEGINI MELVAL
  1543.             IELVAL(ICOMP)=MELVAL
  1544.             IVAL(ICOMP)=MELVAL
  1545. 1100     continue
  1546.          SEGDES NOMID
  1547. *
  1548. *    variables internes
  1549. *
  1550.          IF((MFR.EQ.7.OR.MFR.EQ.13).AND.CMATE.EQ.'SECTION')THEN
  1551.            N2PTEL=NBPTEL
  1552.            N2EL=NEL
  1553.          ENDIF
  1554. *
  1555.          N2=NVART
  1556.          SEGINI MCHAM1
  1557.          MCHEL1.ICHAML(ISOUS)=MCHAM1
  1558.          NSR=1
  1559.          NCOSOR=NVART
  1560.          SEGINI MPTVAL
  1561.          IVARIF=MPTVAL
  1562.          NOMID=MOVARI
  1563.          SEGACT NOMID
  1564. *
  1565. *        composantes obligatoires
  1566. *
  1567.          DO 1200 ICOMP=1,NVARI
  1568.             MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  1569.             IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION')THEN
  1570.               MCHAM1.TYPCHE(ICOMP)='POINTEURMCHAML  '
  1571.               N1PTEL=0
  1572.               N1EL=0
  1573.              ELSE IF(INPLAS.EQ.74.AND.ICOMP.GT.1) THEN
  1574.               MCHAM1.TYPCHE(ICOMP)='POINTEURLISTREEL'
  1575.               N1PTEL=0
  1576.               N1EL=0
  1577.               N2PTEL=NBPTEL
  1578.               N2EL=NEL
  1579.             ELSE
  1580.               MCHAM1.TYPCHE(ICOMP)='REAL*8'
  1581.               N2PTEL=0
  1582.               N2EL=0
  1583.             ENDIF
  1584.             SEGINI MELVAL
  1585.             MCHAM1.IELVAL(ICOMP)=MELVAL
  1586.             IVAL(ICOMP)=MELVAL
  1587. 1200     continue
  1588. *
  1589. *        composantes facultatives
  1590. *
  1591.          DO 1201 ICOMP=1,NVARF
  1592.             JCOMP=ICOMP+NVARI
  1593.             MCHAM1.NOMCHE(JCOMP)=LESFAC(ICOMP)
  1594.             IF(INPLAS.EQ.74) THEN
  1595.               MCHAM1.TYPCHE(JCOMP)='POINTEURLISTREEL'
  1596.               N1PTEL=0
  1597.               N1EL=0
  1598.             ELSE
  1599.               MCHAM1.TYPCHE(JCOMP)='REAL*8'
  1600.               N2PTEL=0
  1601.               N2EL=0
  1602.             ENDIF
  1603.             SEGINI MELVAL
  1604.             MCHAM1.IELVAL(JCOMP)=MELVAL
  1605.             IVAL(JCOMP)=MELVAL
  1606. 1201     continue
  1607.          SEGDES NOMID
  1608. *
  1609. *    deformations inelastiques
  1610. *
  1611.          N1PTEL=NBPTEL
  1612.          N1EL=NEL
  1613.          N2=NDEF
  1614.          SEGINI MCHAM2
  1615.          MCHEL2.ICHAML(ISOUS)=MCHAM2
  1616.          NSR=1
  1617.          NCOSOR=NDEF
  1618.          SEGINI MPTVAL
  1619.          IVADEP=MPTVAL
  1620.          NOMID=MODEIN
  1621.          SEGACT NOMID
  1622.          DO 1300 ICOMP=1,NDEF
  1623.             MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
  1624.             MCHAM2.TYPCHE(ICOMP)='REAL*8'
  1625.             N2PTEL=0
  1626.             N2EL=0
  1627.             SEGINI MELVAL
  1628.             MCHAM2.IELVAL(ICOMP)=MELVAL
  1629.             IVAL(ICOMP)=MELVAL
  1630. 1300     continue
  1631.          SEGDES NOMID
  1632. *
  1633. *    traitement des champs de temperature pour les materiaux
  1634. *                endommageables de lemaitre
  1635. *
  1636.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  1637.             IPH1=MCHEL3.ICHAML(ISOUS)
  1638.             IPH2=MCHEL4.ICHAML(ISOUS)
  1639.             IPH3=MCHEL5.ICHAML(ISOUS)
  1640.          ENDIF
  1641. *
  1642. *    traitement des champs de flux neutronique pour le modèle MISTRAL
  1643. c mistral :
  1644.          IF (IFI.EQ.1) THEN
  1645.             IPH4=MCHEL7.ICHAML(ISOUS)
  1646.             IPH5=MCHEL8.ICHAML(ISOUS)
  1647.          ENDIF
  1648. c mistral.
  1649. *ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  1650. *   A PROPOS DE CE QUI EST FAIT JUSTE AU DESSUS .....
  1651. *
  1652. *   MLR  : DANGEREUX : ON ACCEDE DIRECTEMENT AUX SOUS-ZONES
  1653. *    ALORS QU'IL CONVIENDRAIT DE PASSER PAR KOMCHA
  1654. *    EN ATTENDANT LA CORRECTION, ON OBLIGE
  1655. *    LA DONNEE DE CHPOINTS  ( CF ECOULE)
  1656. *    DANS LE CAS DE LA SUCCION
  1657. *ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  1658. *
  1659. ***********************
  1660. *  SPECIAL SUCCION
  1661. *
  1662. *    traitement des champs de SUCCION
  1663. *
  1664.          IF (ITHHER.EQ.3) THEN
  1665.             IPH1=MCHEL3.ICHAML(ISOUS)
  1666.             IPH2=MCHEL4.ICHAML(ISOUS)
  1667.          ENDIF
  1668. ***********************
  1669. *
  1670. *     recherche des pointeurs imat et icar
  1671. *
  1672.          NUMAT=0
  1673.          NUCAR=0
  1674.          IRET = 1
  1675.          IF (INPLAS.NE.26.AND.INPLAS.NE.29) THEN
  1676.             CALL CARMAT(IMODEL,IPCAR,IPMAIL,MFR,MELE,CMATE,
  1677.      1         ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET)
  1678.          ENDIF
  1679.          IF(IRET.EQ.0) THEN
  1680.             CALL ERREUR(715)
  1681.             GOTO 9990
  1682.          ENDIF
  1683. *
  1684. *        recherche des dimensions du melval de hooke
  1685. *
  1686.          N2PTEL=0
  1687.          N2EL=0
  1688.          MPTVAL=IVAMAT
  1689.          DO 40 IO=1,NMATT
  1690.             MELVAL=IVAL(IO)
  1691.           IF(MELVAL.NE.0)THEN
  1692.             IF (CMATE.EQ.'SECTION') THEN
  1693.                N2PTEL=MAX(N2PTEL,IELCHE(/1))
  1694.                N2EL  =MAX(N2EL  ,IELCHE(/2))
  1695.             ELSE
  1696.                N2PTEL=MAX(N2PTEL,VELCHE(/1))
  1697.                N2EL  =MAX(N2EL  ,VELCHE(/2))
  1698.             ENDIF
  1699.           ENDIF
  1700.  40      CONTINUE
  1701.          IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN
  1702.            N2PTEL=1
  1703.          ELSE
  1704.            N2PTEL=NBG
  1705.          ENDIF
  1706. *
  1707. *****************************************************
  1708. *     appel a l'ecoulement proprement dit
  1709. *****************************************************
  1710. *
  1711. *    On appel les modèles élastiques linéaires
  1712. *    et les modèles PLASTIQUES intégrés par
  1713. *    ECOINC
  1714. *
  1715.          IF (INPLAS.EQ.0.OR.
  1716.      1       INPLAS.EQ.1.OR.
  1717.      2       INPLAS.EQ.3.OR.
  1718.      2       INPLAS.EQ.4.OR.
  1719.      3       INPLAS.EQ.5.OR.
  1720.      4       INPLAS.EQ.7.OR.
  1721.      5       INPLAS.EQ.11.OR.
  1722.      7       INPLAS.EQ.12.OR.
  1723.      7       INPLAS.EQ.13.OR.
  1724.      9       INPLAS.EQ.15.OR. INPLAS.EQ.87) THEN
  1725.          CALL ECOU10(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1726.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1727.      1  IVADS,IVAMAT,IVACAR,
  1728.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1729.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1730.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1731. *
  1732. *    On appelle les modèles VISCOPLASTIQUES et FLUAGE
  1733. *    intégrés par le 'moule' d'intégration CONSTI
  1734. *    L'intégration est effectuée suivant une méthode
  1735. *    de Runge-Kutta
  1736. *
  1737.          ELSE IF (INPLAS.EQ.17.OR.
  1738.      1       INPLAS.EQ.19.OR.
  1739.      2       INPLAS.EQ.20.OR.
  1740.      3       INPLAS.EQ.61.OR.
  1741.      3       INPLAS.EQ.63.OR.
  1742.      4       INPLAS.EQ.21.OR.
  1743.      5       INPLAS.EQ.22.OR.
  1744.      6       INPLAS.EQ.23.OR.
  1745.      7       INPLAS.EQ.24.OR.
  1746.      8       INPLAS.EQ.25.OR.
  1747.      9       INPLAS.EQ.53.OR. INPLAS.EQ.76.OR.
  1748.      9       INPLAS.EQ.44.OR. INPLAS.EQ.77.OR.
  1749.      1       INPLAS.EQ.45.OR. INPLAS.EQ.102.OR.
  1750.      2       INPLAS.EQ.70.OR.
  1751.      3       INPLAS.EQ.84.OR.
  1752.      5       INPLAS.EQ.85.OR.
  1753.      4       INPLAS.EQ.86) THEN
  1754.          CALL ECOU20(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1755.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1756.      1  IVADS,IVAMAT,IVACAR,
  1757.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1758.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1759.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1760. *
  1761. *   On appelle les modèles VISCOPLASTIQUES et FLUAGE
  1762. *   NON INTEGRES par CONSTI
  1763. *
  1764.          ELSE IF (INPLAS.EQ.43.OR.INPLAS.EQ.82.OR.
  1765.      1            INPLAS.EQ.90.OR.INPLAS.EQ.94.OR.
  1766.      1            INPLAS.EQ.95.OR.INPLAS.EQ.100) THEN
  1767.          CALL ECOU25(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1768.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1769.      1  IVADS,IVAMAT,IVACAR,IPH1,IPH2,IPH3,IPH4,IPH5,
  1770.      2  ITHHER,IFI,LHOOK,NSTRS,NVART,NMATT,NMATR,NCARR,
  1771.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1772.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1773.  
  1774.         ELSE IF (INPLAS.EQ.65.OR.INPLAS.EQ.74) THEN
  1775.         CALL ECOU21(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1776.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1777.      1  IVADS,IVAMAT,IVACAR,
  1778.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1779.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1780.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1781. *
  1782. *   On appele les modeles de materiaux endommageables de Lemaitre
  1783. *   Ce sont des matériaux plastiques (26) et viscoplastiques (29)
  1784. *   intégré par CONSTI
  1785. *
  1786.          ELSE IF (INPLAS.EQ.26.OR.
  1787.      9       INPLAS.EQ.29) THEN
  1788.          CALL ECOU29(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1789.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1790.      1  IVADS,IVAMAT,IVACAR,
  1791.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1792.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1793.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1794. *
  1795. *   On appelle les matériaux ENDOMMAGEABLE
  1796. *
  1797.          ELSE IF (INPLAS.EQ.30.OR.
  1798.      1       INPLAS.EQ.31.OR.INPLAS.EQ.37.OR.
  1799.      2       INPLAS.EQ.88.OR.INPLAS.EQ.89.OR.
  1800.      3       INPLAS.EQ.96.OR.INPLAS.EQ.97.OR.
  1801.      3       INPLAS.EQ.98.OR.INPLAS.EQ.118.OR.
  1802.      4       INPLAS.EQ.134.OR.INPLAS.EQ.135.OR.INPLAS.EQ.141) THEN
  1803.  
  1804.          CALL ECOU40(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1805.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1806.      1  IVADS,IVAMAT,IVACAR,
  1807.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1808.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1809.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1810. *
  1811. *   On appelle les matériaux PLASTIQUE_ENDOM(MAGEABLE)
  1812. *
  1813.          ELSE IF (INPLAS.EQ.51.OR.
  1814.      1            INPLAS.EQ.62.OR.
  1815.      2            INPLAS.EQ.64.OR.
  1816.      3            INPLAS.EQ.75) THEN
  1817.          CALL ECOU50(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1818.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1819.      1  IVADS,IVAMAT,IVACAR,
  1820.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1821.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1822.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1823. *
  1824. *   On appelle les matériaux PLASTIQUES qui ne sont pas
  1825. *   intégrés dans ECOINC
  1826. *
  1827. *
  1828.          ELSE IF (INPLAS.EQ.2.OR.INPLAS.EQ.27.OR.
  1829.      3       INPLAS.EQ.9.OR.INPLAS.EQ.14.OR.
  1830.      6       INPLAS.EQ.18.OR.INPLAS.EQ.16.OR.
  1831.      8       INPLAS.EQ.28.OR.INPLAS.EQ.32.OR.
  1832.      8       INPLAS.EQ.33.OR.INPLAS.EQ.38.OR.
  1833.      8       INPLAS.EQ.34.OR.INPLAS.EQ.35.OR.
  1834.      8       INPLAS.EQ.36.OR.INPLAS.EQ.39.OR.
  1835.      8       INPLAS.EQ.40.OR.INPLAS.EQ.41.OR.
  1836.      8       INPLAS.EQ.50.OR.INPLAS.EQ.49.OR.
  1837.      8       INPLAS.EQ.48.OR.INPLAS.EQ.42.OR.
  1838.      8       INPLAS.EQ.47.OR.INPLAS.EQ.52.OR.
  1839.      8       INPLAS.EQ.54.OR.INPLAS.EQ.55.OR.
  1840.      8       INPLAS.EQ.56.OR.INPLAS.EQ.57.OR.
  1841.      8       INPLAS.EQ.58.OR.INPLAS.EQ.59.OR.
  1842.      9       INPLAS.EQ.60.OR.INPLAS.EQ.78.OR.
  1843.      9       INPLAS.EQ.79.OR.INPLAS.EQ.80.OR.
  1844.      9       INPLAS.EQ.91.OR.INPLAS.EQ.92.OR.
  1845.      9       INPLAS.EQ.93.OR.INPLAS.EQ.119.OR.INPLAS.EQ.126) THEN
  1846.          CALL ECOU60(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1847.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1848.      1  IVADS,IVAMAT,IVACAR,
  1849.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR,
  1850.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1851.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1852. *
  1853. *
  1854. *   On appelle les matériaux PLASTIQUES qui ne sont pas
  1855. *   integres dans ECOINC  -  SUITE de ECOU60
  1856. *
  1857.          ELSE IF (INPLAS.EQ.66.OR.INPLAS.EQ.67.OR.
  1858.      1            INPLAS.EQ.68.OR.INPLAS.EQ.69.OR.
  1859.      2            INPLAS.EQ.71.OR.INPLAS.EQ.72.OR.
  1860.      2            INPLAS.EQ.73.OR.INPLAS.EQ.99.OR.
  1861.      3            INPLAS.EQ.101) THEN
  1862.          CALL ECOU70(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  1863.      1  NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  1864.      1  IVADS,IVAMAT,IVACAR,
  1865.      2  IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NMATR,NCARR,
  1866.      3  CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  1867.      4  N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE)
  1868. *
  1869.         ELSE
  1870.            KERRE=99
  1871.         ENDIF
  1872. *
  1873. ***************************************************
  1874. *  Fin de l'appel aux modeles d'ecoulement
  1875. ***************************************************
  1876.  9990    CONTINUE
  1877. *
  1878. *     desactivation des segments
  1879. *
  1880.          SEGDES MELEME*NOMOD,IMODEL*NOMOD
  1881.          SEGDES,MINTE
  1882. *
  1883.          IF(ISUP1.EQ.1)THEN
  1884.             CALL DTMVAL (IVASTR,3)
  1885.          ELSE
  1886.             CALL DTMVAL (IVASTR,1)
  1887.          ENDIF
  1888.          IF(ISUP2.EQ.1)THEN
  1889.             CALL DTMVAL (IVARI,3)
  1890.          ELSE
  1891.             CALL DTMVAL (IVARI,1)
  1892.          ENDIF
  1893.          IF(ISUP3.EQ.1)THEN
  1894.             CALL DTMVAL (IVADEF,3)
  1895.          ELSE
  1896.             CALL DTMVAL (IVADEF,1)
  1897.          ENDIF
  1898.          IF(ISUP4.EQ.1)THEN
  1899.             CALL DTMVAL (IVADS,3)
  1900.          ELSE
  1901.             CALL DTMVAL (IVADS,1)
  1902.          ENDIF
  1903.          IF(ISUP5.EQ.1)THEN
  1904.             CALL DTMVAL (IVAMAT,3)
  1905.          ELSE
  1906.            CALL DTMVAL (IVAMAT,1)
  1907.          ENDIF
  1908.          IF(ISUP5.EQ.1)THEN
  1909.             CALL DTMVAL (IVACAR,3)
  1910.          ELSE
  1911.             CALL DTMVAL (IVACAR,1)
  1912.          ENDIF
  1913.          IF(ISUP6.EQ.1)THEN
  1914.             CALL DTMVAL (IVADET,3)
  1915.          ELSE IF(IPCHE6.NE.0) THEN
  1916.            CALL DTMVAL (IVADET,1)
  1917.          ENDIF
  1918.          IF (KERRE.EQ.0) THEN
  1919.             CALL DTMVAL (IVASTF,1)
  1920.             CALL DTMVAL (IVARIF,1)
  1921.             CALL DTMVAL (IVADEP,1)
  1922.             SEGDES MCHAML,MCHAM1,MCHAM2
  1923.          ELSE
  1924.             CALL DTMVAL (IVASTF,3)
  1925.             CALL DTMVAL (IVARIF,3)
  1926.             CALL DTMVAL (IVADEP,3)
  1927.             IF (MCHAML.NE.0) SEGSUP MCHAML
  1928.             IF (MCHAM1.NE.0) SEGSUP MCHAM1
  1929.             IF (MCHAM2.NE.0) SEGSUP MCHAM2
  1930.          END IF
  1931. *
  1932.          IF (MOCARA.NE.0) THEN
  1933.             NOMID=MOCARA
  1934.             SEGSUP NOMID
  1935.          END IF
  1936. *
  1937.          IF (MOMATR.NE.0) THEN
  1938.             NOMID=MOMATR
  1939.             if(lsupma)SEGSUP NOMID
  1940.          END IF
  1941. *
  1942.          IF (MOVARI.NE.0) THEN
  1943.             NOMID=MOVARI
  1944.             if(lsupva)SEGSUP NOMID
  1945.          END IF
  1946. *
  1947.          IF (MOSTRS.NE.0) THEN
  1948.             NOMID=MOSTRS
  1949.             if(lsupco)SEGSUP NOMID
  1950.          END IF
  1951. *
  1952.          IF (MOEPSI.NE.0) THEN
  1953.             NOMID=MOEPSI
  1954.             if(lsupde)SEGSUP NOMID
  1955.          END IF
  1956.          IF (MODEIN.NE.0) THEN
  1957.             NOMID=MODEIN
  1958.             if(lsupdd)SEGSUP NOMID
  1959.          END IF
  1960. *
  1961. *         IF (IPINF .NE.0) THEN
  1962. *             INFO=IPINF
  1963. *             SEGSUP INFO
  1964. *         END IF
  1965. *
  1966.          IF(KERRE.NE.0)GO TO 888
  1967. 1000  continue
  1968. *
  1969.  888  CONTINUE
  1970. *
  1971. *    traitement des champs de temperature pour les materiaux
  1972. *                endommageables de lemaitre
  1973. *
  1974.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  1975.             SEGDES MCHEL3,MCHEL4,MCHEL5
  1976.       ENDIF
  1977. c mistral :
  1978.       IF (IFI.EQ.1) THEN
  1979.            SEGDES MCHEL7,MCHEL8
  1980.       ENDIF
  1981. c mistral.
  1982. ***********************
  1983. *  SPECIAL SUCCION
  1984. *
  1985.       IF (ITHHER.EQ.3) THEN
  1986.             SEGDES MCHEL3,MCHEL4
  1987.       ENDIF
  1988. ***********************
  1989.  
  1990.       IF(IPCHE6.NE.0) THEN
  1991.         SEGDES MCHEL6
  1992.       ENDIF
  1993.  
  1994.       SEGDES MMODEL*NOMOD
  1995.       IF(KERRE.EQ.0)THEN
  1996.          SEGDES MCHELM,MCHEL1,MCHEL2
  1997.       ELSE
  1998.          SEGSUP MCHELM,MCHEL1,MCHEL2
  1999.       ENDIF
  2000.  
  2001.       RETURN
  2002.       END
  2003.  
  2004.  
  2005.  

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