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

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