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

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