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

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