Télécharger la plaquette Cast3M


fr en

Télécharger vmispo.eso

Retour à la liste

Numérotation des lignes : 

vmispo

  1. C VMISPO    SOURCE    OF166741  24/05/06    21:15:27     11082          
  2. C_______________________________________________________________________
  3. C
  4. C  Entrées:
  5. C  ________
  6. C
  7. C     IPMODL  Pointeur sur un MMODEL
  8. C     IPCHE1  Pointeur sur un MCHAML de contraintes
  9. C     IPCHE2  Pointeur sur un MCHAML de caracteristiques
  10. C
  11. C  SORTIES:
  12. C  ________
  13. C
  14. C     IPCHE3  Pointeur sur un MCHAML de VONMISES
  15. C     IRET =1  OU  0   suivant succes ou pas (Message d'erreur
  16. C                                         imprimé dans ce cas)
  17. C
  18. C    Passage aux nouveaux CHAMELEMs par I.Monnier le 13.06.90
  19. C  
  20. *_______________________________________________________________________
  21.  
  22.       SUBROUTINE VMISPO(IPMODL,IPCHE1,IPCHE2,IPCHE3,IRET,isouc)
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC CCGEOME
  31. C==DEB= FORMULATION HHO == Include specifique ==========================
  32. -INC CCHHOPA
  33. C==FIN= FORMULATION HHO ================================================
  34.  
  35. -INC SMCHAML
  36. -INC SMMODEL
  37. -INC SMCOORD
  38. -INC SMINTE
  39. *
  40.       SEGMENT NOTYPE
  41.         CHARACTER*16 TYPE(NBTYPE)
  42.       ENDSEGMENT
  43. *
  44.       SEGMENT MPTVAL
  45.         INTEGER IPOS(NS)    ,NSOF(NS)
  46.         INTEGER      IVAL(NCOSOU)
  47.         CHARACTER*16 TYVAL(NCOSOU)
  48.       ENDSEGMENT
  49. *
  50.       CHARACTER*(NCONCH) CONM
  51.       PARAMETER ( NINF=3 )
  52.       DIMENSION SIG(9)
  53.       DIMENSION CARAC(25),DIV(7)
  54.       INTEGER INFOS(NINF)
  55.       LOGICAL lsupco
  56.       INTEGER ISUP1,ISUP2
  57.       DATA ALPH1/.4444444444444444D0/
  58.       DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  59.  
  60. *      WRITE(*,*) 'Entrée dans VMISPO.'
  61.       lsupco=.false.
  62.       IRET = 0
  63.       IPCHE3 = 0
  64. *
  65. *     Verification du lieu support du MCHAML de CONTRAINTES
  66. *
  67.       ISUP1 = 0
  68.       ISUP2=0
  69.       IRET1 = 0
  70.       CALL QUESUP (IPMODL,IPCHE1,0,0,ISUP1,IRET1)
  71. *     IF (ISUP1.GT.0) RETURN
  72. *
  73. *     Verification du lieu support du MCHAML de CARACTERISTIQUES
  74. *
  75.       IF (IPCHE2.NE.0) THEN
  76.          ISUP2 = 0
  77.          IRET2 = 0
  78.          CALL QUESUP (IPMODL,IPCHE2,IRET1,1,ISUP2,IRET2)
  79.          IF (ISUP2.GT.0) RETURN
  80.       ENDIF
  81.  
  82. *_______________________________________________________________________
  83. *
  84. *                   ACTIVATION DU MODELE
  85. *_______________________________________________________________________
  86. *
  87.       MMODEL=IPMODL
  88.       SEGACT,MMODEL
  89.       NSOUS=KMODEL(/1)
  90.       KEL22 = 0
  91.       DO ISOUS = 1, NSOUS
  92.         IMODEL=KMODEL(ISOUS)
  93.         SEGACT,IMODEL
  94.         IF (formod(1).ne.'MECANIQUE'.OR.NEFMOD.EQ.22.or.nefmod.eq.259)
  95.      >     KEL22 = KEL22 + 1
  96.       ENDDO
  97. *
  98. *     ACTIVATION DES CONTRAINTES
  99. *
  100.       IRET=1
  101.       MCHEL1=IPCHE1
  102.       SEGACT MCHEL1
  103. *
  104. *     INITIALISATION DU MCHELM DE VON MISES
  105. *
  106.       L1=9
  107.       N1=NSOUS - KEL22
  108.       N3=6
  109.       SEGINI MCHELM
  110.       IFOCHE=IFOUR
  111.       TITCHE='VON MISES'
  112.  
  113. C un petit segment toujours utile :
  114.       NBTYPE=1
  115.       SEGINI,NOTYPE
  116.       TYPE(1)='REAL*8'
  117.       MOTYR8 = NOTYPE
  118.  
  119. *_______________________________________________________________________
  120. *
  121. *               BOUCLE SUR LES SOUS ZONES
  122. *_______________________________________________________________________
  123. *
  124.       isouss=0
  125.       DO 200 ISOUS=1,NSOUS
  126. C
  127. C    QUELQUES INITIALISATIONS
  128. C
  129.       MOSTRS = 0
  130.       MOCARA = 0
  131.       IVASTR = 0
  132.       IVACAR = 0
  133.       IVAMIS = 0
  134. C
  135. C     TRAITEMENT DU MODELE
  136. C
  137.       IMODEL=KMODEL(ISOUS)
  138. C*    SEGACT IMODEL
  139.       MELE=NEFMOD
  140.         IF (NEFMOD.EQ.22.or.nefmod.eq.259) goto 200
  141.         IF (formod(1).ne.'MECANIQUE')  goto 200
  142.       ISOUSS=ISOUSS+1
  143. *
  144.       IPMAIL=IMAMOD
  145.       CONM  =CONMOD
  146. C
  147. C     CREATION DU TABLEAU INFOS
  148. C
  149.       CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  150.       IF (IRTD.EQ.0) GOTO 9990
  151. C
  152. C   COQUE INTEGREE OU PAS ?
  153. C
  154.          IF(INFMOD(/1).NE.0)THEN
  155.            NPINT=INFMOD(1)
  156.          ELSE
  157.            NPINT=0
  158.          ENDIF
  159.  
  160. C_______________________________________________________________________
  161. C
  162. C     INFORMATIONS SUR L'ELEMENT FINI
  163. C_______________________________________________________________________
  164. C
  165. *      CALL ELQUOI(MELE,0,IRET1,IPINF,IMODEL)
  166. *      IF (IERR.NE.0) THEN
  167. *        SEGDES IMODEL,MMODEL
  168. *        SEGSUP MCHELM
  169. *        SEGDES MCHEL1
  170. *        RETURN
  171. *      ENDIF
  172. *      INFO=IPINF
  173.       MFR   =INFELE(13)
  174.       NSTRS =INFELE(16)
  175.       NBPGAU=INFELE( 4)
  176. *      MINTE =INFELE(11)
  177.       MINTE=INFMOD(iret1+2)
  178.       IPPORE=0
  179.       IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE))
  180.       IPMINT=MINTE
  181.       SEGACT,MINTE
  182. *      SEGSUP INFO
  183. C
  184. C     RECOPIE DU MCHELM
  185. C
  186. **    write(6,*) 'isouss ',isouss
  187. **    write(6,*) 'imache ',imache(/1)
  188.       IMACHE(ISOUSS)=IPMAIL
  189.       CONCHE(ISOUSS)=CONMOD
  190. C
  191.       INFCHE(ISOUSS,1)=0
  192.       INFCHE(ISOUSS,2)=0
  193.       INFCHE(ISOUSS,3)=NIFOUR
  194.       INFCHE(ISOUSS,4)=MINTE
  195.       INFCHE(ISOUSS,5)=0
  196.       INFCHE(ISOUSS,6)=IRET1
  197. C
  198. C     CREATION DU MCHAML
  199. C
  200.       N2=1
  201.       SEGINI MCHAML
  202.       ICHAML(ISOUSS)=MCHAML
  203.       NOMCHE(1)='SCAL'
  204.       TYPCHE(1)='REAL*8'
  205.  
  206. C_______________________________________________________________________
  207. C
  208. C     NOMS DE COMPOSANTES DE CONTRAINTES NECESSAIRES
  209. C_______________________________________________________________________
  210. C
  211.       if(lnomid(4).ne.0) then
  212.          nomid=lnomid(4)
  213.          segact nomid
  214.          mostrs=nomid
  215.          nstr=lesobl(/2)
  216.          nfac=lesfac(/2)
  217.          lsupco=.false.
  218.       else
  219.          lsupco=.true.
  220.         CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  221.       endif
  222. C
  223. C     VERIFICATION DE LEUR PRESENCE
  224. C
  225.       MOTYPE = MOTYR8
  226.       CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  227.       IF (IERR.NE.0) GOTO 9990
  228. *
  229.       IF (ISUP1.EQ.1) CALL VALCHE (IVASTR,NSTR,IPMINT,IPPORE,
  230.      &                MOSTRS,MELE)
  231. C
  232. C     RECHERCHE DES TAILLES DE MELVAL
  233. C
  234.       N1EL=0
  235.       N1PTEL=0
  236.       MPTVAL=IVASTR
  237.       DO 20 IO=1,NSTRS
  238.         MELVAL=IVAL(IO)
  239.         N1PTEL=MAX(N1PTEL,VELCHE(/1))
  240.         N1EL  =MAX(N1EL  ,VELCHE(/2))
  241.  20   CONTINUE
  242.       IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
  243.         N1PTEL=1
  244.       ELSE
  245. *PVPVPV N1PTEL=NBPGAU
  246.       ENDIF
  247.       NBPTEL=N1PTEL
  248.       NEL   =N1EL
  249. C
  250. C     CREATION DU MELVAL VMISES
  251. C
  252.       N2PTEL=0
  253.       N2EL=0
  254.       SEGINI MELVAL
  255.       IELVAL(1)=MELVAL
  256.       IVAMIS   =MELVAL
  257. *
  258. *     ON TRAITE LES COQUES INTEGREES COMME LES MASSIFS
  259. *
  260.       IF(NPINT.NE.0)THEN
  261.             MFR1=1
  262.       ELSE
  263.            MFR1=MFR
  264.       ENDIF
  265.  
  266. C_______________________________________________________________________
  267. C
  268. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  269. C_______________________________________________________________________
  270. *
  271.            NBROBL=0
  272.            NBRFAC=0
  273.            MOCARA=0
  274.            IVECT=0
  275.          NOTYPE = MOTYR8
  276. *
  277. * EPAISSEUR ET ALFA DANS LE CAS DES COQUES
  278. *
  279.          IF (MFR1.EQ.3.OR.MFR1.EQ.5.OR.MFR1.EQ.9) THEN
  280.            NBROBL=1
  281.            NBRFAC=1
  282.            SEGINI NOMID
  283.            MOCARA=NOMID
  284.            LESOBL(1)='EPAI'
  285.            LESFAC(1)='CALF'
  286. *
  287. * CARACTERISTIQUES POUR LES POUTRES
  288. *
  289.          ELSE IF (MFR1.EQ.7 ) THEN
  290.            IF(IFOUR.EQ.2) THEN
  291.             NBROBL=4
  292.             NBRFAC=3
  293.             SEGINI NOMID
  294.             MOCARA=NOMID
  295.             LESOBL(1)='TORS'
  296.             LESOBL(2)='INRY'
  297.             LESOBL(3)='INRZ'
  298.             LESOBL(4)='SECT'
  299.             LESFAC(1)='DX  '
  300.             LESFAC(2)='DZ  '
  301.             LESFAC(3)='DY  '
  302.            ELSE
  303.             NBROBL=2
  304.             NBRFAC=1
  305.             SEGINI NOMID
  306.             MOCARA=NOMID
  307.             LESOBL(1)='SECT'
  308.             LESOBL(2)='INRZ'
  309.             LESFAC(1)='DY  '
  310.            ENDIF
  311. *
  312. * CARACTERISTIQUES POUR LES TUYAUX
  313. *
  314.          ELSE IF (MFR1.EQ.13) THEN
  315.            NBROBL=2
  316.            NBRFAC=9
  317.            SEGINI NOMID
  318.            MOCARA=NOMID
  319.            LESOBL(1)='EPAI'
  320.            LESOBL(2)='RAYO'
  321.            LESFAC(1)='RACO'
  322.            LESFAC(2)='PRES'
  323.            LESFAC(3)='CISA'
  324.            LESFAC(4)='CFFX'
  325.            LESFAC(5)='CFMX'
  326.            LESFAC(6)='CFMY'
  327.            LESFAC(7)='CFMZ'
  328.            LESFAC(8)='CFPR'
  329. c            LESFAC(9)='VECT'
  330. c            IVECT=1
  331. c BP, 2016-10-17: pour le calcul de VMISES, on se fiche de l'orientation
  332. c du repere local car les composantes sont deja toutes locales !
  333. c Afin d'utiliser tuycar, on met des valeurs de VX VY et VZ bidons
  334. *
  335.            NBTYPE=11
  336.            SEGINI NOTYPE
  337.            TYPE(1)='REAL*8'
  338.            TYPE(2)='REAL*8'
  339.            TYPE(3)='REAL*8'
  340.            TYPE(4)='REAL*8'
  341.            TYPE(5)='REAL*8'
  342.            TYPE(6)='REAL*8'
  343.            TYPE(7)='REAL*8'
  344.            TYPE(8)='REAL*8'
  345.            TYPE(9)='REAL*8'
  346.            TYPE(10)='REAL*8'
  347.            TYPE(11)='POINTEURPOINT   '
  348.          ENDIF
  349. *
  350.          NCARA=NBROBL
  351.          NCARF=NBRFAC
  352.          NCARR=NCARA+NCARF
  353.          MOTYPE = NOTYPE
  354.          IF (MOCARA.NE.0)  THEN
  355.              IF (IPCHE2.NE.0)  THEN
  356.                CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,
  357.      1                                        1,INFOS,3,IVACAR)
  358.              ELSE
  359.                MOTERR(1:8)='CARACTER'
  360.                MOTERR(9:12)=NOMTP(MELE)
  361.                MOTERR(13:20)='VMIS'
  362.                CALL ERREUR(145)
  363.              ENDIF
  364.              IF (IERR.NE.0) GOTO 9990
  365. *
  366.              IF (ISUP2.EQ.1) THEN
  367.                  CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  368.                  IF(IERR.NE.0)THEN
  369.                    ISUP2=0
  370.                    GOTO 9990
  371.                 ENDIF
  372.              ENDIF
  373.          ENDIF
  374.          IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  375. *
  376. C_______________________________________________________________________
  377. C
  378. C     BRANCHEMENT SUIVANT LA FORMULATION
  379. C_______________________________________________________________________
  380. C
  381. C          MASSI COQUE COQEP POUT  CIST  THER  TUYA  LISP
  382.       GOTO (30,22,60,22,80,22,100,22,70,22,22,22,120,22,90,22,22,
  383. C                                                  INCO  PORE
  384.      .      22,22,22,22,22,22,22,22,22,22,22,22,22,30,22,30),MFR1
  385. C == FORMULATION HHO == IDENTIQUE au CAS MASSIF ========================
  386.       IF (MFR1.EQ.HHO_MFR_ELEMENT) GOTO 30
  387. c     cas XFEM : identique au cas massif
  388.       IF (MFR1.EQ.63) goto 30
  389. C
  390.   22  CONTINUE
  391.       MOTERR(1:8)=NOMFR(MFR1/2+1)
  392.       if (isouc.eq.1) then
  393.         call SOUCIS(193)
  394.       else
  395.         call ERREUR(193)
  396.       endif
  397.       GOTO 150
  398.       GOTO 9990
  399.  
  400. C_______________________________________________________________________
  401. C
  402. C    FORMULATION MASSIVE
  403. C_______________________________________________________________________
  404. C
  405.    30 CONTINUE
  406.       do    IB=1,NEL
  407.       do    IGAU=1,NBPTEL
  408.         MPTVAL=IVASTR
  409.         DO ICOMP=1,NSTRS
  410.           MELVAL=IVAL(ICOMP)
  411.           IGMN=MIN(IGAU,VELCHE(/1))
  412.           IBMN=MIN(IB  ,VELCHE(/2))
  413.           SIG(ICOMP)=VELCHE(IGMN,IBMN)
  414.         ENDDO
  415.       VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)-SIG(1)*SIG(2)
  416.      +       -SIG(1)*SIG(3)-SIG(2)*SIG(3)
  417. C
  418.         IF (IDIM.NE.1) THEN
  419.         DO IE=4,NSTRS
  420.           VONMIS=VONMIS+3.D0*(SIG(IE)*SIG(IE))
  421.         ENDDO
  422.         ENDIF
  423. C
  424.         XXXX=SQRT(ABS(VONMIS))
  425.         MELVAL=IVAMIS
  426.         VELCHE(IGAU,IB)=XXXX
  427.       enddo
  428.       enddo
  429.       GOTO 150
  430.  
  431. C_______________________________________________________________________
  432. C
  433. C    FORMULATION COQUE MINCE
  434. C_______________________________________________________________________
  435. C
  436.    60 CONTINUE
  437. C
  438.       DO    IB=1,NEL
  439.       DO    IGAU=1,NBPTEL
  440.         MPTVAL=IVASTR
  441.         DO 62 ICOMP=1,NSTRS
  442.           MELVAL=IVAL(ICOMP)
  443.           IGMN=MIN(IGAU,VELCHE(/1))
  444.           IBMN=MIN(IB  ,VELCHE(/2))
  445.           SIG(ICOMP)=VELCHE(IGMN,IBMN)
  446.    62   CONTINUE
  447. C
  448.       MPTVAL=IVACAR
  449.       MELVAL=IVAL(1)
  450.         IGMN=MIN(IGAU,VELCHE(/1))
  451.         IBMN=MIN(IB  ,VELCHE(/2))
  452.         EPAIST=VELCHE(IGMN,IBMN)
  453. *
  454.       CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  455.       MPTVAL=IVACAR
  456.       MELVAL=IVAL(2)
  457.       IF (MELVAL.NE.0) THEN
  458.         IGMN=MIN(IGAU,VELCHE(/1))
  459.         IBMN=MIN(IB  ,VELCHE(/2))
  460.         ALPHA=VELCHE(IGMN,IBMN)
  461.       ELSE
  462.         ALPHA=2./3.
  463.       ENDIF
  465. C
  466.       IF(IFOUR.GT.0) THEN
  467.       VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
  468.      +       3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)-
  469.      +       SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6))))
  470.       ELSE IF(IFOUR.LE.0) THEN
  471.       VONMIS= SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
  472.      +     ALPHA*(SIG(3)*SIG(3)+SIG(4)*SIG(4)-SIG(3)*SIG(4))
  473.       VONMIS=SQRT(VONMIS)
  474.       ENDIF
  475. C
  476.       MELVAL=IVAMIS
  477.       VELCHE(IGAU,IB)=VONMIS
  478.       enddo
  479.       enddo
  480.       GOTO 150
  481.  
  482. C_______________________________________________________________________
  483. C
  484. C    FORMULATION COQUE AVEC CISAILLEMENT TRANSVERSE (COQ4)
  485. C_______________________________________________________________________
  486. C
  487.    70 CONTINUE
  488. C
  489.       DO    IB=1,NEL
  490.       DO    IGAU=1,NBPTEL
  491.         MPTVAL=IVASTR
  492.         DO 72 ICOMP=1,NSTRS
  493.           MELVAL=IVAL(ICOMP)
  494.           IGMN=MIN(IGAU,VELCHE(/1))
  495.           IBMN=MIN(IB  ,VELCHE(/2))
  496.           SIG(ICOMP)=VELCHE(IGMN,IBMN)
  497.    72   CONTINUE
  498. C
  499.       MPTVAL=IVACAR
  500.       MELVAL=IVAL(1)
  501.         IGMN=MIN(IGAU,VELCHE(/1))
  502.         IBMN=MIN(IB  ,VELCHE(/2))
  503.         EPAIST=VELCHE(IGMN,IBMN)
  504. *
  505.       CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  506.       MPTVAL=IVACAR
  507.       MELVAL=IVAL(2)
  508.       IF (MELVAL.NE.0) THEN
  509.         IGMN=MIN(IGAU,VELCHE(/1))
  510.         IBMN=MIN(IB  ,VELCHE(/2))
  511.         ALPHA=VELCHE(IGMN,IBMN)
  512.       ELSE
  513.         ALPHA=0.666666666666666666D0
  514.       ENDIF
  516. C
  517.       VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
  518.      +       3.D0*SIG(7)*SIG(7)+3.D0*SIG(8)*SIG(8)+
  519.      +       3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)-
  520.      +       SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6))))
  521. C
  522.       MELVAL=IVAMIS
  523.       VELCHE(IGAU,IB)=VONMIS
  524.       enddo
  525.       enddo
  526.       GOTO 150
  527.  
  528. C_______________________________________________________________________
  529. C
  530. C    FORMULATION COQUE EPAISSE
  531. C_______________________________________________________________________
  532. C
  533.    80 CONTINUE
  534.       DO    IB=1,NEL
  535.       DO    IGAU=1,NBPTEL
  536.         MPTVAL=IVASTR
  537.         DO 85 ICOMP=1,NSTRS
  538.           MELVAL=IVAL(ICOMP)
  539.           IGMN=MIN(IGAU,VELCHE(/1))
  540.           IBMN=MIN(IB  ,VELCHE(/2))
  541.           SIG(ICOMP)=VELCHE(IGMN,IBMN)
  542.    85   CONTINUE
  543.         VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)
  544.      1   + 3.D0*(SIG(3)*SIG(3)+SIG(4)*SIG(4)+SIG(5)*SIG(5))
  545. C
  546.         XXXX=SQRT(ABS(VONMIS))
  547.         MELVAL=IVAMIS
  548.         VELCHE(IGAU,IB)=XXXX
  549.       enddo
  550.       enddo
  551.       GOTO 150
  552.  
  553. C_______________________________________________________________________
  554. C
  555. C    FORMULATION LINESPRING
  556. C_______________________________________________________________________
  557. C
  558.    90 CONTINUE
  559.       DO    IB=1,NEL
  560.       DO    IGAU=1,NBPTEL
  561.         MPTVAL=IVASTR
  562.         DO 95 ICOMP=1,NSTRS
  563.           MELVAL=IVAL(ICOMP)
  564.           IGMN=MIN(IGAU,VELCHE(/1))
  565.           IBMN=MIN(IB  ,VELCHE(/2))
  566.           SIG(ICOMP)=VELCHE(IGMN,IBMN)
  567.   95   CONTINUE
  568.         VONMIS=SQRT(ABS(SIG(1)*SIG(1)+ALPH1*SIG(4)*SIG(4)))
  569. C
  570.         MELVAL=IVAMIS
  571.         VELCHE(IGAU,IB)=VONMIS
  572.       enddo
  573.       enddo
  574.       GOTO 150
  575.  
  576. C_______________________________________________________________________
  577. C
  578. C    FORMULATION POUTRE 2D ET 3D
  579. C_______________________________________________________________________
  580. C
  581.   100 CONTINUE
  582.  
  583. C____ FORMULATION POUTRE 3D = idem TUYAU 3D --> GOTO 120 _______________
  584.       IF (IFOUR.EQ.2) GOTO 120
  585. C
  586. C____ FORMULATION POUTRE 2D ____________________________________________
  587. C
  588. c  -- boucle sur les pt de Gauss --  
  589.       DO     IB=1,NEL
  590.       DO     IGAU=1,NBPTEL
  591.  
  592. c       CONTRAINTES --> SIG() : EFFX,EFFY,MOMZ
  593.         MPTVAL=IVASTR        
  594.         DO 102 ICOMP=1,NSTRS
  595.           MELVAL=IVAL(ICOMP)
  596.           IGMN=MIN(IGAU,VELCHE(/1))
  597.           IBMN=MIN(IB  ,VELCHE(/2))
  598.           SIG(ICOMP)=VELCHE(IGMN,IBMN)
  599.  102    CONTINUE
  600. C
  601. c       CARACTERISTIQUES --> CARAC() : SECT, INRZ, (DZ)
  602.         MPTVAL=IVACAR
  603.         DO 103 ICOMP=1,NCARR
  604.           MELVAL=IVAL(ICOMP)
  605.           IF (MELVAL.NE.0) THEN
  606.             IGMN=MIN(IGAU,VELCHE(/1))
  607.             IBMN=MIN(IB  ,VELCHE(/2))
  608.             CARAC(ICOMP)=VELCHE(IGMN,IBMN)
  609.           ELSE
  610.             CARAC(ICOMP)=0.D0
  611.           ENDIF
  612.  103    CONTINUE
  613. C
  614.         DIV(1)=1.D0/CARAC(1)
  615.         DIV(3)=CARAC(3)/CARAC(2)
  616. C
  617.         VONMIS=SQRT(ABS((SIG(1)*DIV(1))**2+(SIG(3)*DIV(3))**2))
  618. C
  619.         MELVAL=IVAMIS
  620.         VELCHE(IGAU,IB)=VONMIS
  621. C
  622.       enddo
  623.       enddo
  624.       GOTO 150
  625.  
  626. C_______________________________________________________________________
  627. C
  628. C    FORMULATION POUTRE 3D et TUYAU 3D
  629. C_______________________________________________________________________
  630. C
  631.   120 CONTINUE
  632.  
  633. c     initialisations bidons
  634.       DIV(1)=0.D0
  635.       DIV(2)=0.D0
  636.       DIV(3)=0.D0
  637. c     vecteur bidon
  638.       VX = 1.D0
  639.       VY = 1.D0
  640.       VZ = 1.D0
  641.  
  642. c  -- boucle sur les pt de Gauss --  
  643.       DO     IB=1,NEL
  644.       DO     IGAU=1,NBPTEL
  645.  
  646. c       CONTRAINTES --> SIG()
  647.         MPTVAL=IVASTR        
  648.         DO 122 ICOMP=1,NSTRS
  649.           MELVAL=IVAL(ICOMP)
  650.           IGMN=MIN(IGAU,VELCHE(/1))
  651.           IBMN=MIN(IB  ,VELCHE(/2))
  652.           SIG(ICOMP)=VELCHE(IGMN,IBMN)
  653.  122    CONTINUE
  654.  
  655. c       CARACTERISTIQUES --> CARAC()
  656.         MPTVAL=IVACAR
  657. c         NCARR1=NCARR
  658. c         IF(IVECT.EQ.1) NCARR1=NCARR-1
  659. c         DO 123 ICOMP=1,NCARR1
  660.         DO 123 ICOMP=1,NCARR
  661.           MELVAL=IVAL(ICOMP)
  662.           IF (MELVAL.NE.0) THEN
  663.             IGMN=MIN(IGAU,VELCHE(/1))
  664.             IBMN=MIN(IB  ,VELCHE(/2))
  665.             CARAC(ICOMP)=VELCHE(IGMN,IBMN)
  666.           ELSE
  667.             CARAC(ICOMP)=0.D0
  668.           ENDIF
  669.  123    CONTINUE
  670. C
  671. c C       CAS OU ON A LU LE MOT VECTEUR
  672. c C
  673. c         IF (IVECT.EQ.1) THEN
  674. c           IF (IVAL(NCARR).NE.0) THEN
  675. c             MELVAL=IVAL(NCARR)
  676. c             IBMN=MIN(IB,IELCHE(/2))
  677. c             IP=IELCHE(1,IBMN)
  678. c             IREF=(IP-1)*(IDIM+1)
  679. c             DO 124 IC=1,IDIM
  680. c               CARAC(NCARR+IC-1)=XCOOR(IREF+IC)
  681. c  124        CONTINUE
  682. c           ELSE
  683. c             DO 125 IC=1,IDIM
  684. c               CARAC(NCARR+IC-1)=0.D0
  685. c  125        CONTINUE
  686. c           ENDIF
  687. c         ENDIF
  688. C
  689.         SIGPRE=0.D0
  690.         IF(MFR1.EQ.7) THEN
  691.           DIV(1)=1.D0/CARAC(4)
  692. c           DIV(2)=1.D0
  693. c           DIV(3)=1.D0
  694.           DIV(4)=CARAC(5)/CARAC(1)
  695.           DIV(5)=CARAC(6)/CARAC(2)
  696.           DIV(6)=CARAC(7)/CARAC(3)
  697.         ELSE IF(MFR1.EQ.13) THEN
  698.           EPAIS=CARAC(1)
  699.           REXT =CARAC(2)
  700.           RMOY =REXT-EPAIS*0.5D0
  701.           RACO =CARAC(3)
  702.           PRES =CARAC(4)
  703.           CISA =CARAC(5)
  704. C
  705.           GAM=1.D0
  706.           IF(RACO.EQ.0.D0) GO TO 126
  707.           XLAM=RMOY*RMOY/EPAIS/RACO
  708.           GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  709.           IF(GAM.LT.1.D0) GAM=1.D0
  710.  126      CONTINUE
  711. C
  712. C         NB 23/09/98
  713. C         VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  714. C         CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  715. C         CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  716. C         DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  717. C         DUE A LA PRESSION )
  718. C
  719. c           DIV(1)=1.D0
  720. c           DIV(2)=1.D0
  721.           DIV(3)=1.D0
  722.           DIV(4)=R33
  723.           DIV(5)=PI4*GAM
  724.           DIV(6)=DIV(5)
  725.           DIV(7)=0.D0
  726. C
  727.           DO 127 ICOMP=6,10
  728.             MELVAL=IVAL(ICOMP)
  729.             IF (MELVAL.NE.0) DIV(ICOMP-3)=CARAC(ICOMP)
  730.  127     CONTINUE
  731. C
  732. C         NB 23/09/98
  733. C         TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  734. C         1.D0 DE DIV(3)
  735.           DIV(1)=DIV(3)
  736. c           DIV(3)=1.D0
  737. C
  738. C   RE-ARRANGEMENT DE CARAC POUR TUYCAR
  739. C
  740.           CISA=CARAC(5)
  741. c           CARAC(4)=CARAC(11)
  742. c           CARAC(5)=CARAC(12)
  743. c           CARAC(6)=CARAC(13)
  744. c           VX=CARAC(4)
  745. c           VY=CARAC(5)
  746. c           VZ=CARAC(6)
  747.           CALL TUYCAR(CARAC,CISA,VX,VY,VZ,KERRE,1)
  748.           DIV(1)=DIV(1)/CARAC(4)
  749.           DIV(4)=DIV(4)*RMOY/CARAC(1)
  750.           DIV(5)=DIV(5)*RMOY/CARAC(2)
  751.           DIV(6)=DIV(6)*RMOY/CARAC(3)
  752.           SIGPRE=DIV(7)*RMOY*PRES/EPAIS
  753.         ENDIF
  754. C
  755.         VONMIS=SQRT(ABS((SIG(1)*DIV(1))**2+(SIG(4)*DIV(4))**2+
  756.      .                  (SIG(5)*DIV(5))**2+(SIG(6)*DIV(6))**2+
  757.      .                   SIGPRE**2 ))
  758. C
  759.         MELVAL=IVAMIS
  760.         VELCHE(IGAU,IB)=VONMIS
  761. C
  762.       enddo
  763.       enddo
  764.       GOTO 150
  765. C
  766. C_______________________________________________________________________
  767. C
  768. C     AUTRE FORMULATION
  769. C_______________________________________________________________________
  770. C
  771.   150 CONTINUE
  772. C
  773. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  774. C
  775.       IF(ISUP1.EQ.1)THEN
  776.            CALL DTMVAL(IVASTR,3)
  777.       ELSE
  778.           CALL DTMVAL(IVASTR,1)
  779.       ENDIF
  780. *
  781.       MELVAL=IVAMIS
  782. *
  783.       IF(ISUP2.EQ.1)THEN
  784.            CALL DTMVAL(IVACAR,3)
  785.       ELSE
  786.           CALL DTMVAL(IVACAR,1)
  787.       ENDIF
  788. *
  789.       NOMID =MOSTRS
  790.       if(lsupco)SEGSUP NOMID
  791.       NOMID =MOCARA
  792.       IF (MOCARA.NE.0) SEGSUP NOMID
  793. *
  794.   201 CONTINUE
  795. C
  796.   200 CONTINUE
  797.  
  798.       IRET = 1
  799.       IPCHE3 = MCHELM
  800.       GOTO 888
  801. *
  802. *     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  803. *
  804.  9990 CONTINUE
  805. *
  806.       IF(ISUP1.EQ.1)THEN
  807.            CALL DTMVAL(IVASTR,3)
  808.       ELSE
  809.           CALL DTMVAL(IVASTR,1)
  810.       ENDIF
  811. *
  812.       IF(ISUP2.EQ.1)THEN
  813.            CALL DTMVAL(IVACAR,3)
  814.       ELSE
  815.           CALL DTMVAL(IVACAR,1)
  816.       ENDIF
  817. *
  818.       NOMID =MOSTRS
  819.       if(lsupco)SEGSUP NOMID
  820.       NOMID =MOCARA
  821.       IF (MOCARA.NE.0) SEGSUP NOMID
  822. *
  823.       IF (IVAMIS.NE.0) THEN
  824.          MELVAL=IVAMIS
  825.          SEGSUP MELVAL
  826.       ENDIF
  827. *
  828.       SEGSUP MCHAML
  829.       SEGSUP MCHELM
  830.  
  831.       IRET = 0
  832.       IPCHE3 = 0
  833. *
  834.  888  CONTINUE
  835.  
  836.       NOTYPE = MOTYR8
  837.       SEGSUP,NOTYPE
  838.  
  839.       END
  840.  
  841.  
  842.  
  843.  

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