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

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