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    OF166741  25/02/21    21:15:32     12166          
  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. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC CCHAMP
  46. -INC CCGEOME
  47. -INC CCREEL
  48.  
  49. -INC SMCHAML
  50. -INC SMCHPOI
  51. -INC SMELEME
  52. -INC SMCOORD
  53. -INC SMMODEL
  54. -INC SMINTE
  55. -INC SMRIGID
  56.  
  57. -INC TMPTVAL
  58.  
  59.       SEGMENT WRK1
  60.        REAL*8 XFORC(LRE),FOVOL(NDDL),XE(3,NBBB)
  61.       ENDSEGMENT
  62.  
  63.       SEGMENT WRK2
  64.        REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE)
  65.       ENDSEGMENT
  66. *
  67.       SEGMENT WRK5
  68.        REAL*8 XGENE(NSTN,LRN)
  69.       ENDSEGMENT
  70.  
  71.       SEGACT, MCOORD
  72.  
  73. *     INTRODUCTION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  74. *     DE LA SECTION EN DEFO PLANE GENERALISEE
  75. * Pas de rotation en modes 1D generalises
  76.       IF (IFOUR.EQ.-3)THEN
  77.         IREF=(IIPDPG-1)*(IDIM+1)
  78.         XDPGE=XCOOR(IREF+1)
  79.         YDPGE=XCOOR(IREF+2)
  80.       ELSE
  81.         XDPGE=0.D0
  82.         YDPGE=0.D0
  83.       ENDIF
  84.  
  85.       MELEME=IPMAIL
  86.       NBNN=NUM(/1)
  87.       NBELEM=NUM(/2)
  88.       NHRM=NIFOUR
  89.       MINTE=IPMINT
  90.       IELE=NUMGEO(MELE)
  91.  
  92. C_______________________________________________________________________
  93. C
  94. C     NUMERO DES ETIQUETTES      :
  95. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  96. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  97. C     5  CONTINUE
  98. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  99. C     44 CONTINUE
  100. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  101. C_______________________________________________________________________
  102. C
  103.       GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  104.      1      99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  105.      2      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  106.      3      99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,79,79,
  107.      4      79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  108.      5      99,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  109.      6       4, 4),MELE
  110.       IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  111.       GOTO 99
  112. C_______________________________________________________________________
  113. C
  114. C     SECTEUR DE CALCUL POUR LES ELEMENTS MASSIFS
  115. C_______________________________________________________________________
  116. C
  117.    4  CONTINUE
  118. C
  119.       DIM3=1.D0
  120.       NBNO=NBNN
  121.       NBBB=NBNN
  122.       NSTB=NDDL
  123.       SEGINI WRK1,WRK2
  124.       I195=0
  125.       I259=0
  126. C
  127.       DO 3004  IB=1,NBELEM
  128. C
  129. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  130. C
  131.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  132. C
  133. C     MISE A 0 DES FORCES NODALES
  134. C
  135.       CALL ZERO(XFORC,1,LRE)
  136. C
  137. C     BOUCLE SUR LES POINTS DE GAUSS
  138. C
  139.       ISDJC=0
  140.       DO 5004  IGAU=1,NBPGAU
  141. C
  142. C   RECUPERATION DE L'EPAISSEUR
  143. C
  144.       IF (IFOUR.EQ.-2)THEN
  145.         MPTVAL=IVACAR
  146.         IF (IVACAR.NE.0) THEN
  147.          MELVAL=IVAL(1)
  148.          IF (MELVAL.NE.0) THEN
  149.           IGMN=MIN(IGAU,VELCHE(/1))
  150.           IBMN=MIN(IB,VELCHE(/2))
  151.           DIM3=VELCHE(IGMN,IBMN)
  152.          ELSE
  153.           DIM3=1.D0
  154.          ENDIF
  155.         ENDIF
  156.       ENDIF
  157. C
  158.       CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,DIM3,
  159.      1       XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  160. *
  161.       IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  162.       IF(DJAC.EQ.0.D0) I259=IB
  163.       DJAC=ABS(DJAC)*POIGAU(IGAU)
  164. C
  165. C     ON RECUPERE LES FORCES VOLUMIQUES
  166. C
  167.       MPTVAL=IVAFVO
  168.       ICOSOU=IVAL(/1)
  169.       DO 8004 I=1,ICOSOU
  170.          IF (IVAL(I).NE.0) THEN
  171.              MELVAL=IVAL(I)
  172.              IGMN=MIN(IGAU,VELCHE(/1))
  173.              IBMN=MIN(IB  ,VELCHE(/2))
  174.              FOVOL(I)=VELCHE(IGMN,IBMN)
  175.          ELSE
  176.              FOVOL(I)=0.D0
  177.          ENDIF
  178.  8004  CONTINUE
  179. *
  180. *     CALCUL DES FORCES NODALES EQUIVALENTES
  181. *
  182.       DO 9004 J=1,LRE
  183.         r_z = 0.D0
  184.       DO 9005 I=1,NDDL
  185.             r_z = r_z +BGENE(I,J)*FOVOL(I)
  186.  9005 CONTINUE
  187.          XFORC(J) = XFORC(J) + (r_z*DJAC)
  188.  9004 CONTINUE
  189. *
  190.  5004 CONTINUE
  191. *
  192.       IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  193. C
  194. C     ON RANGE XFORC DANS MELVAL
  195. C
  196.       IE=0
  197.       MPTVAL=IVAFOR
  198.       DO 7004 IGAU=1,NBNN
  199.       DO 7005 ICOMP=1,NCOMP
  200.         IE=IE+1
  201.         MELVAL=IVAL(ICOMP)
  202.         VELCHE(IGAU,IB)=XFORC(IE)
  203.  7005 CONTINUE
  204.  7004 CONTINUE
  205. C
  206.  3004 CONTINUE
  207.       IF(I195.NE.0) INTERR(1)=I195
  208.       IF(I195.NE.0) CALL ERREUR(195)
  209.       IF(I259.NE.0) INTERR(1)=I259
  210.       IF(I259.NE.0) CALL ERREUR(259)
  211.       SEGSUP WRK1,WRK2
  212.       GOTO 510
  213. C_______________________________________________________________________
  214. C
  215. C     MILIEUX POREUX
  216. C_______________________________________________________________________
  217. C
  218.   79  CONTINUE
  219. C
  220. C    POUR CES ELEMENTS  NBBB = NOMBRE DE NOEUDS
  221. C                       NBNO = NOMBRE DE FONCTIONS DE FORME
  222. C
  223.       DIM3=1.D0
  224.       NBNO=IPORE
  225.       NBBB=NBNN
  226.       LRN = NBNO-NBBB
  227.       LRB=LRE-LRN
  228.       NSTN=1
  229.       NSTB=NDDL-1
  230.       SEGINI WRK1,WRK2,WRK5
  231.       I195=0
  232.       I259=0
  233. C
  234.       DO 3079  IB=1,NBELEM
  235. C
  236. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  237. C
  238.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  239. C
  240. C     MISE A 0 DES FORCES NODALES
  241. C
  242.       CALL ZERO(XFORC,1,LRE)
  243. C
  244. C     BOUCLE SUR LES POINTS DE GAUSS
  245. C
  246.       ISDJC=0
  247.       DO 5079  IGAU=1,NBPGAU
  248. C
  249. C   RECUPERATION DE L'EPAISSEUR
  250. C
  251.       IF (IFOUR.EQ.-2)THEN
  252.         MPTVAL=IVACAR
  253.         IF (IVACAR.NE.0) THEN
  254.          MELVAL=IVAL(1)
  255.          IF (MELVAL.NE.0) THEN
  256.           IGMN=MIN(IGAU,VELCHE(/1))
  257.           IBMN=MIN(IB,VELCHE(/2))
  258.           DIM3=VELCHE(IGMN,IBMN)
  259.          ELSE
  260.           DIM3=1.D0
  261.          ENDIF
  262.         ENDIF
  263.       ENDIF
  264. C
  265.       CALL BNPORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3,
  266.      .            XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,5)
  267.       IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  268.       IF(DJAC.EQ.0.D0) I259=IB
  269.       DJAC=ABS(DJAC)*POIGAU(IGAU)
  270. C
  271. C     ON RECUPERE LES FORCES VOLUMIQUES
  272. C
  273.       MPTVAL=IVAFVO
  274.       ICOSOU=IVAL(/1)
  275.       DO 8079 I=1,ICOSOU
  276.          MELVAL=IVAL(I)
  277.          IF (MELVAL.NE.0) THEN
  278.              IGMN=MIN(IGAU,VELCHE(/1))
  279.              IBMN=MIN(IB  ,VELCHE(/2))
  280.              FOVOL(I)=VELCHE(IGMN,IBMN)
  281.          ELSE
  282.              FOVOL(I)=0.D0
  283.          ENDIF
  284.  8079  CONTINUE
  285. *
  286. *     CALCUL DES FORCES NODALES EQUIVALENTES
  287. *     D'ABORD LA MECANIQUE
  288. *
  289.       DO 9078 J=1,LRB
  290.          r_z = 0.D0
  291.       DO 9079 I=1,NSTB
  292.          r_z = r_z +BGENE(I,J)*FOVOL(I)
  293.  9079 CONTINUE
  294.          XFORC(J)=XFORC(J) + (r_z*DJAC)
  295.  9078 CONTINUE
  296. *
  297. *     PUIS LA PRESSION
  298. *
  299.       r_z = FOVOL(NDDL)*DJAC
  300.       DO 6079 J=1,LRN
  301.          JJ=LRB+J
  302.          XFORC(JJ)=XFORC(JJ)+XGENE(1,J)*r_z
  303.  6079 CONTINUE
  304. *
  305.  5079 CONTINUE
  306. *
  307.       IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  308. C
  309. C     ON RANGE XFORC DANS MELVAL
  310. C     D'ABORD LES FORCES
  311. C
  312.       IE=0
  313.       MPTVAL=IVAFOR
  314.       DO 7078 IGAU=1,NBNN
  315.       DO 7079 ICOMP=1,NCOMP-1
  316.         IE=IE+1
  317.         MELVAL=IVAL(ICOMP)
  318.         VELCHE(IGAU,IB)=XFORC(IE)
  319.  7079 CONTINUE
  320.  7078 CONTINUE
  321. C
  322. C     PUIS LES DEBITS
  323. C
  324.       DO 4079 IGAU=1,NBSOM(IELE)
  325.         IE=IE+1
  326.         MELVAL=IVAL(NCOMP)
  327.         IGAV  = IBSOM(NSPOS(IELE)+IGAU-1)
  328.         VELCHE(IGAV,IB)=XFORC(IE)
  329.  4079 CONTINUE
  330. C
  331.  3079 CONTINUE
  332.       IF(I195.NE.0) INTERR(1)=I195
  333.       IF(I195.NE.0) CALL ERREUR(195)
  334.       IF(I259.NE.0) INTERR(1)=I259
  335.       IF(I259.NE.0) CALL ERREUR(259)
  336.       SEGSUP WRK1,WRK2,WRK5
  337.       GOTO 510
  338. C_______________________________________________________________________
  339. C
  340.   99  CONTINUE
  341.       MOTERR(1:4)=NOMTP(MELE)
  342.       MOTERR(5:8)='CNEQ'
  343.       CALL ERREUR(86)
  344.  
  345.   510 CONTINUE
  346.       RETURN
  347.       END
  348.  
  349.  
  350.  

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