Télécharger la plaquette Cast3M


fr en

Télécharger motana.eso

Retour à la liste

Numérotation des lignes : 

motana

  1. C MOTANA    SOURCE    JK148537  24/11/05    21:15:07     12067          
  2.       SUBROUTINE MOTANA(IPMODL,IPCHE1,IPCHE2,IPCHE3,PRECIS,IPSCAL,IRET)
  3. *______________________________________________________________________
  4. *
  5. *
  6. *
  7. *   ENTREES :
  8. *   ---------
  9. *     IPMODL   pointeur sur un MMODEL
  10. *     IPCHE1   pointeur sur un MCHAML de sous type CONTRAINTES
  11. *     IPCHE2   pointeur sur un MCHAML de sous type VARIABLES INTERNES
  12. *     IPCHE3   pointeur sur le MCHAML de sous type CARACTARISTIQUE
  13. *     PRECIS    flottant
  14. *
  15. *   SORTIES :
  16. *   ---------
  17. *     IPSCAL   pointeur sur l'objet  de  type RIGIDITE
  18. *     IRET   =  1  si succes 0 sinon
  19. *
  20. *     passage aux nouveaux  CHAMELEMs par JM CAMPENON LE 06/91
  21. *
  22. *______________________________________________________________________
  23. *
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC SMINTE
  31. -INC SMMODEL
  32. -INC SMELEME
  33. -INC SMCHAML
  34. -INC SMCOORD
  35. -INC SMLREEL
  36. -INC SMEVOLL
  37. *______________________________________________________________________
  38. *
  39. *  LA VARIABLE KERRE REGIT LES IMPRESSIONS D ERREURS DANS MOTAN
  40. *      TOUTES ERREURS DE PLASTICITE GEREES DANS CE SOUS PROGRAMME
  41. *   KERRE=0 TOUT OK
  42. *        DE 1 A 7  S ALIGNER SUR VALEURS DONNEES PAR ECOINC
  43. *     =  21  ON NE TROUVE PAS D INTERSECTION AVEC LA SURFACE DE CHARGE
  44. *     =  22  SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  45. *
  46. *     =  30 31 32 ANOMALIES AVEC LA COURBE DE TRACTION
  47. *     =  33 LIMITE ELASTIQUE NULLE
  48. *     =  99 CAS NON ENCORE DISPONIBLE
  49. *----------------------------------------------------------------------
  50. *
  51.       SEGMENT WRK0
  52.        REAL*8 XMAT(NCXMAT)
  53.       ENDSEGMENT
  54. *
  55.       SEGMENT WRK1
  56.          REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),
  57.      .          DSIGT(NSTRS),SIGF(NSTRS),VAR0(NVARI),
  58.      .          VARF(NVARI),DEFP(NSTRS),XCAR(ICARA)
  59.       ENDSEGMENT
  60. *
  61.        SEGMENT WRK2
  62.           REAL*8 TRAC(LTRAC)
  63.        ENDSEGMENT
  64. *
  65.        SEGMENT WRK3
  66.           REAL*8 WORK(LW)
  67.        ENDSEGMENT
  68. *
  69.        SEGMENT WRK4
  70.           REAL *8 XE(3,NBBB)
  71.        ENDSEGMENT
  72. *
  73.        SEGMENT WRK5
  74.           REAL*8 SIG(LSIG),EPS(LSIG)
  75.        ENDSEGMENT
  76. *
  77.        SEGMENT WRK6
  78.           REAL*8 COVNMS(6)
  79.        ENDSEGMENT
  80. *
  81.       SEGMENT MPTVAL
  82.         INTEGER IPOS(NS)    ,NSOF(NS)
  83.         INTEGER      IVAL(NCOSOU)
  84.         CHARACTER*16 TYVAL(NCOSOU)
  85.       ENDSEGMENT
  86. *
  87.       SEGMENT NOTYPE
  88.         CHARACTER*16 TYPE(NBTYPE)
  89.       ENDSEGMENT
  90. *
  91.       CHARACTER*8 CMATE
  92.       CHARACTER*(NCONCH) CONM
  93.       PARAMETER ( NINF=3 )
  94.       INTEGER INFOS(NINF)
  95.       LOGICAL lsupva,lsupco
  96.  
  97.       DIMENSION XEPOU(2),YEPOU(2),ZEPOU(2),DIV(7)
  98.       DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  99.  
  100.       IRET = 0
  101.       NHRM=NIFOUR
  102. *
  103. *     Verification du lieu support du MCHAML de contraintes
  104. *
  105.       CALL  QUESUP(IPMODL,IPCHE1,3,0,ISUPCO,IRETCO)
  106.       IF (ISUPCO.GT.1) RETURN
  107. *
  108. *     Verification du lieu support du MCHAML de variables internes
  109. *
  110.       CALL  QUESUP(IPMODL,IPCHE2,3,0,ISUPVA,IRETVA)
  111.       IF (ISUPVA.GT.1) RETURN
  112. *
  113. *     Verification du lieu support du MCHAML de materiau
  114. *
  115.       CALL  QUESUP(IPMODL,IPCHE3,3,0,ISUPMA,IRETMA)
  116.       IF (ISUPMA.GT.1) RETURN
  117. *
  118. *     Activation du MMODEL
  119. *
  120.       MMODEL=IPMODL
  121.       NSOUS=KMODEL(/1)
  122. *
  123. *     Creation du MCHELM
  124. *
  125.       N1=NSOUS
  126.       L1=8
  127.       N3=6
  128.       SEGINI MCHELM
  129.       TITCHE='SCALAIRE'
  130.       IFOCHE=IFOUR
  131.       IPSCAL=MCHELM
  132.  
  133.       NBTYPE=1
  134.       SEGINI NOTYPE
  135.       TYPE(1)='REAL*8'
  136.       MOTYR8 = NOTYPE
  137. *
  138.       DO 500 ISOUS=1,NSOUS
  139. *
  140. *   INITIALISATION
  141. *
  142.        NSTR=0
  144.        IVACON=0
  145.        MOVARI=0
  146.        NVARI=0
  147.        IVAVAR=0
  148.        NCARA=0
  149.        NCARF=0
  150.        MOCARA=0
  151.        IVACAR=0
  152.        NMATF=0
  153.        NMATR=0
  154.        MOMATR=0
  155.        IVAMAT=0
  156.        KERRE=0
  157.  
  158.         IMODEL=KMODEL(ISOUS)
  159.         IPMOD1=IMODEL
  160.  
  161.         IPMAIL=IMAMOD
  162.         CONM  =CONMOD
  163. C
  164. C   COQUE INTEGREE OU PAS ?
  165. C
  166.         NPINT=INFMOD(1)
  167.         IF (NPINT.NE.0)THEN
  168.           CALL ERREUR(615)
  169.           SEGSUP MCHELM
  170.           RETURN
  171.         ENDIF
  172. C
  173.          IMACHE(ISOUS)=IPMAIL
  174.          CONCHE(ISOUS)=CONMOD
  175. *
  176.          MELE=NEFMOD
  177.          MELEME=IMAMOD
  178. *
  179. *        Nature du materiau
  180. *
  181.          CMATE  = imodel.CMATEE
  182.          INELAS = imodel.IMATEE
  183.          INPLAS = imodel.INATUU
  184. *
  185. *        Information sur l'element fini
  186. *
  187.          MFR  =INFELE(13)
  188.          NBG  =INFELE(6)
  189.          NBGS =INFELE(4)
  190.          NSTRS=INFELE(16)
  191.          LW   =200
  192.          LHOOK=INFELE(10)
  193. *         MINTE=INFELE(11)
  194.          minte=infmod(5)
  195.          IPMIN1=MINTE
  196.  
  197.          INFCHE(ISOUS,1)=0
  198.          INFCHE(ISOUS,2)=0
  199.          INFCHE(ISOUS,3)=NHRM
  200.          INFCHE(ISOUS,4)=MINTE
  201.          INFCHE(ISOUS,5)=0
  202.          INFCHE(ISOUS,6)=3
  203. *
  204.          NBPGAU=POIGAU(/1)
  205.          NBNO  =SHPTOT(/2)
  206. *
  207.          NBNN  =NUM(/1)
  208.          NBELEM=NUM(/2)
  209.          IPPORE=0
  210.          IF(MFR.EQ.33) IPPORE=NBNN
  211.  
  212. *        Creation du tableau INFOS
  213. *
  214.         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  215.         IF (IRTD.EQ.0) GOTO 9901
  216. *
  217. *        Verification du MCHAML de contraintes
  218. *
  219.         nomid=lnomid(4)
  220.         if (nomid.eq.0) then
  221.           write(ioimp,*) 'MOTANE : MOCONT = lnomid(4) = 0'
  222.           call erreur(5)
  223.         endif
  224.         nstr=lesobl(/2)
  225.         nfac=lesfac(/2)
  226.         MOCONT = nomid
  227.  
  228.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCONT,MOTYR8,
  229.      &                               1,INFOS,3,IVACON)
  230.         IF (IERR.NE.0) GOTO 9910
  231.  
  232.         IF (ISUPCO.EQ.1) THEN
  233.           CALL VALCHE(IVACON,NSTRS,IPMIN1,IPPORE,MOCONT,MELE)
  234.         ENDIF
  235. *
  236. *        Verification du MCHAML de variables internes
  237. *
  238.         nomid=lnomid(10)
  239.         if (nomid.eq.0) then
  240.           write(ioimp,*) 'MOTANE : MOVARI = lnomid(10) = 0'
  241.           call erreur(5)
  242.         endif
  243.         nvari=lesobl(/2)
  244.         nfac=lesfac(/2)
  245.         MOVARI=nomid
  246.  
  247.         CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYR8,
  248.      &                                1,INFOS,3,IVAVAR)
  249.         IF(IERR.NE.0)GOTO 9920
  250.  
  251.         IF (ISUPVA.EQ.1) THEN
  252.           CALL VALCHE(IVAVAR,NVARI,IPMIN1,IPPORE,MOVARI,MELE)
  253.         ENDIF
  254. *
  255. *        Creation du tableau INFOS
  256. *
  257.         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE3,INFOS,IRTD)
  258.         IF (IRTD.EQ.0) GOTO 9920
  259. *
  260. *        Verification du MCHAML de materiau
  261. *
  262.         NBROBL = 0
  263.         NBRFAC = 0
  264.         NOMID  = 0
  265.         NOTYPE = MOTYR8
  266.  
  267.         IF (INPLAS.EQ.1) THEN
  268.           NBROBL=2
  269.           SEGINI NOMID
  270.           LESOBL(1)='YOUN'
  271.           LESOBL(2)='SIGY'
  272.         ELSE IF (INPLAS.EQ.4) THEN
  273.           NBROBL=3
  274.           SEGINI NOMID
  275.           LESOBL(1)='YOUN'
  276.           LESOBL(2)='SIGY'
  277.           LESOBL(3)='H   '
  278.         ELSE IF (INPLAS.EQ.5) THEN
  279.           NBROBL=2
  280.           SEGINI NOMID
  281.           LESOBL(1)='YOUN'
  282.           LESOBL(2)='ECRO'
  283.  
  284.           NBTYPE=2
  285.           SEGINI NOTYPE
  286.           TYPE(1)='REAL*8'
  287.           TYPE(2)='POINTEUREVOLUTIO'
  288.         ELSE
  289.           NBROBL=1
  290.           SEGINI NOMID
  291.           LESOBL(1)='YOUN'
  292.         ENDIF
  293.  
  294.         NMATR=NBROBL
  295.         NMATF =NBRFAC
  296.         NMATT = NMATR+NMATF
  297.         MOMATR = NOMID
  298.         MOTYPE = NOTYPE
  299.  
  300.         CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOMATR,MOTYPE,
  301.      &                                 1,INFOS,3,IVAMAT)
  302.         IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  303.         IF (IERR.NE.0) GOTO 9930
  304.  
  305.         IF (ISUPMA.EQ.1) THEN
  306.           CALL VALCHE(IVAMAT,NMATT,IPMIN1,IPPORE,MOMATR,MELE)
  307.           IF(IERR.NE.0)THEN
  308.             ISUPMA=0
  309.             GOTO 9930
  310.           ENDIF
  311.         ENDIF
  312. *
  313. *        Verification du MCHAML de caracteristiques
  314. *
  315.         NBROBL=0
  316.         NBRFAC=0
  317.         NOMID  = 0
  318.         NOTYPE = MOTYR8
  319.         IVECT=0
  320.         IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  321.            NBROBL=2
  322.            SEGINI NOMID
  323.            LESOBL(1)='EPAI'
  324.            LESOBL(2)='CALF'
  325. *
  326. * POUR LES POUTRES
  327. *
  328.         ELSE IF (MFR.EQ.7 ) THEN
  329.            NBROBL=4
  330.            NBRFAC=8
  331.            SEGINI NOMID
  332.            LESOBL(1)='TORS'
  333.            LESOBL(2)='INRY'
  334.            LESOBL(3)='INRZ'
  335.            LESOBL(4)='SECT'
  336.            LESFAC(1)='SECY'
  337.            LESFAC(2)='SECZ'
  338.            LESFAC(3)='DX  '
  339.            LESFAC(4)='DY  '
  340.            LESFAC(5)='DZ  '
  341.            LESFAC(6)='VX'
  342.            LESFAC(6)='VY'
  343.            LESFAC(6)='VZ'
  344.            IVECT=1
  345. *
  346. * POUR LES TUYAUX
  347. *
  348.         ELSE IF (MFR.EQ.13) THEN
  349.            NBROBL=2
  350.            NBRFAC=11
  351.            SEGINI NOMID
  352.            LESOBL(1)='EPAI'
  353.            LESOBL(2)='RAYO'
  354.            LESFAC(1)='RACO'
  355.            LESFAC(2)='PRES'
  356.            LESFAC(3)='CISA'
  357.            LESFAC(4)='CFFX'
  358.            LESFAC(5)='CFMX'
  359.            LESFAC(6)='CFMY'
  360.            LESFAC(7)='CFMZ'
  361.            LESFAC(8)='CFPR'
  362.            LESFAC(9)='VX'
  363.            LESFAC(10)='VY'
  364.            LESFAC(11)='VZ'
  365.            IVECT=1
  366.         ENDIF
  367.         NCARA=NBROBL
  368.         NCARF=NBRFAC
  369.         NCARR=NCARA+NCARF
  370.         MOCARA=NOMID
  371.         MOTYPE = NOTYPE
  372.  
  373.         IF (MOCARA.NE.0) THEN
  374.           CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE,
  375.      &                                     1,INFOS,3,IVACAR)
  376.           IF (IERR.NE.0) GOTO 9940
  377.  
  378.           IF (ISUPMA.EQ.1) THEN
  379.             CALL VALCHE(IVACAR,NCARR,IPMIN1,IPPORE,MOCARA,MELE)
  380.             IF(IERR.NE.0)THEN
  381.               ISUPMA=0
  382.               GOTO 9940
  383.             ENDIF
  384.           ENDIF
  385.         ENDIF
  386.         ICARA=NCARR
  387. *
  388. *        Creation du MCHAML de la sous zone
  389. *
  390.         N2=1
  391.         SEGINI MCHAML
  392.         ICHAML(ISOUS)=MCHAML
  393.         NOMCHE(1)='SCAL'
  394.         TYPCHE(1)='REAL*8'
  395. *
  396. *        Creation du MELVAL de la composante SCAL
  397. *
  398.         N1PTEL=NBG
  399.         N1EL=NBELEM
  400.         N2PTEL=0
  401.         N2EL=0
  402.         SEGINI MELVAL
  403.         IELVAL(1)=MELVAL
  404.         IPMELV=MELVAL
  405. *
  406. *        Mise a 0 des variables du COMMON NECOU si besoin
  407. *        Les bonnes valeurs sont attribuees selon le materiaux
  408. *         ( initialisation selon les cas )
  409. *
  410.          IF(INPLAS.EQ.2) GO TO 681
  411.          IFOURB=IFOUR
  412.          NCOURB=0
  413.          IPLAST=0
  414.          IMAPLA=1
  415.          IT=1
  416.          ISOTRO=0
  417.          ITYP=0
  418. *
  419. *        Correspondance MFR,IFOUR et ITYP faite dans ECOINC
  420. *
  421. *        Correspondance MFR,IFOUR et ITYP
  422. *         a completer
  423. *
  424.          IF(MFR.EQ.1.AND.IFOUR.EQ.-2) ITYP=6
  425.          IF(MFR.EQ.1.AND.IFOUR.GE.-1) ITYP=1
  426.          IF(MFR.EQ.3) ITYP=2
  427.          IF(MFR.EQ.5) ITYP=13
  428.          IF(MFR.EQ.7) ITYP=11
  429.          IF(MFR.EQ.9) ITYP= 2
  430. *
  431. *        cas du coq4 - on ne travaille que sur les 6 eres composantes
  432. *
  433.          IF(MFR.EQ.13) ITYP=12
  434.          IF(MFR.EQ.25) ITYP=3
  435.          IF(MFR.EQ.27) ITYP=4
  436. *
  437.          IFLUAG=0
  438.          ICINE=0
  439.          ITHER=0
  440.          IFLUPL=0
  441.          ICYCL=0
  442.          IBI=0
  443.          JFLUAG=0
  444.          KFLUAG=0
  445.          LFLUAG=0
  446.          IRELAX=0
  447.          JNTRIN=0
  448.          MFLUAG=0
  449.          JSOUFL=0
  450.          JGRDEF=0
  451.          LTRAC=600
  452. *
  453.  681     CONTINUE
  454. *
  455.          NCXMAT=NMATT
  456.          IF(INPLAS.EQ.5)NCXMAT=NMATT+3
  457.          SEGINI WRK0,WRK1,WRK2,WRK3
  458.          IF(MFR.EQ.3.OR.MFR.EQ.7.OR.MFR.EQ.13) THEN
  459.             NBBB=NBNN
  460.             SEGINI WRK4
  461.             SEGINI WRK6
  462.          ENDIF
  463. *
  464. *        Boucle sur les elements
  465. *
  466.          DO 3004  IB=1,NBELEM
  467. *
  468. *           Boucle sur les points de gauss
  469. *
  470.             DO 5004  IGAU=1,N1PTEL
  471. *
  472. *              On remplit les differentes quantites necessaires a
  473. *              ECOULE
  474. *
  475. *              Contraintes initiales
  476. *
  477.                MPTVAL=IVACON
  478.                DO 4004 ICOMP=1,NSTR
  479.                   MELVAL=IVAL(ICOMP)
  480.                   IGMN=MIN(IGAU,VELCHE(/1))
  481.                   IBMN=MIN(IB  ,VELCHE(/2))
  482.                   SIG0(ICOMP)=VELCHE(IGMN,IBMN)
  483.  4004          CONTINUE
  484. *
  485. *              Variables internes initiales
  486. *
  487.                MPTVAL=IVAVAR
  488.                DO 4005 ICOMP=1,NVARI
  489.                   MELVAL=IVAL(ICOMP)
  490.                   IGMN=MIN(IGAU,VELCHE(/1))
  491.                   IBMN=MIN(IB  ,VELCHE(/2))
  492.                   VAR0(ICOMP)=VELCHE(IGMN,IBMN)
  493.  4005          CONTINUE
  494.                IEPS=1
  495.                EPSPL=VAR0(IEPS)
  496. *
  497. *              Les constantes du materiaux
  498. *
  499.                MPTVAL=IVAMAT
  500.                IF(INPLAS.EQ.5)THEN
  501.                  MELVAL=IVAL(1)
  502.                  IBMN=MIN(IB,VELCHE(/2))
  503.                  IGMN=MIN(IGAU,VELCHE(/1))
  504.                  XMAT(1)=VELCHE(IGMN,IBMN)
  505.                  MELVAL=IVAL(2)
  506.                  IBMN=MIN(IB,IELCHE(/2))
  507.                  IGMN=MIN(IGAU,IELCHE(/1))
  508.                  MEVOLL = IELCHE(IGMN,IBMN)
  509. *--------
  510.                  SEGACT MEVOLL
  511.                  KEVOLL=IEVOLL(1)
  512.                  SEGACT KEVOLL
  513.                  MLREEL = IPROGY
  514.                  SEGACT MLREEL
  515.                  LTR2 = PROG(/1)
  516.                  SEGDES MLREEL,KEVOLL,MEVOLL
  517.                  IF(LTR2.GT.LTRAC) THEN
  518.                  LTRAC = LTR2
  519.                  SEGADJ WRK0
  520.                  ENDIF
  521.                  XMAT(5)=MEVOLL
  522.                ELSE
  523.                DO 4007 ICOMP=1,NMATR
  524.                   MELVAL=IVAL(ICOMP)
  525.                   IF(TYVAL(ICOMP)(1:8).NE.'POINTEUR')THEN
  526.                    IBMN=MIN(IB,VELCHE(/2))
  527.                    IGMN=MIN(IGAU,VELCHE(/1))
  528.                    XMAT(ICOMP)=VELCHE(IGMN,IBMN)
  529.                   ELSE
  530.                    IBMN=MIN(IB,IELCHE(/2))
  531.                    IGMN=MIN(IGAU,IELCHE(/1))
  532. *                   XMAT(ICOMP)=IELCHE(IGMN,IBMN)
  533.                  MEVOLL = IELCHE(IGMN,IBMN)
  534.                  SEGACT MEVOLL
  535.                  KEVOLL=IEVOLL(1)
  536.                  SEGACT KEVOLL
  537.                  MLREEL = IPROGY
  538.                  SEGACT MLREEL
  539.                  LTR2 = PROG(/1)
  540.                  SEGDES MLREEL,KEVOLL,MEVOLL
  541.                  IF(LTR2.GT.LTRAC) THEN
  542.                  LTRAC = LTR2
  543.                  SEGADJ WRK0
  544.                  ENDIF
  545.                  XMAT(5)=MEVOLL
  546. *---------------
  547.                   ENDIF
  548.  4007          CONTINUE
  549.                ENDIF
  550.                IYUNG=1
  551.                ETANG=XMAT(IYUNG)
  552. *
  553. *              Les caracteristiques si besoin
  554. *
  555.                IF (ITYP.EQ.2) THEN
  556.                  ALFAH=1.
  557.                  IF(MOCARA.NE.0) THEN
  558.                     MPTVAL=IVACAR
  559.                     DO 6029 ICOMP=1,NCARR
  560.                      MELVAL=IVAL(ICOMP)
  561.                      IBMN=MIN(IB  ,VELCHE(/2))
  562.                      XCAR(ICOMP)=VELCHE(1,IBMN)
  563. 6029                CONTINUE
  564.                     IALF=2
  565.                     ALFAH=XCAR(IALF)*XCAR(IALF)
  566.                  ENDIF
  567. *
  568. *              On transforme les efforts en contraintes pour les
  569. *              coques minces
  570. *
  571.                   CALL EFCONT(XCAR(1),0.D0,NSTRS,SIG0)
  572.                   IF (NVARI.EQ.NSTRS+1) THEN
  573.                      CALL EFCONT(XCAR(1),0.D0,NSTRS,VAR0(2))
  574.                   ENDIF
  575.                ENDIF
  576. *
  577. * cas des tuyaux
  578. *
  579.                IF (ITYP.EQ.12) THEN
  580.                 IF(MOCARA.NE.0) THEN
  581.                   MPTVAL=IVACAR
  582.                     DO 5129 ICOMP=1,5
  583.                        MELVAL=IVAL(ICOMP)
  584.                        IF (MELVAL.NE.0) THEN
  585.                           IGMN=MIN(IGAU,VELCHE(/1))
  586.                           IBMN=MIN(IB  ,VELCHE(/2))
  587.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  588.                        ELSE
  589.                           XCAR(ICOMP)=0.D0
  590.                        ENDIF
  591.  5129               CONTINUE
  592.                   IF(IVECT.EQ.1) THEN
  593.                     DO 5130 ICOMP=6,NCARR
  594.                        MELVAL=IVAL(ICOMP)
  595.                        IF (MELVAL.NE.0) THEN
  596.                           IGMN=MIN(IGAU,VELCHE(/1))
  597.                           IBMN=MIN(IB  ,VELCHE(/2))
  598.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  599.                        ELSE
  600.                           XCAR(ICOMP)=-1.D0
  601.                        ENDIF
  602.  5130               CONTINUE
  603.                   ELSE
  604.                     DO 5330 ICOMP=6,10
  605.                        MELVAL=IVAL(ICOMP)
  606.                        IF (MELVAL.NE.0) THEN
  607.                           IGMN=MIN(IGAU,VELCHE(/1))
  608.                           IBMN=MIN(IB  ,VELCHE(/2))
  609.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  610.                        ELSE
  611.                           XCAR(ICOMP)=-1.D0
  612.                        ENDIF
  613.  5330               CONTINUE
  614.                     DO 5339 ICOMP=11,ICARA
  615.                        MELVAL=IVAL(ICOMP)
  616.                        IF (MELVAL.NE.0) THEN
  617.                           IGMN=MIN(IGAU,VELCHE(/1))
  618.                           IBMN=MIN(IB  ,VELCHE(/2))
  619.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  620.                        ELSE
  621.                           XCAR(ICOMP)=0.D0
  622.                        ENDIF
  623.  5339               CONTINUE
  624.                   ENDIF
  625. *
  626. *    REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  627. *    QUE L'ANCIEN  CHAMELEM
  628. *
  629.                   NWORK = 7
  630.                   DO 5349 IC=4,10
  631.                   WORK(IC-3)=XCAR(IC)
  632.  5349             CONTINUE
  633.                   IF(IDIM.EQ.2)THEN
  634.                      XCAR(4)=XCAR(ICARA-1)
  635.                      XCAR(5)=XCAR(ICARA)
  636.                      DO 5359 IC=1,NWORK
  637.                      XCAR(IC+5)=WORK(IC)
  638.  5359                CONTINUE
  639.                   ELSE IF(IDIM.EQ.3)THEN
  640.                      XCAR(4)=XCAR(ICARA-2)
  641.                      XCAR(5)=XCAR(ICARA-1)
  642.                      XCAR(6)=XCAR(ICARA)
  643.                      DO 5369 IC=1,NWORK
  644.                      XCAR(IC+6)=WORK(IC)
  645.  5369                CONTINUE
  646.                   ENDIF
  647.                ENDIF
  648.              ENDIF
  649. *
  650. * cas des poutres
  651. *
  652.                IF (ITYP.EQ.11) THEN
  653.                 IF(MOCARA.NE.0) THEN
  654.                   MPTVAL=IVACAR
  655.                   IF(IVECT.EQ.1) THEN
  656.                     DO 6129 ICOMP=1,NCARR
  657.                        MELVAL=IVAL(ICOMP)
  658.                        IF (MELVAL.NE.0) THEN
  659.                           IGMN=MIN(IGAU,VELCHE(/1))
  660.                           IBMN=MIN(IB  ,VELCHE(/2))
  661.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  662.                        ELSE
  663.                           XCAR(ICOMP)=0.D0
  664.                        ENDIF
  665.  6129               CONTINUE
  666.                   ELSE
  667.                     DO 6339 ICOMP=1,ICARA
  668.                        MELVAL=IVAL(ICOMP)
  669.                        IF (MELVAL.NE.0) THEN
  670.                           IGMN=MIN(IGAU,VELCHE(/1))
  671.                           IBMN=MIN(IB  ,VELCHE(/2))
  672.                           XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  673.                        ELSE
  674.                           XCAR(ICOMP)=0.D0
  675.                        ENDIF
  676.  6339               CONTINUE
  677.                   ENDIF
  678. *
  679. *    REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE
  680. *    QUE L'ANCIEN  CHAMELEM
  681. *
  682.                   IF(IDIM.EQ.2)THEN
  683.                      VX=XCAR(ICARA-3)
  684.                      VY=XCAR(ICARA-2)
  685.                      XCAR(ICARA-3)=XCAR(ICARA-1)
  686.                      XCAR(ICARA-2)=XCAR(ICARA)
  687.                      XCAR(ICARA-1)=VX
  688.                      XCAR(ICARA)=VY
  689.                   ELSEIF(IDIM.EQ.3)THEN
  690.                      VX=XCAR(ICARA-5)
  691.                      VY=XCAR(ICARA-4)
  692.                      VZ=XCAR(ICARA-3)
  693.                      XCAR(ICARA-5)=XCAR(ICARA-2)
  694.                      XCAR(ICARA-4)=XCAR(ICARA-1)
  695.                      XCAR(ICARA-3)=XCAR(ICARA)
  696.                      XCAR(ICARA-2)=VX
  697.                      XCAR(ICARA-1)=VY
  698.                      XCAR(ICARA)=VZ
  699.                   ENDIF
  700.              ENDIF
  701.            ENDIF
  702. C
  703.                IF(ITYP.EQ.11) THEN
  704.                  DIV(1)=1.D0/XCAR(4)
  705.                  DIV(2)=1.D0
  706.                  DIV(3)=1.D0
  707.                  DIV(4)=XCAR(5)/XCAR(1)
  708.                  DIV(5)=XCAR(6)/XCAR(2)
  709.                  DIV(6)=XCAR(7)/XCAR(3)
  710.                  IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(XCAR(1)*XCAR(4))
  711.                  IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(XCAR(2)*XCAR(4))
  712.                  IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(XCAR(3)*XCAR(4))
  713.                ENDIF
  714. C
  715.                IF(ITYP.EQ.12) THEN
  716.                  EPAIS=XCAR(1)
  717.                  REXT =XCAR(2)
  718.                  RMOY =REXT-EPAIS*0.5D0
  719.                  RACO =XCAR(3)
  720.                  PRES =XCAR(4)
  721.                  CISA =XCAR(5)
  722. C
  723.                  GAM=1.D0
  724.                  IF(RACO.EQ.0.D0) GO TO 6429
  725.                    XLAM=RMOY*RMOY/EPAIS/RACO
  726.                    GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  727.                    IF(GAM.LT.1.D0) GAM=1.D0
  728.  6429            CONTINUE
  729. C
  730. C         NB 23/09/98
  731. C         VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  732. C         CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  733. C         CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  734. C         DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  735. C         DUE A LA PRESSION )
  736. C         POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE
  737. C         DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7)
  738. C
  739.                  DIV(1)=1.D0
  740.                  DIV(2)=1.D0
  741.                  DIV(3)=1.D0
  742.                  DIV(4)=R33
  743.                  DIV(5)=PI4*GAM
  744.                  DIV(6)=DIV(5)
  745.                  DIV(7)=0.D0
  746. C
  747.                  IF(IDIM.EQ.2) THEN
  748.                   PRES1=XCAR(6)
  749.                   CISA1=XCAR(7)
  750.                   IDEB1=8
  751.                  ELSE IF(IDIM.EQ.3) THEN
  752.                   PRES1=XCAR(7)
  753.                   CISA1=XCAR(8)
  754.                   IDEB1=9
  755.                  ENDIF
  756. C
  757.                  JDIV1=2
  758.                  DO 6529 ICOMP=IDEB1,ICARA
  759.                    JDIV1=JDIV1+1
  760.                    VCAR1=XCAR(ICOMP)
  761.                    IF (VCAR1.NE.-1.D0) DIV(JDIV1)=XCAR(ICOMP)
  762.  6529            CONTINUE
  763. C
  764. C         NB 23/09/98
  765. C         TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  766. C         1.D0 DE DIV(3)
  767. C
  768.                  DIV(1) = DIV(3)
  769.                  DIV(3)=1.D0
  770. C
  771.                  IF(IDIM.EQ.2) CISA=XCAR(7)
  772.                  IF(IDIM.EQ.3) CISA=XCAR(8)
  773.                  VX=XCAR(4)
  774.                  VY=XCAR(5)
  775.                  VZ=XCAR(6)
  776.                  CALL TUYCAR(XCAR,CISA,VX,VY,VZ,KERRE,1)
  777.                  DIV(1)=DIV(1)/XCAR(4)
  778.                  DIV(4)=DIV(4)*RMOY/XCAR(1)
  779.                  DIV(5)=DIV(5)*RMOY/XCAR(2)
  780.                  DIV(6)=DIV(6)*RMOY/XCAR(3)
  781.                ENDIF
  782. *
  783. *              On transforme les efforts en contraintes pour les
  784. *              poutres et tuyaux
  785. *
  786.                IF (ITYP.EQ.11.OR.ITYP.EQ.12) THEN
  787.                   DO 6629 ICOMP=1,NSTR
  788.                   SIG0(ICOMP)=SIG0(ICOMP)*DIV(ICOMP)
  789.  6629             CONTINUE
  790.                ENDIF
  791. *______________________________________________________________________
  792. *
  793. *              MATERIAU PUREMENT ELASTIQUE
  794. *_____________________________________________________________________
  795. *
  796.                IF(INPLAS.EQ.0) THEN
  797.                   GO TO 510
  798.                ENDIF
  799. *======================================================================
  800. *
  801. *     NUMERO DES ETIQUETTES      :
  802. *
  803. *     1 A 99 POUR LES MODELES DE PLASTICITE  ( INDICE INPLAS )
  804. *
  805. *======================================================================
  806. *
  807.       GOTO (1, 2,99, 4, 5,99, 7,99,99,99, 7, 7, 7,99,99,99,99,99,99,99,
  808.      &      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  809.      &      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  810.      &      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99),INPLAS
  811. *
  812.   99  CONTINUE
  813.       MOTERR(1:4)=NOMAC(INPLAS)
  814.       MOTERR(5:12)=NOMFR(MFR)
  815.       CALL ERREUR(269)
  816.       SEGSUP MCHAML
  817.       MELVAL=IPMELV
  818.       SEGSUP MELVAL
  819.       GOTO 9940
  820. *_______________________________________________________________________
  821. *
  822. *     MODELE VON MISES ISOTROPE ASSOCIE ( D'APRES INCA )
  823. *_______________________________________________________________________
  824. *
  825.    1  CONTINUE
  826. *
  827. *     Cas de la plasticite parfaite
  828. *
  829.       NCOURB=2
  830.       TRAC(1)=XMAT(2)
  831.       TRAC(2)=0.D0
  832.       TRAC(3)=XMAT(2)
  833.       TRAC(4)=1.D0
  834.       IF(XMAT(2).EQ.0.D0) THEN
  835.          KERRE=33
  836.          GO TO 510
  837.       ENDIF
  838. *
  839. *     On cherche si on est sur la surface de charge
  840. *
  841.       IF(EPSPL.EQ.0.) GO TO 682
  842.       SIGVM=VONMIS(SIG0,ITYP,ALFAH,COVNMS)
  843.       IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682
  844.       ETANG=0.
  845.       GOTO 682
  846. *
  847.    4  CONTINUE
  848. *
  849. *     Cas de la plasticite cinematique bilineaire
  850. *
  851.       ICINE=1
  852.       NCOURB=2
  853.       TRAC(1)=XMAT(2)
  854.       TRAC(2)=0.D0
  855.       TRAC(3)=XMAT(2)+XMAT(3)
  856.       TRAC(4)=1.D0
  857.       IF(XMAT(2).EQ.0.D0) THEN
  858.          KERRE=33
  859.          GO TO 510
  860.       ENDIF
  861. *
  862. *     On cherche si on est sur la surface de charge
  863. *
  864.       IF(EPSPL.EQ.0.) GO TO 682
  865.       ISPHER=2
  866.       CALL AEQBPC(SIG0,SIG0,VAR0(ISPHER),1.D0,-1.D0,NSTRS)
  867. *
  868.       SIGVM=VONMIS(SIG0,ITYP,ALFAH,COVNMS)
  869.       IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682
  870.       H=TRAC(3)
  871.       ETANG=ETANG*H/(ETANG+H)
  872.       GOTO 682
  873. C
  874.    5  CONTINUE
  875. *
  876. *     Cas de la plasticite isotrope ecrouissable
  877. *
  878. *     On recupere la courbe de traction
  879. *
  880.       CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  881.       IF(KERRE.GT.0) GO TO 510
  882.       IF(EPSPL.EQ.0.) GO TO 682
  883.       LSIG=NCOURB
  884.       SEGINI WRK5
  885. *
  886.       DO 7000 IZ=1,LSIG
  887.          SIG(IZ)=TRAC(2*(IZ-1)+1)
  888.          EPS(IZ)=TRAC(2*IZ)
  889.  7000 CONTINUE
  890. *
  891.       CALL TRACTI(SELAS,EPSPL,SIG,EPS,NCOURB,2,IBI)
  892.       IF(IBI.NE.0) THEN
  893.         KERRE=75
  894.         GO TO 510
  895.       ENDIF
  896.       SIGVM=VONMIS(SIG0,ITYP,ALFAH,COVNMS)
  897. *
  898.       IF(SIGVM.LT.PRECIS*SELAS) GO TO 7001
  899.       CALL TRACTI(H,EPSPL,SIG,EPS,NCOURB,1,IBI)
  900.       IF(IBI.NE.0) THEN
  901.         KERRE=75
  902.         GO TO 510
  903.       ENDIF
  904.       ETANG=ETANG*H/(ETANG+H)
  905. *
  906.  7001 CONTINUE
  907.       SEGSUP WRK5
  908.       GO TO 682
  909. *
  910.    7  CONTINUE
  911. *
  912. *     Cas du modele CHABOCHE
  913. *
  914.       ICINE=1
  915.       IMAPLA=4
  916.       GOTO 682
  917. *
  918.   682 CONTINUE
  919.       DO 675 IC=1,NCARR
  920.          WORK(IC)=XCAR(IC)
  921.   675 CONTINUE
  922.       GOTO 510
  923. *
  924. *     Modele LINESPRING
  925. *
  926.    2  CONTINUE
  927.       GOTO 510
  928. *
  929.   510 CONTINUE
  930. *
  931. *
  932. *        Remplissage du segment contenant les contraintes a la fin
  933. *
  934.       IF (KERRE.EQ.0)  THEN
  935.          MELVAL=IPMELV
  936.          VELCHE(IGAU,IB)=ETANG
  937. *
  938. *     Impression des message d'erreurs
  939. *
  940.       ELSE IF(KERRE.NE.0) THEN
  941.          IRT0=0
  942.          IRT6=0
  943.          IRT7=0
  944.          INTERR(1)=IB
  945.          INTERR(2)=IGAU
  946.          MOTERR(1:4)=NOMTP(MELE)
  947.          IF(KERRE.EQ.1) THEN
  948.          CALL ERREUR(267)
  949.          ELSE IF(KERRE.EQ.2) THEN
  950.             CALL ERREUR(268)
  951.          ELSE IF(KERRE.EQ.30) THEN
  952.             CALL ERREUR(270)
  953.          ELSE IF(KERRE.EQ.31) THEN
  954.          CALL ERREUR(271)
  955.          ELSE IF(KERRE.EQ.32) THEN
  956.             CALL ERREUR(272)
  957.          ELSE IF(KERRE.EQ.33) THEN
  958.             CALL ERREUR(273)
  959.          ELSE IF(KERRE.EQ.34) THEN
  960.              CALL ERREUR(325)
  961.          ELSE IF(KERRE.EQ.35) THEN
  962.               CALL ERREUR(331)
  963.          ELSE IF(KERRE.EQ.36) THEN
  964.               CALL ERREUR(330)
  965.          ELSE IF(KERRE.EQ.37) THEN
  966.               CALL ERREUR(354)
  967.          ELSE IF(KERRE.EQ.21) THEN
  968.             CALL ERREUR(276)
  969.          ELSE IF(KERRE.EQ.22) THEN
  970.             CALL ERREUR(275)
  971.          ELSE IF(KERRE.EQ.75) THEN
  972.             CALL ERREUR(876)
  973.          ENDIF
  974.          GOTO 444
  975.       ENDIF
  976. *
  977.  5004 CONTINUE
  978.  3004 CONTINUE
  979. *
  980.   444 CONTINUE
  981.       SEGSUP WRK0,WRK1,WRK2,WRK3
  982.       IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  983.          SEGSUP WRK4,WRK6
  984.       ENDIF
  985. *
  986.       IF (ISUPCO.EQ.1) THEN
  987.          CALL DTMVAL (IVACON,3)
  988.       ELSE
  989.          CALL DTMVAL (IVACON,1)
  990.       ENDIF
  991. *
  992.       IF (ISUPVA.EQ.1) THEN
  993.          CALL DTMVAL (IVAVAR,3)
  994.       ELSE
  995.          CALL DTMVAL (IVAVAR,1)
  996.       ENDIF
  997. *
  998.       IF (ISUPMA.EQ.1) THEN
  999.          CALL DTMVAL (IVAMAT,3)
  1000.       ELSE
  1001.          CALL DTMVAL (IVAMAT,1)
  1002.       ENDIF
  1003. *
  1004.       IF (ISUPMA.EQ.1) THEN
  1005.          CALL DTMVAL (IVACAR,3)
  1006.       ELSE
  1007.          CALL DTMVAL (IVACAR,1)
  1008.       ENDIF
  1009.  
  1010.       NOMID=MOMATR
  1011.       IF (NOMID.NE.0) SEGSUP NOMID
  1012.       NOMID=MOCARA
  1013.       IF (NOMID.NE.0) SEGSUP NOMID
  1014.  
  1015.       IF(KERRE.NE.0)THEN
  1016.        SEGSUP MCHAML
  1017.        MELVAL=IPMELV
  1018.        SEGSUP MELVAL
  1019.        GOTO 888
  1020.       ELSE
  1021.        SEGDES MCHAML
  1022.        MELVAL=IPMELV
  1023.        SEGDES MELVAL
  1024.       ENDIF
  1025.  
  1026.   500 CONTINUE
  1027.  
  1028.   888 CONTINUE
  1029.       SEGDES MMODEL
  1030.       IF(KERRE.NE.0) THEN
  1031.          IRET=0
  1032.          SEGSUP MCHELM
  1033.       ELSE
  1034.          IRET=1
  1035.          SEGDES MCHELM
  1036.       ENDIF
  1037.  
  1038.       notype = MOTYR8
  1039.       SEGSUP,notype
  1040.  
  1041.       RETURN
  1042. *______________________________________________________________________
  1043. *
  1044. *     Erreurs dans une sous zone desactivation et retour
  1045. *______________________________________________________________________
  1046. *
  1047.  9940 CONTINUE
  1048.       IF (ISUPMA.EQ.1) THEN
  1049.         CALL DTMVAL (IVACAR,3)
  1050.       ELSE
  1051.         CALL DTMVAL (IVACAR,1)
  1052.       ENDIF
  1053.       NOMID=MOCARA
  1054.       IF (NOMID.NE.0) SEGSUP NOMID
  1055.  
  1056.  9930 CONTINUE
  1057.       IF (ISUPMA.EQ.1) THEN
  1058.          CALL DTMVAL (IVAMAT,3)
  1059.       ELSE
  1060.          CALL DTMVAL (IVAMAT,1)
  1061.       ENDIF
  1062.       NOMID=MOMATR
  1063.       IF (NOMID.NE.0) SEGSUP NOMID
  1064.  
  1065.  9920 CONTINUE
  1066.       IF (ISUPVA.EQ.1) THEN
  1067.          CALL DTMVAL(IVAVAR,3)
  1068.       ELSE
  1069.          CALL DTMVAL(IVAVAR,1)
  1070.       ENDIF
  1071.  
  1072.  9910 CONTINUE
  1073.       IF (ISUPCO.EQ.1) THEN
  1074.          CALL DTMVAL(IVACON,3)
  1075.       ELSE
  1076.          CALL DTMVAL(IVACON,1)
  1077.       ENDIF
  1078.  
  1079.  9901 CONTINUE
  1080.       SEGDES,MELEME,MINTE
  1081.  9900 CONTINUE
  1082.       SEGDES IMODEL,MMODEL
  1083.       SEGSUP MCHELM
  1084.       IRET = 0
  1085.  
  1086.       notype = MOTYR8
  1087.       SEGSUP,notype
  1088.  
  1089.       RETURN
  1090.       END
  1091.  
  1092.  
  1093.  
  1094.  

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