Télécharger la plaquette Cast3M


fr en

Télécharger hotanp.eso

Retour à la liste

Numérotation des lignes : 

hotanp

  1. C HOTANP    SOURCE    CB215821  24/04/12    21:16:16     11897          
  2.       SUBROUTINE HOTANP(IPMODL,IPCHE1,IPCHE2,IPCHE3,XPREC,
  3.      &                                    DTPS,IPCHOT,IRET)
  4. *_______________________________________________________________________
  5. *
  6. *  ENTREES :
  7. *  ---------
  8. *
  9. *    IPCHE1  pointeur sur le MCHAML de sous type CONTRAINTES
  10. *    IPCHE2  pointeur sur le MCHAML de sous type VARIABLES INTERNES
  11. *    IPCHE3  pointeur sur le MCHAML de sous type CARACTERISTIQUES
  12. *    IPMODL  pointeur sur l'objet de type MMODEL
  13. *    XPREC   flottant (par defaut 1.D-3)
  14. *    DTPS    flottant increment de temps pour les modèles visqueux
  15. *
  16. *  SORTIES :
  17. *  ---------
  18. *
  19. *    IPCHOT  pointeur sur le MCHAML de sous type MATRICE de HOOKE
  20. *            TANGENTE
  21. *     IRET   1 ou 0 suivant succes ou pas
  22. *
  23. *  Passage aux nouveaux CHAMELEM par JM CAMPENON le 05/91
  24. *
  25. *_______________________________________________________________________
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8(A-H,O-Z)
  28. *
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCHAMP
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMMODEL
  37. -INC SMINTE
  38. -INC SMLREEL
  39. *
  40. *- Nombre de points maximal pour stocker une courbe de traction
  41.       PARAMETER (LTRAC=2*75)
  42. *
  43.       SEGMENT WRK1
  44.          REAL*8 DDHOOK(NSTRS,NSTRS)
  45.          REAL*8 DDHOMU(NSTRS,NSTRS)
  46.       ENDSEGMENT
  47. *
  48.       SEGMENT MIDON1
  49.          REAL*8 XMAT(NCXMAT)
  50.       ENDSEGMENT
  51. *
  52.       SEGMENT MIDON2
  53.          REAL*8 VAR(NVART)
  54.       ENDSEGMENT
  55. *
  56.       SEGMENT MIDON3
  57.          REAL*8 XCAR(NCART)
  58.       ENDSEGMENT
  59. *
  60.       DIMENSION TRAC(LTRAC)
  61. *
  62.       SEGMENT NOTYPE
  63.         CHARACTER*16 TYPE(NBTYPE)
  64.       ENDSEGMENT
  65. *
  66.       SEGMENT MPTVAL
  67.         INTEGER IPOS(NS)    ,NSOF(NS)
  68.         INTEGER      IVAL(NCOSOU)
  69.         CHARACTER*16 TYVAL(NCOSOU)
  70.       ENDSEGMENT
  71. *
  72.       CHARACTER*8 CMATE
  73.       CHARACTER*(NCONCH) CONM
  74.       PARAMETER ( NINF=3 )
  75.       INTEGER INFOS(NINF)
  76.       LOGICAL lsupva,lsupco
  77. *
  78.       lsupva=.false.
  79.       IRET = 0
  80. *
  81.       NHRM=NIFOUR
  82.       KERRE=0
  83.       KPE  =0
  84. *
  85. *     Verification du lieu support du MCHAML de contraintes
  86. *
  87.       CALL  QUESUP(IPMODL,IPCHE1,3,0,ISUPCO,IRETCO)
  88.       IF (ISUPCO.GT.1) RETURN
  89. *
  90. *     Verification du lieu support du MCHAML de variables internes
  91. *
  92.       CALL  QUESUP(IPMODL,IPCHE2,3,0,ISUPVA,IRETVA)
  93.       IF (ISUPVA.GT.1) RETURN
  94. *
  95. *     Verification du lieu support du MCHAML de materiau
  96. *
  97.       CALL  QUESUP(IPMODL,IPCHE3,3,0,ISUPMA,IRETMA)
  98.       IF (ISUPMA.GT.1) RETURN
  99. *
  100. *     Activation du MMODEL
  101. *
  102.       MMODEL=IPMODL
  103.       SEGACT MMODEL
  104.       NSOUS=KMODEL(/1)
  105. *
  106. *     Creation du MCHELM de MATRICE DE HOOKE TANGENTE
  107. *
  108.       N1=NSOUS
  109.       L1=16
  110.       N3=6
  111.       SEGINI MCHELM
  112.       IPCHOT=MCHELM
  113.       TITCHE='MATRICE DE HOOKE'
  114.       IFOCHE=IFOUR
  115. *
  116. *     Boucle sur les sous zones du maillage
  117. *
  118.       DO 100 ISOUS=1,NSOUS
  119. *
  120. *        Traitement du modele
  121. *
  122.          IPMOD1=KMODEL(ISOUS)
  123.          IMODEL=IPMOD1
  124.          SEGACT IMODEL
  125.          IPMAIL=IMAMOD
  126.          CONM  =CONMOD
  127.          IMACHE(ISOUS) = IPMAIL
  128.          CONCHE(ISOUS) = CONMOD
  129. *
  130.          MELE=NEFMOD
  131.          MELEME=IMAMOD
  132.          SEGACT MELEME
  133.          NBNN=NUM(/1)
  134.          NBELEM=NUM(/2)
  135.          NFOR=FORMOD(/2)
  136.          NMAT=MATMOD(/2)
  137. C
  138. C   COQUE INTEGREE OU PAS ?
  139. C
  140.       IF(INFMOD(/1).NE.0)THEN
  141.           NPINT=INFMOD(1)
  142.       ELSE
  143.           NPINT=0
  144.       ENDIF
  145. *
  146. *        Nature du materiau
  147. *
  148.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,MAPL)
  149.          IF (CMATE.EQ.' ') THEN
  150.            CALL ERREUR(251)
  151.            SEGSUP MCHELM
  152.            SEGDES MMODEL,IMODEL
  153.            RETURN
  154.          ENDIF
  155. *
  156. *        Information sur l'element fini
  157. *
  158. *         CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  159. *         IF (IERR.NE.0) THEN
  160. *           SEGDES IMODEL,MMODEL
  161. *           SEGSUP MCHELM
  162. *           RETURN
  163. *         ENDIF
  164.          MELE =INFELE(1)
  165.          MFR  =INFELE(13)
  166.          IPPORE=0
  167.          IF(MFR.EQ.33) IPPORE=NBNN
  168.          NBG  =INFELE(6)
  169.          NBGS =INFELE(4)
  170.          NSTRS=INFELE(16)
  171.          LW   =INFELE(7)
  172.          LHOOK=INFELE(10)
  173.          LHOO2=LHOOK*LHOOK
  174.          ICARA=INFELE(5)
  175. *         MINTE=INFELE(11)
  176.          MINTE=INFMOD(5)
  177.          IPMIN1=MINTE
  178. *
  179. *        Creation du tableau INFOS ( contraintes et variables internes )
  180. *
  181.          CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD)
  182.          IF (IRTD.EQ.0) THEN
  183.            SEGDES IMODEL,MMODEL
  184.            SEGSUP MCHELM
  185.            RETURN
  186.          ENDIF
  187. C
  188.          INFCHE(ISOUS,1)=0
  189.          INFCHE(ISOUS,2)=0
  190.          INFCHE(ISOUS,3)=NHRM
  191.          INFCHE(ISOUS,4)=MINTE
  192.          INFCHE(ISOUS,5)=0
  193.          INFCHE(ISOUS,6)=3
  194. *
  195. *        Creation du MCHAML de HOOKE TANGENTE
  196. *
  197.          N2=1
  198.          SEGINI MCHAML
  199.          ICHAML(ISOUS)=MCHAML
  200.          NOMCHE(1)='MAHO'
  201.          TYPCHE(1)='POINTEURLISTREEL'
  202. *
  203.          IVAHOO=0
  204.          WRK1=0
  205.          MOCARA=0
  206.          NCARA=0
  207.          NCARF=0
  208.          MOMATR=0
  209.          NMATR=0
  210.          NMATF=0
  211.          MOVARI=0
  212.          NVARI=0
  213.          NVARF=0
  214.          IVACAR=0
  215.          IVAMAT=0
  216.          IVARI=0
  217.          IVACON=0
  218. C
  219.          SEGACT,MINTE
  220. *
  221. *        Traitement des champ de CONTRAINTES
  222. *
  223.          if(lnomid(4).ne.0) then
  224.           nomid=lnomid(4)
  225.           segact nomid
  226.           mocont=nomid
  227.           nstrs=lesobl(/2)
  228.           nfac=lesfac(/2)
  229.           lsupco=.false.
  230.          else
  231.           lsupco=.true.
  232.           CALL IDCONT(IMODEL,IFOUR,MOCONT,NSTRS,NFAC)
  233.          endif
  234.          IF (MOCONT.EQ.0) THEN
  235.             MOTERR(1:4)='CONT'
  236.             MOTERR(5:8)=NOMTP(MELE)
  237.             CALL ERREUR (76)
  238.             GOTO 9990
  239.          ENDIF
  240. *
  241.          NBTYPE=1
  242.          SEGINI NOTYPE
  243.          MOTYPE=NOTYPE
  244.          TYPE(1)='REAL*8'
  245.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCONT,MOTYPE,1,INFOS,3,IVACON)
  246.          SEGSUP NOTYPE
  247.          IF (IERR.NE.0) GOTO 9990
  248. *
  249.          IF (ISUPCO.EQ.1) THEN
  250.            CALL VALCHE(IVACON,NSTRS,IPMIN1,IPPORE,MOCONT,MELE)
  251.         ENDIF
  252. *
  253. *        Traitement des champ de VARIABLES INTERNES
  254. *
  255.          if(lnomid(10).ne.0) then
  256.           nomid=lnomid(10)
  257.           segact nomid
  258.           movari=nomid
  259.           nvari=lesobl(/2)
  260.           nvarf=lesfac(/2)
  261.           lsupva=.false.
  262.          else
  263.           lsupva=.true.
  264.           CALL IDVARI(MFR,IPMOD1,MOVARI,NVARI,NVARF)
  265.          endif
  266.          IF (MOVARI.EQ.0) THEN
  267.             MOTERR(1:4)='VARI'
  268.             MOTERR(5:8)=NOMTP(MELE)
  269.             CALL ERREUR (76)
  270.             GOTO 9990
  271.          ENDIF
  272.          NVART=NVARI+NVARF
  273. *
  274.          NBTYPE=1
  275.          SEGINI NOTYPE
  276.          MOTYPE=NOTYPE
  277.          TYPE(1)='REAL*8'
  278.          CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  279.          SEGSUP NOTYPE
  280.          IF (IERR.NE.0) GOTO 9990
  281. *
  282.          IF (ISUPVA.EQ.1) THEN
  283.            CALL VALCHE(IVARI,NVART,IPMIN1,IPPORE,MOVARI,MELE)
  284.         ENDIF
  285. *
  286. *        Creation du tableau INFOS (variables internes,caracteristiques)
  287. *
  288.          CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE3,INFOS,IRTE)
  289.          IF (IRTE.EQ.0) GOTO 9990
  290. *
  291. *        Traitement des champs de materiaux
  292. *
  293.          NBROBL=0
  294.          NBRFAC=0
  295.          IF (CMATE.EQ.'ISOTROPE') THEN
  296.             IF (MAPL.EQ.1) THEN
  297.                NBROBL=3
  298.                SEGINI NOMID
  299.                MOMATR=NOMID
  300.                LESOBL(1)='YOUN'
  301.                LESOBL(2)='NU  '
  302.                LESOBL(3)='SIGY'
  303. *
  304.                NBTYPE=1
  305.                SEGINI NOTYPE
  306.                MOTYPE=NOTYPE
  307.                TYPE(1)='REAL*8'
  308.             ELSE IF (MAPL.EQ.3) THEN
  309.                NBROBL=4
  310.                SEGINI NOMID
  311.                MOMATR=NOMID
  312.                LESOBL(1)='YOUN'
  313.                LESOBL(2)='NU  '
  314.                LESOBL(3)='LTR '
  315.                LESOBL(4)='LCS '
  316. *
  317.                NBTYPE=1
  318.                SEGINI NOTYPE
  319.                MOTYPE=NOTYPE
  320.                TYPE(1)='REAL*8'
  321.             ELSE IF (MAPL.EQ.15) THEN
  322.                NBROBL=11
  323.                SEGINI NOMID
  324.                MOMATR=NOMID
  325.                LESOBL(1)='YOUN'
  326.                LESOBL(2)='NU  '
  327.                LESOBL(3)='ETA '
  328.                LESOBL(4)='MU  '
  329.                LESOBL(5)='KL  '
  330.                LESOBL(6)='GAMM'
  331.                LESOBL(7)='DELT'
  332.                LESOBL(8)='ALFA'
  333.                LESOBL(9)='BETA'
  334.                LESOBL(10)='K   '
  335.                LESOBL(11)='H   '
  336. *
  337.                NBTYPE=1
  338.                SEGINI NOTYPE
  339.                MOTYPE=NOTYPE
  340.                TYPE(1)='REAL*8'
  341.             ELSE IF (MAPL.EQ.4) THEN
  342.                NBROBL=4
  343.                SEGINI NOMID
  344.                MOMATR=NOMID
  345.                LESOBL(1)='YOUN'
  346.                LESOBL(2)='NU  '
  347.                LESOBL(3)='SIGY'
  348.                LESOBL(4)='H   '
  349. *
  350.                NBTYPE=1
  351.                SEGINI NOTYPE
  352.                MOTYPE=NOTYPE
  353.                TYPE(1)='REAL*8'
  354.             ELSE IF (MAPL.EQ.5) THEN
  355.                NBROBL=3
  356.                SEGINI NOMID
  357.                MOMATR=NOMID
  358.                LESOBL(1)='YOUN'
  359.                LESOBL(2)='NU  '
  360.                LESOBL(3)='ECRO'
  361. *
  362.                NBTYPE=3
  363.                SEGINI NOTYPE
  364.                MOTYPE=NOTYPE
  365.                TYPE(1)='REAL*8'
  366.                TYPE(2)='REAL*8'
  367.                TYPE(3)='POINTEUREVOLUTIO'
  368.             ELSE IF (MAPL.EQ.26) THEN
  369.                NBROBL=3
  370.                SEGINI NOMID
  371.                MOMATR=NOMID
  372.                LESOBL(1)='YOUN'
  373.                LESOBL(2)='NU  '
  374.                LESOBL(3)='DC  '
  375. *
  376.                NBTYPE=1
  377.                SEGINI NOTYPE
  378.                MOTYPE=NOTYPE
  379.                TYPE(1)='REAL*8'
  380.             ELSE IF (MAPL.EQ.38) THEN
  381. *               pour le modele de gurson l'option est indisponible
  382.                   CALL ERREUR (251)
  383.                   GOTO 9990
  384. *
  385.             ELSE IF (MAPL.EQ.43) THEN
  386. *      modele visco-plastique parfait
  387.               NBROBL=5
  388.               SEGINI NOMID
  389.               MOMATR=NOMID
  390.               LESOBL(1)='YOUN'
  391.               LESOBL(2)='NU  '
  392.               LESOBL(3)='SIGY'
  393.               LESOBL(4)='N   '
  394.               LESOBL(5)='K   '
  395. *
  396.               NBTYPE=1
  397.               SEGINI NOTYPE
  398.               MOTYPE=NOTYPE
  399.               TYPE(1)='REAL*8'
  400.             ELSE
  401.                NBROBL=2
  402.                SEGINI NOMID
  403.                MOMATR=NOMID
  404.                LESOBL(1)='YOUN'
  405.                LESOBL(2)='NU  '
  406. *
  407.                NBTYPE=1
  408.                SEGINI NOTYPE
  409.                MOTYPE=NOTYPE
  410.                TYPE(1)='REAL*8'
  411.             ENDIF
  412.          ELSE
  413.             MOTERR(1:8)=NOMAT(MATE)
  414.             MOTERR(9:12)=NOMAC(MAPL)
  415.             MOTERR(13:20)=NOMFR(MFR)
  416.             INTERR(1)=IFOUR
  417.             CALL ERREUR(328)
  418.             GOTO 9990
  419.          ENDIF
  420. *
  421.          CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  422.          SEGSUP NOTYPE
  423.          IF (IERR.NE.0) GOTO 9990
  424.          IF(ISUPMA.EQ.1)THEN
  425.             CALL VALCHE(IVAMAT,NMATT,IPMIN1,IPPORE,MOMATR,MELE)
  426.             IF(IERR.NE.0)THEN
  427.               ISUPMA=0
  428.               GOTO 9990
  429.             ENDIF
  430.          ENDIF
  431. *
  432.          NCXMAT=NMATT
  433.          IF(MAPL.EQ.3) NCXMAT=NMATT+7
  434. *
  435. *        Traitement des champs de caracteristiques
  436. *
  437.          MOCARA = 0
  438.          NBROBL = 0
  439.          NBRFAC = 0
  440.          IVECT  = 0
  441. *
  442. *        Cas des coques
  443. *
  444.          IF (MFR.EQ.3) THEN
  445.             IF(IFOCHE.GE.-2.OR.IFOCHE.LE.2) THEN
  446.                NBROBL=2
  447.                SEGINI NOMID
  448.                MOCARA=NOMID
  449.                LESOBL(1)='EPAI'
  450.                LESOBL(2)='CALF'
  451. *
  452.                NBTYPE=1
  453.                SEGINI NOTYPE
  454.                MOTYPE=NOTYPE
  455.                TYPE(1)='REAL*8'
  456.             ENDIF
  457.          ENDIF
  458. *
  459.          NCARA=NBROBL
  460.          NCARF=NBRFAC
  461.          NCART=NCARA+NCARF
  462.          IF (MOCARA.NE.0) THEN
  463.          CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  464.          SEGSUP,NOTYPE
  465.            IF (IERR.NE.0) GOTO 9990
  466. *
  467.          IF(ISUPMA.EQ.1)THEN
  468.             CALL VALCHE(IVACAR,NCART,IPMIN1,IPPORE,MOCARA,MELE)
  469.             IF(IERR.NE.0)THEN
  470.               ISUPMA=0
  471.               GOTO 9990
  472.             ENDIF
  473.          ENDIF
  474.            SEGDES NOMID
  475.          ENDIF
  476. *
  477. *        Recherche de la taille des MELVALs a allouer
  478. *
  479.          N2PTEL=NBG
  480.          N2EL=NBELEM
  481.          NEL=N2EL
  482.          NBPTEL=N2PTEL
  483. *
  484.          N1PTEL=0
  485.          N1EL=0
  486.          SEGINI MELVAL
  487.          IVAHOO=MELVAL
  488.          IELVAL(1)=MELVAL
  489. *
  490. *        On met la courbe de traction a zero
  491. *
  492.          SEGINI WRK1
  493.          CALL  ZDANUL(TRAC,LTRAC)
  494. *
  495. *      DANS LE CAS DE COQUES INTEGREES ,ON LES TRAITE COMMME LE
  496. *      MASSIF CONTRAINTE PLANE
  497. *
  498.         IF(NPINT.NE.0)THEN
  499.          IF(MELE.EQ.28)THEN
  500.             IFOURB=-2
  501.             MFR1=1
  502.          ENDIF
  503.         ELSE
  504.            MFR1=MFR
  505.            IFOURB=IFOUR
  506.         ENDIF
  507. *
  508. *        En cas de materiau endommageable
  509. *
  510.          IF (MAPL.EQ.26.OR.MAPL.EQ.29) GOTO 555
  511. *
  512. * MFR=        MASS    COQU  RAYL  POUT CISTR  LIQU  TUYA  LISP
  513.          GOTO(1000,66,3000,66,66,66,66,66,66,66,66,66,66,66,66,
  514. *             TUFI    RAMA    RACO    SURF                 ICQ
  515.      &        66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,1000),MFR1
  516.  66      CONTINUE
  517.          MOTERR(1:8)=NOMFR(MFR)
  518.          CALL ERREUR(193)
  519.          GOTO 9990
  520. *_______________________________________________________________________
  521. *
  522. *        Formulation MASSIVE
  523. *_______________________________________________________________________
  524. *
  525.  1000 CONTINUE
  526.       DO 1001 IB=1,NEL
  527.          DO 1002 IGAU=1,NBPTEL
  528. *
  529.             IF(MAPL.EQ.5) THEN
  530.                MPTVAL=IVAMAT
  531.                MELVAL=IVAL(1)
  532.                IBMN=MIN(IB  ,VELCHE(/2))
  533.                IGMN=MIN(IGAU,VELCHE(/1))
  534.                YYYY=VELCHE(IGMN,IBMN)
  535. *
  536.                MELVAL=IVAL(3)
  537.                IBMN=MIN(IB  ,IELCHE(/2))
  538.                IGMN=MIN(IGAU,IELCHE(/1))
  539.                IMMM=IELCHE(IGMN,IBMN)
  540. *
  541.                CALL COTRA1(IMMM,YYYY,LTRAC,TRAC,NTRAC,KERRE)
  542.                IF(KERRE.NE.0) THEN
  543.                   KERIB=IB
  544.                   KERIG=IGAU
  545.                ENDIF
  546.             ENDIF
  547. *
  548.             CALL DOHOT1(IVAMAT,NMATT,IVACON,NSTRS,IVARI,NVART,TRAC,
  549.      &       LTRAC,IGAU,IB,MATE,MAPL,XPREC,DTPS,
  550.      &                      IFOURB,LHOOK,DDHOOK,IRTD)
  551. *
  552.             IF(IRTD.EQ.-1) THEN
  553.                KPE=-1
  554.                KPEIB=IB
  555.                KPEIG=IGAU
  556.             ENDIF
  557. C
  558.             JG=LHOO2
  559.             SEGINI MLREEL
  560.             MELVAL=IVAHOO
  561.             IELCHE(IGAU,IB)=MLREEL
  562.             KO=0
  563.             DO 1005 IO=1,LHOOK
  564.                DO 1006 JO=1,LHOOK
  565.                   KO=KO+1
  566.                   PROG(KO)=DDHOOK(IO,JO)
  567.  1006       CONTINUE
  568.  1005       CONTINUE
  569. C*//        SEGDES MLREEL
  570.  1002 CONTINUE
  571.  1001 CONTINUE
  572.       GOTO 510
  573. *_______________________________________________________________________
  574. *
  575. *        Cas des coques minces
  576. *_______________________________________________________________________
  577. *
  578.  3000 CONTINUE
  579.       DO 3001 IB=1,NEL
  580.          DO 3002 IGAU=1,NBPTEL
  581. *
  582.             IF(MAPL.EQ.5) THEN
  583.                MPTVAL=IVAMAT
  584. *
  585.                MELVAL=IVAL(1)
  586.                IBMN=MIN(IB  ,VELCHE(/2))
  587.                IGMN=MIN(IGAU,VELCHE(/1))
  588.                YYYY=VELCHE(IGMN,IBMN)
  589. *
  590.                MELVAL=IVAL(3)
  591.                IBMN=MIN(IB  ,IELCHE(/2))
  592.                IGMN=MIN(IGAU,IELCHE(/1))
  593.                IMMM=IELCHE(IGMN,IBMN)
  594. *
  595.                CALL COTRA1(IMMM,YYYY,LTRAC,TRAC,NTRAC,KERRE)
  596.                IF(KERRE.NE.0) THEN
  597.                   KERIB=IB
  598.                   KERIG=IGAU
  599.                ENDIF
  600.             ENDIF
  601. *
  602.             MPTVAL=IVACAR
  603.             MELVAL=IVAL(1)
  604.             IBMN=MIN(IB  ,VELCHE(/2))
  605.             IGMN=MIN(IGAU,VELCHE(/1))
  606.             EPAIST=VELCHE(IGMN,IBMN)
  607. *
  608.             MELVAL=IVAL(2)
  609.             IBMN=MIN(IB  ,VELCHE(/2))
  610.             IGMN=MIN(IGAU,VELCHE(/1))
  611.             ALPHA=VELCHE(IGMN,IBMN)
  612. *
  613. * DOHOT3 se chargera de convertir les efforts generalises (IVACON)
  614. * et les variables internes generalisees (IVARI) en contraintes et
  615. * variables internes "locales"
  616. *
  617.            CALL DOHOT3(IVAMAT,NMATT,IVACON,NSTRS,IVARI,NVART,
  618.      &                 TRAC,LTRAC,ALPHA,EPAIST,IGAU,IB,MATE,MAPL,
  619.      &                 XPREC,DTPS,IFOURB,LHOOK,DDHOOK,IRTD)
  620. *
  621.            IF(IRTD.EQ.-1) THEN
  622.               KPE=-1
  623.               KPEIB=IB
  624.               KPEIG=IGAU
  625.            ENDIF
  626. C
  627.            JG=LHOO2
  628.            SEGINI MLREEL
  629.            MELVAL=IVAHOO
  630.            IELCHE(IGAU,IB)=MLREEL
  631.            KO=0
  632.            DO 3014 IO=1,LHOOK
  633.               DO 3015 JO=1,LHOOK
  634.                  KO=KO+1
  635.                  PROG(KO)=DDHOOK(IO,JO)
  636.  3015      CONTINUE
  637.  3014      CONTINUE
  638. C*//       SEGDES MLREEL
  639.  3002   CONTINUE
  640.  3001   CONTINUE
  641.         GOTO 510
  642. *_______________________________________________________________________
  643. *
  644. *        Cas des materiaux endommageables
  645. *_______________________________________________________________________
  646. *
  647.   555 CONTINUE
  648.       IF(MAPL.EQ.26) NMATT=NMATT+4
  649.       NCXMAT=NMATT
  650.       SEGINI MIDON1
  651.       SEGINI MIDON2
  652.       SEGINI MIDON3
  653.       DO 2001 IB=1,NEL
  654.          DO 2002 IGAU=1,NBPTEL
  655. *
  656. *           On recupere les Cts du mat.,les var. int. et les carac.
  657. *
  658.             MPTVAL=IVAMAT
  659.             DO 2010 ICOMP=1,2
  660.                MELVAL=IVAL(ICOMP)
  661.                IBMN=MIN(IB  ,VELCHE(/2))
  662.                IGMN=MIN(IGAU,VELCHE(/1))
  663.                XMAT(ICOMP)=VELCHE(IGMN,IBMN)
  664.  2010      CONTINUE
  665. C
  666.            IF(MAPL.EQ.29) GOTO 2015
  667. C
  668.             DO 2011 ICOMP=3,6
  669.                XMAT(ICOMP)=0.D0
  670.  2011      CONTINUE
  671.            MELVAL=IVAL(3)
  672.            IBMN=MIN(IB  ,VELCHE(/2))
  673.            IGMN=MIN(IGAU,VELCHE(/1))
  674.            XMAT(7)=VELCHE(IGMN,IBMN)
  675. *
  676.  2015      MPTVAL=IVARI
  677.            DO 2020 ICOMP=1,NVART
  678.               MELVAL=IVAL(ICOMP)
  679.               IBMN=MIN(IB  ,VELCHE(/2))
  680.               IGMN=MIN(IGAU,VELCHE(/1))
  681.               VAR(ICOMP)=VELCHE(IGMN,IBMN)
  682.  2020      CONTINUE
  683. *
  684.            IF(MOCARA.NE.0) THEN
  685.               MPTVAL=IVACAR
  686.               DO 2030 ICOMP=1,NCART
  687.                  MELVAL=IVAL(ICOMP)
  688.                  IBMN=MIN(IB  ,VELCHE(/2))
  689.                  IGMN=MIN(IGAU,VELCHE(/1))
  690.                  XCAR(ICOMP)=VELCHE(IGMN,IBMN)
  691.  2030         CONTINUE
  692.            ENDIF
  693. *
  694. *          Selon le modele de materiau endommageable
  695. *
  696.            ZERO=0.D0
  697.            IF (MAPL.EQ.26) CALL ELAST1(1,IFOURB,VAR,NVART,XMAT,NCXMAT,
  698.      &ZERO,ZERO,XCAR,NCART,MFR1,NSTRS,DDHOOK,DDHOMU,KERRE,-1,0)
  699.            IF (MAPL.EQ.29) CALL ELAST1(1,IFOURB,VAR,NVART,XMAT,NCXMAT,
  700.      &ZERO,ZERO,XCAR,NCART,MFR1,NSTRS,DDHOOK,DDHOMU,KERRE,-2,0)
  701.            IF (KERRE.NE.0) GOTO 66
  702. *
  703. *
  704.            JG=LHOO2
  705.            SEGINI MLREEL
  706.            MELVAL=IVAHOO
  707.            IELCHE(IGAU,IB)=MLREEL
  708.            KO=0
  709.            IF(NPINT.NE.0.AND.MFR.EQ.3)THEN
  710.             DDHOOK(1,3)=DDHOOK(1,4)
  711.             DDHOOK(2,3)=DDHOOK(2,4)
  712.             DDHOOK(3,1)=DDHOOK(1,3)
  713.             DDHOOK(3,2)=DDHOOK(2,3)
  714.             DDHOOK(3,3)=DDHOOK(4,4)
  715.             DO 2041 IO=1,LHOOK/2
  716.               IO1=LHOOK*(IO-1)
  717.               IO2=LHOOK*(2+IO)
  718.               DO 2043 JO=1,LHOOK/2
  719.                  JO1=IO1+JO
  720.                  JO2=IO2+JO
  721.                  PROG(JO1)=DDHOOK(IO,JO)
  722.                  PROG(JO2+3)=DDHOOK(IO,JO)
  723.  2043       CONTINUE
  724.  2041       CONTINUE
  725.            ELSE
  726.             DO 2040 IO=1,LHOOK
  727.               DO 2042 JO=1,LHOOK
  728.                  KO=KO+1
  729.                  PROG(KO)=DDHOOK(IO,JO)
  730.  2042       CONTINUE
  731.  2040       CONTINUE
  732.            ENDIF
  733. C*//       SEGDES MLREEL
  734.  2002 CONTINUE
  735.  2001 CONTINUE
  736. *
  737.       SEGSUP MIDON1
  738.       SEGSUP MIDON2
  739.       SEGSUP MIDON3
  740.       IF(MAPL.EQ.26) NMATT=NMATT-4
  741.  
  742.       GOTO 510
  743. *____________________________________________________________________*
  744. *                                                                    *
  745. *     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS *
  746. *____________________________________________________________________*
  747. *                                                                    *
  748.   510 CONTINUE
  749. *
  750.       IF(MAPL.EQ.26.OR.MAPL.EQ.29) GOTO 110
  751. *
  752. *     ERREUR le materiau n'est pas encore implente pour la
  753. *            formulation MFR et l'option IFOUR
  754. *
  755.       IF(IRTD.EQ.0) THEN
  756.          MOTERR(1:8)=NOMAT(MATE)
  757.          MOTERR(9:12)=NOMAC(MAPL)
  758.          MOTERR(13:20)=NOMFR(MFR)
  759.          INTERR(1)=IFOUR
  760.          CALL ERREUR(328)
  761.          GOTO 9990
  762.       ENDIF
  763. *
  764. *      Contraintes en dehors de la courbe de traction
  765. *
  766.       IF(KPE.EQ.-1) THEN
  767.          INTERR(1)=KPEIB
  768.          INTERR(2)=KPEIG
  769.          MOTERR(1:4)=NOMTP(MELE)
  770.          CALL ERREUR(275)
  771.          GOTO 9990
  772.       ENDIF
  773. *
  774. *     Probleme courbe de traction
  775. *
  776.       IF(KERRE.NE.0) THEN
  777.          INTERR(1)=KERIB
  778.          INTERR(2)=KERIG
  779.          MOTERR(1:4)=NOMTP(MELE)
  780.          CALL ERREUR(KERRE)
  781.          GOTO 9990
  782.       ENDIF
  783. *
  784.  110  CONTINUE
  785.       SEGDES MCHAML
  786.       IF (IVAHOO.NE.0) THEN
  787.          MELVAL=IVAHOO
  788.          SEGDES MELVAL
  789.       ENDIF
  790. *
  791.       IF (ISUPMA.EQ.1) THEN
  792.         CALL DTMVAL(IVAMAT,3)
  793.       ELSE
  794.         CALL DTMVAL(IVAMAT,1)
  795.       ENDIF
  796.       NOMID=MOMATR
  797.       SEGSUP,NOMID
  798. *
  799.       IF (ISUPMA.EQ.1) THEN
  800.         CALL DTMVAL(IVACAR,3)
  801.       ELSE
  802.         CALL DTMVAL(IVACAR,1)
  803.       ENDIF
  804.       NOMID=MOCARA
  805.       IF (MOCARA.NE.0) SEGSUP,NOMID
  806. *
  807.       IF (ISUPVA.EQ.1) THEN
  808.         CALL DTMVAL(IVARI,3)
  809.       ELSE
  810.         CALL DTMVAL(IVARI,1)
  811.       ENDIF
  812.       NOMID=MOVARI
  813.       IF (lsupva) SEGSUP,NOMID
  814. *
  815.       IF (ISUPCO.EQ.1) THEN
  816.         CALL DTMVAL(IVACON,3)
  817.       ELSE
  818.         CALL DTMVAL(IVACON,1)
  819.       ENDIF
  820.       NOMID=MOCONT
  821.       IF (lsupco) SEGSUP,NOMID
  822. *
  823.        SEGDES,MINTE
  824.        SEGDES IMODEL
  825. C*//   SEGDES MELEME
  826.        SEGSUP WRK1
  827.   100  CONTINUE
  828.        IRET = 1
  829.        SEGDES MMODEL,MCHELM
  830.        RETURN
  831. *
  832.  9990 CONTINUE
  833. *_______________________________________________________________________
  834. *
  835. *           ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  836. *_______________________________________________________________________
  837. *
  838.       IRET = 0
  839. *
  840.       IF (ISUPMA.EQ.1) THEN
  841.         CALL DTMVAL(IVAMAT,3)
  842.       ELSE
  843.         CALL DTMVAL(IVAMAT,1)
  844.       ENDIF
  845.       NOMID=MOMATR
  846.       SEGSUP,NOMID
  847. *
  848.       IF (ISUPMA.EQ.1) THEN
  849.         CALL DTMVAL(IVACAR,3)
  850.       ELSE
  851.         CALL DTMVAL(IVACAR,1)
  852.       ENDIF
  853.       NOMID=MOCARA
  854.       IF (MOCARA.NE.0) SEGSUP,NOMID
  855. *
  856.       IF (ISUPVA.EQ.1) THEN
  857.         CALL DTMVAL(IVARI,3)
  858.       ELSE
  859.         CALL DTMVAL(IVARI,1)
  860.       ENDIF
  861.       NOMID=MOVARI
  862.       IF (lsupva.AND.MOVARI.NE.0) SEGSUP,NOMID
  863. *
  864.       IF (ISUPCO.EQ.1) THEN
  865.         CALL DTMVAL(IVACON,3)
  866.       ELSE
  867.         CALL DTMVAL(IVACON,1)
  868.       ENDIF
  869.       NOMID=MOCONT
  870.       IF (lsupco.AND.MOCONT.NE.0) SEGSUP,NOMID
  871. *
  872.       IF (IVAHOO.NE.0) THEN
  873.          MELVAL=IVAHOO
  874.          SEGSUP MELVAL
  875.       ENDIF
  876.       IF (WRK1.NE.0) SEGSUP WRK1
  877.       SEGDES,MINTE
  878.       SEGDES MELEME
  879.       SEGDES IMODEL
  880.       SEGSUP MCHAML
  881. *
  882.       SEGDES MMODEL
  883.       SEGSUP MCHELM
  884.  
  885.       RETURN
  886.       END
  887.  
  888.  
  889.  
  890.  
  891.  
  892.  
  893.  
  894.  
  895.  
  896.  

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