Télécharger la plaquette Cast3M


fr en

Télécharger hhobsg.eso

Retour à la liste

Numérotation des lignes : 

hhobsg

  1. C HHOBSG    SOURCE    CB215821  25/04/23    21:15:22     12247          
  2.  
  3. C----------------------------------------------------------------------*
  4. C Elements massifs HHO en FORMULATION 'MECANIQUE'
  5. C HHO    calcul des efforts internes (B.Sigma)
  6. C----------------------------------------------------------------------*
  7.  
  8.       SUBROUTINE HHOBSG(imoHHO, nmoFOR, IVASTR, NCSTR,
  9.      &                  IIPDPG, ADPG,BDPG,CDPG,
  10.      &                  IVACAR, NCARR, IPMINT, NBPTEL,
  11.      &                  ichDEP, ICHBSG, iret)
  12.  
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC CCREEL
  19.  
  20. -INC CCHHOPA
  21. -INC CCHHOPR
  22.  
  23. -INC SMCHAML
  24. c* si besoin des coordonnees -INC SMCOORD
  25. -INC SMCHPOI
  26. -INC SMCOORD
  27. -INC SMELEME
  28. -INC SMMODEL
  29. -INC SMINTE
  30. -INC SMLENTI
  31.       POINTEUR mlent4.mlenti, mlenPF.mlenti
  32. -INC SMLMOTS
  33. -INC SMLREEL
  34.       POINTEUR mlrdef.mlreel, mlrdec.mlreel, mlrmbh.mlreel
  35.  
  36. -INC TMPTVAL
  37.  
  38.       SEGMENT MWKHHO
  39.         INTEGER TABINT(NBINT)
  40.         REAL*8  TABFLO(NBFLO)
  41.       ENDSEGMENT
  42.  
  43.       LOGICAL B_GDEF, b_z
  44.       CHARACTER*(LOCHAI) chaHHO
  45.  
  46.       EXTERNAL LONG
  47.  
  48.       iret = 0
  49.  
  50.       NDPGE = 0
  51.       ADPG = XZero
  52.       BDPG = XZero
  53.       CDPG = XZero
  54.  
  55.       imodel = imoHHO
  56. c*      segact,imodel <- actif en entree/sortie
  57.  
  58. C- Premieres verifications :
  59.       CALL HHONOB(imoHHO, nobHHO, iret)
  60.       IF (nobHHO.LE.0)THEN
  61.         write(ioimp,*) 'HHOEPS: IMODEL incorrect (not HHO)'
  62.         iret = 5
  63.         RETURN
  64.       END IF
  65.  
  66. C- Recuperation des donnees de infell en entree
  67. c*      MELE   = imodel.NEFMOD
  68. c*      MFR    = imodel.infele(13)
  69.       meleme = imodel.IMAMOD
  70.       NBNOE  = meleme.NUM(/1)
  71.       NBELT  = meleme.NUM(/2)
  72.  
  73.       iva = imodel.IVAMOD(nobHHO)
  74.       CALL QUEVAL(iva,'MOT     ',iret,lenHHO,r_z,chaHHO,b_z,i_z)
  75.       B_GDEF = chaHHO(8:10).EQ.'_ft'
  76. *AV      B_GDEF = chaHHO(10:12).EQ.'_ft'
  77. c-dbg      write(ioimp,*) 'HHOBSG : je suis ici '//chaHHO(1:lenHHO),B_GDEF
  78.  
  79.       mlenti = imodel.IVAMOD(nobHHO+1)
  80. c*      segact,mlenti
  81.       mlent2 = imodel.IVAMOD(nobHHO+2)
  82. c*      segact,mlent2
  83.       mlent3 = imodel.IVAMOD(nobHHO+3)
  84. c*      segact,mlent3
  85.       mlent4 = imodel.IVAMOD(nobHHO+4)
  86. c*      segact,mlent4
  87.  
  88.       n_d_face = mlenti.lect(3)
  89.       n_d_cell = mlenti.lect(5)
  90.       nb_faces = mlenti.lect(7)
  91.       NBPGAU   = mlenti.lect(8)
  92.       idifo    = mlenti.lect(9)
  93.       NBDDL    = mlenti.lect(11)
  94.       NFORF    = idifo * n_d_face
  95.       NFORC    = idifo * n_d_cell
  96.       lhook    = 9
  97.  
  98.       nbel2 = mlent2.lect(/1) / 2
  99.       nbel3 = mlent3.lect(/1) / 2
  100.       nbfa3 = 2 * nb_faces
  101.       nbel4 = mlent4.lect(/1) / 2
  102.  
  103.       IF (mlenti.lect(6).NE.NBNOE) THEN
  104.         write(ioimp,*) 'HHOBSG: Bizarre nb_vertices'
  105.       END IF
  106.       IF (NBDDL .NE. imodel.INFELE(9)) then
  107.         write(ioimp,*) 'HHOBSG: Bizarre NBDDL'
  108.       END IF
  109. c NBPGAU =? (NBPTEL = imodel.INFELE(4))
  110.       IF (NBPGAU .NE. imodel.INFELE(4)) then
  111.         write(ioimp,*) 'HHOBSG: Bizarre nb.p.gau(1)'
  112.       END IF
  113. c NBPGAU =? minte.POIGAU(/1)
  114.       minte = IPMINT
  115. c*      SEGACT minte <- actif en E/S
  116.       if (NBPGAU .NE. minte.POIGAU(/1)) then
  117.         write(ioimp,*) 'HHOBSG: Bizarre nb.p.gau (2)'
  118.       end if
  119. c-dbg      write(ioimp,*) 'HHOBSG nbpgau=',NBPGAU
  120. c-dbg      write(ioimp,*) 'HHOBSG: dof face/cell',n_d_face,n_d_cell,nb_faces
  121.       if (nbel3.NE.(NBELT*nb_faces)) then
  122.         write(ioimp,*) 'HHOBSG: Bizarre nbel3'
  123.       end if
  124.       if (nbel4.NE.NBELT) then
  125.         write(ioimp,*) 'HHOBSG: Bizarre nbel4'
  126.       end if
  127.  
  128. C- Verification des caracteristiques :
  129.       mptval = IVACAR
  130.       IVPIHO = mptval.IVAL(NCARR-1)
  131.       melval = IVPIHO
  132.       IGPI = melval.VELCHE(/1)
  133.       IEPI = melval.VELCHE(/2)
  134. c-dbg      write(ioimp,*) 'IVPIHO',melval,igpi,iepi,tyval(ncarr-1)
  135.       IF (IGPI.NE.NBPGAU .AND. IGPI.NE.1) THEN
  136.         write(ioimp,*) 'HHOBSG: PIHO vector size incorrect'
  137.         iret = 21
  138.         RETURN
  139.       END IF
  140.       IVMBHO = mptval.IVAL(NCARR)
  141.       melval = IVMBHO
  142.       IGMB = melval.IELCHE(/1)
  143.       IEMB = melval.IELCHE(/2)
  144. c-dbg      write(ioimp,*) 'IVMBHO',melval,igmb,iemb,tyval(ncarr)
  145.       mlrmbh = melval.IELCHE(1,1)
  146. c*      segact,mlrmbh
  147. c*      write(ioimp,*) 'HHOBSG MBHHO SIZE:',mlrmbh.prog(/1),
  148. c*     &               NBDDL,9*NBDDL,mlenti.lect(14)
  149.       IF ((mlrmbh.prog(/1).NE.(9*NBDDL)) .OR. 
  150.      &    (mlrmbh.prog(/1).NE.mlenti.lect(14))) THEN
  151.         write(ioimp,*) 'HHOBSG: BHHO matrix size incorrect'
  152.         iret = 21
  153.         RETURN
  154.       END IF
  155.  
  156. C- Forces des faces et des cellules :
  157.       nomid = nmoFOR
  158. c      segact,nomid
  159. c-dbg      write(ioimp,*) 'HHOBSG=',NFORC,NFORF,lesobl(/2),lesfac(/2)
  160.       nfac = 0
  161.       JGN = nomid.lesobl(/1)
  162.  
  163. C- Le chapeau du champ point de forces interieures
  164.       NAT = 2
  165.       NSOUPO = 2
  166.       SEGINI,MCHPOI
  167.       mchpoi.MTYPOI = 'FORCES  '
  168.       mchpoi.MOCHDE = '  '
  169.       mchpoi.JATTRI(1) = 2
  170.       mchpoi.JATTRI(2) = 0
  171.       mchpoi.IFOPOI = IFOUR
  172.       ICHBSG = MCHPOI
  173.  
  174. C- 2 sous-zones : les points supports des cellules et des faces
  175.       NC = NFORC
  176.       N = nbel4
  177.       SEGINI,MSOUP1
  178.       SEGINI,MPOVA1
  179.       DO i = 1, NC
  180.         msoup1.NOCOMP(i) = '        '
  181.         msoup1.NOCOMP(i)(1:JGN) = nomid.lesobl(i)(1:JGN)
  182.         msoup1.NOHARM(i) = 0
  183.       END DO
  184.       msoup1.IPOVAL = MPOVA1
  185.       CALL HHOMPO('CELL',mlent4,IPT1)
  186.       msoup1.IGEOC  = IPT1
  187.       mchpoi.IPCHP(1) = MSOUP1
  188.  
  189.       NC = NFORF
  190.       N = nbel2
  191.       SEGINI,MSOUP2
  192.       SEGINI,MPOVA2
  193.       DO i = 1, NC
  194.         msoup2.NOCOMP(i) = '        '
  195.         msoup2.NOCOMP(i)(1:JGN) = nomid.lesobl(NFORC+i)(1:JGN)
  196.         msoup2.NOHARM(i) = 0
  197.       END DO
  198.       msoup2.IPOVAL = MPOVA2
  199.       CALL HHOMPO('FACE',mlent2,IPT2)
  200.       msoup2.IGEOC  = IPT2
  201.       mchpoi.IPCHP(2) = MSOUP2
  202.  
  203. C- La liste mlenPF devrait etre initialisee une seule fois et remplie
  204.       CALL HHOMPO('LGFA',mlent2,mlenPF)
  205.       IPT4 = MPFHHO
  206. c      segact,ipt4
  207.  
  208. C- Le modele est en grandes deformations : Il donc transporter le 
  209. C- tenseur des contraintes (de Cauchy SIGC) sur la geometrie initiale 
  210. C- (tenseur de Piola-Kirchhoff 1 = PK1) PK1 = SIGC.[det(F).inv(transF)] 
  211.       IF ( B_GDEF ) THEN
  212.         NDEPC = NFORC
  213.         NDEPF = NFORF
  214.         nomid = imodel.LNOMID(1)
  215.         if (nomid.eq.0) then
  216.           write(ioimp,*) 'HHOBSG - IMODEL - MODEPL incorrect'
  217.           iret = 5
  218.           return
  219.         end if
  220. c*        segact,nomid
  221.         JGN = nomid.lesobl(/1)
  222.         ivid = 1
  223. C- Deplacements des faces et des cellules :
  224. c-dbg      write(ioimp,*) 'HHOBSG=',NDEPC,NDEPF,lesobl(/2),lesfac(/2)
  225.         nfac = 0
  226. C Deplacements des cellules - Points supports des cellules
  227.         JGM = NDEPC + nfac
  228.         SEGINI,mlmots
  229.         DO i = 1, NDEPC
  230.           mlmots.MOTS(i)(1:JGN) = nomid.lesobl(i)(1:JGN)
  231.         END DO
  232.         CALL EXTR23(ichDEP,mlmots,MPCHHO,mlrDEC,ivid)
  233.         SEGACT,mlrDEC
  234. C Deplacements des faces - Points supports des faces
  235.         JGM = NDEPF + nfac
  236.         SEGADJ,mlmots
  237.         DO i = 1, NDEPF
  238.           mlmots.MOTS(i)(1:JGN) = nomid.lesobl(NDEPC+i)(1:JGN)
  239.         END DO
  240.         CALL EXTR23(ichDEP,mlmots,MPFHHO,mlrDEF,ivid)
  241.         SEGACT,mlrDEF
  242.       END IF
  243.  
  244. C- Indices et tableau de travail
  245.       ir_coo =          0
  246. c* si besoin des coordonnees      ir_sig = ir_coo + (IDIM*NBNOE)
  247.       ir_sig = ir_coo + 0
  248. c* si besoin des contraintes      ir_fce = ir_sig + lhook
  249.       ir_fce = ir_sig + 0
  250.       ir_ffa = ir_fce + NFORC
  251.       ir_fge = ir_ffa + (NFORF*nb_faces)
  252.       ir_fin = ir_fge + NDPGE
  253.       IF (B_GDEF) THEN
  254.         ir_gra = ir_fin
  255. c* si besoin des gradients        ir_uce = ir_gra + lhook
  256.         ir_uce = ir_gra + 0
  257.         ir_ufa = ir_uce + NDEPC
  258.         ir_uge = ir_ufa + (NDEPF*nb_faces)
  259.         ir_fin = ir_uge + NDPGE
  260.       END IF
  261.  
  262.       NBINT = nb_faces
  263.       NBFLO = ir_fin
  264.       SEGINI,MWKHHO
  265.  
  266. C Pour l'instant NDPGE = 0, a recuperer dans ichDEP ?
  267.       IF (NDPGE.GT.0) THEN
  268.         DO ic = 1, NDPGE
  269. ccc?          TABFLO(ir_fge+ic) = XZero
  270. ccc?          TABFLO(ir_uge+ic) = A recuperer dans ichDEP
  271.         END DO
  272.       END IF
  273. c* si besoin des coordonnees        SEGACT,mcoord*nomod
  274.  
  275. C-------------------------
  276. C Boucle sur les elements
  277. C-------------------------
  278.       DO IEL = 1, NBELT
  279.  
  280. C- Recuperation des coordonnees des noeuds de l element IEL
  281. c*        CALL HHOCOO(meleme.num,NBNOE, mcoord.xcoor, IEL,
  282. c*    &               TABFLO(ir_coo+1), iret)
  283. c*        IF (iret.NE.0) RETURN
  284.  
  285. C- Reperage des faces :
  286.         in1 = (IEL-1) * nbfa3
  287.         DO j1 = 1, nb_faces
  288.           in2 = in1 + (2 * j1)
  289.           je = mlent3.lect(in2-1)
  290.           ip = ABS(mlent3.lect(in2))
  291. c-dbg      if (ip.eq.0) write(ioimp,*) 'HHOEPS IFAE Bizarre...',iel,j1,je,ip
  292.           TABINT(j1) = ip + NBFHHO(je-1)
  293.         END DO
  294. C- Remise a zero des forces
  295.         DO jc = ir_fce+1, ir_fge
  296.           TABFLO(jc) = XZero
  297.         END DO
  298. C- Valeurs des inconnues primales pour l'element IEL (cell+faces)
  299.         IF (B_GDEF) THEN
  300.           in1 = IEL * 2
  301.           je = mlent4.lect(in1-1)
  302.           ip = mlent4.lect(in1)
  303. c-dbg      if (ip.le.0) write(ioimp,*) 'HHOBSG ICEL Bizarre...',iel,je,ip
  304.           jp = ip + NBCHHO(je-1)
  305. c-dbg      write(ioimp,*) 'HHOBSG ICEL :',iel,je,ip,jp
  306. c-dbg      write(ioimp,*) 'HHOBSG      :',NDEPC,NCEHHO,ir_uce
  307. c-dbg      write(ioimp,*) 'HHOBSG      :',NDEPF,NFAHHO,ir_ufa
  308.           DO ic = 1, NDEPC
  309.             jc = NCEHHO * (ic - 1)
  310. c-dbg      write(ioimp,*) 'HHOBSG    ic:',ic,jc,jp,mlrDEC.prog(/1),
  311. c-dbg     &             TABFLO(/1),ir_uce+ic,jp+jc
  312.             TABFLO(ir_uce + ic) = mlrDEC.prog(jp + jc)
  313.           END DO
  314.           ir_kc = ir_ufa
  315.           DO j1 = 1, nb_faces
  316.             jp = TABINT(j1)
  317.             DO ic = 1, NDEPF
  318.               jc = NFAHHO * (ic - 1)
  319.               TABFLO(ir_kc + ic) = mlrDEF.prog(jp + jc)
  320.             END DO
  321.             ir_kc = ir_kc + NDEPF
  322.           END DO
  323.         END IF
  324.  
  325.         JEPI = MIN(IEL,IEPI)
  326.         JEMB = MIN(IEL,IEMB)
  327. C--  --  --  --  --  --  --  --  --
  328. C - Boucle sur les points de Gauss
  329. C--  --  --  --  --  --  --  --  --
  330.         DO IGAU = 1, NBPGAU
  331.  
  332.           melval = IVPIHO
  333.           JGPI = MIN(IGAU,IGPI)
  334.           pgau = melval.VELCHE(JGPI,JEPI)
  335.  
  336.           melval = IVMBHO
  337.           JGMB = MIN(IGAU,IGMB)
  338.           mlrmbh = melval.IELCHE(JGMB,JEMB)
  339. c*          segact,mlrmbh
  340. c* !! matrice BHHO stockee colonne par colonne : lhook*NBDDL
  341.  
  342. C -- Recuperation des "contraintes" de Cauchy
  343.           mptval = IVASTR
  344. C -- Contraintes "Diagonales" SIG(11,22,33)
  345.           melval = mptval.IVAL(1)
  346.           IEMN = MIN(IEL ,melval.VELCHE(/1))
  347.           IGMN = MIN(IGAU,melval.VELCHE(/2))
  348.           SIGC11 = melval.velche(IGMN,IEMN)
  349.           melval = mptval.IVAL(2)
  350.           IEMN = MIN(IEL ,melval.VELCHE(/1))
  351.           IGMN = MIN(IGAU,melval.VELCHE(/2))
  352.           SIGC22 = melval.velche(IGMN,IEMN)
  353.           melval = mptval.IVAL(3)
  354.           IEMN = MIN(IEL ,melval.VELCHE(/1))
  355.           IGMN = MIN(IGAU,melval.VELCHE(/2))
  356.           SIGC33 = melval.velche(IGMN,IEMN)
  357. C -- Contraintes de cisaillement SIG(12,13,23)
  358.           melval = mptval.IVAL(4)
  359.           IEMN = MIN(IEL ,melval.VELCHE(/1))
  360.           IGMN = MIN(IGAU,melval.VELCHE(/2))
  361.           SIGC12 = melval.velche(IGMN,IEMN)
  362.           IF (NCSTR.GT.4) THEN
  363.             melval = mptval.IVAL(5)
  364.             IEMN = MIN(IEL ,melval.VELCHE(/1))
  365.             IGMN = MIN(IGAU,melval.VELCHE(/2))
  366.             SIGC13 = melval.velche(IGMN,IEMN)
  367.             melval = mptval.IVAL(6)
  368.             IEMN = MIN(IEL ,melval.VELCHE(/1))
  369.             IGMN = MIN(IGAU,melval.VELCHE(/2))
  370.             SIGC23 = melval.velche(IGMN,IEMN)
  371.           ELSE
  372.             SIGC13 = XZero
  373.             SIGC23 = XZero
  374.           END IF
  375.           SIGC21 = SIGC12
  376.           SIGC31 = SIGC13
  377.           SIGC32 = SIGC23
  378.  
  379. c* !! matrice BHHO stockee colonne par colonne : lhook*NBDDL
  380.           IF ( B_GDEF ) THEN
  381. C- Il faut calculer le tenseurs des contraintes de Piola-Kirchhoff 1
  382. C- F = gradient_transformation
  383.             F11 = 1.D0
  384.             F22 = 1.D0
  385.             F33 = 1.D0
  386.             F12 = XZero
  387.             F21 = XZero
  388.             F13 = XZero
  389.             F31 = XZero
  390.             F23 = XZero
  391.             F32 = XZero
  392.             DO jc = 1, NBDDL
  393.               jnc = lhook * (jc-1)
  394.               r_z = TABFLO(ir_uce + jc)
  395.               F11 = F11 + mlrmbh.prog(1 + jnc) * r_z
  396.               F22 = F22 + mlrmbh.prog(2 + jnc) * r_z
  397.               F33 = F33 + mlrmbh.prog(3 + jnc) * r_z
  398.               F12 = F12 + mlrmbh.prog(4 + jnc) * r_z
  399.               F21 = F21 + mlrmbh.prog(5 + jnc) * r_z
  400.               F13 = F13 + mlrmbh.prog(6 + jnc) * r_z
  401.               F31 = F31 + mlrmbh.prog(7 + jnc) * r_z
  402.               F23 = F23 + mlrmbh.prog(8 + jnc) * r_z
  403.               F32 = F32 + mlrmbh.prog(9 + jnc) * r_z
  404.             END DO
  405. c- DIFT = det(F).inv(trans(F))
  406.             DIFT11 = F22*F33 - F32*F23
  407.             DIFT12 = F31*F23 - F21*F33
  408.             DIFT13 = F21*F32 - F31*F22
  409.             DIFT21 = F32*F13 - F12*F33
  410.             DIFT22 = F11*F33 - F31*F13
  411.             DIFT23 = F31*F12 - F11*F32
  412.             DIFT31 = F12*F23 - F22*F13
  413.             DIFT32 = F21*F13 - F11*F23
  414.             DIFT33 = F11*F22 - F21*F12
  415. c- Contraintes de Piola-Kirchhoff 1 : PIKU = SIGC.DIFT
  416.             PIKU11 = SIGC11 * DIFT11 + SIGC12 * DIFT21 + SIGC13 * DIFT31
  417.             PIKU22 = SIGC21 * DIFT12 + SIGC22 * DIFT22 + SIGC23 * DIFT32
  418.             PIKU33 = SIGC31 * DIFT13 + SIGC32 * DIFT23 + SIGC33 * DIFT33
  419.             PIKU12 = SIGC11 * DIFT12 + SIGC12 * DIFT22 + SIGC13 * DIFT32
  420.             PIKU21 = SIGC21 * DIFT11 + SIGC22 * DIFT21 + SIGC23 * DIFT31
  421.             PIKU13 = SIGC11 * DIFT13 + SIGC12 * DIFT23 + SIGC13 * DIFT33
  422.             PIKU31 = SIGC31 * DIFT11 + SIGC32 * DIFT21 + SIGC33 * DIFT31
  423.             PIKU23 = SIGC21 * DIFT13 + SIGC22 * DIFT23 + SIGC23 * DIFT33
  424.             PIKU32 = SIGC31 * DIFT12 + SIGC32 * DIFT22 + SIGC33 * DIFT32
  425. c* !! matrice BHHO stockee colonne par colonne : lhook*NBDDL
  426.             DO jc = 1, NBDDL
  427.               jnc = lhook * (jc-1)
  428.               r_z =   mlrmbh.prog(1 + jnc) * PIKU11
  429.      &              + mlrmbh.prog(2 + jnc) * PIKU22
  430.      &              + mlrmbh.prog(3 + jnc) * PIKU33
  431.      &              + mlrmbh.prog(4 + jnc) * PIKU12
  432.      &              + mlrmbh.prog(5 + jnc) * PIKU21
  433.               IF (NCSTR.GT.4) THEN
  434.                 r_z = r_z + mlrmbh.prog(6 + jnc) * PIKU13
  435.      &                    + mlrmbh.prog(7 + jnc) * PIKU31
  436.      &                    + mlrmbh.prog(8 + jnc) * PIKU23
  437.      &                    + mlrmbh.prog(9 + jnc) * PIKU32
  438.               END IF
  439.               TABFLO(ir_fce + jc) = TABFLO(ir_fce + jc) + pgau * r_z
  440.             END DO
  441.           ELSE
  442.             DO jc = 1, NBDDL
  443.               jnc = lhook * (jc-1)
  444.               r_z =   mlrmbh.prog(1 + jnc) * SIGC11
  445.      &              + mlrmbh.prog(2 + jnc) * SIGC22
  446.      &              + mlrmbh.prog(3 + jnc) * SIGC33
  447.      &              + mlrmbh.prog(4 + jnc) * SIGC12
  448.      &              + mlrmbh.prog(5 + jnc) * SIGC21
  449.               IF (NCSTR.GT.4) THEN
  450.                 r_z = r_z + mlrmbh.prog(6 + jnc) * SIGC13
  451.      &                    + mlrmbh.prog(7 + jnc) * SIGC31
  452.      &                    + mlrmbh.prog(8 + jnc) * SIGC23
  453.      &                    + mlrmbh.prog(9 + jnc) * SIGC32
  454.               END IF
  455.               TABFLO(ir_fce + jc) = TABFLO(ir_fce + jc) + pgau * r_z
  456.             END DO
  457.           END IF
  458.  
  459. C--  --  --  --  --  --  --  --  --
  460.         END DO
  461. C--  --  --  --  --  --  --  --  --
  462.  
  463. C Pour les cellules
  464. c-dbg      write(ioimp,*) 'mpova1',iel,NBELT,nbel4,ir_fce
  465.         DO ic = 1, NFORC
  466.           mpova1.VPOCHA(IEL,ic) =   mpova1.VPOCHA(IEL,ic)
  467.      &                            + TABFLO(ir_fce + ic)
  468.         END DO
  469. C Pour les faces
  470.         ir_kc = ir_ffa
  471.         DO j1 = 1, nb_faces
  472.           jp = TABINT(j1)
  473.           kp = ipt4.num(1,jp)
  474.           IFA = mlenPF.lect(kp)
  475. c-dbg      write(ioimp,*) 'mpova2',iel,j1,nb_faces,kp,IFA,nbel2,ir_kc
  476.           DO ic = 1, NFORF
  477.             mpova2.VPOCHA(IFA,ic) =   mpova2.VPOCHA(IFA,ic)
  478.      &                              + TABFLO(ir_kc + ic)
  479.           END DO
  480.           ir_kc = ir_kc + NFORF
  481.         END DO
  482.  
  483. C-------------------------
  484.       END DO
  485. C-------------------------
  486.       SEGSUP,MWKHHO
  487.       SEGSUP,mlenPF
  488.       IF ( B_GDEF ) THEN
  489.         SEGSUP,mlrDEC,mlrDEF
  490.         SEGSUP,mlmots
  491.       END IF
  492.  
  493. c*      RETURN
  494.       END
  495.  
  496.  
  497.  
  498.  

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