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