Télécharger la plaquette Cast3M


fr en

Télécharger cprefib.eso

Retour à la liste

Numérotation des lignes : 

cprefib

  1. C CPREFIB   SOURCE    CB215821  25/06/19    21:15:01     12288          
  2.        SUBROUTINE CPREFIB(IPMODL,MLMOTS,ISUP,ICARA)
  3. *----------------------------------------------------------------------------------------------
  4. *           preconditionnement caracteristiques materiau pour modele de fibres
  5. *                                                    dans FLDO3D
  6. *----------------------------------------------------------------------------------------------
  7. *
  8. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  9. * -----------
  10. *
  11. *     IPMODL  (E)   POINTEUR D'OBJET MODELE
  12. *     MLMOTS  (E)   POINTEUR SUR LE LISTMOTS DE CARACTERISTIQUES
  13. *     ISUP    (E)   NUMERO DE SUPPORT DEMANDE
  14. *     ICARA  (E+S)  POINTEUR SUR LE CHAMELEM
  15. *
  16. * LANGAGE:
  17. * --------
  18. *
  19. *     ESOPE + FORTRAN77
  20. *
  21. *-----------------------------------------------------------------------
  22. *
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26.       REAL*8 COEFFK1(10),COEFFK2(10),COEFFWP1(10),COEFFWP2(10)
  27.       REAL*8 COEFFFP(10),COEFFWF(10),COEFFW03(10),MAXFP,MINFP
  28.       REAL*8 MAXWP1,MINWP1,MAXWP2,MINWP2,MAXWF,MINWF,MAXW03,MINW03
  29.       REAL*8 MAXK02,MINK02,MAXK01,MINK01
  30.  
  31.  
  32.       PARAMETER (XUnDemi=0.5,XUn=1.)
  33.  
  34.         parameter (niter=20,nligne=10000)
  35.       parameter (nangl=7,nlongfi=60,nrt=8)
  36.       parameter (phit=80.d0,phicrit=50.d0)
  37.       parameter (nangredu=int(phicrit*nangl/phit+1))
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC CCHAMP
  42. -INC SMCHAML
  43. -INC SMMODEL
  44. -INC SMCOORD
  45. -INC SMLMOTS
  46. -INC SMLREEL
  47. *
  48. *      SEGMENT INFO
  49. *       INTEGER INFELE(JG)
  50. *      ENDSEGMENT
  51.  
  52.        SEGMENT MWOR
  53.            real*8 fel(mligne),ld1(mligne,miter),ld2(mligne,miter)
  54.            real*8 sp1(mligne),fcrit1(mligne,miter),fcrit2(mligne,miter)
  55.            real*8 L1(mligne,miter),L2(mligne,miter),dls1(mligne,miter)
  56.            real*8 dls2(mligne,miter),ls1(mligne,miter),ls2(mligne,miter)
  57.            real*8 F(mligne,miter),w1(mligne,miter),w2(mligne,miter)
  58.            real*8 Fd1(mligne,miter),sd1(mligne,miter),lsf1(mligne)
  59.            real*8 sel1(mligne,miter),sdf1(mligne)
  60.            real*8 Fo(mligne,miter),ldf2(mligne),Ffo(mligne)
  61.            real*8 lsf2(mligne),Lf2(mligne),sdf2(mligne),Fco(mligne)
  62.            real*8 sd2(mligne,miter),sel2(mligne,miter)
  63.            real*8 Dwf(mligne),Ff(mligne),Lf1(mligne),ldf1(mligne)
  64.            real*8 ffo2(mligne,mangl1,mlongfi)
  65.            real*8 Ffo1(mligne,mangl1,mlongfi)
  66.            real*8 FmoyL(mligne,mangl1),wf1(mligne,mangl1,mlongfi)
  67.            real*8 Fmoylis(mligne),wlist(mligne)
  68. *
  69.           real*8 lisRt(mrtang1),lisphid(mrtang1)
  70.           real*8 lisfp(mrtang1),lisk0m(mrtang1)
  71.           real*8 liswf(mrtang1)
  72.           real*8 lisw03(mrtang1)
  73. *
  74.           real*8 lisrt1(mangnrt),lisphid1(mangnrt)
  75.           real*8 lisrt2(mangnan)
  76.           real*8 lisphid2(mangnan)
  77.           real*8 liswp1(mangnrt),liswp2(mangnan)
  78.           real*8 lisk01(mangnrt),lisk02(mangnan)
  79.        ENDSEGMENT
  80. *
  81.       CHARACTER*(NCONCH)  CONM
  82. *
  83.       SEGACT,MLMOTS
  84. *
  85. *      La composante 'K1'  existe t-elle deja? Si oui, on considere que le preconditionnement
  86. *      a deja ete fait et on s'en va.
  87. *      A adapter pour le modele de fibres
  88. *
  89.       DO 1 I=1,MOTS(/2)
  90.       IF(MOTS(I).EQ.'K11') RETURN
  91.    1  CONTINUE
  92. *
  93. *     ACTIVATIONS
  94. *
  95.       MMODEL=IPMODL
  96.       NSOUS=KMODEL(/1)
  97.       MCHELM=ICARA
  98.       SEGACT MCHELM
  99.  
  100.  
  101. *
  102. *     BOUCLE SUR LES SOUS ZONES DU MODELE
  103. *
  104.       DO 200 ISOUS=1,NSOUS
  105.  
  106. *
  107. *     TRAITEMENT DU MODELE
  108. *
  109.       IMODEL=KMODEL(ISOUS)
  110.       MELE  =NEFMOD
  111.       IPMAIL=IMAMOD
  112.       CONM  =CONMOD
  113. *
  114. *
  115. *     INFORMATIONS SUR L'{L{MENT FINI
  116. *
  117. *      CALL ELQUOI(MELE,0,ISUP,INFO,IMODEL)
  118.       IF (IERR.NE.0) RETURN
  119.       MFR =INFELE(13)
  120.       LHOOK=INFELE(10)
  121.       IF(MFR.NE.1) THEN
  122. *         SEGSUP INFO
  123.          GO TO 200
  124.       ENDIF
  125. *
  126. *     RECHERCHE DE LA ZONE DU CHAMELEM
  127. *
  128.       N1  = IMACHE(/1)
  129.       N3  = INFCHE(/2)
  130.       LAZON = 0
  131.       DO 11 I=1,N1
  132.          IF (IPMAIL.NE.IMACHE(I) .OR.
  133.      .         CONM.NE.CONCHE(I)) GO TO 11
  134.             LAZON=I
  135.             GO TO 12
  136.  11   CONTINUE
  137. *
  138.       CALL ERREUR(472)
  139. *      SEGSUP INFO
  140.       RETURN
  141. *
  142.  12   CONTINUE
  143.       MCHAML=ICHAML(LAZON)
  144.       SEGACT MCHAML
  145.       N2=NOMCHE(/2)
  146.       NPAR=84
  147. *      print *, 'N2=',N2
  148.  
  149. *  on cherche les indices des parametres materiau necessaires aux calculs du preconditionnement
  150. *    par exemple le diametre des fibres et la longueur des fibres
  151.       IVDIFI=0
  152.       IVLOFI=0
  153.       IVHFI=0
  154.       IVTMAX=0
  155.       IVTD=0
  156.       IVSK=0
  157.       IVFABO=0
  158.       IVALEC=0
  159.       IVMECR=0
  160.       IVLCAN=0
  161.       IVMUF=0
  162.       IVYOFI=0
  163.       IVLECH=0
  164.       IVMW=0
  165.       IVFU=0
  166.       IVRTEC=0
  167.       IVFYF=0
  168. c
  169.       JVDIFI=0
  170.       JVLOFI=0
  171.       JVHFI=0
  172.       JVTMAX=0
  173.       JVTD=0
  174.       JVSK=0
  175.       JVFABO=0
  176.       JVALEC=0
  177.       JVMECR=0
  178.       JVLCAN=0
  179.       JVMUF=0
  180.       JVYOFI=0
  181.       JVLECH=0
  182.       JVMW=0
  183.       JVFU=0
  184.       JVRTEC=0
  185.       JVFYF=0
  186.  
  187.       do i=1,n2
  188.         if(NOMCHE(i).EQ.'DIFI') then
  189.         IVDIFI=i
  190.         JVDIFI=1
  191.         endif
  192.         if(NOMCHE(i).EQ.'LOFI') then
  193.         IVLOFI=i
  194.         JVLOFI=1
  195.         endif
  196.         if(NOMCHE(i).EQ.'HFI') then
  197.         IVHFI=i
  198.         JVHFI=1
  199.         endif
  200.         if(NOMCHE(i).EQ.'TMAX') then
  201.         IVTMAX=i
  202.         JVTMAX=1
  203.         endif
  204.         if(NOMCHE(i).EQ.'TD') then
  205.         IVTD=i
  206.         JVTD=1
  207.         endif
  208.         if(NOMCHE(i).EQ.'SK') then
  209.         IVSK=i
  210.         JVSK=1
  211.         endif
  212.         if(NOMCHE(i).EQ.'FABO') then
  213.         IVFABO=i
  214.         JVFABO=1
  215.         endif
  216.         if(NOMCHE(i).EQ.'ALEC') then
  217.         IVALEC=i
  218.         JVALEC=1
  219.         endif
  220.         if(NOMCHE(i).EQ.'MECR') then
  221.         IVMECR=i
  222.         JVMECR=1
  223.         endif
  224.         if(NOMCHE(i).EQ.'LCAN') then
  225.         IVLCAN=i
  226.         JVLCAN=1
  227.         endif
  228.         if(NOMCHE(i).EQ.'MUF') then
  229.         IVMUF=i
  230.         JVMUF=1
  231.         endif
  232.         if(NOMCHE(i).EQ.'YOFI') then
  233.         IVYOFI=i
  234.         JVYOFI=1
  235.         endif
  236.         if(NOMCHE(i).EQ.'LECH') then
  237.         IVLECH=i
  238.         JVLECH=1
  239.         endif
  240.         if(NOMCHE(i).EQ.'MW') then
  241.         IVMW=i
  242.         JVMW=1
  243.         endif
  244.         if(NOMCHE(i).EQ.'FU') then
  245.         IVFU=i
  246.         JVFU=1
  247.         endif
  248.         if(NOMCHE(i).EQ.'RTEC') then
  249.         IVRTEC=i
  250.         JVRTEC=1
  251.         endif
  252.         if(NOMCHE(i).EQ.'FYF')  then
  253.         IVFYF=i
  254.         JVFYF=1
  255.         endif
  256.       enddo
  257.  
  258. *  on teste si il faut continuer ou sortir de cprefib
  259.  
  260.             isomm = JVDIFI+JVLOFI+JVHFI+JVTMAX+JVTD+JVSK+JVFABO
  261.      &    +JVALEC+JVMECR+JVLCAN+JVMUF+JVYOFI+JVLECH+JVMW
  262.      &    +JVFU+JVRTEC+JVFYF
  263.  
  264.             if(isomm.eq.0) then
  265.                RETURN
  266.              else if (isomm.ne.17) then
  267.                call erreur(5)
  268.                RETURN
  269.             endif
  270.  
  271.  
  272. *
  273. *  on va ajouter les composantes associees aux parametres des surfaces ( 3 pour l'exemple : K1, K2, K3)
  274. *  a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  275. *  calcules par preconditionnement
  276. *
  277.       N2A = N2
  278.       N2=N2A+NPAR
  279.       SEGADJ MCHAML
  280. * on ajuste la taille du segment
  281. * rigidite initiale 1
  282.       NOMCHE(N2A+1)='K11'
  283.       TYPCHE(N2A+1)='REAL*8'
  284.       NOMCHE(N2A+2)='K12'
  285.       TYPCHE(N2A+2)='REAL*8'
  286.       NOMCHE(N2A+3)='K13'
  287.       TYPCHE(N2A+3)='REAL*8'
  288.       NOMCHE(N2A+4)='K14'
  289.       TYPCHE(N2A+4)='REAL*8'
  290.       NOMCHE(N2A+5)='K15'
  291.       TYPCHE(N2A+5)='REAL*8'
  292.       NOMCHE(N2A+6)='K16'
  293.       TYPCHE(N2A+6)='REAL*8'
  294.       NOMCHE(N2A+7)='K17'
  295.       TYPCHE(N2A+7)='REAL*8'
  296.       NOMCHE(N2A+8)='K18'
  297.       TYPCHE(N2A+8)='REAL*8'
  298.       NOMCHE(N2A+9)='K19'
  299.       TYPCHE(N2A+9)='REAL*8'
  300.       NOMCHE(N2A+10)='K110'
  301.       TYPCHE(N2A+10)='REAL*8'
  302. * rigidite initiale 2
  303.       NOMCHE(N2A+11)='K21'
  304.       TYPCHE(N2A+11)='REAL*8'
  305.       NOMCHE(N2A+12)='K22'
  306.       TYPCHE(N2A+12)='REAL*8'
  307.       NOMCHE(N2A+13)='K23'
  308.       TYPCHE(N2A+13)='REAL*8'
  309.       NOMCHE(N2A+14)='K24'
  310.       TYPCHE(N2A+14)='REAL*8'
  311.       NOMCHE(N2A+15)='K25'
  312.       TYPCHE(N2A+15)='REAL*8'
  313.       NOMCHE(N2A+16)='K26'
  314.       TYPCHE(N2A+16)='REAL*8'
  315.       NOMCHE(N2A+17)='K27'
  316.       TYPCHE(N2A+17)='REAL*8'
  317.       NOMCHE(N2A+18)='K28'
  318.       TYPCHE(N2A+18)='REAL*8'
  319.       NOMCHE(N2A+19)='K29'
  320.       TYPCHE(N2A+19)='REAL*8'
  321.       NOMCHE(N2A+20)='K210'
  322.       TYPCHE(N2A+20)='REAL*8'
  323. * ouverture au pic 1
  324.       NOMCHE(N2A+21)='W11'
  325.       TYPCHE(N2A+21)='REAL*8'
  326.       NOMCHE(N2A+22)='W12'
  327.       TYPCHE(N2A+22)='REAL*8'
  328.       NOMCHE(N2A+23)='W13'
  329.       TYPCHE(N2A+23)='REAL*8'
  330.       NOMCHE(N2A+24)='W14'
  331.       TYPCHE(N2A+24)='REAL*8'
  332.       NOMCHE(N2A+25)='W15'
  333.       TYPCHE(N2A+25)='REAL*8'
  334.       NOMCHE(N2A+26)='W16'
  335.       TYPCHE(N2A+26)='REAL*8'
  336.       NOMCHE(N2A+27)='W17'
  337.       TYPCHE(N2A+27)='REAL*8'
  338.       NOMCHE(N2A+28)='W18'
  339.       TYPCHE(N2A+28)='REAL*8'
  340.       NOMCHE(N2A+29)='W19'
  341.       TYPCHE(N2A+29)='REAL*8'
  342.       NOMCHE(N2A+30)='W110'
  343.       TYPCHE(N2A+30)='REAL*8'
  344. * ouverture au pic 2
  345.       NOMCHE(N2A+31)='W21'
  346.       TYPCHE(N2A+31)='REAL*8'
  347.       NOMCHE(N2A+32)='W22'
  348.       TYPCHE(N2A+32)='REAL*8'
  349.       NOMCHE(N2A+33)='W23'
  350.       TYPCHE(N2A+33)='REAL*8'
  351.       NOMCHE(N2A+34)='W24'
  352.       TYPCHE(N2A+34)='REAL*8'
  353.       NOMCHE(N2A+35)='W25'
  354.       TYPCHE(N2A+35)='REAL*8'
  355.       NOMCHE(N2A+36)='W26'
  356.       TYPCHE(N2A+36)='REAL*8'
  357.       NOMCHE(N2A+37)='W27'
  358.       TYPCHE(N2A+37)='REAL*8'
  359.       NOMCHE(N2A+38)='W28'
  360.       TYPCHE(N2A+38)='REAL*8'
  361.       NOMCHE(N2A+39)='W29'
  362.       TYPCHE(N2A+39)='REAL*8'
  363.       NOMCHE(N2A+40)='W210'
  364.       TYPCHE(N2A+40)='REAL*8'
  365. * Force au pic
  366.       NOMCHE(N2A+41)='FP1'
  367.       TYPCHE(N2A+41)='REAL*8'
  368.       NOMCHE(N2A+42)='FP2'
  369.       TYPCHE(N2A+42)='REAL*8'
  370.       NOMCHE(N2A+43)='FP3'
  371.       TYPCHE(N2A+43)='REAL*8'
  372.       NOMCHE(N2A+44)='FP4'
  373.       TYPCHE(N2A+44)='REAL*8'
  374.       NOMCHE(N2A+45)='FP5'
  375.       TYPCHE(N2A+45)='REAL*8'
  376.       NOMCHE(N2A+46)='FP6'
  377.       TYPCHE(N2A+46)='REAL*8'
  378.       NOMCHE(N2A+47)='FP7'
  379.       TYPCHE(N2A+47)='REAL*8'
  380.       NOMCHE(N2A+48)='FP8'
  381.       TYPCHE(N2A+48)='REAL*8'
  382.       NOMCHE(N2A+49)='FP9'
  383.       TYPCHE(N2A+49)='REAL*8'
  384.       NOMCHE(N2A+50)='FP10'
  385.       TYPCHE(N2A+50)='REAL*8'
  386. * ouverture intermediaire a 0.3fp
  387.       NOMCHE(N2A+51)='W31'
  388.       TYPCHE(N2A+51)='REAL*8'
  389.       NOMCHE(N2A+52)='W32'
  390.       TYPCHE(N2A+52)='REAL*8'
  391.       NOMCHE(N2A+53)='W33'
  392.       TYPCHE(N2A+53)='REAL*8'
  393.       NOMCHE(N2A+54)='W34'
  394.       TYPCHE(N2A+54)='REAL*8'
  395.       NOMCHE(N2A+55)='W35'
  396.       TYPCHE(N2A+55)='REAL*8'
  397.       NOMCHE(N2A+56)='W36'
  398.       TYPCHE(N2A+56)='REAL*8'
  399.       NOMCHE(N2A+57)='W37'
  400.       TYPCHE(N2A+57)='REAL*8'
  401.       NOMCHE(N2A+58)='W38'
  402.       TYPCHE(N2A+58)='REAL*8'
  403.       NOMCHE(N2A+59)='W39'
  404.       TYPCHE(N2A+59)='REAL*8'
  405.       NOMCHE(N2A+60)='W310'
  406.       TYPCHE(N2A+60)='REAL*8'
  407. * ouverture finale f=0
  408.       NOMCHE(N2A+61)='WF1'
  409.       TYPCHE(N2A+61)='REAL*8'
  410.       NOMCHE(N2A+62)='WF2'
  411.       TYPCHE(N2A+62)='REAL*8'
  412.       NOMCHE(N2A+63)='WF3'
  413.       TYPCHE(N2A+63)='REAL*8'
  414.       NOMCHE(N2A+64)='WF4'
  415.       TYPCHE(N2A+64)='REAL*8'
  416.       NOMCHE(N2A+65)='WF5'
  417.       TYPCHE(N2A+65)='REAL*8'
  418.       NOMCHE(N2A+66)='WF6'
  419.       TYPCHE(N2A+66)='REAL*8'
  420.       NOMCHE(N2A+67)='WF7'
  421.       TYPCHE(N2A+67)='REAL*8'
  422.       NOMCHE(N2A+68)='WF8'
  423.       TYPCHE(N2A+68)='REAL*8'
  424.       NOMCHE(N2A+69)='WF9'
  425.       TYPCHE(N2A+69)='REAL*8'
  426.       NOMCHE(N2A+70)='WF10'
  427.       TYPCHE(N2A+70)='REAL*8'
  428. * min et max des listes calculees
  429.       NOMCHE(N2A+71)='K1MI'
  430.       TYPCHE(N2A+71)='REAL*8'
  431.       NOMCHE(N2A+72)='K1MA'
  432.       TYPCHE(N2A+72)='REAL*8'
  433.       NOMCHE(N2A+73)='K2MI'
  434.       TYPCHE(N2A+73)='REAL*8'
  435.       NOMCHE(N2A+74)='K2MA'
  436.       TYPCHE(N2A+74)='REAL*8'
  437.       NOMCHE(N2A+75)='W1MI'
  438.       TYPCHE(N2A+75)='REAL*8'
  439.       NOMCHE(N2A+76)='W1MA'
  440.       TYPCHE(N2A+76)='REAL*8'
  441.       NOMCHE(N2A+77)='W2MI'
  442.       TYPCHE(N2A+77)='REAL*8'
  443.       NOMCHE(N2A+78)='W2MA'
  444.       TYPCHE(N2A+78)='REAL*8'
  445.       NOMCHE(N2A+79)='FPMI'
  446.       TYPCHE(N2A+79)='REAL*8'
  447.       NOMCHE(N2A+80)='FPMA'
  448.       TYPCHE(N2A+80)='REAL*8'
  449.       NOMCHE(N2A+81)='W3MI'
  450.       TYPCHE(N2A+81)='REAL*8'
  451.       NOMCHE(N2A+82)='W3MA'
  452.       TYPCHE(N2A+82)='REAL*8'
  453.       NOMCHE(N2A+83)='WFMI'
  454.       TYPCHE(N2A+83)='REAL*8'
  455.       NOMCHE(N2A+84)='WFMA'
  456.       TYPCHE(N2A+84)='REAL*8'
  457.  
  458.  
  459.  
  460. *      MELEME=IPMAIL
  461. *      SEGACT MELEME
  462. *      NBNN=NUM(/1)
  463. *
  464. *  CREATION DES MELVALs ET REMPLISSAGE
  465. *
  466. *  on gere d'abord la taille necessaire, en fonction de la taille des autres parametres materiau
  467.  
  468.       N1EL=0
  469.       N1PTEL=0
  470.       MELVAL=IELVAL(IVDIFI)
  471.       NGDIFI=VELCHE(/1)
  472.       NBDIFI=VELCHE(/2)
  473.  
  474.       MELVAL=IELVAL(IVLOFI)
  475.       NGLOFI=VELCHE(/1)
  476.       NBLOFI=VELCHE(/2)
  477.  
  478.       MELVAL=IELVAL(IVHFI)
  479.       NGHFI=VELCHE(/1)
  480.       NBHFI=VELCHE(/2)
  481.  
  482.       MELVAL=IELVAL(IVTMAX)
  483.       NGTMAX=VELCHE(/1)
  484.       NBTMAX=VELCHE(/2)
  485.  
  486.       MELVAL=IELVAL(IVTD)
  487.       NGTD=VELCHE(/1)
  488.       NBTD=VELCHE(/2)
  489.  
  490.       MELVAL=IELVAL(IVSK)
  491.       NGSK=VELCHE(/1)
  492.       NBSK=VELCHE(/2)
  493.  
  494.       MELVAL=IELVAL(IVFABO)
  495.       NGFABO=VELCHE(/1)
  496.       NBFABO=VELCHE(/2)
  497.  
  498.       MELVAL=IELVAL(IVALEC)
  499.       NGALEC=VELCHE(/1)
  500.       NBALEC=VELCHE(/2)
  501.  
  502.       MELVAL=IELVAL(IVMECR)
  503.       NGMECR=VELCHE(/1)
  504.       NBMECR=VELCHE(/2)
  505.  
  506.       MELVAL=IELVAL(IVLCAN)
  507.       NGLCAN=VELCHE(/1)
  508.       NBLCAN=VELCHE(/2)
  509.  
  510.       MELVAL=IELVAL(IVMUF)
  511.       NGMUF=VELCHE(/1)
  512.       NBMUF=VELCHE(/2)
  513.  
  514.       MELVAL=IELVAL(IVYOFI)
  515.       NGYOFI=VELCHE(/1)
  516.       NBYOFI=VELCHE(/2)
  517.  
  518.       MELVAL=IELVAL(IVLECH)
  519.       NGLECH=VELCHE(/1)
  520.       NBLECH=VELCHE(/2)
  521.  
  522.       MELVAL=IELVAL(IVMW)
  523.       NGMW=VELCHE(/1)
  524.       NBMW=VELCHE(/2)
  525.  
  526.       MELVAL=IELVAL(IVFU)
  527.       NGFU=VELCHE(/1)
  528.       NBFU=VELCHE(/2)
  529.  
  530.       MELVAL=IELVAL(IVRTEC)
  531.       NGRTEC=VELCHE(/1)
  532.       NBRTEC=VELCHE(/2)
  533.  
  534.       MELVAL=IELVAL(IVFYF)
  535.       NGFYF=VELCHE(/1)
  536.       NBFYF=VELCHE(/2)
  537.  
  538. *Ici on est en train de regarder si les données mx sont constantes sur le maillage et dans les elements ?
  539.       IF(NGDIFI.EQ.1.AND.NGLOFI.EQ.1.AND.NGHFI.EQ.1.AND.NGTMAX.EQ.1
  540.      #.AND.NGTD.EQ.1.AND.NGSK.EQ.1.AND.NGFABO.EQ.1.AND.NGALEC.EQ.1.
  541.      #AND.NGMECR.EQ.1.AND.NGLCAN.EQ.1.AND.NGMUF.EQ.1.AND.NGYOFI.EQ.1
  542.      #.AND.NGLECH.EQ.1.AND.NGMW.EQ.1.AND.NGFU.EQ.1.AND.NGRTEC.EQ.1
  543.      # .AND.NGFYF.EQ.1) THEN
  544.         N1PTEL=1
  545.       ELSE
  546.         N1PTEL=MAX(NGDIFI,NGLOFI,NGHFI,NGTMAX,NGTD,NGSK,NGFABO,NGALEC,
  547.      #NGMECR,NGLCAN,NGMUF,NGYOFI,NGLECH,NGMW,NGFU,NGRTEC,NGFYF)
  548.       ENDIF
  549.       IF(NBDIFI.EQ.1.AND.NBLOFI.EQ.1.AND.NBHFI.EQ.1.AND.NBTMAX.EQ.1
  550.      #.AND.NBTD.EQ.1.AND.NBSK.EQ.1.AND.NBFABO.EQ.1.AND.NBALEC.EQ.1.
  551.      #AND.NBMECR.EQ.1.AND.NBLCAN.EQ.1.AND.NBMUF.EQ.1.AND.NBYOFI.EQ.1
  552.      #.AND.NBLECH.EQ.1.AND.NBMW.EQ.1.AND.NBFU.EQ.1.AND.NBRTEC.EQ.1
  553.      #.AND.NBFYF.EQ.1) THEN
  554.         N1EL=1
  555.       ELSE
  556.         N1EL=MAX(NBDIFI,NBLOFI,NBHFI,NBTMAX,NBTD,NBSK,NBFABO,NBALEC,
  557.      #NBMECR,NBLCAN,NBMUF,NBYOFI,NBLECH,NBMW,NBFU,NBRTEC,NBFYF)
  558.       ENDIF
  559.       N2EL=0
  560.       N2PTEL=0
  561.  
  562. *  creation des  3 melvals, associés à K1,K2,K3
  563. *  a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  564. *  calcules par preconditionnement
  565.  
  566.       DO I=1,NPAR
  567.         SEGINI MELVAL
  568.         IELVAL(N2A+I)=MELVAL
  569.       ENDDO
  570.  
  571.  
  572. *  on crée un segment de travail
  573.               MLIGNE = nligne
  574.               MITER = niter
  575.               MANGL1 = nangl+1
  576.               MLONGFI = nlongfi
  577.               MRTANG1 = nrt*(nangl+1)
  578.               MANGNRT = nangredu*nrt
  579.               MANGNAN = (nangl+1-nangredu)*nrt
  580.               SEGINI MWOR
  581.  
  582.  
  583.  
  584. *
  585. *  calcul de K1,K2,K3
  586. *   boucle sur les elements et sur les points de Gauss
  587. * donc si le champ est constant sur le maillage et les elements niel = 1 et n1ptel=1 et on va faire l'appel qu'une seule fois
  588.             DO     IB=1,N1EL
  589.               DO     IGAU=1,N1PTEL
  590. *  recuperation du diametre de la fibre
  591.                MELVAL=IELVAL(IVDIFI)
  592.                IGMN=MIN(IGAU,VELCHE(/1))
  593.                IBMN=MIN(IB  ,VELCHE(/2))
  594.                XDIFI =VELCHE(IGMN,IBMN)
  595. * recuperation de la longueur de la fibre
  596.                MELVAL=IELVAL(IVLOFI)
  597.                IGMN=MIN(IGAU,VELCHE(/1))
  598.                IBMN=MIN(IB  ,VELCHE(/2))
  599.                XLOFI =VELCHE(IGMN,IBMN)
  600. * recuperation de la rigidite de l interface
  601.                MELVAL=IELVAL(IVHFI)
  602.                IGMN=MIN(IGAU,VELCHE(/1))
  603.                IBMN=MIN(IB  ,VELCHE(/2))
  604.                XHFI =VELCHE(IGMN,IBMN)
  605. * recuperation de la contrainte de cisaillement max
  606.                MELVAL=IELVAL(IVTMAX)
  607.                IGMN=MIN(IGAU,VELCHE(/1))
  608.                IBMN=MIN(IB  ,VELCHE(/2))
  609.                XTMAX =VELCHE(IGMN,IBMN)
  610. * recuperation de la contrainte de frottement
  611.                MELVAL=IELVAL(IVTD)
  612.                IGMN=MIN(IGAU,VELCHE(/1))
  613.                IBMN=MIN(IB  ,VELCHE(/2))
  614.                XTD =VELCHE(IGMN,IBMN)
  615. * recuperation du glissement caracteristique
  616.                MELVAL=IELVAL(IVSK)
  617.                IGMN=MIN(IGAU,VELCHE(/1))
  618.                IBMN=MIN(IB  ,VELCHE(/2))
  619.                XSK =VELCHE(IGMN,IBMN)
  620. * recuperation de la contrainte de la force d about
  621.                MELVAL=IELVAL(IVFABO)
  622.                IGMN=MIN(IGAU,VELCHE(/1))
  623.                IBMN=MIN(IB  ,VELCHE(/2))
  624.                XFABO =VELCHE(IGMN,IBMN)
  625. * recuperation de l angle du cone de rupture et d ecaill
  626.                MELVAL=IELVAL(IVALEC)
  627.                IGMN=MIN(IGAU,VELCHE(/1))
  628.                IBMN=MIN(IB  ,VELCHE(/2))
  629.                XALEC =VELCHE(IGMN,IBMN)
  630. * recuperation du module d ecrouissage d abrasion
  631.                MELVAL=IELVAL(IVMECR)
  632.                IGMN=MIN(IGAU,VELCHE(/1))
  633.                IBMN=MIN(IB  ,VELCHE(/2))
  634.                XMECR =VELCHE(IGMN,IBMN)
  635. * recuperation de la longueur  dancrage caracteristique
  636.                MELVAL=IELVAL(IVLCAN)
  637.                IGMN=MIN(IGAU,VELCHE(/1))
  638.                IBMN=MIN(IB  ,VELCHE(/2))
  639.                XLCAN =VELCHE(IGMN,IBMN)
  640. * recuperation du coefficient de frottement fibre matrice
  641.                MELVAL=IELVAL(IVMUF)
  642.                IGMN=MIN(IGAU,VELCHE(/1))
  643.                IBMN=MIN(IB  ,VELCHE(/2))
  644.                XMUF =VELCHE(IGMN,IBMN)
  645. * recuperation du module d elasticite de la fibre
  646.                MELVAL=IELVAL(IVYOFI)
  647.                IGMN=MIN(IGAU,VELCHE(/1))
  648.                IBMN=MIN(IB  ,VELCHE(/2))
  649.                XYOFI =VELCHE(IGMN,IBMN)
  650. * recuperation de la longueur de l echantillon qui a donne RTEC
  651.                MELVAL=IELVAL(IVLECH)
  652.                IGMN=MIN(IGAU,VELCHE(/1))
  653.                IBMN=MIN(IB  ,VELCHE(/2))
  654.                XLECH =VELCHE(IGMN,IBMN)
  655. * recuperation du parametre de weibull
  656.                MELVAL=IELVAL(IVMW)
  657.                IGMN=MIN(IGAU,VELCHE(/1))
  658.                IBMN=MIN(IB  ,VELCHE(/2))
  659.                XMW =VELCHE(IGMN,IBMN)
  660. * recuperation de la contrainte ultime des fibres
  661.                MELVAL=IELVAL(IVFU)
  662.                IGMN=MIN(IGAU,VELCHE(/1))
  663.                IBMN=MIN(IB  ,VELCHE(/2))
  664.                XFU =VELCHE(IGMN,IBMN)
  665. * recuperation de la resistance a la traction associee a lech
  666.                MELVAL=IELVAL(IVRTEC)
  667.                IGMN=MIN(IGAU,VELCHE(/1))
  668.                IBMN=MIN(IB  ,VELCHE(/2))
  669.                XRTEC =VELCHE(IGMN,IBMN)
  670. * recuperation de la LIMITE ELASTIQUE DES FIBRES
  671.                MELVAL=IELVAL(IVFYF)
  672.                IGMN=MIN(IGAU,VELCHE(/1))
  673.                IBMN=MIN(IB  ,VELCHE(/2))
  674.                XFYF =VELCHE(IGMN,IBMN)
  675.  
  676.  
  677.  
  678.            CALL PRPFI0(COEFFK1,COEFFK2,COEFFWP1,
  679.      #COEFFWP2,COEFFFP,COEFFWF,COEFFW03,XLECH,XMW,
  680.      #MAXFP,MINFP,MAXWP1,MINWP1,MAXWP2,MINWP2,MAXWF,
  681.      #MINWF,MAXW03,MINW03,XLOFI,XMUF,XTD,XTMAX,XYOFI,XHFI,XDIFI,XSK,
  682.      #XFABO,XALEC,XMECR,XFU,XLCAN,XRTEC,MAXK02,MINK02,MAXK01,MINK01,
  683.      #XFYF,
  684.      #mwor,nligne,niter,nangl,nlongfi,nrt,nangredu,phit,phicrit)
  685.  
  686.  
  687. C   REMPLISSAGE DES RESULTATS
  688. C
  689. *  a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  690. *  calcules par preconditionnement
  691.  
  692.               DO I=1,10
  693.                 MELVAL=IELVAL(N2A+I)
  694.                 VELCHE(IGAU,IB)=COEFFK1(I)
  695.               ENDDO
  696.  
  697.               DO I=1,10
  698.                 MELVAL=IELVAL(N2A+I+10)
  699.                 VELCHE(IGAU,IB)=COEFFK2(I)
  700.               ENDDO
  701.  
  702.               DO I=1,10
  703.                 MELVAL=IELVAL(N2A+I+20)
  704.                 VELCHE(IGAU,IB)=COEFFWP1(I)
  705.               ENDDO
  706.  
  707.               DO I=1,10
  708.                 MELVAL=IELVAL(N2A+I+30)
  709.                 VELCHE(IGAU,IB)=COEFFWP2(I)
  710.               ENDDO
  711.  
  712.               DO I=1,10
  713.                 MELVAL=IELVAL(N2A+I+40)
  714.                 VELCHE(IGAU,IB)=COEFFFP(I)
  715.               ENDDO
  716.  
  717.               DO I=1,10
  718.                 MELVAL=IELVAL(N2A+I+50)
  719.                 VELCHE(IGAU,IB)=COEFFW03(I)
  720.               ENDDO
  721.  
  722.               DO I=1,10
  723.                 MELVAL=IELVAL(N2A+I+60)
  724.                 VELCHE(IGAU,IB)=COEFFWF(I)
  725.               ENDDO
  726.  
  727. c min et max des surfaces
  728.               MELVAL=IELVAL(N2A+71)
  729.               VELCHE(IGAU,IB)=MINK01
  730.               MELVAL=IELVAL(N2A+72)
  731.               VELCHE(IGAU,IB)=MAXK01
  732.               MELVAL=IELVAL(N2A+73)
  733.               VELCHE(IGAU,IB)=MINK02
  734.               MELVAL=IELVAL(N2A+74)
  735.               VELCHE(IGAU,IB)=MAXK02
  736.               MELVAL=IELVAL(N2A+75)
  737.               VELCHE(IGAU,IB)=MINWP1
  738.               MELVAL=IELVAL(N2A+76)
  739.               VELCHE(IGAU,IB)=MAXWP1
  740.               MELVAL=IELVAL(N2A+77)
  741.               VELCHE(IGAU,IB)=MINWP2
  742.               MELVAL=IELVAL(N2A+78)
  743.               VELCHE(IGAU,IB)=MAXWP2
  744.               MELVAL=IELVAL(N2A+79)
  745.               VELCHE(IGAU,IB)=MINFP
  746.               MELVAL=IELVAL(N2A+80)
  747.               VELCHE(IGAU,IB)=MAXFP
  748.               MELVAL=IELVAL(N2A+81)
  749.               VELCHE(IGAU,IB)=MINW03
  750.               MELVAL=IELVAL(N2A+82)
  751.               VELCHE(IGAU,IB)=MAXW03
  752.               MELVAL=IELVAL(N2A+83)
  753.               VELCHE(IGAU,IB)=MINWF
  754.               MELVAL=IELVAL(N2A+84)
  755.               VELCHE(IGAU,IB)=MAXWF
  756.  
  757.  
  758. *
  759.               ENDDO
  760.             ENDDO
  761. *
  762. *     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  763. *
  764. *      SEGDES MELEME
  765. C      MELVAL=IELVAL(IVDIFI)
  766. C      SEGDES MELVAL
  767. C      MELVAL=IELVAL(IVLOFI)
  768. C      SEGDES MELVAL
  769. C      MELVAL=IELVAL(IVHFI)
  770. C      SEGDES MELVAL
  771. C      MELVAL=IELVAL(IVTMAX)
  772. C      SEGDES MELVAL
  773. C      MELVAL=IELVAL(IVTD)
  774. C      SEGDES MELVAL
  775. C      MELVAL=IELVAL(IVSK)
  776. C      SEGDES MELVAL
  777. C      MELVAL=IELVAL(IVFABO)
  778. C      SEGDES MELVAL
  779. C      MELVAL=IELVAL(IVALEC)
  780. C      SEGDES MELVAL
  781. C      MELVAL=IELVAL(IVMECR)
  782. C      SEGDES MELVAL
  783. C      MELVAL=IELVAL(IVLCAN)
  784. C      SEGDES MELVAL
  785. C      MELVAL=IELVAL(IVMUF)
  786. C      SEGDES MELVAL
  787. C      MELVAL=IELVAL(IVYOFI)
  788. C      SEGDES MELVAL
  789. C      MELVAL=IELVAL(IVLECH)
  790. C      SEGDES MELVAL
  791. C      MELVAL=IELVAL(IVMW)
  792. C      SEGDES MELVAL
  793. C      MELVAL=IELVAL(IVFU)
  794. C      SEGDES MELVAL
  795. C      MELVAL=IELVAL(IVRTEC)
  796. C      SEGDES MELVAL
  797. C      MELVAL=IELVAL(IVFYF)
  798. C      SEGDES MELVAL
  799.  
  800.  
  801.  
  802. *  a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  803. *  calcules par preconditionnement
  804.  
  805. C      DO I=1,NPAR
  806. C         MELVAL=IELVAL(N2A+I)
  807. C         SEGDES MELVAL
  808. C       ENDDO
  809. C      SEGDES MCHAML
  810.  
  811. *  on supprime le segment de travail
  812.         SEGSUP  MWOR
  813.  
  814.  
  815.  
  816. *      SEGSUP INFO
  817. *
  818.   200 CONTINUE
  819. *
  820. C      SEGDES MCHELM
  821. C      SEGDES,MLMOTS
  822.       RETURN
  823.       END
  824.  
  825.  
  826.  
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837.  
  838.  

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