Télécharger la plaquette Cast3M


fr en

Télécharger hhoeps.eso

Retour à la liste

Numérotation des lignes : 

hhoeps

  1. C HHOEPS    SOURCE    OF166741  25/02/21    21:17:24     12166          
  2.  
  3. C-----------------------------------------------------------------------*
  4. C Elements massifs HHO en FORMULATION 'MECANIQUE'
  5. C HHO        calcul des deformations (HHP), du gradient
  6. C-----------------------------------------------------------------------*
  7.  
  8.       SUBROUTINE HHOEPS(chaopt, imoHHO, ichDEP,nmoDEP,
  9.      &                  IIPDPG,UZDPG,RYDPG,RXDPG,
  10.      &                  IVACAR, NCARR, IPMINT, NBPTEL,
  11.      &                  IVAEPS,NCEPS, 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. -INC SMCOORD
  25. -INC SMELEME
  26. -INC SMMODEL
  27. -INC SMINTE
  28. -INC SMLENTI
  29.       POINTEUR mlent4.mlenti
  30. -INC SMLMOTS
  31. -INC SMLREEL
  32.       POINTEUR mlrdef.mlreel, mlrdec.mlreel, mlrmbh.mlreel
  33.  
  34. -INC TMPTVAL
  35.  
  36.       SEGMENT MWKHHO
  37.         INTEGER TABINT(NBINT)
  38.         REAL*8  TABFLO(NBFLO)
  39.       ENDSEGMENT
  40.  
  41.       CHARACTER*(*) chaopt
  42.  
  43.       DIMENSION UDPGE(3)
  44.  
  45.       iret = 0
  46.  
  47. C- OPTION DE CALCUL : GRADIENT DU DEPLACEMENT OU TENSEUR DES DEFORMATIONS
  48.       IF      (chaopt(1:4).EQ.'EPSI') THEN
  49.         NCHOPT = 1
  50.         IF (NCEPS.GT.9) THEN
  51.           write(ioimp,*) 'HHOEPS: NCEPS incorrect (> 9)'
  52.           iret = 5
  53.           RETURN
  54.         END IF
  55.       ELSE IF (chaopt(1:4).EQ.'GRAD') THEN
  56.         NCHOPT = 2
  57.         IF (NCEPS.NE.9) THEN
  58.           write(ioimp,*) 'HHOGRA: NCGRA incorrect (/= 9)'
  59.           iret = 5
  60.           RETURN
  61.         END IF
  62.       ELSE
  63.         NCHOPT = 0
  64.         write(ioimp,*) 'HHOEPS '//chaopt(1:4)//' unknown option'
  65.         iret = 5
  66.         RETURN
  67.       END IF
  68.  
  69.       imodel = imoHHO
  70. c*      segact,imodel <- actif en entree/sortie
  71.  
  72. C- Premieres verifications :
  73.       CALL HHONOB(imoHHO, nobHHO, iret)
  74.       IF (nobHHO.LE.0)THEN
  75.         write(ioimp,*) 'HHOEPS: IMODEL incorrect (not HHO)'
  76.         iret = 5
  77.         RETURN
  78.       END IF
  79.  
  80. C- Introduction du point autour duquel se fait le mouvement
  81. C  de la section en defo plane generalisee
  82. C  IIPDPG = numero du noeud/point support si defini pour le modele
  83. C  NDPGE > 0 si prise en compte du point support
  84.       IF (IIPDPG.GT.0) THEN
  85.         write(ioimp,*) 'HHOEPS: GENE mode not implemented!'
  86.         iret = 5
  87.         return
  88.         IF (IFOUR.EQ.-3) THEN
  89.           NDPGE = 3
  90.           UDPGE(1) = UZDPG
  91.           UDPGE(2) = RYDPG
  92.           UDPGE(3) = RXDPG
  93. C          SEGACT,MCOORD
  94.           IREF = (IIPDPG-1)*(IDIM+1)
  95.           XDPGE = XCOOR(IREF+1)
  96.           YDPGE = XCOOR(IREF+2)
  97.         ELSE IF (IFOUR.EQ.11) THEN
  98.           NDPGE = 2
  99.           UDPGE(1) = UZDPG
  100.           UDPGE(2) = RXDPG
  101.           UDPGE(3) = XZero
  102.           XDPGE = XZero
  103.           YDPGE = XZero
  104.         ELSE IF (IFOUR.EQ. 7 .OR. IFOUR.EQ. 8 .OR. IFOUR.EQ. 9 .OR.
  105.      &           IFOUR.EQ.10 .OR. IFOUR.EQ.14) THEN
  106.           NDPGE = 1
  107.           UDPGE(1) = UZDPG
  108.           UDPGE(2) = XZero
  109.           UDPGE(3) = XZero
  110.           XDPGE = XZero
  111.           YDPGE = XZero
  112.         else
  113.           write(ioimp,*) 'HHOEPS: ERREUR NDPGE'
  114.           iret = 5
  115.           return
  116.         ENDIF
  117.       ELSE
  118.         NDPGE = 0
  119.         UDPGE(1) = XZero
  120.         UDPGE(2) = XZero
  121.         UDPGE(3) = XZero
  122.         XDPGE = XZero
  123.         YDPGE = XZero
  124.       END IF
  125.  
  126. C- Recuperation des donnees de infell en entree
  127. c*      MELE   = imodel.NEFMOD
  128. c*      MFR    = imodel.infele(13)
  129.       meleme = imodel.IMAMOD
  130.       NBNOE  = meleme.NUM(/1)
  131.       NBELT  = meleme.NUM(/2)
  132.  
  133.       mlenti = imodel.IVAMOD(nobHHO+1)
  134. c*      segact,mlenti
  135.       mlent3 = imodel.IVAMOD(nobHHO+3)
  136. c*      segact,mlent3
  137.       mlent4 = imodel.IVAMOD(nobHHO+4)
  138. c*      segact,mlent4
  139.  
  140.       n_d_face = mlenti.lect(3)
  141.       n_d_cell = mlenti.lect(5)
  142.       nb_faces = mlenti.lect(7)
  143.       NBPGAU   = mlenti.lect(8)
  144.       idifo    = mlenti.lect(9)
  145.       NBDDL    = mlenti.lect(11)
  146.       NDEPF    = idifo * n_d_face
  147.       NDEPC    = idifo * n_d_cell
  148.       lhook    = 9
  149.  
  150.       nbel3 = mlent3.lect(/1) / 2
  151.       nbfa3 = 2 * nb_faces
  152.       nbel4 = mlent4.lect(/1) / 2
  153.  
  154.       IF (mlenti.lect(6).NE.NBNOE) THEN
  155.         write(ioimp,*) 'HHOEPS: Bizarre nb_vertices'
  156.       END IF
  157.       IF (NBDDL .NE. imodel.INFELE(9)) then
  158.         write(ioimp,*) 'HHOEPS: Bizarre NBDDL'
  159.       END IF
  160. c NBPGAU =? (NBPTEL = imodel.INFELE(4))
  161.       IF (NBPGAU .NE. imodel.INFELE(4)) then
  162.         write(ioimp,*) 'HHOEPS: Bizarre nb.p.gau(1)'
  163.       END IF
  164. c NBPGAU =? minte.POIGAU(/1)
  165.       minte = IPMINT
  166. c*      SEGACT minte <- actif en E/S
  167.       if (NBPGAU .NE. minte.POIGAU(/1)) then
  168.         write(ioimp,*) 'HHOEPS: Bizarre nb.p.gau (2)'
  169.       end if
  170. c-dbg      write(ioimp,*) 'HHOEPS nbpgau=',NBPGAU
  171. c-dbg      write(ioimp,*) 'HHOEPS: dof face/cell',n_d_face,n_d_cell,nb_faces
  172.       if (nbel3.NE.(NBELT*nb_faces)) then
  173.         write(ioimp,*) 'HHOEPS: Bizarre nbel3'
  174.       end if
  175.       if (nbel4.NE.NBELT) then
  176.         write(ioimp,*) 'HHOEPS: Bizarre nbel4'
  177.       end if
  178.  
  179.       ivid = 1
  180. C- Deplacements des faces et des cellules :
  181.       nomid = nmoDEP
  182. c*      segact,nomid
  183.       JGN = nomid.lesobl(/1)
  184. c-dbg      write(ioimp,*) 'HHOEPS=',NDEPC,NDEPF,lesobl(/2),lesfac(/2)
  185.       nfac = 0
  186. C Deplacements des cellules - Points supports des cellules
  187.       JGM = NDEPC + nfac
  188.       SEGINI,mlmots
  189.       DO i = 1, NDEPC
  190.         mlmots.MOTS(i)(1:JGN) = nomid.lesobl(i)(1:JGN)
  191.       END DO
  192. c*      DO i = 1, nfac
  193. c*        mlmots.MOTS(NDEP+i)(1:JGN) = nomid.lesfac(i)(1:JGN)
  194. c*      END DO
  195.       CALL EXTR23(ichDEP,mlmots,MPCHHO,mlrDEC,ivid)
  196.       SEGACT,mlrDEC
  197. c*      IF (IERR.NE.0) THEN
  198. c*        iret = 21
  199. c*        return
  200. c*      END IF
  201. c-dbg      write(ioimp,*) 'mlmots DEPC ',(mots(i),i=1,mots(/2))
  202. c-dbg      write(ioimp,*) 'U.CELL',mlrdec.prog(/1),NCEHHO,NDEPC
  203. c-dbg      write(ioimp,*) '      ',(mlrdec.prog(i),i=1,mlrdec.prog(/1))
  204. c-dbg      write(ioimp,*)
  205.  
  206. C Deplacements des faces - Points supports des faces
  207.       JGM = NDEPF + nfac
  208.       SEGADJ,mlmots
  209.       DO i = 1, NDEPF
  210.         mlmots.MOTS(i)(1:JGN) = nomid.lesobl(NDEPC+i)(1:JGN)
  211.       END DO
  212. c*      DO i = 1, nfac
  213. c*        mlmots.MOTS(NDEP+i)(1:JGN) = nomid.lesfac(i)(1:JGN)
  214. c*      END DO
  215.       CALL EXTR23(ichDEP,mlmots,MPFHHO,mlrDEF,ivid)
  216.       SEGACT,mlrDEF
  217. c*      IF (IERR.NE.0) THEN
  218. c*        iret = 21
  219. c*        return
  220. c*      END IF
  221. c-dbg      write(ioimp,*) 'mlmots DEPF ',(mots(i),i=1,mots(/2))
  222. c-dbg      write(ioimp,*) 'U.FACE',mlrdef.prog(/1),NFAHHO,NDEPF
  223. c-dbg      write(ioimp,*) '      ',(mlrdef.prog(i),i=1,mlrdef.prog(/1))
  224. c-dbg      write(ioimp,*)
  225.  
  226. C- Verification des caracteristiques :
  227.       mptval = IVACAR
  228.       IVMBHO = mptval.IVAL(NCARR)
  229.       melval = IVMBHO
  230.       IGMB = melval.IELCHE(/1)
  231.       IEMB = melval.IELCHE(/2)
  232. c-dbg      write(ioimp,*) 'IVMBHO',melval,igmb,iemb,tyval(nvmat)
  233.       mlrmbh = melval.IELCHE(1,1)
  234. c*      segact,mlrmbh
  235. c*      write(ioimp,*) 'HHOEPS MBHHO SIZE:',mlrmbh.prog(/1),
  236. c*     &               NBDDL,9*NBDDL,mlenti.lect(14)
  237.       IF ((mlrmbh.prog(/1).NE.(9*NBDDL)) .OR. 
  238.      &    (mlrmbh.prog(/1).NE.mlenti.lect(14))) THEN
  239.         write(ioimp,*) 'HHOEPS: BHHO matrix size incorrect'
  240.         iret = 21
  241.         RETURN
  242.       END IF
  243.  
  244. C- Indices et tableau de travail
  245.       ir_coo =          0
  246. c* si besoin des coordonnees      ir_eps = ir_coo + (IDIM*NBNOE)
  247.       ir_eps = ir_coo + 0
  248.       ir_uce = ir_eps + lhook
  249.       ir_ufa = ir_uce + NDEPC
  250.       ir_uge = ir_ufa + (NDEPF*nb_faces)
  251.       ir_fin = ir_uge + NDPGE
  252.  
  253.       NBINT = 1
  254.       NBFLO = ir_fin
  255.       SEGINI,MWKHHO
  256.  
  257.       IF (NDPGE.GT.0) THEN
  258.         DO ic = 1, NDPGE
  259.           TABFLO(ir_uge+ic) = UDPGE(ic)
  260.         END DO
  261.       END IF
  262. c* si besoin des coordonnees        SEGACT,MCOORD*NOMOD
  263.  
  264. C-------------------------
  265. C Boucle sur les elements
  266. C-------------------------
  267.       DO IEL = 1, NBELT
  268.  
  269. C- Recuperation des coordonnees des noeuds de l element IEL
  270. c*        CALL HHOCOO(meleme.num,NBNOE, mcoord.xcoor, IEL,
  271. c*    &               TABFLO(ir_coo+1), iret)
  272. c*        IF (iret.NE.0) RETURN
  273.  
  274. C- Valeurs des inconnues primales pour l'element IEL (cell+faces)
  275.         in1 = IEL * 2
  276.         je = mlent4.lect(in1-1)
  277.         ip = mlent4.lect(in1)
  278.       if (ip.le.0) write(ioimp,*) 'HHOEPS ICEL Bizarre...',iel,je,ip
  279.         jp = ip + NBCHHO(je-1)
  280.  
  281.         DO ic = 1, NDEPC
  282.           jc = NCEHHO * (ic - 1)
  283.           TABFLO(ir_uce + ic) = mlrDEC.prog(jp + jc)
  284.         END DO
  285. c-dbg      write(ioimp,*) 'HHOEPS ICEL',iel,je,ip,jp,ir_uce
  286. c-dbg      write(ioimp,*) (TABFLO(ir_uce+ic),ic=1,ndepc)
  287.  
  288.         in1 = (IEL-1) * nbfa3
  289.         ir_kc = ir_ufa
  290.         DO j1 = 1, nb_faces
  291.           in2 = in1 + (2 * j1)
  292.           je = mlent3.lect(in2-1)
  293.           ip = ABS(mlent3.lect(in2))
  294.       if (ip.eq.0) write(ioimp,*) 'HHOEPS IFAE Bizarre...',iel,j1,je,ip
  295.           jp = ip + NBFHHO(je-1)
  296.           DO ic = 1, NDEPF
  297.             jc = NFAHHO * (ic - 1)
  298.             TABFLO(ir_kc + ic) = mlrDEF.prog(jp + jc)
  299.           END DO
  300. c-dbg      write(ioimp,*) 'HHOEPS IFAE',iel,j1,je,ip,jp,ir_kc
  301. c-dbg      write(ioimp,*) (TABFLO(ir_kc+ic),ic=1,ndepf)
  302.           ir_kc = ir_kc + NDEPF
  303.         END DO
  304.  
  305. c-dbg      write(ioimp,*) 'HHOEPS ...',ir_uce,ir_kc,NBDDL
  306.  
  307.         JEMB = MIN(IEL,IEMB)
  308. C--  --  --  --  --  --  --  --  --
  309. C - Boucle sur les points de Gauss
  310. C--  --  --  --  --  --  --  --  --
  311.         DO IGAU = 1, NBPGAU
  312.  
  313.           melval = IVMBHO
  314.           JGMB = MIN(IGAU,IGMB)
  315.           mlrmbh = melval.IELCHE(JGMB,JEMB)
  316. c*          segact,mlrmbh
  317. c* !! matrice BHHO stockee colonne par colonne : lhook*NBDDL
  318.           DO ic = 1, lhook
  319.             r_z = XZero
  320.             DO jc = 1, NBDDL
  321.               jnc = lhook * (jc-1)
  322.               r_z = r_z + mlrmbh.prog(ic + jnc) * TABFLO(ir_uce + jc)
  323.             END DO
  324.             TABFLO(ir_eps + ic) = r_z
  325.           END DO
  326.  
  327.           mptval = IVAEPS
  328. C -- Remplissage du segment contenant les "deformations"
  329.           IF (NCHOPT.EQ.1) THEN
  330. C -- Deformations "Diagonales" EP (11,22,33)
  331.             melval = mptval.IVAL(1)
  332.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 1)
  333.             melval = mptval.IVAL(2)
  334.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 2)
  335.             melval = mptval.IVAL(3)
  336.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 3)
  337. C -- Glissements "hors diagonale" GA (12,13,23)
  338.             melval = mptval.IVAL(4)
  339.             melval.velche(IGAU,IEL) =  TABFLO(ir_eps + 4)
  340.      &                               + TABFLO(ir_eps + 5)
  341.             IF (NCEPS.GT.4) THEN
  342.               melval = mptval.IVAL(5)
  343.               melval.velche(IGAU,IEL) =  TABFLO(ir_eps + 6)
  344.      &                                 + TABFLO(ir_eps + 7)
  345.               melval = mptval.IVAL(6)
  346.               melval.velche(IGAU,IEL) =  TABFLO(ir_eps + 8)
  347.      &                                 + TABFLO(ir_eps + 9)
  348.             END IF
  349. C -- Remplissage du segment contenant le "gradient du deplacement"
  350.           ELSE IF (NCHOPT.EQ.2) THEN
  351.             melval = mptval.IVAL(1)
  352.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 1)
  353.             melval = mptval.IVAL(2)
  354.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 4)
  355.             melval = mptval.IVAL(3)
  356.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 6)
  357.             melval = mptval.IVAL(4)
  358.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 5)
  359.             melval = mptval.IVAL(5)
  360.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 2)
  361.             melval = mptval.IVAL(6)
  362.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 8)
  363.             melval = mptval.IVAL(7)
  364.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 7)
  365.             melval = mptval.IVAL(8)
  366.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 9)
  367.             melval = mptval.IVAL(9)
  368.             melval.velche(IGAU,IEL) = TABFLO(ir_eps + 3)
  369.           END IF
  370. C--  --  --  --  --  --  --  --  --
  371.         END DO
  372. C--  --  --  --  --  --  --  --  --
  373.  
  374. C-------------------------
  375.       END DO
  376. C-------------------------
  377.       SEGSUP,MWKHHO
  378.       SEGSUP,mlrdec,mlrdef
  379.       SEGSUP,mlmots
  380.  
  381. c*      RETURN
  382.       END
  383.  
  384.  
  385.  

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