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

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