Télécharger la plaquette Cast3M


fr en

Télécharger invaca.eso

Retour à la liste

Numérotation des lignes : 

invaca

  1. C INVACA    SOURCE    OF166741  24/05/06    21:15:21     11082          
  2.  
  3.       SUBROUTINE INVACA(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHE5,
  4.      &                  IMIL,IRET)
  5.  
  6. *---------------------------------------------------------------------
  7. *
  8. *      CALCUL DES 3 INVARIANTS D'UN TENSEUR D'ORDRE 2
  9. *                 (APPELE PAR INVARI)
  10. *
  11. *   ENTREES:
  12. *   --------
  13. *
  14. *     IPMODL   POINTEUR SUR UN MMODEL
  15. *     IPCHE1   POINTEUR SUR UN CHAMELEM DE CONTRAINTES OU DEFORMATIONS
  16. *              (TYPE MCHAML)
  17. *     IPCHE5   POINTEUR SUR UN CHAMELEM DE CARACTERISTIQUES
  18. *              (TYPE MCHAML)
  19. *     IMIL     INDICATEUR OU ON CALCULE LES CONTRAINTES POUR
  20. *              LES COQUES
  21. *
  22. *  SORTIES :
  23. *  ---------
  24. *
  25. *     IPCHE2   POINTEUR SUR UN CHAMELEM STRESSES ( I1)
  26. *     IPCHE3   POINTEUR SUR UN CHAMELEM STRESSES ( I2 )
  27. *     IPCHE4   POINTEUR SUR UN CHAMELEM STRESSES ( I3 )
  28. *     IRET     =1  OU  0   SUIVANT SUCCES OU PAS
  29. *
  30. *  PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 12/90
  31. *
  32. *---------------------------------------------------------------------
  33. *
  34.       IMPLICIT INTEGER(I-N)
  35.       IMPLICIT REAL*8(A-H,O-Z)
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC CCHAMP
  40. C==DEB= FORMULATION HHO == Include specifique ==========================
  41. -INC CCHHOPA
  42. C==FIN= FORMULATION HHO ================================================
  43.  
  44. -INC SMCHAML
  45. -INC SMMODEL
  46.  
  47.       SEGMENT NOTYPE
  48.         CHARACTER*16 TYPE(NBTYPE)
  49.       ENDSEGMENT
  50. *
  51.       SEGMENT MPTVAL
  52.         INTEGER IPOS(NS)    ,NSOF(NS)
  53.         INTEGER      IVAL(NCOSOU)
  54.         CHARACTER*16 TYVAL(NCOSOU)
  55.       ENDSEGMENT
  56. *
  57.       PARAMETER ( NINF=3 )
  58.       INTEGER INFOS(NINF)
  59.       CHARACTER*(NCONCH) CONM
  60.       LOGICAL lsupno
  61. *
  62.       DIMENSION SIG(9)
  63.  
  64. *------ Fin des déclarations ------------------------------------
  65.  
  66.       IRET = 0
  67.       IPCHE2 = 0
  68.       IPCHE3 = 0
  69.       IPCHE4 = 0
  70. *
  71. * Reduction des MCHAMLs sur le MODELE
  72. *
  73.       kerre = 0
  74. *
  75.       CALL REDUAF(IPCHE1,IPMODL,ipch,0,ir,kerre)
  76.       IF (ir.NE.1) CALL ERREUR(kerre)
  77.       IF (IERR.NE.0) RETURN
  78.       IPCHE1 = ipch
  79. *
  80.       IF (IPCHE5.NE.0) THEN
  81.         CALL REDUAF(IPCHE5,IPMODL,ipch,0,ir,kerre)
  82.         IF (ir.NE.1) CALL ERREUR(kerre)
  83.         IF (IERR.NE.0) RETURN
  84.         IPCHE5 = ipch
  85.       ENDIF
  86. *
  87. * Verification du type de IPCHE1 !
  88. *
  89.       MCHELM = IPCHE1
  90.       SEGACT,MCHELM
  91.       IF (TITCHE.EQ.'CONTRAINTES') THEN
  92.         ICONTR = 1
  93.         W1 = 2.D0
  94.         W2 = 1.D0
  95.         W3 = 2.D0
  96.       ELSE IF (TITCHE.EQ.'DEFORMATIONS') THEN
  97.         ICONTR = 0
  98.         W1 = 0.5D0
  99.         W2 = 0.25D0
  100.         W3 = 0.25D0
  101.       ELSE
  102.         MOTERR(1:24)='CONTRAINTES'
  103.         MOTERR(25:48)='DEFORMATIONS'
  104.         CALL ERREUR(109)
  105.         GOTO 666
  106.       ENDIF
  107. *
  108. *  Verification du lieu support des mchamls
  109. *
  110.       CALL QUESUP(IPMODL,IPCHE1,0,0,iret1,ISUP1)
  111.       IF (IERR.NE.0) GOTO 666
  112. *
  113.       IPCH5O = IPCHE5
  114.       IF (IPCHE5.NE.0) THEN
  115.         CALL QUESUP(IPMODL,IPCH5O,ISUP1,0,ISUP5,iret5)
  116.         IF (ISUP5.GT.1) GOTO 666
  117.         IF (IERR.NE.0) GOTO 666
  118. C Le support des caractéristiques est différent de celui de IPCHE1
  119.         IF (ISUP5.NE.0) THEN
  120.           CALL CHASUP(IPMODL,IPCH5O,IPCHE5,irecar,ISUP1)
  121.           IF (irecar.NE.0) GOTO 666
  122.         ENDIF
  123.       ENDIF
  124. *
  125. *  Activation et verification du modele
  126. *
  127.       MMODEL = IPMODL
  128.       SEGACT,MMODEL
  129.       NSOUS = KMODEL(/1)
  130.       KEL22 = 0
  131.       DO ISOUS = 1, NSOUS
  132.         IMODEL=KMODEL(ISOUS)
  133.         SEGACT,IMODEL
  134.         IF (FORMOD(1).NE.'MECANIQUE' .AND.
  135.      &      FORMOD(1).NE.'POREUX') THEN
  136.           MOTERR(1:8) = FORMOD(1)
  137.           CALL ERREUR(193)
  138.           GOTO 666
  139.         ENDIF
  140.         IF ((NEFMOD.EQ.22).OR.(NEFMOD.EQ.259)) KEL22 = KEL22 + 1
  141.       ENDDO
  142. *
  143. C ... Initialisation des trois nouveaux MCHELM - resultats ...
  144.       N1 = NSOUS - KEL22
  145.       L1 = 8
  146.       N3 = 6
  147. *
  148.       SEGINI MCHEL1
  149.       MCHEL1.IFOCHE=IFOUR
  150.       MCHEL1.TITCHE='SCALAIRE'
  151. *
  152.       SEGINI MCHEL2
  153.       MCHEL2.IFOCHE=IFOUR
  154.       MCHEL2.TITCHE='SCALAIRE'
  155. *
  156.       SEGINI MCHEL3
  157.       MCHEL3.IFOCHE=IFOUR
  158.       MCHEL3.TITCHE='SCALAIRE'
  159. *
  160. * Petit segment utile
  161.       nbtype = 1
  162.       SEGINI,notype
  163.       type(1)='REAL*8'
  164.       MOTYPE = notype
  165. *
  166.       ISOUS = 0
  167. *
  168. * ... BOUCLE SUR LES SOUS ZONES DU MODELE ...
  169. *
  170.       DO 200 JSOUS = 1, NSOUS
  171. *
  172.         IMODEL = KMODEL(JSOUS)
  173.         SEGACT,IMODEL
  174. *
  175.         IPMAIL= IMAMOD
  176.         CONM  = CONMOD
  177.         MELE  = NEFMOD
  178. *
  179.         iOK = 1
  180.         IF ((MELE.EQ.22).OR.(MELE.EQ.259)) GOTO 210
  181. *
  182.         iOK = 0
  183. *
  184. C    ... COQUE INTEGREE OU NON ? ...
  185.         IF (INFMOD(/1).NE.0) THEN
  186.           NPINT = INFMOD(1)
  187.           IF (NPINT.NE.0)THEN
  188.             CALL ERREUR(615)
  189.             GOTO 210
  190.           ENDIF
  191.         ELSE
  192.           NPINT = 0
  193.         ENDIF
  194. *
  195. *    ... INITIALISATION ...
  196. *
  197.         ISOUS = ISOUS + 1
  198. *
  199.         IVACAR = 0
  200.         IVACOM = 0
  201.         MOCOMP = 0
  202.         MOCARA = 0
  203.         lsupno = .false.
  204. *
  205. *  ... INFORMATION SUR L'ELEMENT FINI ...
  206. *
  207.         MFR   = INFELE(13)
  208.         MINTE = INFMOD(2+ISUP1)
  209.         NSTRS = INFELE(16)
  210. *
  211. *  ... Verification de compatibilité des MCHAML du point de vue des
  212. *      tableaux INFCHE et remplissage du tableau INFOS pour KOMCHA ...
  213. *
  214.         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE5,INFOS,IRTD)
  215.         IF (IRTD.EQ.0) GOTO 210
  216. *
  217. *  ... RECHERCHE DES NOMS de COMPOSANTES de CONTRAINTES/DEFORMATIONS...
  218. *
  219.         IF (ICONTR.EQ.1) THEN
  220.           IF (lnomid(4).NE.0) THEN
  221.             MOCOMP = lnomid(4)
  222.           ELSE
  223.             lsupno = .true.
  224.             CALL IDCONT(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
  225.           ENDIF
  226.         ELSE
  227.           IF (lnomid(5).NE.0) THEN
  228.             MOCOMP = lnomid(5)
  229.           ELSE
  230.             lsupno = .true.
  231.             CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NCOMP,NFAC)
  232.           ENDIF
  233.         ENDIF
  234.         nomid = MOCOMP
  235.         SEGACT,nomid
  236.         NCOMP = lesobl(/2)
  237.         NFAC  = lesfac(/2)
  238. *
  239. *    ... VERIFICATION DE LEUR PRESENCE ...
  240. *
  241.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCOMP,MOTYPE,1,INFOS,3,IVACOM)
  242.         IF (IERR.NE.0) GOTO 220
  243. *
  244. *    ... TRAITEMENT DES CHAMPS DE CARACTERISTIQUES ...
  245. *
  246.         nbrobl = 0
  247.         nbrfac = 0
  248.         nomid  = 0
  249. *    ... EPAISSEUR DANS LE CAS DES COQUES MINCES ...
  250.         IF (MFR.EQ.3 .OR. MFR.EQ.9) THEN
  251.           nbrobl = 1
  252.           nbrfac = 0
  253.           SEGINI,nomid
  254.           lesobl(1) = 'EPAI'
  255.         ENDIF
  256. *
  257.         MOCARA = nomid
  258.         NCARA = nbrobl
  259.         NCARF = nbrfac
  260.         NCARR = NCARA+NCARF
  261. *
  262.         IF (MOCARA.NE.0 .AND. NCARA.GE.1)  THEN
  263.           IF (IPCHE5.NE.0)  THEN
  264. C          ... On vérifie si elle est présente dans le champ de
  265. C              caractéristiques qui a été fourni ...
  266.             CALL KOMCHA(IPCHE5,IPMAIL,CONM,MOCARA,MOTYPE,1,
  267.      &                                     INFOS,3,IVACAR)
  268.           ELSE
  269. C          ... S'il n'y a pas de champ de caractéristiques, on râle ...
  270.             MOTERR(1:8)='CARACTER'
  271.             MOTERR(9:12)=NOMTP(MELE)
  272.             MOTERR(13:20)='INVA'
  273.             CALL ERREUR(145)
  274.           ENDIF
  275.           IF (IERR.NE.0) GOTO 230
  276.         ENDIF
  277. *
  278. C  Creation des MELVAL de la zone élémentaire
  279. *
  280. *  ... RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER ...
  281. *
  282.         MPTVAL = IVACOM
  283.         N1PTEL= 0
  284.         N1EL  = 0
  285.         DO 110 ICOMP = 1, NCOMP
  286.           MELVAL = IVAL(ICOMP)
  287.           N1PTEL = MAX(N1PTEL,VELCHE(/1))
  288.           N1EL   = MAX(N1EL  ,VELCHE(/2))
  289.  110    CONTINUE
  290.         N2PTEL=0
  291.         N2EL  =0
  292. *
  293.         SEGINI,MELVA1,MELVA2,MELVA3
  294. *
  295. *  Création des MCHAML ...
  296. *
  297.         N2 = 1
  298.         SEGINI,MCHAM1
  299.         SEGINI,MCHAM2
  300.         SEGINI,MCHAM3
  301. *
  302.         MCHAM1.NOMCHE(1)='SCAL'
  303.         MCHAM1.TYPCHE(1)='REAL*8'
  304.         MCHAM1.IELVAL(1)=MELVA1
  305. *
  306.         MCHAM2.NOMCHE(1)='SCAL'
  307.         MCHAM2.TYPCHE(1)='REAL*8'
  308.         MCHAM2.IELVAL(1)=MELVA2
  309. *
  310.         MCHAM3.NOMCHE(1)='SCAL'
  311.         MCHAM3.TYPCHE(1)='REAL*8'
  312.         MCHAM3.IELVAL(1)=MELVA3
  313. *
  314. * Remplissage des attributs de la sous-zone ...
  315. *
  316.         MCHEL1.INFCHE(ISOUS,1)=0
  317.         MCHEL1.INFCHE(ISOUS,2)=0
  318.         MCHEL1.INFCHE(ISOUS,3)=NIFOUR
  319.         MCHEL1.INFCHE(ISOUS,4)=MINTE
  320.         MCHEL1.INFCHE(ISOUS,5)=0
  321.         MCHEL1.INFCHE(ISOUS,6)=ISUP1
  322.         MCHEL1.IMACHE(ISOUS)=IPMAIL
  323.         MCHEL1.CONCHE(ISOUS)=CONMOD
  324.         MCHEL1.ICHAML(ISOUS)=MCHAM1
  325. *
  326.         MCHEL2.INFCHE(ISOUS,1)=0
  327.         MCHEL2.INFCHE(ISOUS,2)=0
  328.         MCHEL2.INFCHE(ISOUS,3)=NIFOUR
  329.         MCHEL2.INFCHE(ISOUS,4)=MINTE
  330.         MCHEL2.INFCHE(ISOUS,5)=0
  331.         MCHEL2.INFCHE(ISOUS,6)=ISUP1
  332.         MCHEL2.IMACHE(ISOUS)=IPMAIL
  333.         MCHEL2.CONCHE(ISOUS)=CONMOD
  334.         MCHEL2.ICHAML(ISOUS)=MCHAM2
  335. *
  336.         MCHEL3.INFCHE(ISOUS,1)=0
  337.         MCHEL3.INFCHE(ISOUS,2)=0
  338.         MCHEL3.INFCHE(ISOUS,3)=NIFOUR
  339.         MCHEL3.INFCHE(ISOUS,4)=MINTE
  340.         MCHEL3.INFCHE(ISOUS,5)=0
  341.         MCHEL3.INFCHE(ISOUS,6)=ISUP1
  342.         MCHEL3.IMACHE(ISOUS)=IPMAIL
  343.         MCHEL3.CONCHE(ISOUS)=CONMOD
  344.         MCHEL3.ICHAML(ISOUS)=MCHAM3
  345. *
  346. **********************************************************************
  347. *                                                                    *
  348. *               BRANCHEMENT SUIVANT LA FORMULATION                   *
  349. *                                                                    *
  350. **********************************************************************
  351. *            MASSI   COQUE    COQEP          CIST
  352.         GOTO ( 30, 99, 60, 99, 80, 99, 99, 99,120, 99,
  353.      &         99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
  354.      &         99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
  355. *             INCO    PORE
  356.      &         30, 99, 30, 99, 99, 99, 99, 99, 99, 99), MFR
  357. C == FORMULATION HHO == IDENTIQUE au CAS MASSIF ========================
  358.         IF (MFR.EQ.HHO_MFR_ELEMENT) GOTO 30
  359. C == FORMULATION HHO ===================================================
  360. C       XFEM : idem massif
  361.         IF (MFR.EQ.63) GOTO 30
  362. C
  363.  99     CONTINUE
  364.         MOTERR(1:8) = NOMFR(MFR/2+1)
  365.         CALL ERREUR(193)
  366.         GOTO 240
  367. *_______________________________________________________________________
  368. *
  369. *    FORMULATION MASSIVE / INCOMPRESSIBLE / POREUX / XFEM
  370. *_______________________________________________________________________
  371. *
  372.    30   CONTINUE
  373.         DO IB=1,N1EL
  374.           DO IGAU=1,N1PTEL
  375. *
  376. C       ... Recherche des composantes du champ des contraintes ...
  377.             MPTVAL=IVACOM
  378.             DO ICOMP=1,NCOMP
  379.                MELVAL=IVAL(ICOMP)
  380.                IGMN=MIN(IGAU,VELCHE(/1))
  381.                IBMN=MIN(IB  ,VELCHE(/2))
  382.                SIG(ICOMP)=VELCHE(IGMN,IBMN)
  383.             ENDDO
  384.  
  385. C       ... Calcul des invariants ...
  386.  
  387.             XI1=SIG(1)+SIG(2)+SIG(3)
  388.             IF (IFOUR.LT.1.AND.IFOUR.GT.-3) THEN
  389.                XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
  390.      .             W1*SIG(4)*SIG(4)
  391.                XI3=SIG(3)*(SIG(1)*SIG(2)-W2*SIG(4)*SIG(4))
  392.             ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  393.                XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)
  394.                XI3=SIG(1)*SIG(2)*SIG(3)
  395.             ELSE
  396.                XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
  397.      .             W1*(SIG(4)*SIG(4)+SIG(5)*SIG(5)+SIG(6)*SIG(6))
  398.                XI3=SIG(1)*SIG(2)*SIG(3)-
  399.      .             W2*(SIG(1)*SIG(6)*SIG(6)+SIG(2)*SIG(5)*SIG(5)+
  400.      .             SIG(3)*SIG(4)*SIG(4))+W3*SIG(4)*SIG(5)*SIG(6)
  401.             ENDIF
  402.  
  403. C       ... et leur stockage ...
  404.  
  405.             MELVA1.VELCHE(IGAU,IB)=XI1
  406.             MELVA2.VELCHE(IGAU,IB)=XI2
  407.             MELVA3.VELCHE(IGAU,IB)=XI3
  408.  
  409.           ENDDO
  410.         ENDDO
  411.         GOTO 250
  412. *_______________________________________________________________________
  413. *
  414. *    FORMULATION COQUE MINCE
  415. *_______________________________________________________________________
  416. *
  417.    60 CONTINUE
  418.       DO IB=1,N1EL
  419.         DO IGAU=1,N1PTEL
  420. C       ... Recherche des composantes du champ des contraintes généralisées ...
  421.             MPTVAL=IVACOM
  422.             DO ICOMP=1,NCOMP
  423.                MELVAL=IVAL(ICOMP)
  424.                IGMN=MIN(IGAU,VELCHE(/1))
  425.                IBMN=MIN(IB  ,VELCHE(/2))
  426.                SIG(ICOMP)=VELCHE(IGMN,IBMN)
  427.             ENDDO
  428. *
  429. C       ... Recherche de l'épaisseur de la coque ...
  430.             MPTVAL=IVACAR
  431.             MELVAL=IVAL(1)
  432.             IGMN=MIN(IGAU,VELCHE(/1))
  433.             IBMN=MIN(IB  ,VELCHE(/2))
  434.             EPAIST=VELCHE(IGMN,IBMN)
  435. *
  436. *       ... CALCUL DES CONTRAINTES ...
  437. *
  438.             CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  439.             IF(IFOUR.GT.0) THEN
  440.                SIG(1)=SIG(1)+SIG(4)*IMIL
  441.                SIG(2)=SIG(2)+SIG(5)*IMIL
  442.                SIG(3)=SIG(3)+SIG(6)*IMIL
  443.             ELSE IF(IFOUR.LE.0) THEN
  444.                SIG(1)=SIG(1)+SIG(3)*IMIL
  445.                SIG(2)=SIG(2)+SIG(4)*IMIL
  446.                SIG(3)=0.D0
  447.             ENDIF
  448. *
  449. C       ... Calcul des invariants ...
  450.  
  451.             XI1=SIG(1)+SIG(2)
  452.             XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+W1*SIG(3)*SIG(3)
  453.             XI3=0.D0
  454. *
  455. C       ... et leur stockage ...
  456.             MELVA1.VELCHE(IGAU,IB)=XI1
  457.             MELVA2.VELCHE(IGAU,IB)=XI2
  458.             MELVA3.VELCHE(IGAU,IB)=XI3
  459. *
  460.           ENDDO
  461.         ENDDO
  462.         GOTO 250
  463. *_______________________________________________________________________
  464. *
  465. *    FORMULATION COQUE EPAISSE
  466. *_______________________________________________________________________
  467. *
  468.    80   CONTINUE
  469.         DO IB=1,N1EL
  470.           DO IGAU=1,N1PTEL
  471. C       ... Recherche des composantes du champ des contraintes ...
  472.             MPTVAL=IVACOM
  473.             DO ICOMP=1,NCOMP
  474.                MELVAL=IVAL(ICOMP)
  475.                IGMN=MIN(IGAU,VELCHE(/1))
  476.                IBMN=MIN(IB  ,VELCHE(/2))
  477.                SIG(ICOMP)=VELCHE(IGMN,IBMN)
  478.             ENDDO
  479. *
  480. C       ... Calcul des invariants ...
  481.  
  482.             XI1=SIG(1)+SIG(2)
  483.             XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+
  484.      &          W1*(SIG(3)*SIG(3)+SIG(4)*SIG(4)+SIG(5)*SIG(5))
  485.             XI3=-W2*(SIG(1)*SIG(5)*SIG(5)+SIG(2)*SIG(4)*SIG(4))
  486.      &          +W3*SIG(3)*SIG(4)*SIG(5)
  487. *
  488. C       ... et leur stockage ...
  489.  
  490.             MELVA1.VELCHE(IGAU,IB)=XI1
  491.             MELVA2.VELCHE(IGAU,IB)=XI2
  492.             MELVA3.VELCHE(IGAU,IB)=XI3
  493. *
  494.           ENDDO
  495.         ENDDO
  496.         GOTO 250
  497. *_______________________________________________________________________
  498. *
  499. *    FORMULATION COQUE AVEC CISAILLEMENT
  500. *_______________________________________________________________________
  501. *
  502.   120   CONTINUE
  503.         DO IB=1,N1EL
  504.           DO IGAU=1,N1PTEL
  505. C       ... Recherche des composantes du champ des contraintes ...
  506.             MPTVAL=IVACOM
  507.             DO ICOMP=1,NCOMP
  508.                MELVAL=IVAL(ICOMP)
  509.                IGMN=MIN(IGAU,VELCHE(/1))
  510.                IBMN=MIN(IB  ,VELCHE(/2))
  511.                SIG(ICOMP)=VELCHE(IGMN,IBMN)
  512.             ENDDO
  513. *
  514. C       ... Recherche de l'épaisseur de la coque ...
  515.             MPTVAL=IVACAR
  516.             MELVAL=IVAL(1)
  517.             IGMN=MIN(IGAU,VELCHE(/1))
  518.             IBMN=MIN(IB  ,VELCHE(/2))
  519.             EPAIST=VELCHE(IGMN,IBMN)
  520. *
  521. *       ... CALCUL DES CONTRAINTES ...
  522. *
  523.             CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  524.             SIG(1)=SIG(1)+SIG(4)*IMIL
  525.             SIG(2)=SIG(2)+SIG(5)*IMIL
  526.             SIG(4)=SIG(3)+SIG(6)*IMIL
  527.             SIG(3)=0.D0
  528.             SIG(5)=SIG(7)
  529.             SIG(6)=SIG(8)
  530.  
  531. C       ... Calcul des invariants ...
  532.  
  533.             XI1=SIG(1)+SIG(2)+SIG(3)
  534.             XI2=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)+
  535.      &          W1*(SIG(4)*SIG(4)+SIG(5)*SIG(5)+SIG(6)*SIG(6))
  536.             XI3=SIG(1)*SIG(2)*SIG(3)-
  537.      &          W2*(SIG(1)*SIG(6)*SIG(6)+SIG(2)*SIG(5)*SIG(5)+
  538.      &          SIG(3)*SIG(4)*SIG(4))+W3*SIG(4)*SIG(5)*SIG(6)
  539. *
  540. C       ... et leur stockage ...
  541.             MELVA1.VELCHE(IGAU,IB)=XI1
  542.             MELVA2.VELCHE(IGAU,IB)=XI2
  543.             MELVA3.VELCHE(IGAU,IB)=XI3
  544. *
  545.           ENDDO
  546.         ENDDO
  547.         GOTO 250
  548. *
  549. **********************************************************************
  550. *                                                                    *
  551. *           FIN DU BRANCHEMENT SUIVANT LA FORMULATION                *
  552. *                                                                    *
  553. **********************************************************************
  554. *
  555. *    ... DESACTIVATION DES SEGMENTS PROPRES A LA GEOMETRIE ISOUS ...
  556. *
  557.   250    CONTINUE
  558.          iOK = 1
  559.  
  560.   240    CONTINUE
  561.          SEGDES,MELVA1,MELVA2,MELVA3
  562.          SEGDES,MCHAM1,MCHAM2,MCHAM3
  563. *
  564.  230    CONTINUE
  565.         IF (MOCARA.NE.0) THEN
  566.           nomid = MOCARA
  567.           SEGSUP,nomid
  568.         ENDIF
  569. *
  570.         CALL DTMVAL(IVACOM,1)
  571. *
  572.  220    CONTINUE
  573.         nomid = MOCOMP
  574.         SEGDES,nomid
  575.         IF (lsupno) SEGSUP,nomid
  576. *
  577.  210    CONTINUE
  578.         SEGDES,IMODEL
  579. *
  580. * ... ERREUR DANS UNE SOUS ZONE : DESACTIVATION ET RETOUR ...
  581.         IF (iOK.EQ.0) GOTO 990
  582. *
  583.   200 CONTINUE
  584.  
  585. C ... FIN DE LA GRANDE BOUCLE SUR LES ZONES ÉLÉMENTAIRES ...
  586.  
  587.       IRET = 1
  588.  
  589.  990  CONTINUE
  590.       SEGDES,MMODEL
  591.  
  592.       IF (IRET.EQ.1) THEN
  593.         SEGDES,MCHEL1,MCHEL2,MCHEL3
  594.         IPCHE2 = MCHEL1
  595.         IPCHE3 = MCHEL2
  596.         IPCHE4 = MCHEL3
  597.       ELSE
  598.         SEGSUP,MCHEL1,MCHEL2,MCHEL3
  599.         IPCHE2 = 0
  600.         IPCHE3 = 0
  601.         IPCHE4 = 0
  602.       ENDIF
  603. *
  604.       SEGSUP,notype
  605.       IF (IPCH5O.NE.IPCHE5) THEN
  606.         CALL DTCHAM(IPCHE5)
  607.         IPCHE5 = IPCH5O
  608.       ENDIF
  609. *
  610.   666 CONTINUE
  611.       SEGDES,MCHELM
  612.  
  613.       RETURN
  614.       END
  615.  
  616.  
  617.  

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