Télécharger la plaquette Cast3M


fr en

Télécharger comval.eso

Retour à la liste

Numérotation des lignes : 

comval

  1. C COMVAL    SOURCE    CB215821  24/04/12    21:15:26     11897          
  2.       SUBROUTINE COMVAL(iqmod,indeso,ililuc,iwrk52,iwrk53,ib,igau,iw522)
  3. C
  4. C----------------------------------------------------------------------
  5. C                   SUBROUTINE APPELEE PAR COML6
  6. C
  7. C  OBJECTIF : RENSEIGNER LES SEGMENTS WRK52 et WRK522 (include DECHE)
  8. C             AVEC LES VALEURS AU POINT D'INTEGRATION
  9. C
  10. C   ENTREES : 
  11. C   ---------
  12. C     IQMOD  : POINTEUR SUR LE SEGMENT IMODEL
  13. C     INDESO : ENTIER INDIQUANT DEBUT DE PAS (=1) FIN DE PAS (=2) 
  14. C              OU CHAMP RESULTAT (=3)
  15. C     ILILUC : POINTEUR SUR LE SEGMENT LILUC (voir comouw)
  16. C     IWRK53 : POINTEUR SUR LE SEGMENT WRK53
  17. C     IB     : ELEMENT COURANT
  18. C     IGAU   : POINT D'INTEGRATION COURANT
  19. C
  20. C   SORTIES : 
  21. C   ---------
  22. C     IWRK52 : POINTEUR SUR LE SEGMENT WRK52
  23. C     IW522  : POINTEUR SUR LE SEGMENT WRK522
  24. C----------------------------------------------------------------------
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8(A-H,O-Z)
  27. *
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCGEOME
  31. -INC SMCHAML
  32. -INC SMELEME
  33. -INC SMCOORD
  34. -INC SMMODEL
  35. -INC SMINTE
  36. -INC CCHAMP
  37. -INC SMEVOLL
  38. -INC SMNUAGE
  39. * segment deroulant le mcheml
  40. -INC DECHE
  41. C
  42. C     wrk52 contient les valeurs des differents champs
  43. C     pour les materiaux, on a d'abord les composantes obligatoires 
  44. C     puis les composantes facultatives.
  45. C     wrk522 ne sert que dans cette subroutine pour aider au remplissage
  46. C     de wrk52
  47. C
  48.       melval = 0
  49.       imodel = iqmod
  50.       liluc  = ililuc
  51.       nbluc1 = liluc(/1)
  52.       wrk52  = iwrk52
  53.       wrk53  = iwrk53
  54.       wrk522 = iw522
  55. C
  56. C     =================================================================
  57. C     initialisations particulieres
  58.       N2EL = 0
  59.       N2PTEL=0
  60. * tuyaux (attention ajout de caracteristiques facultatives telles que DENS)
  61.       IF (mfr.eq.13) THEN
  62.         do ic = 1,5
  63.           xcarb(ic) = 0.d0
  64.         enddo
  65.         do ic=6,10
  66.           xcarb(ic) = -1.d0
  67.         enddo
  68.         do ic=11,xcarb(/1)
  69.           xcarb(ic) = 0.d0
  70.         enddo
  71.       ENDIF
  72. C
  73. C     =================================================================
  74.       IF (ib+igau.ne.2) then
  75. C
  76. C       COMPOSANTE SCAL
  77.         if( mkkalz.EQ.1)then
  78.           do 701 ma=1,mkkal0(/1)
  79.             if(mkkal0(ma).eq.0) go to 701
  80.             deche =mkkal0(ma)
  81.             melval=ABS(ieldec)
  82.             if (typree) then
  83.               IBMN=MIN(IB,VELCHE(/2))
  84.               IGMN=MIN(IGAU,VELCHE(/1))
  85.               scal0(ma)=VELCHE(IGMN,IBMN)
  86.             else
  87.               IBMN=MIN(IB,IELCHE(/2))
  88.               IGMN=MIN(IGAU,IELCHE(/1))
  89.               scal0(ma)=DBLE(IELCHE(IGMN,IBMN))
  90.             endif
  91.   701     continue
  92.           do 7011 ma=1,mkklaf(/1)
  93.             if(mkklaf(ma).eq.0) go to 7011
  94.             deche =mkklaf(ma)
  95.             melval=ABS(ieldec)
  96.             if (typree) then
  97.               IBMN=MIN(IB,VELCHE(/2))
  98.               IGMN=MIN(IGAU,VELCHE(/1))
  99.               scalf(ma)=VELCHE(IGMN,IBMN)
  100.             else
  101.               IBMN=MIN(IB,IELCHE(/2))
  102.               IGMN=MIN(IGAU,IELCHE(/1))
  103.               scalf(ma)=DBLE(IELCHE(IGMN,IBMN))
  104.             endif
  105.  7011     continue
  106.         endif
  107. C
  108.         if(mkktp0.ne.0) then
  109.           deche = mkktp0
  110.           melval=ABS(ieldec)
  111.           IBMN=MIN(IB,VELCHE(/2))
  112.           IGMN=MIN(IGAU,VELCHE(/1))
  113.           temp0=VELCHE(IGMN,IBMN)
  114.         endif
  115. C
  116.         if(mkktpf.ne.0) then
  117.           deche = mkktpf
  118.           melval=ABS(ieldec)
  119.           IBMN=MIN(IB,VELCHE(/2))
  120.           IGMN=MIN(IGAU,VELCHE(/1))
  121.           tempf=VELCHE(IGMN,IBMN)
  122.         endif
  123. C
  124. C       COMPOSANTES PRIMALES
  125.         if( mkkplz.EQ.1)then
  126.           do 706 ma=1,mkkpl0(/1)
  127.             if(mkkpl0(ma).eq.0) go to 706
  128.             deche =mkkpl0(ma)
  129.             melval=ABS(ieldec)
  130.             if (typree) then
  131.               IBMN=MIN(IB,VELCHE(/2))
  132.               IGMN=MIN(IGAU,VELCHE(/1))
  133.               depl0(ma)=VELCHE(IGMN,IBMN)
  134.             else
  135.               IBMN=MIN(IB,IELCHE(/2))
  136.               IGMN=MIN(IGAU,IELCHE(/1))
  137.               depl0(ma)=DBLE(IELCHE(IGMN,IBMN))
  138.             endif
  139.   706     continue
  140.           do 7061 ma=1,mkkplf(/1)
  141.             if(mkkplf(ma).eq.0) go to 7061
  142.             deche =mkkplf(ma)
  143.             melval=ABS(ieldec)
  144.             if (typree) then
  145.               IBMN=MIN(IB,VELCHE(/2))
  146.               IGMN=MIN(IGAU,VELCHE(/1))
  147.               deplf(ma)=VELCHE(IGMN,IBMN)
  148.             else
  149.               IBMN=MIN(IB,IELCHE(/2))
  150.               IGMN=MIN(IGAU,IELCHE(/1))
  151.               deplf(ma)=DBLE(IELCHE(IGMN,IBMN))
  152.             endif
  153.  7061     continue
  154.         endif
  155. C
  156. C       COMPOSANTES DUALES
  157.         if(mkkrcz.eq.1) then
  158.           do 707 ma=1,mkkrc0(/1)
  159.             if(mkkrc0(ma).eq.0) go to 707
  160.             deche =mkkrc0(ma)
  161.             melval=ABS(ieldec)
  162.             if (typree) then
  163.               IBMN=MIN(IB,VELCHE(/2))
  164.               IGMN=MIN(IGAU,VELCHE(/1))
  165.               forc0(ma)=VELCHE(IGMN,IBMN)
  166.             else
  167.               IBMN=MIN(IB,IELCHE(/2))
  168.               IGMN=MIN(IGAU,IELCHE(/1))
  169.               forc0(ma)=DBLE(IELCHE(IGMN,IBMN))
  170.             endif
  171.   707     continue
  172.           do 7071 ma=1,mkkrcf(/1)
  173.             if(mkkrcf(ma).eq.0) go to 7071
  174.             deche =mkkrcf(ma)
  175.             melval=ABS(ieldec)
  176.             if (typree) then
  177.               IBMN=MIN(IB,VELCHE(/2))
  178.               IGMN=MIN(IGAU,VELCHE(/1))
  179.               forcf(ma)=VELCHE(IGMN,IBMN)
  180.             else
  181.               IBMN=MIN(IB,IELCHE(/2))
  182.               IGMN=MIN(IGAU,IELCHE(/1))
  183.               forcf(ma)=DBLE(IELCHE(IGMN,IBMN))
  184.             endif
  185.  7071     continue
  186.         endif
  187. C
  188. C       COMPOSANTES GRADIENTS
  189.         if(mkkadz.eq.1) then
  190.           do 710 ma=1,mkkad0(/1)
  191.             if(mkkad0(ma).eq.0) go to 710
  192.             deche =mkkad0(ma)
  193.             melval=ABS(ieldec)
  194.             if (typree) then
  195.               IBMN=MIN(IB,VELCHE(/2))
  196.               IGMN=MIN(IGAU,VELCHE(/1))
  197.               grad0(ma)=VELCHE(IGMN,IBMN)
  198.             else
  199.               IBMN=MIN(IB,IELCHE(/2))
  200.               IGMN=MIN(IGAU,IELCHE(/1))
  201.               grad0(ma)=DBLE(IELCHE(IGMN,IBMN))
  202.             endif
  203.   710     continue
  204.           do 7101 ma=1,mkkadf(/1)
  205.             if(mkkadf(ma).eq.0) go to 7101
  206.             deche =mkkadf(ma)
  207.             melval=ABS(ieldec)
  208.             if (typree) then
  209.               IBMN=MIN(IB,VELCHE(/2))
  210.               IGMN=MIN(IGAU,VELCHE(/1))
  211.               gradf(ma)=VELCHE(IGMN,IBMN)
  212.             else
  213.               IBMN=MIN(IB,IELCHE(/2))
  214.               IGMN=MIN(IGAU,IELCHE(/1))
  215.               gradf(ma)=DBLE(IELCHE(IGMN,IBMN))
  216.             endif
  217.  7101     continue
  218.         endif
  219. C
  220. C       COMPOSANTES CONTRAINTES
  221.         if(mkkigz.eq.1) then
  222.           do 711 ma=1,mkkig0(/1)
  223.             if(mkkig0(ma).eq.0) go to 711
  224.             deche =mkkig0(ma)
  225.             melval=ABS(ieldec)
  226.             if (typree) then
  227.               IBMN=MIN(IB,VELCHE(/2))
  228.               IGMN=MIN(IGAU,VELCHE(/1))
  229.               sig0(ma)=VELCHE(IGMN,IBMN)
  230.             else
  231.               IBMN=MIN(IB,IELCHE(/2))
  232.               IGMN=MIN(IGAU,IELCHE(/1))
  233.               sig0(ma)=DBLE(IELCHE(IGMN,IBMN))
  234.             endif
  235.   711     continue
  236.           do 7111 ma=1,mkkigf(/1)
  237.             if(mkkigf(ma).eq.0) go to 7111
  238.             deche =mkkigf(ma)
  239.             melval=ABS(ieldec)
  240.             if (typree) then
  241.               IBMN=MIN(IB,VELCHE(/2))
  242.               IGMN=MIN(IGAU,VELCHE(/1))
  243.               sigf(ma)=VELCHE(IGMN,IBMN)
  244.             else
  245.               IBMN=MIN(IB,IELCHE(/2))
  246.               IGMN=MIN(IGAU,IELCHE(/1))
  247.               sigf(ma)=DBLE(IELCHE(IGMN,IBMN))
  248.             endif
  249.  7111     continue
  250.         endif
  251. C
  252. C       COMPOSANTES DEFORMATIONS
  253.         if(mkkstz.eq.1) then
  254.           do 712 ma=1,mkkst0(/1)
  255.             if(mkkst0(ma).eq.0) go to 712
  256.             deche =mkkst0(ma)
  257.             melval=ABS(ieldec)
  258.             if (typree) then
  259.               IBMN=MIN(IB,VELCHE(/2))
  260.               IGMN=MIN(IGAU,VELCHE(/1))
  261.               epst0(ma)=VELCHE(IGMN,IBMN)
  262.             else
  263.               IBMN=MIN(IB,IELCHE(/2))
  264.               IGMN=MIN(IGAU,IELCHE(/1))
  265.               epst0(ma)=DBLE(IELCHE(IGMN,IBMN))
  266.             endif
  267.   712     continue
  268.           do 7121 ma=1,mkkstf(/1)
  269.             if(mkkstf(ma).eq.0) go to 7121
  270.             deche =mkkstf(ma)
  271.             melval=ABS(ieldec)
  272.             if (typree) then
  273.               IBMN=MIN(IB,VELCHE(/2))
  274.               IGMN=MIN(IGAU,VELCHE(/1))
  275.               epstf(ma)=VELCHE(IGMN,IBMN)
  276.             else
  277.               IBMN=MIN(IB,IELCHE(/2))
  278.               IGMN=MIN(IGAU,IELCHE(/1))
  279.               epstf(ma)=DBLE(IELCHE(IGMN,IBMN))
  280.             endif
  281.  7121     continue
  282.         endif
  283. C
  284. C       COMPOSANTES TEMPERATURES
  285.         if( mkkrez.eq.1) then
  286.           do 715 ma=1,mkkre0(/1)
  287.             if(mkkre0(ma).eq.0) go to 715
  288.             deche =mkkre0(ma)
  289.             melval=ABS(ieldec)
  290.             if (typree) then
  291.               IBMN=MIN(IB,VELCHE(/2))
  292.               IGMN=MIN(IGAU,VELCHE(/1))
  293.               ture0(ma)=VELCHE(IGMN,IBMN)
  294.             else
  295.               IBMN=MIN(IB,IELCHE(/2))
  296.               IGMN=MIN(IGAU,IELCHE(/1))
  297.               ture0(ma)=DBLE(IELCHE(IGMN,IBMN))
  298.             endif
  299.   715     continue
  300.           do 7151 ma=1,mkkref(/1)
  301.             if(mkkref(ma).eq.0) go to 7151
  302.             deche =mkkref(ma)
  303.             melval=ABS(ieldec)
  304.             if (typree) then
  305.               IBMN=MIN(IB,VELCHE(/2))
  306.               IGMN=MIN(IGAU,VELCHE(/1))
  307.               turef(ma)=VELCHE(IGMN,IBMN)
  308.             else
  309.               IBMN=MIN(IB,IELCHE(/2))
  310.               IGMN=MIN(IGAU,IELCHE(/1))
  311.               turef(ma)=DBLE(IELCHE(IGMN,IBMN))
  312.             endif
  313.  7151     continue
  314.         endif
  315. C
  316. C       COMPOSANTES CONTRAINTES PRINCIPALES
  317.         if( mkkinz.eq.1) then
  318.           do 716 ma=1,mkkin0(/1)
  319.             if(mkkin0(ma).eq.0) go to 716
  320.             deche =mkkin0(ma)
  321.             melval=ABS(ieldec)
  322.             if (typree) then
  323.               IBMN=MIN(IB,VELCHE(/2))
  324.               IGMN=MIN(IGAU,VELCHE(/1))
  325.               prin0(ma)=VELCHE(IGMN,IBMN)
  326.             else
  327.               IBMN=MIN(IB,IELCHE(/2))
  328.               IGMN=MIN(IGAU,IELCHE(/1))
  329.               prin0(ma)=DBLE(IELCHE(IGMN,IBMN))
  330.             endif
  331.   716     continue
  332.           do 7161 ma=1,mkkinf(/1)
  333.             if(mkkinf(ma).eq.0) go to 7161
  334.             deche =mkkinf(ma)
  335.             melval=ABS(ieldec)
  336.             if (typree) then
  337.               IBMN=MIN(IB,VELCHE(/2))
  338.               IGMN=MIN(IGAU,VELCHE(/1))
  339.               prinf(ma)=VELCHE(IGMN,IBMN)
  340.             else
  341.               IBMN=MIN(IB,IELCHE(/2))
  342.               IGMN=MIN(IGAU,IELCHE(/1))
  343.               prinf(ma)=DBLE(IELCHE(IGMN,IBMN))
  344.             endif
  345.  7161     continue
  346.         endif
  347. C
  348. C       COMPOSANTE MAHO
  349.         if(mkkhoz.eq.1) then
  350.           do 717 ma=1,mkkho0(/1)
  351.             if(mkkho0(ma).eq.0) go to 717
  352.             deche =mkkho0(ma)
  353.             melval=ABS(ieldec)
  354.             if (typree) then
  355.               IBMN=MIN(IB,VELCHE(/2))
  356.               IGMN=MIN(IGAU,VELCHE(/1))
  357.               maho0(ma)=VELCHE(IGMN,IBMN)
  358.             else
  359.               IBMN=MIN(IB,IELCHE(/2))
  360.               IGMN=MIN(IGAU,IELCHE(/1))
  361.               maho0(ma)=DBLE(IELCHE(IGMN,IBMN))
  362.             endif
  363.   717     continue
  364.           do 7171 ma=1,mkkhof(/1)
  365.             if(mkkhof(ma).eq.0) go to 7171
  366.             deche =mkkhof(ma)
  367.             melval=ABS(ieldec)
  368.             if (typree) then
  369.               IBMN=MIN(IB,VELCHE(/2))
  370.               IGMN=MIN(IGAU,VELCHE(/1))
  371.               mahof(ma)=VELCHE(IGMN,IBMN)
  372.             else
  373.               IBMN=MIN(IB,IELCHE(/2))
  374.               IGMN=MIN(IGAU,IELCHE(/1))
  375.               mahof(ma)=DBLE(IELCHE(IGMN,IBMN))
  376.             endif
  377.  7171     continue
  378.         endif
  379. C
  380. C       COMPOSANTE MAHT
  381.         if(mkktaz.eq.1) then
  382.           do 718 ma=1,mkkta0(/1)
  383.             if(mkkta0(ma).eq.0) go to 718
  384.             deche =mkkta0(ma)
  385.             melval=ABS(ieldec)
  386.             if (typree) then
  387.               IBMN=MIN(IB,VELCHE(/2))
  388.               IGMN=MIN(IGAU,VELCHE(/1))
  389.               hota0(ma)=VELCHE(IGMN,IBMN)
  390.             else
  391.               IBMN=MIN(IB,IELCHE(/2))
  392.               IGMN=MIN(IGAU,IELCHE(/1))
  393.               hota0(ma)=DBLE(IELCHE(IGMN,IBMN))
  394.             endif
  395.   718     continue
  396.           do 7181 ma=1,mkktaf(/1)
  397.             if(mkktaf(ma).eq.0) go to 7181
  398.             deche =mkktaf(ma)
  399.             melval=ABS(ieldec)
  400.             if (typree) then
  401.               IBMN=MIN(IB,VELCHE(/2))
  402.               IGMN=MIN(IGAU,VELCHE(/1))
  403.               hotaf(ma)=VELCHE(IGMN,IBMN)
  404.             else
  405.               IBMN=MIN(IB,IELCHE(/2))
  406.               IGMN=MIN(IGAU,IELCHE(/1))
  407.               hotaf(ma)=DBLE(IELCHE(IGMN,IBMN))
  408.             endif
  409.  7181     continue
  410.         endif
  411. C
  412. C       COMPOSANTES VARIABLES INTERNES
  413.         if(mkkvrz.eq.1) then
  414.           do 720 ma=1,mkkvr0(/1)
  415.             if(mkkvr0(ma).eq.0) go to 720
  416.             deche =mkkvr0(ma)
  417.             melval=ABS(ieldec)
  418.             if (typree) then
  419.               IBMN=MIN(IB,VELCHE(/2))
  420.               IGMN=MIN(IGAU,VELCHE(/1))
  421.               var0(ma)=VELCHE(IGMN,IBMN)
  422.             else
  423.               IBMN=MIN(IB,IELCHE(/2))
  424.               IGMN=MIN(IGAU,IELCHE(/1))
  425.               var0(ma)=DBLE(IELCHE(IGMN,IBMN))
  426.             endif
  427.   720     continue
  428.           do 7201 ma=1,mkkvrf(/1)
  429.             if(mkkvrf(ma).eq.0) go to 7201
  430.             deche =mkkvrf(ma)
  431.             melval=ABS(ieldec)
  432.             if (typree) then
  433.               IBMN=MIN(IB,VELCHE(/2))
  434.               IGMN=MIN(IGAU,VELCHE(/1))
  435.               varf(ma)=VELCHE(IGMN,IBMN)
  436.             else
  437.               IBMN=MIN(IB,IELCHE(/2))
  438.               IGMN=MIN(IGAU,IELCHE(/1))
  439.               varf(ma)=DBLE(IELCHE(IGMN,IBMN))
  440.             endif
  441.  7201     continue
  442.         endif
  443. C
  444. C       COMPOSANTES GRADIENTS FLEXION
  445.         if( mkkafz.eq.1) then
  446.           do 721 ma=1,mkkaf0(/1)
  447.             if(mkkaf0(ma).eq.0) go to 721
  448.             deche =mkkaf0(ma)
  449.             melval=ABS(ieldec)
  450.             if (typree) then
  451.               IBMN=MIN(IB,VELCHE(/2))
  452.               IGMN=MIN(IGAU,VELCHE(/1))
  453.               graf0(ma)=VELCHE(IGMN,IBMN)
  454.             else
  455.               IBMN=MIN(IB,IELCHE(/2))
  456.               IGMN=MIN(IGAU,IELCHE(/1))
  457.               graf0(ma)=DBLE(IELCHE(IGMN,IBMN))
  458.             endif
  459.   721     continue
  460.           do 7211 ma=1,mkkaff(/1)
  461.             if(mkkaff(ma).eq.0) go to 7211
  462.             deche =mkkaff(ma)
  463.             melval=ABS(ieldec)
  464.             if (typree) then
  465.               IBMN=MIN(IB,VELCHE(/2))
  466.               IGMN=MIN(IGAU,VELCHE(/1))
  467.               graff(ma)=VELCHE(IGMN,IBMN)
  468.             else
  469.               IBMN=MIN(IB,IELCHE(/2))
  470.               IGMN=MIN(IGAU,IELCHE(/1))
  471.               graff(ma)=DBLE(IELCHE(IGMN,IBMN))
  472.             endif
  473.  7211     continue
  474.         endif
  475. C
  476. C       COMPOSANTES VARIABLES MICROSTRUCTURES
  477.         if(mkkasz.eq.1) then
  478.           do 723 ma=1,mkkas0(/1)
  479.             if(mkkas0(ma).eq.0) go to 723
  480.             deche =mkkas0(ma)
  481.             melval=ABS(ieldec)
  482.             if (typree) then
  483.               IBMN=MIN(IB,VELCHE(/2))
  484.               IGMN=MIN(IGAU,VELCHE(/1))
  485.               rhas0(ma)=VELCHE(IGMN,IBMN)
  486.             else
  487.               IBMN=MIN(IB,IELCHE(/2))
  488.               IGMN=MIN(IGAU,IELCHE(/1))
  489.               rhas0(ma)=DBLE(IELCHE(IGMN,IBMN))
  490.             endif
  491.   723     continue
  492.           do 7231 ma=1,mkkasf(/1)
  493.             if(mkkasf(ma).eq.0) go to 7231
  494.             deche =mkkasf(ma)
  495.             melval=ABS(ieldec)
  496.             if (typree) then
  497.               IBMN=MIN(IB,VELCHE(/2))
  498.               IGMN=MIN(IGAU,VELCHE(/1))
  499.               rhasf(ma)=VELCHE(IGMN,IBMN)
  500.             else
  501.               IBMN=MIN(IB,IELCHE(/2))
  502.               IGMN=MIN(IGAU,IELCHE(/1))
  503.               rhasf(ma)=DBLE(IELCHE(IGMN,IBMN))
  504.             endif
  505.  7231     continue
  506.         endif
  507. C
  508. C       COMPOSANTES DEFORMATIONS INELASTIQUES
  509.         if(mkkpnz.eq.1) then
  510.           do 724 ma=1,mkkpn0(/1)
  511.             if(mkkpn0(ma).eq.0) go to 724
  512.             deche =mkkpn0(ma)
  513.             melval=ABS(ieldec)
  514.             if (typree) then
  515.               IBMN=MIN(IB,VELCHE(/2))
  516.               IGMN=MIN(IGAU,VELCHE(/1))
  517.               epin0(ma)=VELCHE(IGMN,IBMN)
  518.             else
  519.               IBMN=MIN(IB,IELCHE(/2))
  520.               IGMN=MIN(IGAU,IELCHE(/1))
  521.               epin0(ma)=DBLE(IELCHE(IGMN,IBMN))
  522.             endif
  523.   724     continue
  524.           do 7241 ma=1,mkkpnf(/1)
  525.             if(mkkpnf(ma).eq.0) go to 7241
  526.             deche =mkkpnf(ma)
  527.             melval=ABS(ieldec)
  528.             if (typree) then
  529.               IBMN=MIN(IB,VELCHE(/2))
  530.               IGMN=MIN(IGAU,VELCHE(/1))
  531.               epinf(ma)=VELCHE(IGMN,IBMN)
  532.             else
  533.               IBMN=MIN(IB,IELCHE(/2))
  534.               IGMN=MIN(IGAU,IELCHE(/1))
  535.               epinf(ma)=DBLE(IELCHE(IGMN,IBMN))
  536.             endif
  537.  7241     continue
  538.         endif
  539. C-
  540.         if (mkkexz.eq.1) then
  541.           do 725 ma=1,mkkex0(/1)
  542.             if(mkkex0(ma).eq.0) go to 725
  543.             deche =mkkex0(ma)
  544.             melval=ABS(ieldec)
  545.             if (typree) then
  546.               IBMN=MIN(IB,VELCHE(/2))
  547.               IGMN=MIN(IGAU,VELCHE(/1))
  548.               parex0(ma)=VELCHE(IGMN,IBMN)
  549.             else
  550.               IBMN=MIN(IB,IELCHE(/2))
  551.               IGMN=MIN(IGAU,IELCHE(/1))
  552.               parex0(ma)=DBLE(IELCHE(IGMN,IBMN))
  553.             endif
  554.   725     continue
  555.           do 7251 ma=1,mkkexf(/1)
  556.             if(mkkexf(ma).eq.0) go to 7251
  557.             deche =mkkexf(ma)
  558.             melval=ABS(ieldec)
  559.             if (typree) then
  560.               IBMN=MIN(IB,VELCHE(/2))
  561.               IGMN=MIN(IGAU,VELCHE(/1))
  562.               parexf(ma)=VELCHE(IGMN,IBMN)
  563.             else
  564.               IBMN=MIN(IB,IELCHE(/2))
  565.               IGMN=MIN(IGAU,IELCHE(/1))
  566.               parexf(ma)=DBLE(IELCHE(IGMN,IBMN))
  567.             endif
  568.  7251     continue
  569.         endif
  570. C-
  571.         if(mkkvxz.eq.1) then
  572.           do 726 ma=1,mkkvx0(/1)
  573.             if(mkkvx0(ma).eq.0) go to 726
  574.             deche =mkkvx0(ma)
  575.             melval=ABS(ieldec)
  576.             if (typree) then
  577.               IBMN=MIN(IB,VELCHE(/2))
  578.               IGMN=MIN(IGAU,VELCHE(/1))
  579.               exova0(ma)=VELCHE(IGMN,IBMN)
  580.             else
  581.               IBMN=MIN(IB,IELCHE(/2))
  582.               IGMN=MIN(IGAU,IELCHE(/1))
  583.               exova0(ma)=DBLE(IELCHE(IGMN,IBMN))
  584.             endif
  585.   726     continue
  586.           do 7261 ma=1,mkkvx1(/1)
  587.             if(mkkvx1(ma).eq.0) go to 7261
  588.             deche =mkkvx1(ma)
  589.             melval=ABS(ieldec)
  590.             if (typree) then
  591.               IBMN=MIN(IB,VELCHE(/2))
  592.               IGMN=MIN(IGAU,VELCHE(/1))
  593.               exova1(ma)=VELCHE(IGMN,IBMN)
  594.             else
  595.               IBMN=MIN(IB,IELCHE(/2))
  596.               IGMN=MIN(IGAU,IELCHE(/1))
  597.               exova1(ma)=DBLE(IELCHE(IGMN,IBMN))
  598.             endif
  599.  7261     continue
  600.         endif
  601. C-
  602.       endif
  603. C     =================================================================
  604. C     =================================================================
  605.       if( ib+IGAu.eq.2) THEN
  606.         idepup=1
  607.         ifinup=nbluc1
  608.       else
  609.         idepup=13
  610.         ifinup=14
  611.       endif
  612. C
  613. C     -------------------------------------------
  614. C     Boucle (1000) sur les composantes a traiter
  615. C     -------------------------------------------
  616.       DO 1000 INO = IDEPUP,IFINUP
  617. C
  618.         nomid  = liluc(ino,1)
  619.         pilnec = liluc(ino,2)
  620.         if (pilnec.le.0) goto 1000
  621. C
  622.         mran = pilobl(/2)
  623.         mobl = pilobl(/1)
  624.         mfac = pilfac(/1)
  625.         if (mran.le.0) goto 1000
  626. C
  627.         DO 3000 IR = 1,MRAN
  629. C
  630. C         ++++++++++++++++++++++++
  631. C         COMPOSANTES OBLIGATOIRES
  632. C         ++++++++++++++++++++++++
  633.           if (mobl.le.0) goto 101
  634.           DO 100 IC = 1,MOBL
  635.             passe1= 0.d0
  636.             ipilo1 = pilobl(ic,ir)
  637. * attention les valeurs induites par deche (nomdec, typdec)ne sont pas effacees
  638.             if (pilobl(ic,ir).gt.0) then
  639.               deche = pilobl(ic,ir)
  640. * on evite les deche crees pour le modele
  641. *          write(6,*) ino,ir,ic,deche,nomdec,typdec,condec
  642.               if (ir.eq.indeso.and.condec(1:24).eq.conmod(1:24))goto 100
  643.               melval = ABS(ieldec)
  644.               if (typree) then
  645.                 IBMN=MIN(IB,VELCHE(/2))
  646.                 IGMN=MIN(IGAU,VELCHE(/1))
  647.                 passe1=VELCHE(IGMN,IBMN)
  648.               else
  649.                 IBMN=MIN(IB,IELCHE(/2))
  650.                 IGMN=MIN(IGAU,IELCHE(/1))
  651.                 passe1=DBLE(IELCHE(IGMN,IBMN))
  652.               endif
  653.             endif
  654. C
  655. C           AIGUILLAGE SUIVANT MOT CLE
  656. C
  657.             if (ino.gt.nmot) goto 98
  658.         GOTO ( 1, 2, 99, 99, 99, 6, 7,99,99,10,11,12,13,14,15,16, 17,18,
  659.      &        99,20,21,99,23,24,25) ino
  660. C
  661.   99        CONTINUE
  662. C
  663. C           PAS DE COMPOSANTES POUR CE CHAMP
  664.             RETURN
  665. C
  666. C           COMPOSANTE SCAL
  667.    1        CONTINUE
  668.             if (ipilo1.le.0) goto 100
  669.             if (ir.eq.1) then
  670.               scal0(ic) = passe1
  671.               mkkal0(ic)=deche
  672.             else if (ir.ge.(mran -1)) then
  673.               scalf(ic) = passe1
  674.               mkklaf(ic)=deche
  675.             endif
  676.             if(deche.ne.0) mkkalz=1
  677.             GOTO 120
  678. C
  679. C           COMPOSANTE TEMP
  680.    2        CONTINUE
  681.             if (ipilo1.le.0) goto 100
  682.             if (ir.eq.1) then
  683.               temp0 = passe1
  684.               mkktp0=deche
  685.             else if (ir.ge.(mran -1)) then
  686.               tempf = passe1
  687.               mkktpf=deche
  688.             endif
  689.             GOTO 120
  690. C
  691. C           COMPOSANTES PRIMALES
  692.    6        CONTINUE
  693.             if (ipilo1.le.0) goto 100
  694.             if (ir.eq.1) then
  695.               depl0(ic) = passe1
  696.               mkkpl0(ic)=deche
  697.             else if (ir.ge.(mran -1)) then
  698.               deplf(ic) = passe1
  699.               mkkplf(ic)=deche
  700.             endif
  701.             if(deche.ne.0) mkkplz=1
  702.             GOTO 120
  703. C
  704. C           COMPOSANTES DUALES
  705.    7        CONTINUE
  706.             if (ipilo1.le.0) goto 100
  707.             if (ir.eq.1) then
  708.               forc0(ic) = passe1
  709.               mkkrc0(ic)=deche
  710.             else if (ir.ge.(mran -1)) then
  711.               forcf(ic) = passe1
  712.               mkkrcf(ic)=deche
  713.             endif
  714.             if(deche.ne.0) mkkrcz=1
  715.             GOTO 120
  716. C
  717. C           COMPOSANTES GRADIENTS
  718.   10        CONTINUE
  719.             if (ipilo1.le.0) goto 100
  720.             if (ir.eq.1) then
  721.               grad0(ic) = passe1
  722.               mkkad0(ic)=deche
  723.             else if (ir.ge.(mran -1)) then
  724.               gradf(ic) = passe1
  725.               mkkadf(ic)=deche
  726.             endif
  727.             if(deche.ne.0) mkkadz=1
  728.             GOTO 120
  729. C
  730. C           COMPOSANTES CONTRAINTES
  731.   11        CONTINUE
  732.             if (ipilo1.le.0) goto 100
  733.             if (ir.eq.1) then
  734.               SIG0(ic) = passe1
  735.               mkkig0(ic)=deche
  736.             else if (ir.ge.(mran -1)) then
  737.               SIGF(ic) = passe1
  738.               mkkigf(ic)=deche
  739.             endif
  740.             if(deche.ne.0) mkkigz=1
  741.             GOTO 120
  742. C
  743. C           COMPOSANTES DEFORMATIONS
  744.   12        CONTINUE
  745.             if (ipilo1.le.0) goto 100
  746.             if (ir.eq.1) then
  747.               epst0(ic) = passe1
  748.               mkkst0(ic) =deche
  749.             else if (ir.gt.1.and.ir.le.mran) then
  750.               epstf(ic) = passe1
  751.               mkkstf(ic) = deche
  752.             endif
  753.             if(deche.ne.0) mkkstz=1
  754.             GOTO 120
  755. C
  756. C           COMPOSANTES MATERIAUX
  757.   13        CONTINUE
  758.             if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  759.               commat(ic) = lesobl(ic)
  760.               tyval(ic) = 'REAL*8  '
  761.             endif
  762.             if (ir.gt.1) then
  763.               ivalma(ic) = 0
  764.               if (ipilo1.gt.0) ivalma(ic) = ABS(ieldec)
  765.             endif
  766.             if (ipilo1.le.0) goto 100
  767.             if (ir.eq.1) then
  768.               valma0(ic) = passe1
  769.               mkkva0(ic)=deche
  770.             elseif (ir.gt.1.and.ir.le.(mran -1)) then
  771.               VALMAT(ic) = passe1
  772.               mkkvat(ic)=deche
  773.               if (deche.eq.0) then
  774.                 call erreur(1073)
  775.                 return
  776.               endif
  777.               tyval (ic)= typdec
  778.               xmatf(ic) = passe1
  779.               mkkatf(ic)=deche
  780.             else if (ir.eq.mran ) then
  781.               xmatf(ic) = passe1
  782.               mkkatf(ic)=deche
  783.             endif
  784.             if (igau.eq.1.and.ib.eq.1) then
  785.               IF (CMATE.EQ.'SECTION ') THEN
  786.                 N2PTEL=MAX(N2PTEL,IELCHE(/1))
  787.                 N2EL  =MAX(N2EL  ,IELCHE(/2))
  788.               ELSE
  789.                 N2PTEL=MAX(N2PTEL,VELCHE(/1))
  790.                 N2EL  =MAX(N2EL  ,VELCHE(/2))
  791.               ENDIF
  792.             endif
  793.             GOTO 120
  794. C
  795. C           COMPOSANTES CARACTERISTIQUES
  796.   14        CONTINUE
  797.             if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  798.               comcar(ic) = lesobl(ic)
  799.               tycar(ic) = 'REAL*8  '
  800.             endif
  801.             mblcar=mobl
  802.             if (ipilo1.le.0.and.mfr.ne.9.and.mfr.ne.3) goto 100
  803.             if (ir.eq.1) then
  804.               xcar0(ic) = passe1
  805.               mkkar0(ic)=deche
  806.             elseif (ir.gt.1.and.ir.le.(mran-1)) then
  807.               if (deche.eq.0) then
  808.                 call erreur(1073)
  809.                 return
  810.               endif
  811.               tycar(ic) = typdec
  812.               XCARB(ic) = passe1
  813.               mkkarb(ic)=deche
  814.               xcarbf(ic) = passe1
  815.               mkkrbf(ic)=deche
  816. *
  817. * tuyaux
  818. *
  819.               IF (mfr.eq.13) THEN
  820. C
  821. C Poutre 3D
  822. C
  823.               ELSE IF(mfr.EQ.7.AND.IDIM.EQ.3)THEN
  824. C
  825. C Poutre 2D
  826. C
  827.               ELSEIF(IDIM.EQ.2) THEN
  828.                 if (ipilo1.le.0.and.ic.eq.2) then
  829.                   IF(mfr.EQ.3.OR.mfr.EQ.9) THEN
  830.                     XCARB(IC)=0.66666666666666D0
  831.                   ENDIF
  832.                 endif
  833.               ELSE
  834. *    cas des coques minces : défaut de alfah
  835.                 IF (ipilo1.le.0.and.IC.EQ.2.AND.
  836.      &                     (mfr.EQ.3.OR.mfr.EQ.9)) THEN
  837.                   XCARB(IC)=0.666666666666666D0
  838.                 ENDIF
  839. C
  840.               ENDIF
  841.  
  842.             else if (ir.eq.mran) then
  843.               xcarbf(ic) = passe1
  844.               mkkrbf(ic)=deche
  845.             endif
  846.             if(deche.ne.0) mkkarz=1
  847.             GOTO 120
  848. C
  849. C           COMPOSANTES TEMPERATURES
  850.   15        CONTINUE
  851.             if (ipilo1.le.0) goto 100
  852.             if (ir.eq.1) then
  853.               ture0(ic) = passe1
  854.               mkkre0(ic)=deche
  855.             else if (ir.ge.(mran -1)) then
  856.               turef(ic) = passe1
  857.               mkkref(ic)=deche
  858.             endif
  859.             if(deche.ne.0) mkkrez=1
  860.             GOTO 120
  861. C
  862. C           COMPOSANTES CONTRAINTES PRINCIPALES
  863.   16        CONTINUE
  864.             if (ipilo1.le.0) goto 100
  865.             if (ir.eq.1) then
  866.               prin0(ic) = passe1
  867.               mkkin0(ic)=deche
  868.             else if (ir.ge.(mran -1)) then
  869.               prinf(ic) = passe1
  870.               mkkinf(ic)=deche
  871.             endif
  872.             if(deche.ne.0) mkkinz=1
  873.             GOTO 120
  874. C
  875. C           COMPOSANTE MAHO
  876.   17        CONTINUE
  877.             if (ipilo1.le.0) goto 100
  878.             if (ir.eq.1) then
  879.               maho0(ic) = passe1
  880.               mkkho0(ic)=deche
  881.             else if (ir.ge.(mran -1)) then
  882.               mahof(ic) = passe1
  883.               mkkhof(ic)=deche
  884.             endif
  885.             if(deche.ne.0) mkkhoz=1
  886.             GOTO 120
  887. C
  888. C           COMPOSANTE MAHT
  889.   18        CONTINUE
  890.             if (ipilo1.le.0) goto 100
  891.             if (ir.eq.1) then
  892.               hota0(ic) = passe1
  893.               mkkta0(ic)=deche
  894.             else if (ir.ge.(mran -1)) then
  895.               hotaf(ic) = passe1
  896.               mkktaf(ic)=deche
  897.             endif
  898.             if(deche.ne.0) mkktaz=1
  899.             GOTO 120
  900. C
  901. C           COMPOSANTES VARIABLES INTERNES
  902.   20        CONTINUE
  903.             if (ipilo1.le.0) goto 100
  904.             if (ir.eq.1) then
  905.               VAR0(ic) = passe1
  906. *             write(6,*) 'var0 ', passe1
  907.               mkkvr0(ic)=deche
  908.             else if (ir.ge.(mran -1)) then
  909.               VARF(ic) = passe1
  910.               mkkvrf(ic)=deche
  911.             endif
  912.             if(deche.ne.0) mkkvrz=1
  913.             GOTO 120
  914. C
  915. C           COMPOSANTES GRADIENTS FLEXION
  916.   21        CONTINUE
  917.             if (ipilo1.le.0) goto 100
  918.             if (ir.eq.1) then
  919.               graf0(ic) = passe1
  920.               mkkaf0(ic)=deche
  921.             else if (ir.ge.(mran -1)) then
  922.               graff(ic) = passe1
  923.               mkkaff(ic)=deche
  924.             endif
  925.             if(deche.ne.0) mkkafz=1
  926.             GOTO 120
  927. C
  928. C           COMPOSANTES VARIABLES MICROSTRUCTURES
  929.   23        CONTINUE
  930.             if (ipilo1.le.0) goto 100
  931.             if (ir.eq.1) then
  932.               rhas0(ic) = passe1
  933.               mkkas0(ic)=deche
  934.             else if (ir.ge.(mran -1)) then
  935.               rhasf(ic) = passe1
  936.               mkkasf(ic)=deche
  937.             endif
  938.             if(deche.ne.0) mkkasz=1
  939.             GOTO 120
  940. C
  941. C           COMPOSANTES DEFORMATIONS INELASTIQUES
  942.   24        CONTINUE
  943.             if (ipilo1.le.0) goto 100
  944.             if (ir.eq.1) then
  945.               EPIN0(ic) = passe1
  946.               mkkpn0(ic)=deche
  947.             else if (ir.ge.(mran -1)) then
  948.               EPINF(ic) = passe1
  949.               mkkpnf(ic)=deche
  950.             endif
  951.             if(deche.ne.0) mkkpnz=1
  952.             GOTO 120
  953. C
  954.   25        CONTINUE
  955.             if (ipilo1.le.0) goto 100
  956.             if (ir.eq.1) then
  957.               PAREX0(ic) = passe1
  958.               mkkex0(ic)=deche
  959.             else if (ir.ge.(mran -1)) then
  960.               PAREXF(ic) = passe1
  961.               mkkexf(ic)=deche
  962.             endif
  963.             if(deche.ne.0) mkkexz=1
  964.             GOTO 120
  965. C
  966.   98        CONTINUE
  967.             if (ipilo1.le.0) goto 100
  968.             if (ir.eq.1) then
  969.               exova0(ic) = passe1
  970.               mkkvx0(ic)=deche
  971.             else if (ir.ge.(mran -1)) then
  972.               exova1(ic) = passe1
  973.               mkkvx1(ic)=deche
  974.             endif
  975.             if (nomexo(ic).eq.'STEP    ') istep = int(exova0(ic))
  976.             if(deche.ne.0) mkkvxz=1
  977.             GOTO 120
  978. C
  979.  120        CONTINUE
  980.  100      CONTINUE
  981. C
  982.  101      CONTINUE
  983. C
  984. C         ++++++++++++++++++++++++
  985. C         COMPOSANTES FACULTATIVES
  986. C         ++++++++++++++++++++++++
  987. C         if (mfac.le.0) goto 301
  988.           DO 200 IC = 1,MFAC
  989.             passe1= 0.d0
  990.             ipilo2 = pilfac(ic,ir)
  991.             if (pilfac(ic,ir).gt.0) then
  992.               deche = pilfac(ic,ir)
  993. * on evite les deche crees pour le modele
  994. *           if (ib.eq.1.and.igau.eq.1)
  995. *    &     write(6,*) ino,ir,ic,deche,nomdec,typdec,condec
  996.               if (ir.eq.indeso.and.condec(1:24).eq.conmod(1:24))goto 200
  997.               melval = ABS(ieldec)
  998. c              segact melval
  999.               if (typree) then
  1000.                 IBMN=MIN(IB,VELCHE(/2))
  1001.                 IGMN=MIN(IGAU,VELCHE(/1))
  1002.                 passe1=VELCHE(IGMN,IBMN)
  1003.               else
  1004.                 IBMN=MIN(IB,IELCHE(/2))
  1005.                 IGMN=MIN(IGAU,IELCHE(/1))
  1006.                 passe1=DBLE(IELCHE(IGMN,IBMN))
  1007.               endif
  1008.             endif
  1009. C
  1010. C           AIGUILLAGE SUIVANT MOT CLE
  1011. C
  1012.             if (ino.gt.nmot) goto 298
  1013.         GOTO ( 201,202,299,299,299,206, 207,299,299,210,211,
  1014.      & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino
  1015. *
  1016.  299        CONTINUE
  1017. C
  1018. C           PAS DE COMPOSANTES POUR CE CHAMP
  1019.             RETURN
  1020. C
  1021. C           COMPOSANTE SCAL
  1022.   201       CONTINUE
  1023.             if (ipilo2.le.0) goto 200
  1024.             if (ir.eq.1) then
  1025.               scal0(mobl+ic) = passe1
  1026.               mkkal0(ic+mobl)=deche
  1027.             else if (ir.ge.(mran -1)) then
  1028.               scalf(mobl+ic) = passe1
  1029.               mkklaf(ic+mobl)=deche
  1030.             endif
  1031.             if(deche.ne.0) mkkalz=1
  1032.             GOTO 320
  1033. C
  1034. C           COMPOSANTE TEMP
  1035.   202       CONTINUE
  1036.             if (ipilo2.le.0) goto 200
  1037. * bizarre de passer la ...
  1038.             GOTO 320
  1039. C
  1040. C           COMPOSANTES PRIMALES
  1041.   206       CONTINUE
  1042.             if (ipilo2.le.0) goto 200
  1043.             if (ir.eq.1) then
  1044.               depl0(mobl+ic) = passe1
  1045.               mkkpl0(ic+mobl)=deche
  1046.             else if (ir.ge.(mran -1)) then
  1047.               deplf(mobl+ic) = passe1
  1048.               mkkplf(ic+mobl)=deche
  1049.             endif
  1050.             if(deche.ne.0) mkkplz=1
  1051.             GOTO 320
  1052. C
  1053. C           COMPOSANTES DUALES
  1054.   207       CONTINUE
  1055.             if (ipilo2.le.0) goto 200
  1056.             if (ir.eq.1) then
  1057.               forc0(mobl+ic) = passe1
  1058.               mkkrc0(ic+mobl)=deche
  1059.             else if (ir.ge.(mran -1)) then
  1060.               forcf(mobl+ic) = passe1
  1061.               mkkrcf(ic+mobl)=deche
  1062.             endif
  1063.             if(deche.ne.0) mkkrcz=1
  1064.             GOTO 320
  1065. C
  1066. C           COMPOSANTES GRADIENTS
  1067.   210       CONTINUE
  1068.             if (ipilo2.le.0) goto 200
  1069.             if (ir.eq.1) then
  1070.               grad0(mobl+ic) = passe1
  1071.               mkkad0(ic+mobl)=deche
  1072.             else if (ir.ge.(mran -1)) then
  1073.               gradf(mobl+ic) = passe1
  1074.               mkkadf(ic+mobl)=deche
  1075.             endif
  1076.             if(deche.ne.0) mkkadz=1
  1077.             GOTO 320
  1078. C
  1079. C           COMPOSANTES CONTRAINTES
  1080.   211       CONTINUE
  1081.             if (ipilo2.le.0) goto 200
  1082.             if (ir.eq.1) then
  1083.               SIG0(mobl+ic) = passe1
  1084.               mkkig0(ic+mobl)=deche
  1085.             else if (ir.ge.(mran -1)) then
  1086.               SIGF(mobl+ic) = passe1
  1087.               mkkigf(ic+mobl)=deche
  1088.             endif
  1089.             if(deche.ne.0) mkkigz=1
  1090.             GOTO 320
  1091. C
  1092. C           COMPOSANTES DEFORMATIONS
  1093.   212       CONTINUE
  1094.             if (ipilo2.le.0) goto 200
  1095.             if (ir.eq.1) then
  1096.               epst0(mobl+ic) = passe1
  1097.               mkkst0(ic+mobl) =deche
  1098.             else if (ir.gt.1.and.ir.le.mran) then
  1099.               epstf(mobl+ic) = passe1
  1100.               mkkstf(ic+mobl) = deche
  1101.             endif
  1102.             if(deche.ne.0) mkkstz=1
  1103.             GOTO 320
  1104. C
  1105. C           COMPOSANTES MATERIAUX
  1106.   213       CONTINUE
  1107.             if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  1108.               commat(mobl+ic) = lesfac(ic)
  1109.               tyval(mobl+ic) = 'REAL*8  '
  1110.             endif
  1111.             if (ir.gt.1) then
  1112.               ivalma(mobl+ic) = 0
  1113.               if (ipilo2.gt.0) ivalma(mobl+ic) = ABS(ieldec)
  1114.             endif
  1115.             if (ipilo2.le.0) goto 200
  1116.             if (ir.eq.1) then
  1117.               valma0(mobl+ic) = passe1
  1118.               mkkva0(ic+mobl)=deche
  1119.             elseif (ir.gt.1.and.ir.le.(mran - 1)) then
  1120.               VALMAT(mobl+ic) = passe1
  1121.               mkkvat(ic+mobl)=deche
  1122.               if (deche.eq.0) then
  1123.                 call erreur(1073)
  1124.                 return
  1125.               endif
  1126.               tyval(mobl+ic) = typdec
  1127.               xmatf(mobl+ic) = passe1
  1128.               mkkatf(ic+mobl)=deche
  1129.               if ((inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142)
  1130.      &    .and.nomdec(1:4).eq.'ALPH') then
  1131. **          if (typdec(1:8).eq.'REAL*8  '.or.typdec(1:8).eq.'POINTEUR')
  1132.             if (typree                   .or.typdec(1:8).eq.'POINTEUR')
  1133.      &      ITHHER=1
  1134.               endif
  1135.             else if (ir.eq.mran) then
  1136.               xmatf(mobl+ic) = passe1
  1137.               mkkatf(ic+mobl)=deche
  1138.             endif
  1139. C
  1140.             if (igau.eq.1.and.ib.eq.1) then
  1141.               IF (CMATE.EQ.'SECTION ') THEN
  1142.                 N2PTEL=MAX(N2PTEL,IELCHE(/1))
  1143.                 N2EL  =MAX(N2EL  ,IELCHE(/2))
  1144.               ELSE
  1145.                 N2PTEL=MAX(N2PTEL,VELCHE(/1))
  1146.                 N2EL  =MAX(N2EL  ,VELCHE(/2))
  1147.               ENDIF
  1148.             endif
  1149.             GOTO 320
  1150. C
  1151. C           COMPOSANTES CARACTERISTIQUES
  1152.   214       CONTINUE
  1153.             if (ib.eq.1.and.igau.eq.1.and.ir.eq.1) then
  1154.               comcar(mobl+ic)=lesfac(ic)
  1155.               tycar(mobl+ic)='REAL*8  '
  1156.             endif
  1157.             if (ipilo2.le.0.and.mfr.ne.9.and.mfr.ne.3) goto 200
  1158.             if (ir.eq.1) then
  1159.               xcar0(mobl+ic) = passe1
  1160.               mkkar0(ic+mobl)=deche
  1161.             else if (ir.gt.1.and.ir.le.(mran -1)) then
  1162.               XCARB(mobl+ic) = passe1
  1163.               mkkarb(ic+mobl)=deche
  1164.               xcarbf(mobl+ic) = passe1
  1165.               if (deche.eq.0) then
  1166.                 call erreur(1073)
  1167.                 return
  1168.               endif
  1169.               tycar(mobl+ic) = typdec
  1170. *
  1171. * tuyaux
  1172. *
  1173.               IF (mfr.eq.13) THEN
  1174. * composante VECT
  1175. * remplacee par VX VY VZ
  1176.           if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VX    ') then
  1177. * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR
  1178. **             write(6,*) 'comval ic+mobl ncarr',ic+mobl,ncarr
  1179.                XCARB(ic+mobl)=passe1
  1180.                mkkarb(ic+mobl)=deche
  1181. **             write(6,*) 'comval vx ic mobl ncarr',ic,mobl,ncarr
  1182.           elseif (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VY    ') then
  1183.                XCARB(ic+mobl)=passe1
  1184.                mkkarb(ic+mobl)=deche
  1185. **             write(6,*) 'comval vy ic mobl ncarr',ic,mobl,ncarr
  1186.           elseif (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VZ    ') then
  1187.                XCARB(ic+mobl)=passe1
  1188.                mkkarb(ic+mobl)=deche
  1189. **             write(6,*) 'comval vz ic mobl ncarr',ic,mobl,ncarr
  1190.           else   
  1191. ***            XCARB(ic+mobl)=0.d0
  1192.           endif
  1193.                 tycar(mobl+ic) = 'REAL*8'
  1194. C
  1195. C Poutre 3D
  1196. C
  1197.               ELSE IF(mfr.EQ.7.AND.IDIM.EQ.3)THEN
  1198. * composante VECT
  1199. * remplacee par VX VY VZ
  1200.           if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VX    ') then
  1201. **           write(6,*) 'comval en 1205'
  1202. * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR
  1203.             mkkarb(ic+mobl)=deche
  1204. **         write(6,*) 'comval VX ic+ mobl passe1',ic+mobl,passe1,deche
  1205.                XCARB(ic+mobl)=passe1
  1206.           elseif (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VY    ') then
  1207. **         write(6,*) 'comval VY ic+ mobl passe1',ic+mobl,passe1,deche
  1208.               mkkarb(ic+mobl)=deche
  1209.                XCARB(ic+mobl)=passe1
  1210.           elseif (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VZ    ') then
  1211. **         write(6,*) 'comval VZ ic+ mobl passe1',ic+mobl,passe1,deche
  1212.               mkkarb(ic+mobl)=deche
  1213.                XCARB(ic+mobl)=passe1
  1214.           else   
  1215. **             XCARB(ic+mobl)=0.d0
  1216.           endif
  1217.                 tycar(mobl+ic) = 'REAL*8'
  1218. C
  1219. C Poutre 2D
  1220. C
  1221.               ELSEIF(IDIM.EQ.2) THEN
  1222.                 if (ipilo2.le.0.and.mobl+ic.eq.2) then
  1223.                   IF(mfr.EQ.3.OR.mfr.EQ.9) THEN
  1224.                     XCARB(mobl+IC)=0.66666666666666D0
  1225.                   ENDIF
  1226.                 endif
  1227.               ELSE
  1228. *    cas des coques minces : défaut de alfah
  1229.                 IF (ipilo2.le.0.and.mobl+IC.EQ.2.AND.
  1230.      &                        (mfr.EQ.3.OR.mfr.EQ.9)) THEN
  1231.                   XCARB(mobl+IC)=0.666666666666666D0
  1232.                 ENDIF
  1233.               ENDIF
  1234.             else if (ir.ge.mran) then
  1235.               xcarbf(mobl+ic) = passe1
  1236.               mkkrbf(ic+mobl)=deche
  1237.             endif
  1238.             if(deche.ne.0) mkkarz=1
  1239.             GOTO 320
  1240. C
  1241. C           COMPOSANTES TEMPERATURES
  1242.   215       CONTINUE
  1243.             if (ipilo2.le.0) goto 200
  1244.             if (ir.eq.1) then
  1245.               ture0(mobl+ic) = passe1
  1246.               mkkre0(ic+mobl)=deche
  1247.             else if (ir.ge.(mran -1)) then
  1248.               turef(mobl+ic) = passe1
  1249.               mkkref(ic+mobl)=deche
  1250.             endif
  1251.             if(deche.ne.0) mkkrez=1
  1252.             GOTO 320
  1253. C
  1254. C           COMPOSANTES CONTRAINTES PRINCIPALES
  1255.   216       CONTINUE
  1256.             if (ipilo2.le.0) goto 200
  1257.             if (ir.eq.1) then
  1258.               prin0(mobl+ic) = passe1
  1259.               mkkin0(ic+mobl)=deche
  1260.             else if (ir.ge.(mran -1)) then
  1261.               prinf(mobl+ic) = passe1
  1262.               mkkinf(ic+mobl)=deche
  1263.             endif
  1264.             if(deche.ne.0) mkkinz=1
  1265.             GOTO 320
  1266. C
  1267. C           COMPOSANTE MAHO
  1268.   217       CONTINUE
  1269.             if (ipilo2.le.0) goto 200
  1270.             if (ir.eq.1) then
  1271.               maho0(mobl+ic) = passe1
  1272.               mkkho0(ic+mobl)=deche
  1273.             else if (ir.ge.(mran -1)) then
  1274.               mahof(mobl+ic) = passe1
  1275.               mkkhof(ic+mobl)=deche
  1276.             endif
  1277.             if(deche.ne.0) mkkhoz=1
  1278.             GOTO 320
  1279. C
  1280. C           COMPOSANTE MAHT
  1281.   218       CONTINUE
  1282.             if (ipilo2.le.0) goto 200
  1283.             if (ir.eq.1) then
  1284.               hota0(mobl+ic) = passe1
  1285.               mkkta0(ic+mobl)=deche
  1286.             else if (ir.ge.(mran -1)) then
  1287.               hotaf(mobl+ic) = passe1
  1288.               mkktaf(ic+mobl)=deche
  1289.             endif
  1290.             if(deche.ne.0) mkktaz=1
  1291.             GOTO 320
  1292. C
  1293. C           COMPOSANTES VARIABLES INTERNES
  1294.   220       CONTINUE
  1295.             if (ipilo2.le.0) goto 200
  1296.             if (ir.eq.1) then
  1297.               VAR0(mobl+ic) = passe1
  1298.               mkkvr0(ic+mobl)=deche
  1299.             else if (ir.ge.(mran -1)) then
  1300.               VARF(mobl+ic) = passe1
  1301.               mkkvrf(ic+mobl)=deche
  1302.             endif
  1303.             if(deche.ne.0) mkkvrz=1
  1304.             GOTO 320
  1305. C
  1306. C           COMPOSANTES GRADIENTS FLEXION
  1307.   221       CONTINUE
  1308.             if (ipilo2.le.0) goto 200
  1309.             if (ir.eq.1) then
  1310.               graf0(mobl+ic) = passe1
  1311.               mkkaf0(ic+mobl)=deche
  1312.             else if (ir.ge.(mran -1)) then
  1313.               graff(mobl+ic) = passe1
  1314.               mkkaff(ic+mobl)=deche
  1315.             endif
  1316.             if(deche.ne.0) mkkafz=1
  1317.             GOTO 320
  1318. C
  1319. C           COMPOSANTES VARIABLES MICROSTRUCTURES
  1320.   223       CONTINUE
  1321.             if (ipilo2.le.0) goto 200
  1322.             if (ir.eq.1) then
  1323.               rhas0(mobl+ic) = passe1
  1324.               mkkas0(ic+mobl)=deche
  1325.             else if (ir.ge.(mran -1)) then
  1326.               rhasf(mobl+ic) = passe1
  1327.               mkkasf(ic+mobl)=deche
  1328.             endif
  1329.             if(deche.ne.0) mkkasz=1
  1330.             GOTO 320
  1331. C
  1332. C           COMPOSANTES DEFORMATIONS INELASTIQUES
  1333.   224       CONTINUE
  1334.             if (ipilo2.le.0) goto 200
  1335.             if (ir.eq.1) then
  1336.               EPIN0(mobl+ic) = passe1
  1337.               mkkpn0(ic+mobl)=deche
  1338.             else if (ir.ge.(mran -1)) then
  1339.              EPINF(mobl+ic) = passe1
  1340.              mkkpnf(ic+mobl)=deche
  1341.             endif
  1342.             if(deche.ne.0) mkkpnz=1
  1343.             GOTO 320
  1344. C
  1345.   298       CONTINUE
  1346.             if (ipilo2.le.0) goto 200
  1347.             exova0(mobl + ic) = passe1
  1348.             mkkvx0(ic+mobl)=deche
  1349.             if(deche.ne.0) mkkvxz=1
  1350.             GOTO 320
  1351. C
  1352.   320       CONTINUE
  1353.  200      CONTINUE
  1354. C
  1355.  301      CONTINUE
  1356. C
  1357.  3000   CONTINUE
  1358.  1000 CONTINUE
  1359. C     ------------------------------------------------------------
  1360. C
  1361.       IF (IGAU.EQ.1.AND.IB.EQ.1) THEN
  1362.         IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN
  1363.           N2PTEL=1
  1364.         ELSE
  1365.           N2PTEL=NBG
  1366.         ENDIF
  1367.       ENDIF
  1368. C
  1369. C     Increment de deformations
  1370.       DO IG = 1, DEPST(/1)
  1371.         DEPST(ig)= epstf(ig) - epst0(ig)
  1372.       ENDDO
  1373. C
  1374.       nucar = xcarb(/1)
  1375.       IF((mfr.EQ.7.OR.mfr.EQ.13.OR.mfr.EQ.15.OR.mfr.EQ.17)
  1376.      &                .AND.  CMATE.NE.'SECTION ') THEN
  1377. *
  1378.         IF (mfr.EQ.15) THEN
  1379.           NUCAR=NUCAR/2
  1380.           IE=1
  1381.           pilnec = liluc(14,2)
  1382. c         segact pilnec*nomod
  1383.           mobl = pilobl(/1)
  1384.           mfac = pilfac(/1)
  1385.           DO 1007 IC=1,3,2
  1386.              DO 1107 ICOMP=1,min(NUCAR,mobl)
  1387.               deche = pilobl(icomp,2)
  1388.               if (deche.gt.0) then
  1389. c              segact deche
  1390.                melval = ABS(ieldec)
  1391. c               segact melval
  1392.                IAUX=MELVAL
  1393.                IF (IAUX.NE.0) THEN
  1394.                  IGMN=MIN(IC,VELCHE(/1))
  1395.                  IBMN=MIN(IB,VELCHE(/2))
  1396.                  VALCAR(IE)=VELCHE(IGMN,IBMN)
  1397.                ELSE
  1398.                  VALCAR(IE)=0.D0
  1399.                ENDIF
  1400.               else
  1401.                VALCAR(IE)=0.D0
  1402.               endif
  1403.               IE=IE+1
  1404.  1107        CONTINUE
  1405.  1007     CONTINUE
  1406.           DO 1009 IC=1,3,2
  1407.              DO 1109 ICOMP=1,mfac
  1408.               deche = pilfac(icomp,2)
  1409.               if (deche.gt.0) then
  1410. c               segact deche
  1411.                melval = ABS(ieldec)
  1412. c               segact melval
  1413.                IAUX=MELVAL
  1414.                IF (IAUX.NE.0) THEN
  1415.                  IGMN=MIN(IC,VELCHE(/1))
  1416.                  IBMN=MIN(IB,VELCHE(/2))
  1417.                  VALCAR(IE)=VELCHE(IGMN,IBMN)
  1418.                ELSE
  1419.                  VALCAR(IE)=0.D0
  1420.                ENDIF
  1421.               else
  1422.                VALCAR(IE)=0.D0
  1423.               endif
  1424.               IE=IE+1
  1425.  1109       CONTINUE
  1426.  1009     CONTINUE
  1427. *
  1428.         ELSE if (inplas.ne.73) then
  1429. * pour la loi de cisaillement 73, valcar ne sert a rien
  1430.           pilnec = liluc(14,2)
  1431. c         segact pilnec*nomod
  1432.           mobl = pilobl(/1)
  1433.           mfac = pilfac(/1)
  1434.           DO 1010 ICOMP=1,pilobl(/1)
  1435.              VALCAR(ICOMP)=0.D0
  1436.              deche = pilobl(icomp,2)
  1437.               if (deche.gt.0) then
  1438. c              segact deche
  1439.               melval = ABS(ieldec)
  1440. c              segact melval
  1441.               IAUX=MELVAL
  1442.              DO 1008 IAUX1=1,NBPTEL
  1443.                IF (IAUX.NE.0) THEN
  1444.                  IBMN=MIN(IB  ,VELCHE(/2))
  1445.                  IGMN=MIN(IAUX1,VELCHE(/1))
  1446.                  VALCAR(ICOMP)=VALCAR(ICOMP)+VELCHE(IGMN,IBMN)
  1447.                ENDIF
  1448.                IF(IAUX1.EQ.NBPTEL) VALCAR(ICOMP)=VALCAR(ICOMP)/NBPTEL
  1449.  1008        CONTINUE
  1450.              endif
  1451.  1010     CONTINUE
  1452.           DO 1012 ICOMP=1,pilfac(/1)
  1453.              VALCAR(mobl+ICOMP)=0.D0
  1454.              deche = pilfac(icomp,2)
  1455.               if (deche.gt.0) then
  1456. c              segact deche
  1457.               melval = ABS(ieldec)
  1458. c              segact melval
  1459.               IAUX=MELVAL
  1460.              DO 1011 IAUX1=1,NBPTEL
  1461.                IF (IAUX.NE.0) THEN
  1462.                  IF (ielche(/2).ne.0)  THEN
  1463.                    IBMN=MIN(IB  ,IELCHE(/2))
  1464.                    IGMN=MIN(IAUX1,IELCHE(/1))
  1465.          VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+IELCHE(IGMN,IBMN)
  1466.                  ELSE
  1467.                    IBMN=MIN(IB  ,VELCHE(/2))
  1468.                    IGMN=MIN(IAUX1,VELCHE(/1))
  1469.          VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+VELCHE(IGMN,IBMN)
  1470.                  ENDIF
  1471.                ENDIF
  1472.         IF(IAUX1.EQ.NBPTEL) VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)/NBPTEL
  1473.  1011        CONTINUE
  1474.              endif
  1475.  1012     CONTINUE
  1476.         ENDIF
  1477.  
  1478.       else
  1479.         if (nucar.gt.0) then
  1480.           do ip = 1,nucar
  1481.             valcar(ip) = xcarb(ip)
  1482.           enddo
  1483.         endif
  1484.       ENDIF
  1485. *
  1486. *  prise en compte de l'epaisseur et de l'excentrement
  1487. *  dans le cas des coques minces avec ou sans cisaillement
  1488. *  transverse
  1489. *
  1490.       IF (mfr.EQ.3.OR.mfr.EQ.9) THEN
  1491.         IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR.
  1492.      1      CMATE.EQ.'UNIDIREC') THEN
  1493.           pilnec = liluc(14,2)
  1494. *         segact pilnec
  1495.           deche = pilobl(1,2)
  1496. c         segact deche
  1498.           if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2)
  1499.           melval = ABS(ieldec)
  1500. c         segact melval
  1501.           IAUX=MELVAL
  1502.           IF (IAUX.NE.0) THEN
  1503.             IBMN=MIN(IB  ,VELCHE(/2))
  1504.             IGMN=MIN(IGAU,VELCHE(/1))
  1505.             EPAIST=VELCHE(IGMN,IBMN)
  1506.           ELSE
  1507.             EPAIST=0.D0
  1508.           ENDIF
  1509.         ENDIF
  1510.       ENDIF
  1511. **
  1512. * on traite le materiau dependant de la temperature pour lemaitre endommageable
  1513.       if (inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142) then
  1514.         do ic = 1,tyval(/2)
  1515.          if (tyval(ic)(9:16).EQ.'EVOLUTIO') then
  1516.            MEVOLL=nint(valmat(ic))
  1517.            IF(MEVOLL.EQ.0) THEN
  1518.            KERRE=37
  1519.            RETURN
  1520.            ENDIF
  1521. C           SEGACT MEVOLL
  1522.            KEVOLL=IEVOLL(1)
  1523. C           SEGACT KEVOLL
  1524.            if (nomevx(1:4).eq.'T   ') ITHHER = 2
  1525. *  on ne desactive pas les segments pour reduire la contention sur esope en //
  1526. ***        segdes kevoll,mevoll
  1527.            if (ithher.eq.2) goto 4010
  1528.          endif
  1529.          if (tyval(ic)(9:16).EQ.'NUAGE   ') then
  1530.             MNUAGE=nint(valmat(ic))
  1531. C            SEGACT MNUAGE
  1532.             IF(MNUAGE.EQ.0) THEN
  1533.               MOTERR(1:8)='NUAGE   '
  1534.               CALL ERREUR(37)
  1535.               KERRE=37
  1536.               RETURN
  1537.            ENDIF
  1538.            NVAR=NUANOM(/2)
  1539.            IF(NVAR.LE.1) THEN
  1540. *  on ne desactive pas les segments pour reduire la contention sur esope en //
  1541. ***          SEGDES MNUAGE
  1542.              INTERR(1)=MNUAGE
  1543.              INTERR(2)=2
  1544.              INTERR(3)=2
  1545.              CALL ERREUR(628)
  1546.              KERRE=628
  1547.              RETURN
  1548.            ENDIF
  1549.            if (nuanom(1).eq.'T       ')  ITHHER = 2
  1550. *  on ne desactive pas les segments pour reduire la contention sur esope en //
  1551. ***        segdes mnuage
  1552.            if (ithher.eq.2) goto 4010
  1553.          endif
  1554.         enddo
  1555.  4010  continue
  1556.       endif
  1557. C
  1558.       RETURN
  1559.       END
  1560.  
  1561.  
  1562.  
  1563.  
  1564.  

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