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

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