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

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