Télécharger la plaquette Cast3M


fr en

Télécharger cneq1.eso

Retour à la liste

Numérotation des lignes : 

cneq1

  1. C CNEQ1     SOURCE    CB215821  24/04/12    21:15:18     11897          
  2.       SUBROUTINE CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT,
  3.      &                   IVACAR,IPORE,NCOMP,IVAFOR,IIPDPG)
  4. *----------------------------------------------------------------------
  5. *        _______________________________                              *
  6. *        |                              |                             *
  7. *        |  CALCUL DES FORCES AUX NOEUDS|                             *
  8. *        |______________________________|                             *
  9. *                                                                     *
  10. *                       massif                                        *
  11. *                                                                     *
  12. *---------------------------------------------------------------------*
  13. *                                                                     *
  14. *   ENTREES :                                                         *
  15. *   ________                                                          *
  16. *                                                                     *
  17. *        IPMAIL   Pointeur sur un segment  MELEME                     *
  18. *        LRE      Nombre de ddl dans la matrice de rigidite           *
  19. *        NDDL     Nombre de degré de liberté                          *
  20. *        NBPGAU   Nombre de points d'integration pour les contraintes *
  21. *        MELE     Numero de l'element fini                            *
  22. *        MFR      Numero de la formulation                            *
  23. *        IVAFVO   pointeur sur un segment MPTVAL contenant les        *
  24. *                 les melvals de FORCES VOLUMIQUES                    *
  25. *        IPMINT   Pointeur sur un segment MINTE                       *
  26. *        IVACAR   Pointeur sur un melval de caractéristiques          *
  27. *        IPORE    Nombre de fonctions de forme                        *                               *
  28. *        NCOMP    Nombre de composantes de forces                     *
  29. *                                                                     *
  30.  
  31. *   SORTIES :                                                         *
  32. *   ________                                                          *
  33. *                                                                     *
  34. *        IVAFOR   pointeur sur un segment MPTVAL contenant les        *
  35. *                 les melvals de forces NODALES                       *
  36. *                                                                     *
  37. *---------------------------------------------------------------------*
  38. *    F CAFFIN  INSPIRE DE BSIGM1
  39. *---------------------------------------------------------------------*
  40.       IMPLICIT INTEGER(I-N)
  41.       IMPLICIT REAL*8(A-H,O-Z)
  42. *
  43.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC CCHAMP
  47. -INC SMCHAML
  48. -INC SMCHPOI
  49. -INC SMELEME
  50. -INC SMCOORD
  51. -INC SMMODEL
  52. -INC SMINTE
  53. -INC CCGEOME
  54. -INC CCREEL
  55. -INC SMRIGID
  56. *
  57.       SEGMENT WRK1
  58.        REAL*8 XFORC(LRE),FOVOL(NDDL),XE(3,NBBB)
  59.       ENDSEGMENT
  60. *
  61.       SEGMENT WRK2
  62.        REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE)
  63.       ENDSEGMENT
  64. *
  65.       SEGMENT WRK5
  66.        REAL*8 XGENE(NSTN,LRN)
  67.       ENDSEGMENT
  68. *
  69.       SEGMENT MPTVAL
  70.         INTEGER IPOS(NS) , NSOF(NS)
  71.         INTEGER      IVAL(NCOSOU)
  72.         CHARACTER*16 TYVAL(NCOSOU)
  73.       ENDSEGMENT
  74. *
  75. *     INTRODUCTION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  76. *     DE LA SECTION EN DEFO PLANE GENERALISEE
  77. * Pas de rotation en modes 1D generalises
  78.       IF (IFOUR.EQ.-3)THEN
  79.         IP=IIPDPG
  80.         SEGACT MCOORD
  81.         IREF=(IP-1)*(IDIM+1)
  82.         XDPGE=XCOOR(IREF+1)
  83.         YDPGE=XCOOR(IREF+2)
  84.       ELSE
  85.         XDPGE=0.D0
  86.         YDPGE=0.D0
  87.       ENDIF
  88. *
  89.       MELEME=IPMAIL
  90.       NBNN=NUM(/1)
  91.       NBELEM=NUM(/2)
  92.       NHRM=NIFOUR
  93.       MINTE=IPMINT
  94.       IELE=NUMGEO(MELE)
  95. *
  96. C_______________________________________________________________________
  97. C
  98. C     NUMERO DES ETIQUETTES      :
  99. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  100. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  101. C     5  CONTINUE
  102. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  103. C     44 CONTINUE
  104. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  105. C_______________________________________________________________________
  106. C
  107.       GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  108.      1      99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  109.      2      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  110.      3      99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,79,79,
  111.      4      79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  112.      5      99,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  113.      6       4, 4),MELE
  114.       IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  115.       GOTO 99
  116. C_______________________________________________________________________
  117. C_______________________________________________________________________
  118. C
  119. C     SECTEUR DE CALCUL POUR LES ELEMENTS MASSIFS
  120. C_______________________________________________________________________
  121. C
  122.    4  CONTINUE
  123. C
  124.       DIM3=1.D0
  125.       NBNO=NBNN
  126.       NBBB=NBNN
  127.       NSTB=NDDL
  128.       SEGINI WRK1,WRK2
  129.       I195=0
  130.       I259=0
  131.       SEGACT, MCOORD
  132. *
  133. C
  134.       DO 3004  IB=1,NBELEM
  135. C
  136. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  137. C
  138.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  139. C
  140. C     MISE A 0 DES FORCES NODALES
  141. C
  142.       CALL ZERO(XFORC,1,LRE)
  143. C
  144. C     BOUCLE SUR LES POINTS DE GAUSS
  145. C
  146.       ISDJC=0
  147.       DO 5004  IGAU=1,NBPGAU
  148. C
  149. C   RECUPERATION DE L'EPAISSEUR
  150. C
  151.       IF (IFOUR.EQ.-2)THEN
  152.         MPTVAL=IVACAR
  153.         IF (IVACAR.NE.0) THEN
  154.          MELVAL=IVAL(1)
  155.          IF (MELVAL.NE.0) THEN
  156.           IGMN=MIN(IGAU,VELCHE(/1))
  157.           IBMN=MIN(IB,VELCHE(/2))
  158.           DIM3=VELCHE(IGMN,IBMN)
  159.          ELSE
  160.           DIM3=1.D0
  161.          ENDIF
  162.         ENDIF
  163.       ENDIF
  164. C
  165.       CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,DIM3,
  166.      1       XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  167. *
  168.       IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  169.       IF(DJAC.EQ.0.D0) I259=IB
  170.       DJAC=ABS(DJAC)*POIGAU(IGAU)
  171. C
  172. C     ON RECUPERE LES FORCES VOLUMIQUES
  173. C
  174.       MPTVAL=IVAFVO
  175.       ICOSOU=IVAL(/1)
  176.       DO 8004 I=1,ICOSOU
  177.          IF (IVAL(I).NE.0) THEN
  178.              MELVAL=IVAL(I)
  179.              IGMN=MIN(IGAU,VELCHE(/1))
  180.              IBMN=MIN(IB  ,VELCHE(/2))
  181.              FOVOL(I)=VELCHE(IGMN,IBMN)
  182.          ELSE
  183.              FOVOL(I)=0.D0
  184.          ENDIF
  185.  8004  CONTINUE
  186. *
  187. *     CALCUL DES FORCES NODALES EQUIVALENTES
  188. *
  189.       DO 9004 J=1,LRE
  190.       DO 9005 I=1,NDDL
  191.          XFORC(J)=XFORC(J)+BGENE(I,J)*FOVOL(I)*DJAC
  192.  9005 CONTINUE
  193.  9004 CONTINUE
  194. *
  195.  5004 CONTINUE
  196. *
  197.       IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  198. *
  199. C
  200. C     ON RANGE XFORC DANS MELVAL
  201. C
  202.       IE=0
  203.       MPTVAL=IVAFOR
  204.       DO 7004 IGAU=1,NBNN
  205.       DO 7005 ICOMP=1,NCOMP
  206.         IE=IE+1
  207.         MELVAL=IVAL(ICOMP)
  208.         VELCHE(IGAU,IB)=XFORC(IE)
  209.  7005 CONTINUE
  210.  7004 CONTINUE
  211. C
  212.  3004 CONTINUE
  213.       IF(I195.NE.0) INTERR(1)=I195
  214.       IF(I195.NE.0) CALL ERREUR(195)
  215.       IF(I259.NE.0) INTERR(1)=I259
  216.       IF(I259.NE.0) CALL ERREUR(259)
  217.       SEGSUP WRK1,WRK2
  218.       GOTO 510
  219. C_______________________________________________________________________
  220. C
  221. C     MILIEUX POREUX
  222. C_______________________________________________________________________
  223. C
  224.   79  CONTINUE
  225. C
  226. C    POUR CES ELEMENTS  NBBB = NOMBRE DE NOEUDS
  227. C                       NBNO = NOMBRE DE FONCTIONS DE FORME
  228. C
  229.       DIM3=1.D0
  230.       NBNO=IPORE
  231.       NBBB=NBNN
  232.       LRN = NBNO-NBBB
  233.       LRB=LRE-LRN
  234.       NSTN=1
  235.       NSTB=NDDL-1
  236.       SEGINI WRK1,WRK2,WRK5
  237.       I195=0
  238.       I259=0
  239. C
  240.       DO 3079  IB=1,NBELEM
  241. C
  242. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  243. C
  244.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  245. C
  246. C     MISE A 0 DES FORCES NODALES
  247. C
  248.       CALL ZERO(XFORC,1,LRE)
  249. C
  250. C     BOUCLE SUR LES POINTS DE GAUSS
  251. C
  252.       ISDJC=0
  253.       DO 5079  IGAU=1,NBPGAU
  254. C
  255. C   RECUPERATION DE L'EPAISSEUR
  256. C
  257.       IF (IFOUR.EQ.-2)THEN
  258.         MPTVAL=IVACAR
  259.         IF (IVACAR.NE.0) THEN
  260.          MELVAL=IVAL(1)
  261.          IF (MELVAL.NE.0) THEN
  262.           IGMN=MIN(IGAU,VELCHE(/1))
  263.           IBMN=MIN(IB,VELCHE(/2))
  264.           DIM3=VELCHE(IGMN,IBMN)
  265.          ELSE
  266.           DIM3=1.D0
  267.          ENDIF
  268.         ENDIF
  269.       ENDIF
  270. C
  271.       CALL BNPORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3,
  272.      .            XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,5)
  273.       IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  274.       IF(DJAC.EQ.0.D0) I259=IB
  275.       DJAC=ABS(DJAC)*POIGAU(IGAU)
  276. C
  277. C     ON RECUPERE LES FORCES VOLUMIQUES
  278. C
  279.       MPTVAL=IVAFVO
  280.       ICOSOU=IVAL(/1)
  281.       DO 8079 I=1,ICOSOU
  282.          IF (IVAL(I).NE.0) THEN
  283.              MELVAL=IVAL(I)
  284.              IGMN=MIN(IGAU,VELCHE(/1))
  285.              IBMN=MIN(IB  ,VELCHE(/2))
  286.              FOVOL(I)=VELCHE(IGMN,IBMN)
  287.          ELSE
  288.              FOVOL(I)=0.D0
  289.          ENDIF
  290.  8079  CONTINUE
  291. *
  292. *     CALCUL DES FORCES NODALES EQUIVALENTES
  293. *     D'ABORD LA MECANIQUE
  294. *
  295.       DO 9078 J=1,LRB
  296.       DO 9079 I=1,NSTB
  297.          XFORC(J)=XFORC(J)+BGENE(I,J)*FOVOL(I)*DJAC
  298.  9079 CONTINUE
  299.  9078 CONTINUE
  300. *
  301. *     PUIS LA PRESSION
  302. *
  303.       DO 6079 J=1,LRN
  304.          JJ=LRB+J
  305.          XFORC(JJ)=XFORC(JJ)+XGENE(1,J)*FOVOL(NDDL)*DJAC
  306.  6079 CONTINUE
  307. *
  308.  5079 CONTINUE
  309. *
  310.       IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  311. *
  312. C
  313. C     ON RANGE XFORC DANS MELVAL
  314. C     D'ABORD LES FORCES
  315. C
  316.       IE=0
  317.       MPTVAL=IVAFOR
  318.       DO 7078 IGAU=1,NBNN
  319.       DO 7079 ICOMP=1,NCOMP-1
  320.         IE=IE+1
  321.         MELVAL=IVAL(ICOMP)
  322.         VELCHE(IGAU,IB)=XFORC(IE)
  323.  7079 CONTINUE
  324.  7078 CONTINUE
  325. C
  326. C     PUIS LES DEBITS
  327. C
  328.       DO 4079 IGAU=1,NBSOM(IELE)
  329.         IE=IE+1
  330.         MELVAL=IVAL(NCOMP)
  331.         IGAV  = IBSOM(NSPOS(IELE)+IGAU-1)
  332.         VELCHE(IGAV,IB)=XFORC(IE)
  333.  4079 CONTINUE
  334. C
  335.  3079 CONTINUE
  336.       IF(I195.NE.0) INTERR(1)=I195
  337.       IF(I195.NE.0) CALL ERREUR(195)
  338.       IF(I259.NE.0) INTERR(1)=I259
  339.       IF(I259.NE.0) CALL ERREUR(259)
  340.       SEGSUP WRK1,WRK2,WRK5
  341.       GOTO 510
  342. C
  343. C_______________________________________________________________________
  344. C
  345. C
  346.   99  CONTINUE
  347.       MOTERR(1:4)=NOMTP(MELE)
  348.       MOTERR(5:8)='CNEQ'
  349.       CALL ERREUR(86)
  350. C
  351.   510 CONTINUE
  352.       RETURN
  353.       END
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  

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