Télécharger la plaquette Cast3M


fr en

Télécharger vloc2.eso

Retour à la liste

Numérotation des lignes : 

vloc2

  1. C VLOC2     SOURCE    OF166741  25/02/21    21:19:09     12166          
  2. C
  3.       SUBROUTINE VLOC2(IPMODL,IPMATE,IPCHE,IRET)
  4. C=======================================================================
  5. C
  6. C Fonction : CALCULE LES VECTEURS DE BASE DU REPERE D'ORTHOTROPIE
  7. C
  8. C Input  :   MODL : MODELE de calcul , type MMODEL
  9. C            CHAML : CHAMELEM materiau (contenant les V1X V1Y ...)
  10. C
  11. C Output :   CHAML : CHAMELEM aux POINTS DE GAUSS
  12. c                    contenant les vecteurs de base du repere local
  13. C                    de sous type VECTEURS LOCAUX
  14. c                    de composantes :
  15. c                     (UX UY UZ) (VX VY VZ) (WX WY WZ)  en 3D
  16. c                     (UX UY) (VX VY) en 2D
  17. C
  18. C Creation : BP, 2017-01-17 (inspiré de VLOC1)
  19. C
  20. C=====================================================================
  21. C
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25.       PARAMETER(UN=1.D0,XZER=0.D0)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30.  
  31. -INC SMCHAML
  32. -INC SMMODEL
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMINTE
  36.  
  37. -INC TMPTVAL
  38.  
  39.       SEGMENT WRK1
  40.        REAL*8 XE(3,NBBB),XEL(3,NBBB)
  41.       ENDSEGMENT
  42.  
  43.       SEGMENT WRK2
  44.        REAL*8 XE2(3,NBBB), BPSS2(3,3,NBBB)
  45.       ENDSEGMENT
  46.  
  47.       SEGMENT INFO
  48.          INTEGER INFELL(JG)
  49.       ENDSEGMENT
  50.  
  51.       SEGMENT NOTYPE
  52.         CHARACTER*16 TYPE(NBTYPE)
  53.       ENDSEGMENT
  54.  
  55.       DIMENSION BPSS(3,3),VV1(3),VV2(3),VV3(3)
  56.       DIMENSION BPSS3(IDIM,IDIM)
  57.  
  58.       PARAMETER (NINF=3)
  59.       INTEGER INFOS(NINF)
  60.       CHARACTER*(NCONCH) CONM
  61.  
  62. C=====================================================================
  63.  
  64.       NHRM = NIFOUR
  65.       IRET = IDIM
  66. C
  67. C     ACTIVATION DU MODELE
  68. C
  69.       MMODEL= IPMODL
  70.       SEGACT MMODEL
  71.       NSOUS =KMODEL(/1)
  72. C
  73. C     CREATION DU CHAMELEM
  74. C
  75.       N1=NSOUS
  76.       L1=15
  77.       N3=6
  78.       SEGINI MCHELM
  79.       IPCHE=MCHELM
  80.       TITCHE(1:15)='VECTEURS LOCAUX'
  81.       IFOCHE=IFOUR
  82.  
  83.       NBTYPE = 1
  84.       SEGINI,NOTYPE
  85.       NOTYPE.TYPE(1) = 'REAL*8'
  86.       MOTYR8 = NOTYPE
  87.  
  88. C____________________________________________________________________
  89. C
  90. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  91. C____________________________________________________________________
  92. C
  93.       ISORTH=0
  94.       DO 500 ISOUS=1,NSOUS
  95. C
  96. C     ON RECUPERE L INFORMATION GENERALE
  97. C
  98.          IMODEL=KMODEL(ISOUS)
  99.          SEGACT IMODEL
  100.          IPMAIL=IMAMOD
  101.          IMACHE(ISOUS)=IPMAIL
  102.          CONCHE(ISOUS)=CONMOD
  103.          CONM = CONMOD
  104. C
  105. C     TRAITEMENT DU MODELE
  106. C
  107.          MELE=NEFMOD
  108.          MELEME=IMAMOD
  109.          NFOR=FORMOD(/2)
  110.          NMAT=MATMOD(/2)
  111. c        si le modele n'est pas orthotrope : on saute !
  112.          CALL PLACE(MATMOD,NMAT,KORTHO,'ORTHOTROPE')
  113.          IF (KORTHO.EQ.0) GOTO 499
  114.  
  115. C____________________________________________________________________
  116. C
  117. C     INFORMATION SUR L'ELEMENT FINI
  118. C____________________________________________________________________
  119. C
  120.          IF(INFMOD(/1).LT.7) THEN
  121.             CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  122.             IF (IERR.NE.0) THEN
  123.                 SEGDES IMODEL,MMODEL
  124.                 SEGSUP MCHELM
  125.                 IRET=0
  126.                 RETURN
  127.             ENDIF
  128.             INFO=IPINF
  129.             MELE =INFELL(1)
  130.             MFR  =INFELL(13)
  131. c           MINTE=segment MINTE aux points de Gauss
  132.             MINTE=INFELL(11)
  133. c           MINTE1=segment MINTE aux noeuds (pour les coques epaisses)
  134.             MINTE1=INFELL(12)
  135.             segsup info
  136.          ELSE
  137.             MELE =INFELE(1)
  138.             MFR  =INFELE(13)
  139. c           MINTE=segment MINTE aux points de Gauss
  140.             MINTE=INFMOD(7)
  141. c           MINTE1=segment MINTE aux noeuds (pour les coques epaisses)
  142.             MINTE1=INFMOD(8)
  143.          ENDIF
  144.  
  145. c        si formulation non prévue : on saute !
  146.          IF(MFR.NE.3.AND.MFR.NE.5.AND.MFR.NE.9
  147.      &      .AND.MFR.NE.1.AND.MFR.NE.33) GOTO 499
  148. c        TODO : MFR = 7 35 31 45 (77) ...
  149.  
  150.          ISORTH=ISORTH+1
  151. c          write(*,*) ISOUS,' MFR=',MFR,' ok -> ',ISORTH,' zones ok',IFOUR
  152. C
  153.          INFCHE(ISORTH,1)=0
  154.          INFCHE(ISORTH,2)=0
  155.          INFCHE(ISORTH,3)=NHRM
  156.          INFCHE(ISORTH,4)=MINTE
  157.          INFCHE(ISORTH,5)=0
  158. *        par defaut aux stresses
  159.          INFCHE(ISORTH,6)=5
  160. C
  161. C     INITIALISATION DE MINTE
  162. C
  163.          SEGACT MINTE
  164.          NBPGAU=POIGAU(/1)
  165. C
  166. C     ACTIVATION DU MELEME
  167. C
  168.          SEGACT MELEME
  169.          NBNN  =NUM(/1)
  170.          NBELEM=NUM(/2)
  171. C
  172. C     RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  173.           N1PTEL=NBPGAU
  174.           N1EL=NBELEM
  175.           N2PTEL = 0
  176.           N2EL = 0
  177. C
  178. C     CREATION DU MCHAML DE LA SOUS ZONE
  179. c
  180. C        N2 = NOMBRE DE COMPOSANTES
  181. c        cas massif et poreux
  182.          IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  183.             N2=IDIM*IDIM
  184.             IF(IFOUR.eq.1) N2=9
  185. c        cas coques et zones cohesives
  186.          ELSEIF(MFR.eq.3.or.MFR.eq.5.or.MFR.eq.9.or.MFR.eq.77) THEN
  187. c            IF (IFOUR.EQ.-2) THEN
  188. c            IF (IFOUR.EQ.0) THEN
  189. c              N2=4
  190. c            ELSE
  191.              N2=9
  192. c            ENDIF
  193.          ELSE
  194.            N2=0
  195.            call erreur(5)
  196.            return
  197.          ENDIF
  198.  
  199.          SEGINI MCHAML
  200.          ICHAML(ISORTH)=MCHAML
  201.          NSR=1
  202.          NCOSOR=N2
  203.          SEGINI MPTVAL
  204.          IVAVLO=MPTVAL
  205. C
  206. C     COMPOSANTES
  207. C
  208. C        3D + 2D DEF PLANES ET CONTRAINTES PLANES
  209.          IF (IFOUR.EQ.2 .OR. IFOUR.EQ.-1 .OR. IFOUR.EQ.-2
  210.      &  .OR. IFOUR.EQ.-3) THEN
  211.            IF(N2.EQ.9) THEN
  212.             NOMCHE(1)='V1X'
  213.             NOMCHE(2)='V1Y'
  214.             NOMCHE(3)='V1Z'
  215.             NOMCHE(4)='V2X'
  216.             NOMCHE(5)='V2Y'
  217.             NOMCHE(6)='V2Z'
  218.             NOMCHE(7)='V3X'
  219.             NOMCHE(8)='V3Y'
  220.             NOMCHE(9)='V3Z'
  221.            ELSE
  222.             NOMCHE(1)='V1X'
  223.             NOMCHE(2)='V1Y'
  224.             NOMCHE(3)='V2X'
  225.             NOMCHE(4)='V2Y'
  226.            ENDIF
  227. c        AXI + 2D FOURIER
  228.          ELSEIF(IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  229.            IF(N2.EQ.9) THEN
  230.             NOMCHE(1)='V1R'
  231.             NOMCHE(2)='V1Z'
  232.             NOMCHE(3)='V1T'
  233.             NOMCHE(4)='V2R'
  234.             NOMCHE(5)='V2Z'
  235.             NOMCHE(6)='V2T'
  236.             NOMCHE(7)='V3R'
  237.             NOMCHE(8)='V3Z'
  238.             NOMCHE(9)='V3T'
  239.            ELSE
  240.             NOMCHE(1)='V1R'
  241.             NOMCHE(2)='V1Z'
  242.             NOMCHE(3)='V2R'
  243.             NOMCHE(4)='V2Z'
  244.            ENDIF
  245.          ELSE
  246.            CALL ERREUR(717)
  247.          ENDIF
  248.  
  249.          DO ICOMP=1,N2
  250.             TYPCHE(ICOMP)='REAL*8'
  251.             SEGINI,MELVAL
  252.             IELVAL(ICOMP)=MELVAL
  253.             IVAL(ICOMP)=MELVAL
  254.          ENDDO
  255.  
  256. c          write(*,*) ' MCHAML=',MCHAML,' N2=',N2
  257. c          write(*,*) ' NOMCHE=',(NOMCHE(iou),iou=1,N2)
  258.  
  259. C____________________________________________________________________
  260. c
  261. C        RECHERCHE DES MELVAL DE MATERIAUX QUI NOUS INTERESSENT
  262. C____________________________________________________________________
  263.  
  264.          NBROBL = 0
  265.          NBRFAC = 0
  266.          NOMID = 0
  267. c        COQUES + ZONES COHESIVES
  268.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  269.             NBROBL=2
  270.             SEGINI,NOMID
  271.             LESOBL(1)='V1X'
  272.             LESOBL(2)='V1Y'
  273. c        MASSIFS
  274.          ELSEIF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  275.             IF(IDIM.EQ.3.OR.IFOUR.EQ.1) THEN
  276.               NBROBL=6
  277.               SEGINI,NOMID
  278.               LESOBL(1)='V1X'
  279.               LESOBL(2)='V1Y'
  280.               LESOBL(3)='V1Z'
  281.               LESOBL(4)='V2X'
  282.               LESOBL(5)='V2Y'
  283.               LESOBL(6)='V2Z'
  284.             ELSE
  285.               NBROBL=2
  286.               SEGINI,NOMID
  287.               LESOBL(1)='V1X'
  288.               LESOBL(2)='V1Y'
  289.             ENDIF
  290.          ENDIF
  291.          MOCARA=NOMID
  292. c          write(*,*) ' MATERIAU =',(LESOBL(iou),iou=1,NBROBL)
  293.  
  294. *        CREATION DU TABLEAU INFOS
  295.          IRTD=1
  296.          CALL IDENT(IPMAIL,CONM,0,IPMATE,INFOS,IRTD)
  297.          IF (IRTD.EQ.0) GOTO 499
  298. c          write(*,*) ' INFOS=',(INFOS(iou),iou=1,NINF)
  299.  
  300. *        RECHERCHE DES MELVAL
  301.          CALL KOMCHA(IPMATE,IPMAIL,CONM,MOCARA,MOTYR8,1,
  302.      &               INFOS,NINF,IVAMAT)
  303.          IF (IERR.NE.0) RETURN
  304.  
  305. C        MISE A ZERO INITIALE
  306.          DO I=1,3
  307.            VV1(I)=0.D0
  308.            VV2(I)=0.D0
  309.            VV3(I)=0.D0
  310.          ENDDO
  311. C
  312. C____________________________________________________________________
  313. C
  314. C        AIGUILLAGE SELON FORMULATION et TYPE D ELEMENT
  315. C____________________________________________________________________
  316. C
  317. c        FORMULATION MASSIVE : ON CREE LE REPERE GLOBAL
  318.          IF(MFR.EQ.1.OR.MFR.EQ.33) GOTO 1
  319. c        FORMULATION COQUE MINCE : OK
  320.          IF(MFR.EQ.3.OR.MFR.EQ.9) GOTO 100
  321. C TODO   FORMULATION ZONES COHESIVES
  322. c        IF(MFR.EQ.77) :  BRANCHER LES ELEMENTS
  323. c        FORMULATION COQUE EPAISSE : OK
  324.          IF(MFR.EQ.5) GOTO 100
  325. C TODO   FORMULATION POUTRE ET TUYAU
  326. c        IF(MFR.EQ.7.OR.MFR.EQ.13) GOTO 100
  327.  
  328.  100     CONTINUE
  329. c           1  2  3 ...
  330.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  331. c                        ... 27,28
  332.      1     99,99,99,99,99,99,28,28,99,99,99,99,99,99,99,99,99,99,99,99,
  333. c          41       44 45          49                   56
  334.      2     41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  335.      3     99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  336. c                                              93
  337.      4     99,99,99,99,99,99,99,99,99,99,99,99,28,99,99,99,99),MELE
  338.       GOTO 99
  339. c     MELE = 27  ->  COQ3
  340. c     MELE = 28  ->  DKT
  341. c     MELE = 41  ->  COQ8
  342. c     MELE = 44  ->  COQ2
  343. c     MELE = 45  ->  POI1 ???
  344. c     MELE = 49  ->  COQ4
  345. c     MELE = 56  ->  COQ6
  346. c     MELE = 93  ->  DST
  347.  
  348. C_______________________________________________________________________
  349. C
  350. C     ELEMENTS MASSIFS
  351. C_______________________________________________________________________
  352. C
  353.    1  CONTINUE
  354.  
  355.       NBBB=NBNN
  356.       SEGINI WRK1
  357.  
  358. *     RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
  359. *     L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
  360.       IPMIN2 = 0
  361.       NLG=NUMGEO(MELE)
  362.       CALL RESHPT(1,NBNN,NLG,MELE,0,IPMIN2,IRT1)
  363.       MINTE2=IPMIN2
  364.       SEGACT MINTE2
  365.  
  366. C---- BOUCLE SUR LES ELEMENTS
  367.       DO  3001 IB=1,NBELEM
  368. C
  369. C       XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  370.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  371.  
  372. c       BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ]
  373.         NBSH=MINTE2.SHPTOT(/2)
  374.         CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,BPSS3)
  375.         IF (NBSH.EQ.-1) THEN
  376.          CALL ERREUR(525)
  377.          GOTO 99
  378.         ENDIF
  379.  
  380. C------ BOUCLE SUR LES POINTS DE GAUSS
  381.         DO 4001 IGAU=1,NBPGAU
  382.  
  383. c         RECUP DES VALEURS MATERIAUX
  384.           MPTVAL=IVAMAT
  385.           MELVAL=IVAL(1)
  386.           IGMN=MIN(IGAU,VELCHE(/1))
  387.           IBMN=MIN(IB,VELCHE(/2))
  388.           V1X=VELCHE(IGMN,IBMN)
  389.           MELVAL=IVAL(2)
  390.           IGMN=MIN(IGAU,VELCHE(/1))
  391.           IBMN=MIN(IB,VELCHE(/2))
  392.           V1Y=VELCHE(IGMN,IBMN)
  393.           IF(IDIM.EQ.3.OR.IFOUR.EQ.1) THEN
  394.             MELVAL=IVAL(3)
  395.             IGMN=MIN(IGAU,VELCHE(/1))
  396.             IBMN=MIN(IB,VELCHE(/2))
  397.             V1Z=VELCHE(IGMN,IBMN)
  398.             MELVAL=IVAL(4)
  399.             IGMN=MIN(IGAU,VELCHE(/1))
  400.             IBMN=MIN(IB,VELCHE(/2))
  401.             V2X=VELCHE(IGMN,IBMN)
  402.             MELVAL=IVAL(5)
  403.             IGMN=MIN(IGAU,VELCHE(/1))
  404.             IBMN=MIN(IB,VELCHE(/2))
  405.             V2Y=VELCHE(IGMN,IBMN)
  406.             MELVAL=IVAL(6)
  407.             IGMN=MIN(IGAU,VELCHE(/1))
  408.             IBMN=MIN(IB,VELCHE(/2))
  409.             V2Z=VELCHE(IGMN,IBMN)
  410.           ENDIF
  411.  
  412. c         CALCUL DE V1 V2 (et V3 en 3D)
  413.           IF(IDIM.EQ.3) THEN
  414.             VV1(1) = V1X*BPSS3(1,1)+V1Y*BPSS3(1,2)+V1Z*BPSS3(1,3)
  415.             VV1(2) = V1X*BPSS3(2,1)+V1Y*BPSS3(2,2)+V1Z*BPSS3(2,3)
  416.             VV1(3) = V1X*BPSS3(3,1)+V1Y*BPSS3(3,2)+V1Z*BPSS3(3,3)
  417.             VV2(1) = V2X*BPSS3(1,1)+V2Y*BPSS3(1,2)+V2Z*BPSS3(1,3)
  418.             VV2(2) = V2X*BPSS3(2,1)+V2Y*BPSS3(2,2)+V2Z*BPSS3(2,3)
  419.             VV2(3) = V2X*BPSS3(3,1)+V2Y*BPSS3(3,2)+V2Z*BPSS3(3,3)
  420. c           CALCUL DE V3
  421.             CALL CROSS2(VV1,VV2,VV3,IRET)
  422.           ELSEIF(IFOUR.EQ.1) THEN
  423.             VV1(1) = V1X*BPSS3(1,1)+V1Y*BPSS3(1,2)
  424.             VV1(2) = V1X*BPSS3(2,1)+V1Y*BPSS3(2,2)
  425.             VV2(1) = V2X*BPSS3(1,1)+V2Y*BPSS3(1,2)
  426.             VV2(2) = V2X*BPSS3(2,1)+V2Y*BPSS3(2,2)
  427.             VV1(3) = V1Z
  428.             VV2(3) = V2Z
  429.             CALL CROSS2(VV1,VV2,VV3,IRET)
  430.           ELSE
  431.             VV1(1) = V1X*BPSS3(1,1)+V1Y*BPSS3(1,2)
  432.             VV1(2) = V1X*BPSS3(2,1)+V1Y*BPSS3(2,2)
  433. c           en 2d calcul de v2 deduit de v1
  434.             VV2(1)=-1.D0*VV1(2)
  435.             VV2(2)=VV1(1)
  436.           ENDIF
  437.  
  438. c         ECRITURE DANS LES MELVAL
  439.           MPTVAL=IVAVLO
  440. *         boucle sur les composantes
  441.           IF(N2.EQ.9) THEN
  442.             DO I=1,3
  443.               MELVAL=IVAL(I)
  444.               MELVAL.VELCHE(IGAU,IB)=VV1(I)
  445.               MELVAL=IVAL(3+I)
  446.               MELVAL.VELCHE(IGAU,IB)=VV2(I)
  447.               MELVAL=IVAL(6+I)
  448.               MELVAL.VELCHE(IGAU,IB)=VV3(I)
  449.             ENDDO
  450.           ELSE
  451.             DO I=1,2
  452.               MELVAL=IVAL(I)
  453.               MELVAL.VELCHE(IGAU,IB)=VV1(I)
  454.               MELVAL=IVAL(2+I)
  455.               MELVAL.VELCHE(IGAU,IB)=VV2(I)
  456.             ENDDO
  457.           ENDIF
  458.  
  459.  4001   CONTINUE
  460. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  461.  
  462.  3001 CONTINUE
  463.  
  464.       SEGDES MINTE2
  465.       SEGSUP,WRK1
  466.       GOTO 99
  467.  
  468. C_______________________________________________________________________
  469. C
  470. C     ELEMENTS COQ3, DKT et DST
  471. C_______________________________________________________________________
  472. C
  473.   28  CONTINUE
  474.       NBBB=NBNN
  475.       SEGINI WRK1
  476.  
  477. C---- BOUCLE SUR LES ELEMENTS
  478.       DO  3028 IB=1,NBELEM
  479. C
  480. C       XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  481.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  482.  
  483. c       BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ]
  484.         CALL VPAST(XE,BPSS)
  485.  
  486. C------ BOUCLE SUR LES POINTS DE GAUSS
  487.         DO 4028 IGAU=1,NBPGAU
  488.  
  489. c         RECUP DES VALEURS MATERIAUX
  490.           MPTVAL=IVAMAT
  491.           MELVAL=IVAL(1)
  492.           IGMN=MIN(IGAU,VELCHE(/1))
  493.           IBMN=MIN(IB,VELCHE(/2))
  494.           V1X=VELCHE(IGMN,IBMN)
  495.           MELVAL=IVAL(2)
  496.           V1Y=VELCHE(IGMN,IBMN)
  497.  
  498. c         CALCUL DE V1 ET V3
  499.           VV1(1) = V1X*BPSS(1,1)+V1Y*BPSS(2,1)
  500.           VV1(2) = V1X*BPSS(1,2)+V1Y*BPSS(2,2)
  501.           VV1(3) = V1X*BPSS(1,3)+V1Y*BPSS(2,3)
  502.           VV3(1) = BPSS(3,1)
  503.           VV3(2) = BPSS(3,2)
  504.           VV3(3) = BPSS(3,3)
  505. c         CALCUL DE V2
  506.           CALL CROSS2(VV3,VV1,VV2,IRET)
  507. c           IF(IRET)
  508.  
  509. c         ECRITURE DANS LES MELVAL
  510.           MPTVAL=IVAVLO
  511. *         boucle sur la dimension
  512.           DO I=1,3
  513.             MELVAL=IVAL(I)
  514.             MELVAL.VELCHE(IGAU,IB)=VV1(I)
  515.             MELVAL=IVAL(3+I)
  516.             MELVAL.VELCHE(IGAU,IB)=VV2(I)
  517.             MELVAL=IVAL(6+I)
  518.             MELVAL.VELCHE(IGAU,IB)=VV3(I)
  519.           ENDDO
  520.  
  521.  4028   CONTINUE
  522. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  523.  
  524.  3028 CONTINUE
  525. C---- FIN DE BOUCLE SUR LES ELEMENTS
  526.  
  527.       SEGSUP,WRK1
  528.       GOTO 99
  529.  
  530. C_______________________________________________________________________
  531. C
  532. C     ELEMENT COQ8 et COQ6
  533. C_______________________________________________________________________
  534. C
  535.   41  CONTINUE
  536.       NBBB=NBNN
  537.       SEGINI WRK2
  538.       SEGACT MINTE1
  539.  
  540. C---- BOUCLE SUR LES ELEMENTS
  541.       DO  3041 IB=1,NBELEM
  542. C
  543. C       XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  544.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE2)
  545.  
  546. C       DETERMINATION DES AXES LOCAUX AUX NOEUDS
  547.         CALL CQ8LOC(XE2,NBNN,MINTE1.SHPTOT,BPSS2,IRR)
  548. C       GESTION D'ERREUR:IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2)
  549. C                        IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC)
  550.         IF(IRR.EQ.0) THEN
  551.           CALL ERREUR(241)
  552.           GOTO 3041
  553.         ELSE IF(IRR.EQ.-1)THEN
  554.           CALL ERREUR(240)
  555.           GOTO 3041
  556.         ENDIF
  557.  
  558. C------ BOUCLE SUR LES POINTS DE GAUSS
  559.         DO 4041 IGAU=1,NBPGAU
  560.  
  561. c         CALCUL DES AXES LOCAUX AUX POINTS DE GAUSS
  562. c         BPSS(J1,J2) = vecteurs locaux au point de Gauss
  563. c         avec J1 = indice du vecteur local (u,v,w)
  564. c              J2 = indice du repere global (X,Y,Z)
  565.           DO J2=1,3
  566.             DO J1=1,3
  567.               r_z = 0.D0
  568.               DO I=1,NBNN
  569.                 r_z = r_z + SHPTOT(1,I,IGAU)*BPSS2(J2,J1,I)
  570.               ENDDO
  571.               BPSS(J1,J2) = r_z
  572.           ENDDO
  573.           ENDDO
  574.  
  575. c         RECUP DES VALEURS MATERIAUX
  576.           MPTVAL=IVAMAT
  577.           MELVAL=IVAL(1)
  578.           IGMN=MIN(IGAU,VELCHE(/1))
  579.           IBMN=MIN(IB,VELCHE(/2))
  580.           V1X=VELCHE(IGMN,IBMN)
  581.           MELVAL=IVAL(2)
  582.           V1Y=VELCHE(IGMN,IBMN)
  583.  
  584. c         CALCUL DE V1 ET V3
  585.           DO I=1,3
  586.             VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I)
  587.             VV3(I) = BPSS(3,I)
  588.           ENDDO
  589. c         CALCUL DE V2
  590.           CALL CROSS2(VV3,VV1,VV2,IRET)
  591. c           IF(IRET)
  592.  
  593. c         ECRITURE DANS LES MELVAL
  594.           MPTVAL=IVAVLO
  595. *         boucle sur la dimension
  596.           DO I=1,3
  597.             MELVAL=IVAL(I)
  598.             MELVAL.VELCHE(IGAU,IB)=VV1(I)
  599.             MELVAL=IVAL(3+I)
  600.             MELVAL.VELCHE(IGAU,IB)=VV2(I)
  601.             MELVAL=IVAL(6+I)
  602.             MELVAL.VELCHE(IGAU,IB)=VV3(I)
  603.           ENDDO
  604.  
  605.  4041   CONTINUE
  606. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  607.  
  608.  3041 CONTINUE
  609. C---- FIN DE BOUCLE SUR LES ELEMENTS
  610.  
  611.       SEGSUP,WRK2
  612.       GOTO 99
  613.  
  614. C_______________________________________________________________________
  615. C
  616. C     SECTEUR DE CALCUL POUR LE COQ2
  617. C_______________________________________________________________________
  618. C
  619.   44  CONTINUE
  620.       NBBB=NBNN
  621.       SEGINI WRK1
  622.  
  623. C---- BOUCLE SUR LES ELEMENTS
  624.       DO  3044 IB=1,NBELEM
  625. C
  626. C       XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  627.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  628.  
  629. c       BPSS = MATRICE DE PASSAGE
  630.         CALL VPAST2(XE,BPSS)
  631.  
  632. C------ BOUCLE SUR LES POINTS DE GAUSS
  633.         DO 4044 IGAU=1,NBPGAU
  634.  
  635. c         RECUP DES VALEURS MATERIAUX
  636.           MPTVAL=IVAMAT
  637.           MELVAL=IVAL(1)
  638.           IGMN=MIN(IGAU,VELCHE(/1))
  639.           IBMN=MIN(IB,VELCHE(/2))
  640.           V1X=VELCHE(IGMN,IBMN)
  641.           MELVAL=IVAL(2)
  642.           V1Y=VELCHE(IGMN,IBMN)
  643.  
  644. c           IF(IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  645. c c           CALCUL DE V1 ET V3
  646. c             DO I=1,3
  647. c               VV1(I) = V1X*BPSS(I,1)+V1Y*BPSS(I,2)
  648. c               VV2(I) = BPSS(I,3)
  649. c             ENDDO
  650. c c           CALCUL DE V2
  651. c             CALL CROSS2(VV2,VV1,VV3,IRET)
  652. c           ELSE
  653. c           CALCUL DE V1 ET V3
  654.             DO I=1,3
  655.               VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I)
  656.               VV3(I) = BPSS(3,I)
  657.             ENDDO
  658. c           CALCUL DE V2
  659.             CALL CROSS2(VV3,VV1,VV2,IRET)
  660. c           ENDIF
  661. c           IF(IRET)
  662.  
  663. c         ECRITURE DANS LES MELVAL
  664.           MPTVAL=IVAVLO
  665. *         boucle sur la dimension
  666.           DO I=1,3
  667.             MELVAL=IVAL(I)
  668.             MELVAL.VELCHE(IGAU,IB)=VV1(I)
  669.             MELVAL=IVAL(3+I)
  670.             MELVAL.VELCHE(IGAU,IB)=VV2(I)
  671.             MELVAL=IVAL(6+I)
  672.             MELVAL.VELCHE(IGAU,IB)=VV3(I)
  673.           ENDDO
  674.  
  675.  4044   CONTINUE
  676. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  677.  
  678.  
  679.  3044 CONTINUE
  680. C---- FIN DE BOUCLE SUR LES ELEMENTS
  681.  
  682.       SEGSUP,WRK1
  683.       GOTO 99
  684.  
  685. C_______________________________________________________________________
  686. C
  687. C     SECTEUR DE CALCUL POUR LE COQ4
  688. C_______________________________________________________________________
  689. C
  690.   49  CONTINUE
  691.       NBBB=NBNN
  692.       SEGINI WRK1
  693.  
  694. C---- BOUCLE SUR LES ELEMENTS
  695.       DO  3049 IB=1,NBELEM
  696. C
  697. C       XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  698.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  699.  
  700. c       BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ]T
  701.         CALL CQ4LOC(XE,XEL,BPSS,IRRT,1)
  702.         do i=1,3
  703. c         write(*,*) 'BPSS(',i,',:)=',(BPSS(i,jou),jou=1,3)
  704.         enddo
  705.  
  706. C------ BOUCLE SUR LES POINTS DE GAUSS
  707.         DO 4049 IGAU=1,NBPGAU
  708.  
  709. c         RECUP DES VALEURS MATERIAUX
  710.           MPTVAL=IVAMAT
  711.           MELVAL=IVAL(1)
  712.           IGMN=MIN(IGAU,VELCHE(/1))
  713.           IBMN=MIN(IB,VELCHE(/2))
  714.           V1X=VELCHE(IGMN,IBMN)
  715.           MELVAL=IVAL(2)
  716.           V1Y=VELCHE(IGMN,IBMN)
  717. c           write(*,*) 'V1X,V1Y=',V1X,V1Y
  718.  
  719. c         CALCUL DE V1 ET V3
  720.           DO I=1,3
  721.             VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I)
  722.             VV3(I) = BPSS(3,I)
  723.           ENDDO
  724. c         CALCUL DE V2
  725.           CALL CROSS2(VV3,VV1,VV2,IRET)
  726. c           IF(IRET)
  727.  
  728. c         ECRITURE DANS LES MELVAL
  729.           MPTVAL=IVAVLO
  730. *         boucle sur la dimension
  731.           DO I=1,3
  732.             MELVAL=IVAL(I)
  733.             MELVAL.VELCHE(IGAU,IB)=VV1(I)
  734.             MELVAL=IVAL(3+I)
  735.             MELVAL.VELCHE(IGAU,IB)=VV2(I)
  736.             MELVAL=IVAL(6+I)
  737.             MELVAL.VELCHE(IGAU,IB)=VV3(I)
  738.           ENDDO
  739.  
  740.  4049   CONTINUE
  741. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  742.  
  743.  
  744.  3049 CONTINUE
  745. C---- FIN DE BOUCLE SUR LES ELEMENTS
  746.  
  747.       SEGSUP,WRK1
  748.       GOTO 99
  749.  
  750. C---------------------------------------------------------------------
  751. C  DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  752. C---------------------------------------------------------------------
  753.  99      CONTINUE
  754.          MPTVAL=IVAVLO
  755.          DO I2=1,N2
  756.            MELVAL=IVAL(I2)
  757.            IF (MELVAL.NE.0) SEGDES MELVAL
  758.          ENDDO
  759.          SEGSUP MPTVAL
  760. C
  761.          SEGDES MINTE
  762.  
  763.          SEGDES MELEME
  764.          SEGDES MCHAML
  765. C
  766.          IF (MFR.EQ.5) THEN
  767.             SEGDES MINTE1
  768.          ENDIF
  769.  
  770.   499    SEGDES IMODEL
  771.  
  772.  
  773.   500 CONTINUE
  774. C____________________________________________________________________
  775. C
  776. C     FIN DE LA BOUCLE SUR LES DIFFERENTES ZONES
  777. C____________________________________________________________________
  778.  
  779.       N1=ISORTH
  780.       L1=15
  781.       N3=6
  782.       SEGADJ,MCHELM
  783.       SEGDES MCHELM
  784.       SEGDES MMODEL
  785.  
  786.       NOTYPE = MOTYR8
  787.       SEGSUP,NOTYPE
  788.  
  789.       RETURN
  790. C
  791.       END
  792.  
  793.  
  794.  

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