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

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