Télécharger la plaquette Cast3M


fr en

Télécharger epsix.eso

Retour à la liste

Numérotation des lignes : 

epsix

  1. C EPSIX     SOURCE    MB234859  25/09/08    21:15:22     12358          
  2.  
  3. C     PROCEDURE UTILISEE DANS LE CAS D'ELEMENTS XFEM
  4. c     POUR LE CALCUL DE la deformation
  5. C
  6. C*********************************************************
  7. C       PARTIE DECLARATIVE
  8. C*********************************************************
  9.       SUBROUTINE EPSIX (IMODEL,IREPS2,IVADEP,IVAEPS,
  10.      &                  UZDPG,RYDPG,RXDPG,IIPDPG,IRETER)
  11.  
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8 (A-H,O-Z)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.  
  18. -INC SMCOORD
  19. -INC SMMODEL
  20. -INC SMCHAML
  21. -INC SMINTE
  22. -INC SMELEME
  23. -INC SMLREEL
  24. C
  25.       POINTEUR    MCHEX1.MCHELM,MINT1.MINTE,MINT2.MINTE
  26.  
  27. -INC TMPTVAL
  28.  
  29.       SEGMENT WRK1
  30.        REAL*8 XE(3,NBBB)
  31.        REAL*8 XDDL(LRE),XSTRS(LHOOK)
  32.       ENDSEGMENT
  33.  
  34.       SEGMENT WRK2
  35.        REAL*8 SHPWRK(6,NBNO),BGENE(LHOOK,LRE)
  36. c       REAL*8 LV7WRK(NBENRMA2,2,6,NBNO)
  37.        REAL*8 LV7WRK(NBENRMA2,2,6,NBBB)
  38.       ENDSEGMENT
  39.  
  40.       SEGMENT MRACC
  41.          INTEGER TLREEL(NBENRMA2,NBI)
  42.       ENDSEGMENT
  43.  
  44.       SEGMENT MTRACE
  45.         REAL*8 TRACE(NBPTEL)
  46.       ENDSEGMENT
  47.       DIMENSION UDPGE(3)
  48.  
  49.       PARAMETER  (NDDLMAX=30,NBNIMAX=10)
  50.       PARAMETER  (NBENRMAX=5)
  51.       DIMENSION  MLRE(NBENRMAX+1)
  52.  
  53. C      write (*,*) '############################'
  54. C      write (*,*) '#####  DEBUT DE EPSIX  #####'
  55. C      write (*,*) '############################'
  56.  
  57. C*********************************************************
  58. c  Introduction du point autour duquel se fait le mouvement
  59. c  de la section en defo plane generalisee
  60. C*********************************************************
  61. C IIPDPG > 0 (argument) si noeud/point support defini dans le modele
  62. C NDPGE > 0 si besoin de calcul avec point support
  63.       IF (IIPDPG.GT.0) THEN
  64.         IF (IFOUR.EQ.-3) THEN
  65.           NDPGE=3
  66.           UDPGE(1)=UZDPG
  67.           UDPGE(2)=RYDPG
  68.           UDPGE(3)=RXDPG
  69.           IREF=(IIPDPG-1)*(IDIM+1)
  70.           XDPGE=XCOOR(IREF+1)
  71.           YDPGE=XCOOR(IREF+2)
  72. C*        ELSE IF (IFOUR.EQ.11) THEN
  73. C*          NDPGE=2
  74. C*          UDPGE(1)=UZDPG
  75. C*          UDPGE(2)=RXDPG
  76. C*          UDPGE(3)=0.D0
  77. C*          XDPGE=0.D0
  78. C*          YDPGE=0.D0
  79. C*        ELSE IF (IFOUR.EQ. 7 .OR. IFOUR.EQ. 8 .OR. IFOUR.EQ. 9 .OR.
  80. C*     &           IFOUR.EQ.10 .OR. IFOUR.EQ.14) THEN
  81. C*          NDPGE=1
  82. C*          UDPGE(1)=UZDPG
  83. C*          UDPGE(2)=0.D0
  84. C*          UDPGE(3)=0.D0
  85. C*          XDPGE=0.D0
  86. C*          YDPGE=0.D0
  87.         else
  88.           write(ioimp,*) 'EPSI4 : erreur NDPGE'
  89.           call erreur(5)
  90.           return
  91.         ENDIF
  92.       ELSE
  93.         NDPGE=0
  94.         UDPGE(1)=0.D0
  95.         UDPGE(2)=0.D0
  96.         UDPGE(3)=0.D0
  97.         XDPGE=0.D0
  98.         YDPGE=0.D0
  99.       ENDIF
  100.  
  101. C*********************************************************
  102. c
  103. C       RECUPERATION + ACTIVATIONS + VALEURS UTILES
  104. c
  105. C*********************************************************
  106.  
  107. C++++ Recuperation de la geometrie ++++++++++++++++++++++
  108.       MELEME= IMAMOD
  109.  
  110. C++++ RECUP DES INFOS EF ++++++++++++++++++++++++++++++++
  111. c   + OBTENUES PAR ELQUOI DANS RIGI1 PENDANT PHASE 1
  112. C     segment INFO deja actif dans RIGI1
  113. c   + rigi1 n appelle pas elquoi, c'est modeli qui l'a fait
  114. c     mais du coup, on na pas de segment minte
  115. c     (car depend de si pt de g pour rigi, pour sigma....)
  116. c     c'est + simple de rappeler elquoi ici
  117.       MELE  = NEFMOD
  118.       NGAU1 = INFELE(6)
  119.       LRE   = INFELE(9)
  120.       LHOOK = INFELE(10)
  121.       MINT1 = INFMOD(6)
  122.       MINT2 = INFMOD(10)
  123.       MFR   = INFELE(13)
  124.       IELE  = INFELE(14)
  125.       NDDL  = INFELE(15)
  126.       NSTRS = INFELE(16)
  127.  
  128. c   + AUTRES INFOS
  129. C     nbre de noeuds par element
  130.       NBNN1 = NUM(/1)
  131. C     nbre d elements
  132.       NBEL1 = NUM(/2)
  133.  
  134. c REM: pour se passer du dimensionnement du nbre d'enrichissement dans
  135. c      elquoi et le realiser localement , on pourrait ecrire:
  136. c      LRE = NDDLMAX*NBNN1
  137. c      NDDL= NDDLMAX
  138.  
  139. C     sous decoupage et points de Gauss de l element geometrique de base
  140.       if (MELE.eq.263.or.mele.eq.264) then
  141.          NGAU2 = MINT2.POIGAU(/1)
  142.       endif
  143. C      write(*,*) 'dim de MINT2=6,',(MINT2.SHPTOT(/2)),(MINT2.SHPTOT(/3))
  144. C      write(*,*) 'MINT2',(MINT2.QSIGAU(iou),iou=1,NGAU)
  145.  
  146. C++++ Recup des infos d enrichissement +++++++++++++++++++
  147. c     recup du MCHEX1 d'enrichissement
  148.       NOBMO1 = IVAMOD(/1)
  149.       if(NOBMO1.ne.0) then
  150.        do iobmo1=1,NOBMO1
  151.         if((TYMODE(iobmo1)).eq.'MCHAML') then
  152.          MCHEX1 = IVAMOD(iobmo1)
  153.          segact,MCHEX1
  154.           if((MCHEX1.TITCHE).eq.'ENRICHIS') then
  155.             MCHAM1 = MCHEX1.ICHAML(1)
  156.             segact,MCHAM1
  157.             goto 1000
  158.           endif
  159.         endif
  160.        enddo
  161.        write(*,*) 'Le modele est vide (absence d enrichissement)'
  162.       else
  163.       write(*,*) 'Il n y a pas de MCHEML enrichissement dans le Modele'
  164.       endif
  165.  
  166.  1000 continue
  167. c     niveau d enrichissement(s) du modele (ddls std u exclus)
  168. c     NBENR1= 0 si std, 1 si H seul,  2 si H+F1,  3 si H+F1+F2, etc...
  169.       if(NOBMO1.ne.0) then
  170.         NBENR1= MCHAM1.IELVAL(/1)
  171.       else
  172.         NBENR1 = 0
  173.       endif
  174. c      write(*,*) 'niveau d enrichissement(s) du modele',NBENR1
  175.  
  176. C*********************************************************
  177. C       INITIALISATIONS...
  178. C*********************************************************
  179.       IRETER = 0
  180. c
  181. c     preparation des tables avec:
  182.  
  183.       if(NBENR1.ne.0) then
  184.       do ienr=1,NBENR1
  185. c        -le nombre d'inconnues de chaque sous-zone
  186. c         determinee depuis le nombre de fonction de forme
  187. c ienr=  1: U+H(1+1=2), 2: U+H+F1(2+4=6), 3: U+H+F1+F2(6+4=10)
  188.          nbniJ = 2 + ((ienr-1)*4)
  189.          MLRE(1+ienr) = IDIM*NBNN1*nbniJ
  190.       enddo
  191.       endif
  192. C     Tables + longues car 1er indice correspond au fontion de forme std
  193.       MLRE(1)    = IDIM*NBNN1*1
  194.  
  195.       if(NBENR1.lt.(NBENRMAX+1)) then
  196.         do ienr=(NBENR1+1),(NBENRMAX)
  197.            MLRE(1+ienr) = 0
  198.         enddo
  199.       endif
  200. c
  201. c      ...DU SEGMENT WRK1
  202.       NBENRMA2 = NBENRMAX
  203.       NBBB = NBNN1
  204.       SEGINI,WRK1
  205.  
  206. c      ...DU SEGMENT WRK2
  207. c      NBNO = NBNI
  208.       NBNO = LRE/IDIM
  209.       SEGINI,WRK2
  210. C
  211. c      ...DU SEGMENT MRACC
  212.       NBENRMA2 = NBENRMAX
  213.       NBI = NBNN1
  214.       segini,MRACC
  215. C
  216. C     du nombre d erreurs sur le nom des composantes
  217.       NBERR1=0
  218.  
  219. C*********************************************************
  220. C
  221. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  BOUCLE SUR LES ELEMENTS
  222. C
  223.       DO 2000 J=1,NBEL1
  224.  
  225. c      write(*,*) '==================================='
  226. c      write(*,*) '========= EF',J,' /NBEL1 ========='
  227.  
  228. C*********************************************************
  229. C     POUR CHAQUE ELEMENT, ...
  230. C*********************************************************
  231. C
  232. C++++ ON RECUPERE LES COORDONNEES DES NOEUDS DE L ELEMENT
  233.       CALL DOXE(XCOOR,IDIM,NBNN1,NUM,J,XE)
  234.  
  235. C++++ NBENRJ = niveau d enrichissement de l element ++++
  236. C     =0 si EF std   =1 si U+H   =2 si U+H+F1   =3 si U+H+F1+F2
  237.       NBENRJ=0
  238.       if(NBENR1.ne.0) then
  239.       do IENR=1,NBENR1
  240.         MELVA1 = MCHAM1.IELVAL(IENR)
  241.         segact,MELVA1
  242.         do I=1,NBNN1
  243.          mlree1 = MELVA1.IELCHE(I,J)
  244. C        on en profite pour remplir MRACC table de raccourcis pour cet element
  245.          TLREEL(IENR,I) = mlree1
  246.          if(mlree1.ne.0)  then
  247.             NBENRJ = max(NBENRJ,IENR)
  248. C           et on active la listreel
  249.             segact,mlree1
  250.          endif
  251.         enddo
  252.       enddo
  253.       endif
  254.       if(NBENRMA2.gt.NBENR1) then
  255.         do IENR2=(NBENR1+1),NBENRMA2
  256.         do I=1,NBNN1
  257.            TLREEL(IENR2,I) = 0
  258.         enddo
  259.         enddo
  260.       endif
  261.  
  262. c++++ quelques indices pour dimensionner au plus juste
  263. c     nbre total de ddl de l'élément considéré
  264.       NLIGRD = MLRE(1+NBENRJ)
  265.       NLIGRP = MLRE(1+NBENRJ)
  266. c     nbre fonction de forme=((Ni_std+Ni_enrichi)*nbnoeud)=Ninconnues/idim
  267.       NBNI = (MLRE(1+NBENRJ)) / IDIM
  268.  
  269. C      write(*,*) 'EF',J,' NBENRJ=',NBENRJ,
  270. C    &'donc',NLIGRD,' ddls et ',NBNI,' fonctions de forme'
  271.  
  272. C++++ ON CALCULE XDDL ++++
  273.       MPTVAL = IVADEP
  274.       NCOSOU = IVAL(/1)
  275. C
  276.       INITOT = 0
  277. C-->> BOUCLE SUR LES niveaux d'ENRICHISSEMENTS (0:U 1:A 2:BCDE1 3:BCDE2)
  278.       DO IENR=0,NBENRJ
  279. *nbre de fonction(s) de ce niveau d'enrichissement (=1 si std ou H, =4 pour F1,2,...)
  280.         if(IENR .le. 1) then
  281.          NBNIENR = 1
  282.         else
  283.          NBNIENR = 4
  284.         endif
  285. C---->> BOUCLE SUR LES fonctions de forme de ce type d'enrichissement
  286.         DO INI=1,NBNIENR
  287.           INITOT = INITOT + 1
  288. C------>> BOUCLE SUR LA DIMENSION
  289.           DO 2220 KDIM=1,IDIM
  290.             ICOMP = (INITOT-1)*IDIM + KDIM
  291.  
  292. c         --cas ou on n'a pas trouvé assez de composantes--
  293.             if(ICOMP.GT.NCOSOU) GOTO 2221
  294.  
  295.             MELVAL = IVAL(ICOMP)
  296. c         --cas ou on a pas trouvé cette composante dans cette zone du
  297. c           chpoint solution devenu mchaml  --
  298.             if(MELVAL.eq.0)then
  299. c             Avait on besoin de cette composante?
  300. c             oui, si c'est une composante obligatoire
  301.               if(IENR.eq.0) goto 2991
  302. c             oui, si l'un des noeuds est enrichi
  303.               do I=1,NBNN1
  304.                 if(TLREEL(IENR,I).ne.0) goto 2991
  305.               enddo
  306. c             non, si c'est facultatif et qu'on n'est pas enrichi -> on saute
  307.               goto 2220
  308. c           ->AVERTISSEMENT puis on saute
  309.  2991         NBERR1=NBERR1+1
  310.               if(IIMPI.lt.1) goto 2220
  311. c               write(IOIMP,*) 'PB OPERATEUR EPSI :'
  312.               write(IOIMP,991) ICOMP,IENR,INI,KDIM
  313.   991         format(2X,'ABSENCE DANS LE CHPOINT DEPLACEMENT DE LA ',I3,
  314.      $                  'ieme COMPOSANTE (enrichissement',I3,
  315.      $                   ', fonction',I3,', direction ',I3,
  316.      $                   ') NECESSAIRE POUR L UN DES NOEUDS SUIVANTS :')
  317.               write(IOIMP,*)'  noeuds :',(NUM(iou,J),iou=1,NBNN1)
  318.               goto 2220
  319.             endif
  320.  
  321. C---------->> BOUCLE SUR LES NOEUDS
  322.             IGMX = VELCHE(/1)
  323.             IEMN = MIN(J,VELCHE(/2))
  324.             IQ = ((INITOT-1)*NBNN1*IDIM) + KDIM
  325.             DO I=1,NBNN1
  326. c**              IQ = ((INITOT-1)*NBNN1*IDIM) + ((I-1)*IDIM) + KDIM
  327.               XDDL(IQ) = VELCHE(MIN(I,IGMX),IEMN)
  328.               IQ = IQ + IDIM
  329.             ENDDO
  330.  
  331.  2220     CONTINUE
  332.         ENDDO
  333.       ENDDO
  334.  
  335. c   --cas normal (toutes les composantes souhaitees etaient presentes)--
  336.       GOTO 2223
  337.  
  338. c   --cas ou on n'a pas trouvé assez de composantes--
  339.  2221 CONTINUE
  340.       if (IIMPI.ge.1) then
  341.         WRITE(IOIMP,2222) J,NCOSOU,ICOMP
  342.  2222   FORMAT(2X,'ATTENTION : ELEMENT ',I6,
  343.      &  ' LE CHAMP DE DEPLACEMENT CONTIENT ',I3,' COMPOSANTES',
  344.      &  ' PAR NOEUD AU LIEU DE ',I3,' ATTENDUES')
  345.       endif
  346.       NDDL=NCOSOU*NBNN1
  347.       NBENRJ=IENR
  348.  
  349.  2223 CONTINUE
  350. c   --cas ou on a une ou des erreurs--
  351.       IF (NBERR1.gt.0.and.J.eq.NBEL1) THEN
  352.         write(IOIMP,*) 'OPERATEUR GRAD : ABSENCE DANS LE CHPOINT ',
  353.      &   'DEPLACEMENT DE CERTAINES INCONNUES ATTENDUES PAR LE MODELE'
  354.       ENDIF
  355. c
  356. c rem: il serait probablement interessant au niveau du tems cpu
  357. c  d'utiliser moins de pts de Gauss lorsque l element est élastique
  358. c  On pourrait par ex. utiliser MINT2 = infell(12) qui contient
  359. c  le segment d'integration de l'EF std (QUA4 par ex.)
  360. *      if((NBENRJ.eq.0).and.(MINT2.ne.0)) then
  361. *         MINTE = MINT2
  362. *         NBPGAU= NGAU2
  363. *      else
  364.          MINTE = MINT1
  365.          NBPGAU= NGAU1
  366. *      endif
  367. c
  368. c       pour les def quadratiques
  369.         ISDJC=0
  370.         NBPTEL=NBPGAU
  371.         IF (IREPS2.EQ.1) SEGINI MTRACE
  372. C
  373. C*********************************************************
  374. C
  375. C>>>>>>>>>>  BOUCLE SUR LES POINTS DE GAUSS
  376. C
  377.       DO 2500 KGAU=1,NBPGAU
  378. C
  379. C*********************************************************
  380. C     Initialisation à 0
  381. C*********************************************************
  382.  
  383. c ZERO ne serait-il pas facultatif?
  384.       CALL ZERO(SHPWRK,6,NBNO)
  385.  
  386.       i6zz = 3
  387.       IF (IDIM.EQ.3) i6zz = 4
  388.  
  389.       do ienr7=1,NBENRJ
  390.        do inod7=1,NBNN1
  391.         do i6=1,i6zz
  392.            LV7WRK(ienr7,1,i6,inod7) = 0.D0
  393.            LV7WRK(ienr7,2,i6,inod7) = 0.D0
  394.         enddo
  395.        enddo
  396.       enddo
  397.  
  398. c*********************************************************
  399. c     Calcul des fonction de forme std dans repere local
  400. c*********************************************************
  401.  
  402. ccccc BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccccc
  403. c     (et donc sur les Ni std)
  404.       DO 2510 I=1,NBNN1
  405.  
  406. C++++ Calcul des Ni std
  407. c     (rappel: 1:Ni  2:Ni,qsi  3:Ni,eta  avec i=1,4)
  408.       SHPWRK(1,I) = SHPTOT(1,I,KGAU)
  409.       SHPWRK(2,I) = SHPTOT(2,I,KGAU)
  410.       SHPWRK(3,I) = SHPTOT(3,I,KGAU)
  411.       IF (IDIM.EQ.3) SHPWRK(4,I) = SHPTOT(4,I,KGAU)
  412.  
  413.  2510 CONTINUE
  414. ccccc fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc
  415.  
  416. c*********************************************************
  417. c     Passage des fonctions de forme std dans repere global
  418. c*********************************************************
  419.  
  420. C++++ CALCUL DES  Ni,x Ni,y (i=1,4) + CALCUL DE det(J)
  421.       CALL JACOBI(XE,SHPWRK,IDIM,NBNN1,DJAC)
  422. c      if(J.eq.1.and.KGAU.eq.1)
  423. c     &write(*,*) 'Ni(i=1,4)=',(SHPWRK(1,iou),iou=1,NBNN1)
  424.  
  425. c*********************************************************
  426. c     Si on est pas du tout enrichi on peut sauter une grosse partie
  427. c*********************************************************
  428.       if(NBENRJ.eq.0) goto 2999
  429.  
  430. c*********************************************************
  431. c     Calcul des level set + leurs derivees dans repere global
  432. c*********************************************************
  433.  
  434. ccccc BOUCLE SUR LES enrichissements ccccccccccccccccccc
  435.       do 2520 ienr=1,NBENRJ
  436.  
  437. c       MELVA1=MCHAM1.IELVAL(IENR)
  438. c       segact,MELVA1
  439.  
  440. ccccc  BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccc
  441.        DO 2521 I=1,NBNN1
  442.  
  443. C++++ Le I eme noeud est-il ienr-enrichi?
  444.         mlree1= TLREEL(IENR,I)
  445.         if(mlree1.eq.0)  goto 2521
  446.  
  447. c       Calcul du repere local de fissure(=PSI,PHI)
  448. c       (rappel: 1,1:psi  1,2:phi  2,1 psi,x  ...etc...)
  449.         do 2522 inode=1,NBNN1
  450. c         pour le H-enrichissement, on n a pas gardé PSI (inutile)
  451.           if(ienr.ne.1) then
  452. c          valeur de PSI au inode^ieme noeud
  453.            xpsi1 = mlree1.PROG(inode)
  454. c          qu on multiplie par la valeur de Ni^std au pt de G considéré
  455.            LV7WRK(ienr,1,1,I)= LV7WRK(ienr,1,1,I)
  456.      &      + (SHPWRK(1,inode)*xpsi1)
  457.            LV7WRK(ienr,1,2,I)= LV7WRK(ienr,1,2,I)
  458.      &      + (SHPWRK(2,inode)*xpsi1)
  459.            LV7WRK(ienr,1,3,I)= LV7WRK(ienr,1,3,I)
  460.      &      + (SHPWRK(3,inode)*xpsi1)
  461.       IF (IDIM.EQ.3) LV7WRK(ienr,1,4,I)= LV7WRK(ienr,1,4,I)
  462.      &      + (SHPWRK(4,inode)*xpsi1)
  463. c          valeur de PHI au inode^ieme noeud
  464.            xphi1 = mlree1.PROG(NBNN1+inode)
  465.           else
  466.            xphi1 = mlree1.PROG(inode)
  467.           endif
  468.           LV7WRK(ienr,2,1,I)= LV7WRK(ienr,2,1,I)
  469.      &      + (SHPWRK(1,inode)*xphi1)
  470.           LV7WRK(ienr,2,2,I)= LV7WRK(ienr,2,2,I)
  471.      &      + (SHPWRK(2,inode)*xphi1)
  472.           LV7WRK(ienr,2,3,I)= LV7WRK(ienr,2,3,I)
  473.      &      + (SHPWRK(3,inode)*xphi1)
  474.       IF (IDIM.EQ.3) LV7WRK(ienr,2,4,I)= LV7WRK(ienr,2,4,I)
  475.      &      + (SHPWRK(4,inode)*xphi1)
  476.  2522   continue
  477.  
  478.  2521  continue
  479. ccccc  fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc
  480.  
  481.  
  482.  2520 CONTINUE
  483. ccccc fin de BOUCLE SUR LES enrichissements cccccccccccccccc
  484.  
  485. c     on a construit
  486. C     LV7WRK(ienr, PSI/PHI, valeur/deriveeparqsi/pareta, iNOEUD)
  487.  
  488. c*********************************************************
  489. c     Ajout des fonctions de forme d enrichissement
  490. c     + leurs derivees dans repere global
  491. c*********************************************************
  492.       CALL SHAPX(MELE,LV7WRK,NBENRMAX,NBENRJ,TLREEL,SHPWRK,IRET)
  493.  
  494.  
  495. c     retour a la partie commune aux EF enrichis et non enrichis
  496.  2999 continue
  497.  
  498. C*********************************************************
  499. C       CALCUL DE B'
  500. C*********************************************************
  501. c ZERO ne serait-il pas facultatif?
  502. c        call ZERO(BGENE,LHOOK,NLIGRP)
  503.         KB=1
  504. C       boucle sur tous les Ni
  505.         DO 3001 II=1,NBNI
  506.  
  507.           BGENE(1,KB)   = SHPWRK(2,II)
  508.           BGENE(2,KB+1) = SHPWRK(3,II)
  509.           BGENE(4,KB)   = SHPWRK(3,II)
  510.           BGENE(4,KB+1) = SHPWRK(2,II)
  511.  
  512.           IF(IDIM.EQ.3) THEN
  513.             BGENE(3,KB+2)=SHPWRK(4,II)
  514.             BGENE(5,KB)  =SHPWRK(4,II)
  515.             BGENE(5,KB+2)=SHPWRK(2,II)
  516.             BGENE(6,KB+1)=SHPWRK(4,II)
  517.             BGENE(6,KB+2)=SHPWRK(3,II)
  518.           ENDIF
  519.  
  520.           KB = KB + IDIM
  521.  
  522.  3001   CONTINUE
  523. C
  524. c      if(J.eq.5.and.KGAU.eq.1) then
  525. c      if(KGAU.eq.1) then
  526. c      write(*,*) 'BGENE(1,..)=',(BGENE(1,iou),iou=1,2*NBNI)
  527. c      write(*,*) 'BGENE(2,..)=',(BGENE(2,iou),iou=1,2*NBNI)
  528. c      write(*,*) 'BGENE(6,..)=',(BGENE(6,iou),iou=1,2*NBNI)
  529. c      endif
  530. c      endif
  531.  
  532. C*********************************************************
  533. C       CALCUL DE  B.q'
  534. C*********************************************************
  535.  
  536. C  APPEL A LA PROCEDURE DE CALCUL
  537.         CALL BST(BGENE,XDDL,(NBNI*IDIM),LHOOK,XSTRS)
  538. c
  539. c       cas de la priâe en compte des termes quadratiques
  540.         IF (IREPS2.EQ.1)
  541.      &  CALL BST2(SHPWRK,XDDL,XE,NBNI,IFOUR,XSTRS,TRACE,KGAU,
  542.      &            XDPGE,YDPGE,UDPGE,NIFOUR)
  543.  
  544. C*********************************************************
  545. C       ECRITURE DES DIFFERENTES COMPOSANTES DES DEFORMATIONS
  546. C*********************************************************
  547.         MPTVAL = IVAEPS
  548.         DO 7000 ICOMP=1,LHOOK
  549.           MELVAL = IVAL(ICOMP)
  550.           VELCHE(KGAU,J) = XSTRS(ICOMP)
  551.  7000   CONTINUE
  552. C     if(KGAU.eq.1) then
  553. C      write(*,*) J,KGAU,'EPSI(..)=',(XSTRS(iou),iou=1,LHOOK)
  554. C     endif
  555.  
  556.  2500 CONTINUE
  557. C FIN DE BOUCLE SUR LES POINTS DE GAUSS <<<<<<<<<<<<<<
  558.  
  559. c     quelques suppressions
  560. c     (ici element non-incompressible=> pas besoin de MTRACE (cf epsi2)
  561.       IF (IREPS2.EQ.1) THEN
  562.         SEGSUP MTRACE
  563.       ENDIF
  564.  
  565.  2000 CONTINUE
  566. C FIN DE BOUCLE SUR LES ELEMENTS <<<<<<<<<<<<<<<<<<<<<
  567.  
  568. C*********************************************************
  569. C       SUPPRESSION ET DESACTIVATION DE SEGMENTS
  570. C*********************************************************
  571. C
  572.       SEGSUP,WRK1,WRK2
  573.       SEGSUP,MRACC
  574.  
  575.       END
  576.  
  577.  
  578.  
  579.  

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