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

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