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

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