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

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