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

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