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

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