Télécharger la plaquette Cast3M


fr en

Télécharger cneq2.eso

Retour à la liste

Numérotation des lignes : 

cneq2

  1. C CNEQ2     SOURCE    CB215821  24/04/12    21:15:18     11897          
  2.       SUBROUTINE CNEQ2(IPMAIL,LRE,NDDD,IVAFVO,LW,NBPGAU,IVACAR,
  3.      &  CMATE,NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,
  4.      &  IMAT,IVAFOR)
  5. *----------------------------------------------------------------------
  6. *        _______________________________                              *
  7. *        |                              |                             *
  8. *        |  CALCUL DES FORCES AUX NOEUDS|                             *
  9. *        |______________________________|                             *
  10. *                                                                     *
  11. *                     dkt,coq4                                        *
  12. *                                                                     *
  13. *---------------------------------------------------------------------*
  14. *                                                                     *
  15. *   ENTREES :                                                         *
  16. *   ________                                                          *
  17. *                                                                     *
  18. *        IPMAIL   Pointeur sur un segment  MELEME                     *
  19. *        LRE      Nombre de ddl dans la matrice de rigidite           *
  20. *        NDDD     Nombre de degrE de libertE PAR NOEUD                *
  21. *        IVAFVO   pointeur sur un segment MPTVAL contenant les        *
  22. *                 les melvals de forces volumiques                    *
  23. *        LW       Dimension du tableau de travail de l'element        *
  24. *        NBPGAU   Nombre de points d'integration                      *
  25. *        IVACAR   Pointeur sur les chamelems de caracteristiques      *
  26. *        NBPTEL   Nombre de points par element                        *
  27. *        MELE     Numero de l'element fini                            *
  28. *        IPMINT   Pointeur sur un segment MINTE                       *
  29. *        IPMIN1   Pointeur sur un segment MINTE (aux noeuds)          *
  30. *                                                                     *
  31. *   SORTIES :                                                         *
  32. *   ________                                                          *
  33. *                                                                     *
  34. *        IVAFOR   pointeur sur un segment MPTVAL contenant les        *
  35. *                 les melvals de forces                               *
  36. *                                                                     *
  37. *---------------------------------------------------------------------*
  38.       IMPLICIT INTEGER(I-N)
  39.       IMPLICIT REAL*8(A-H,O-Z)
  40. *
  41. *
  42.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC CCHAMP
  46. -INC CCREEL
  47. -INC SMCHAML
  48. -INC SMCHPOI
  49. -INC SMELEME
  50. -INC SMCOORD
  51. -INC SMMODEL
  52. -INC SMINTE
  53. -INC SMLREEL
  54. -INC SMRIGID
  55. *
  56.       SEGMENT WRK1
  57.        REAL*8 XFORC(LRE), FOVOL(NDDD), XE(3,NBBB)
  58.       ENDSEGMENT
  59. *
  60.       SEGMENT WRK2
  61.        REAL*8 SHPWRK(6,NBNO), BGENE(NDDL,LRE)
  62.       ENDSEGMENT
  63. *
  64.       SEGMENT WRK3
  65.        REAL*8 WORK(LW)
  66.       ENDSEGMENT
  67. *
  68.       SEGMENT WRK4
  69.        REAL*8 BPSS(3,3), XEL(3,NBBB), XFOLO(LRE)
  70.       ENDSEGMENT
  71. *
  72.       SEGMENT MPTVAL
  73.         INTEGER IPOS(NS)    ,NSOF(NS)
  74.         INTEGER      IVAL(NCOSOU)
  75.         CHARACTER*16 TYVAL(NCOSOU)
  76.       ENDSEGMENT
  77. *
  78.       CHARACTER*8 CMATE
  79. *
  80. *
  81.       MELEME=IPMAIL
  82.       NDDL=NDDD
  83.       NBNN=NUM(/1)
  84.       NBELEM=NUM(/2)
  85.       NHRM=NIFOUR
  86.       MINTE=IPMINT
  87. C_______________________________________________________________________
  88. C
  89. C     NUMERO DES ETIQUETTES      :
  90. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  91. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  92. C     5  CONTINUE
  93. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  94. C     44 CONTINUE
  95. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  96. C_______________________________________________________________________
  97. C
  98.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  99.      1      99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  100.      2      41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  101.      3      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  102.      4      99,99,99,99,99,99,99,88,99,99,99,99,93,99,99,99,99),MELE
  103.       GOTO 99
  104. C_______________________________________________________________________
  105. C_______________________________________________________________________
  106. C
  107. C     ELEMENT COQ3
  108. C_______________________________________________________________________
  109. C
  110.   27  CONTINUE
  111. C
  112. C               CAS NON PREVU
  113.       GO TO 99
  114. C_______________________________________________________________________
  115. C
  116. C     ELEMENT DKT
  117. C_______________________________________________________________________
  118. C
  119.   28  CONTINUE
  120.       NBNO=NBNN
  121.       NBBB=NBNN
  122.       NDDL=3
  123.       SEGINI WRK1,WRK2,WRK3,WRK4
  124. C
  125.       DO 3028  IB=1,NBELEM
  126. C
  127. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  128. C
  129.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  130. C
  131. C     MISE A ZERO DES FORCES NODALES
  132. C
  133.       CALL ZERO(XFORC,1,LRE)
  134. C
  135.       CALL VPAST(XE,BPSS)
  136.       CALL VCORLC (XE,XEL,BPSS)
  137. C
  138. C     BOUCLE SUR LES POINTS DE GAUSS
  139. C
  140.       DO 6028  IGAU=1,NBPGAU
  141.         MPTVAL=IVACAR
  142.         MELVAL=IVAL(1)
  143.         IGMN=MIN(IGAU,VELCHE(/1))
  144.         IBMN=MIN(IB  ,VELCHE(/2))
  145.         EPAIST=VELCHE(IGMN,IBMN)
  146.         IF (IVAL(2).NE.0) THEN
  147.           MELVAL=IVAL(2)
  148.           IGMN=MIN(IGAU,VELCHE(/1))
  149.           IBMN=MIN(IB  ,VELCHE(/2))
  150.           EXCENT=VELCHE(IGMN,IBMN)
  151.         ELSE
  152.           EXCENT=0.D0
  153.         ENDIF
  154. *
  155.         CALL NDKT (IGAU,XEL,EXCENT,SHPTOT,SHPWRK,BGENE,DJAC)
  156.         DJAC=DJAC*POIGAU(IGAU)*EPAIST
  157. *
  158. *     ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL
  159. *
  160.       MPTVAL=IVAFVO
  161.       ICOSOU=IVAL(/1)
  162.       DO 8028 I=1,ICOSOU
  163.          IF (IVAL(I).NE.0) THEN
  164.              MELVAL=IVAL(I)
  165.              IGMN=MIN(IGAU,VELCHE(/1))
  166.              IBMN=MIN(IB  ,VELCHE(/2))
  167.              FOVOL(I)=VELCHE(IGMN,IBMN)
  168.          ELSE
  169.              FOVOL(I)=0.D0
  170.          ENDIF
  171. 8028  CONTINUE
  172. *
  173. *    ON LES PASSE DANS LE REPERE LOCAL
  174. *
  175.       CALL MATVEC(FOVOL,XFOLO,BPSS,1)
  176. C
  177. C     CALCUL DES FORCES NODALES
  178. C
  179.       DO 7028 J=1,LRE
  180.       DO 7028 I=1,NDDL
  181.          XFORC(J)=XFORC(J)+BGENE(I,J)*XFOLO(I)*DJAC
  182.  7028 CONTINUE
  183.  6028 CONTINUE
  184. C
  185. C     TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL
  186. C
  187.       CALL TRPOSE(BPSS)
  188.       CALL MATVEC(XFORC,XFOLO,BPSS,6)
  189.       IE=0
  190.       MPTVAL=IVAFOR
  191.       DO 9028 IGAU=1,NBNN
  192.       DO 9028 ICOMP=1,6
  193.         IE=IE+1
  194.         MELVAL=IVAL(ICOMP)
  195.         VELCHE(IGAU,IB)=XFOLO(IE)
  196.  9028 CONTINUE
  197.  3028 CONTINUE
  198.       SEGSUP WRK1,WRK2,WRK3,WRK4
  199.       GOTO 510
  200. C_______________________________________________________________________
  201. C_______________________________________________________________________
  202. C
  203. C    ELEMENTS COQ6 ET COQ8
  204. C_______________________________________________________________________
  205. C
  206.   41  CONTINUE
  207. C
  208. C      CAS NON PREVU
  209.       GO TO 99
  210. C
  211. C_______________________________________________________________________
  212. C_______________________________________________________________________
  213. C
  214. C  ELEMENT COQ2
  215. C_______________________________________________________________________
  216. C
  217.    44 CONTINUE
  218. C
  219. C      CAS NON PREVU
  220.       GO TO 99
  221. C
  222. C_______________________________________________________________________
  223. C_______________________________________________________________________
  224. C
  225. C  ELEMENT COQ4
  226. C_______________________________________________________________________
  227. C
  228. C
  229.    49 CONTINUE
  230.       IG1=0
  231.       NBNO=NBNN
  232.       NBBB=NBNN
  233.       SEGINI WRK1,WRK2,WRK4
  234. C
  235.       DO 3049 IB=1,NBELEM
  236. C
  237. C  ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  238. C
  239.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  240. C
  241. C  MISE A ZERO DES FORCES  NODALES
  242. C
  243.       CALL ZERO(XFORC,1,LRE)
  244. C
  245. C  CALCUL DE LA MATRICE DE PASSAGE EN REPERE LOCAL
  246. C
  247.       CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  248. C
  249.       IF (IERT .EQ. 3) THEN
  250.          NOPLAN = 1
  251.        ELSE
  252.          NOPLAN = 0
  253.        END IF
  254. C
  255.          MPTVAL=IVACAR
  256.          MELVAL=IVAL(1)
  257.          IBMN=MIN(IB,VELCHE(/2))
  258.          EP=VELCHE(1,IBMN)
  259.          MELVAL=IVAL(2)
  260.          IF (MELVAL.NE.0) THEN
  261.             IBMN=MIN(IB,VELCHE(/2))
  262.             EXCEN =VELCHE(1,IBMN)
  263.          ELSE
  264.             EXCEN=0.D0
  265.          ENDIF
  266. C
  267. C  BOUCLE SUR LES POINTS DE GAUSS
  268. C
  269.           NBPGAM=NBPGAU-1
  270.           DO 4049 IGAU=1,NBPGAM
  271.             CALL NCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,IERT)
  272. *
  273. *           IERT=1 JACOBIANO=<0
  274.             IF (IERT.NE.0) IG1=IB
  275. *
  276.             DJAC=DJAC*POIGAU(IGAU)*EP
  277. *
  278. *  ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL
  279. *
  280.       MPTVAL=IVAFVO
  281.       ICOSOU=IVAL(/1)
  282.       DO 3549 I=1,ICOSOU
  283.          IF (IVAL(I).NE.0) THEN
  284.              MELVAL=IVAL(I)
  285.              IGMN=MIN(IGAU,VELCHE(/1))
  286.              IBMN=MIN(IB  ,VELCHE(/2))
  287.              FOVOL(I)=VELCHE(IGMN,IBMN)
  288.          ELSE
  289.              FOVOL(I)=0.D0
  290.          ENDIF
  291.  3549 CONTINUE
  292. *
  293. *  ON LES PASSE DANS LE REPERE LOCAL
  294. *
  295.       CALL MATVEC(FOVOL,XFOLO,BPSS,1)
  296. C
  297. C  ON CALCULE LES FORCES NODALES
  298. C
  299.       DO 3649 J=1,LRE
  300.       DO 3649 I=1,3
  301.          XFORC(J)=XFORC(J)+BGENE(I,J)*XFOLO(I)*DJAC
  302.  3649 CONTINUE
  303.  4049 CONTINUE
  304. C
  305. C  TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL
  306. C
  307.       CALL TRPOSE(BPSS)
  308.       CALL MATVEC(XFORC,XFOLO,BPSS,8)
  309.       IE=0
  310.       MPTVAL=IVAFOR
  311.       DO 9049 NODE=1,4
  312.       DO 9049 ICOMP=1,6
  313.         IE=IE+1
  314.         MELVAL=IVAL(ICOMP)
  315.         VELCHE(NODE,IB)=XFOLO(IE)
  316.  9049 CONTINUE
  317.  3049 CONTINUE
  318. C
  319. C     IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  320. C
  321.       IF(IG1.NE.0) THEN
  322.          INTERR(1)=IG1
  323.          CALL ERREUR(323)
  324.       ENDIF
  325.       SEGSUP WRK1,WRK2,WRK4
  326.       GOTO 510
  327. C_______________________________________________________________________
  328. C
  329. C  ELEMENT JOINT JOI4
  330. C_______________________________________________________________________
  331. C
  332.    88 CONTINUE
  333. C
  334. C      CAS NON PREVU
  335.       GO TO 99
  336. C
  337. C_______________________________________________________________________
  338. C
  339. C     ELEMENT DST
  340. C_______________________________________________________________________
  341. C
  342.   93  CONTINUE
  343. C
  344. C      CAS NON PREVU
  345.       GO TO 99
  346. C
  347. C_______________________________________________________________________
  348. *
  349.    99 CONTINUE
  350.       MOTERR(1:4)=NOMTP(MELE)
  351.       MOTERR(5:9)='CNEQ2'
  352.       CALL ERREUR(86)
  353. *
  354.   510 CONTINUE
  355.       RETURN
  356.       END
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  

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