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  26/08/24    21:15:36     12622          
  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. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC CCHAMP
  44. -INC CCREEL
  45.  
  46. -INC SMCHAML
  47. -INC SMCHPOI
  48. -INC SMELEME
  49. -INC SMCOORD
  50. -INC SMMODEL
  51. -INC SMINTE
  52. -INC SMLREEL
  53. -INC SMRIGID
  54.  
  55. -INC TMPTVAL
  56.  
  57.       SEGMENT WRK1
  58.        REAL*8 XFORC(LRE), FOVOL(NDDD), XE(3,NBBB)
  59.       ENDSEGMENT
  60. *
  61.       SEGMENT WRK2
  62.        REAL*8 SHPWRK(6,NBNO), BGENE(NDDL,LRE)
  63.       ENDSEGMENT
  64. *
  65.       SEGMENT WRK3
  66.        REAL*8 WORK(LW)
  67.       ENDSEGMENT
  68. *
  69.       SEGMENT WRK4
  70.        REAL*8 BPSS(3,3), XEL(3,NBBB), XFOLO(LRE)
  71.       ENDSEGMENT
  72. *
  73.       CHARACTER*8 CMATE
  74. *
  75.       MELEME=IPMAIL
  76.       NDDL=NDDD
  77.       NBNN=NUM(/1)
  78.       NBELEM=NUM(/2)
  79.       NHRM=NIFOUR
  80.       MINTE=IPMINT
  81. C_______________________________________________________________________
  82. C
  83. C     NUMERO DES ETIQUETTES      :
  84. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  85. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  86. C     5  CONTINUE
  87. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  88. C     44 CONTINUE
  89. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  90. C_______________________________________________________________________
  91. C
  92.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  93.      1      99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  94.      2      41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  95.      3      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  96.      4      99,99,99,99,99,99,99,88,99,99,99,99,93,99,99,99,99),MELE
  97.       GOTO 99
  98. C_______________________________________________________________________
  99. C_______________________________________________________________________
  100. C
  101. C     ELEMENT COQ3
  102. C_______________________________________________________________________
  103. C
  104.   27  CONTINUE
  105. C
  106. C               CAS NON PREVU
  107.       GO TO 99
  108. C_______________________________________________________________________
  109. C
  110. C     ELEMENT DKT
  111. C_______________________________________________________________________
  112. C
  113.   28  CONTINUE
  114.       NBNO=NBNN
  115.       NBBB=NBNN
  116.       NDDL=3
  117.       SEGINI WRK1,WRK2,WRK3,WRK4
  118. C
  119.       DO 3028  IB=1,NBELEM
  120. C
  121. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  122. C
  123.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  124. C
  125. C     MISE A ZERO DES FORCES NODALES
  126. C
  127.       CALL ZERO(XFORC,1,LRE)
  128. C
  129.       CALL VPAST(XE,BPSS)
  130.       CALL VCORLC (XE,XEL,BPSS)
  131. C
  132. C     BOUCLE SUR LES POINTS DE GAUSS
  133. C
  134.       DO 6028  IGAU=1,NBPGAU
  135.         MPTVAL=IVACAR
  136.         MELVAL=IVAL(1)
  137.         IGMN=MIN(IGAU,VELCHE(/1))
  138.         IBMN=MIN(IB  ,VELCHE(/2))
  139.         EPAIST=VELCHE(IGMN,IBMN)
  140.         IF (IVAL(2).NE.0) THEN
  141.           MELVAL=IVAL(2)
  142.           IGMN=MIN(IGAU,VELCHE(/1))
  143.           IBMN=MIN(IB  ,VELCHE(/2))
  144.           EXCENT=VELCHE(IGMN,IBMN)
  145.         ELSE
  146.           EXCENT=0.D0
  147.         ENDIF
  148. *
  149.         CALL NDKT (IGAU,XEL,EXCENT,SHPTOT,SHPWRK,BGENE,DJAC)
  150.         DJAC=DJAC*POIGAU(IGAU)*EPAIST
  151. *
  152. *     ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL
  153. *
  154.       MPTVAL=IVAFVO
  155.       ICOSOU=IVAL(/1)
  156.       DO 8028 I=1,ICOSOU
  157.          IF (IVAL(I).NE.0) THEN
  158.              MELVAL=IVAL(I)
  159.              IGMN=MIN(IGAU,VELCHE(/1))
  160.              IBMN=MIN(IB  ,VELCHE(/2))
  161.              FOVOL(I)=VELCHE(IGMN,IBMN)
  162.          ELSE
  163.              FOVOL(I)=0.D0
  164.          ENDIF
  165. 8028  CONTINUE
  166. *
  167. *    ON LES PASSE DANS LE REPERE LOCAL
  168. *
  169.       CALL MATVEC(FOVOL,XFOLO,BPSS,1)
  170. C
  171. C     CALCUL DES FORCES NODALES
  172. C
  173.       DO 9050 J=1,LRE
  174.         r_z = 0.D0
  175.       DO 7028 I=1,NDDL
  176.          r_z = r_z + BGENE(I,J)*XFOLO(I)
  177.  7028 CONTINUE
  178.  9050 CONTINUE
  179.          XFORC(J) = XFORC(J) + (r_z*DJAC)
  180.  6028 CONTINUE
  181. C
  182. C     TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL
  183. C
  184.       CALL TRPOSE(BPSS)
  185.       CALL MATVEC(XFORC,XFOLO,BPSS,6)
  186.       IE=0
  187.       MPTVAL=IVAFOR
  188.       DO 9051 IGAU=1,NBNN
  189.       DO 9028 ICOMP=1,6
  190.         IE=IE+1
  191.         MELVAL=IVAL(ICOMP)
  192.         VELCHE(IGAU,IB)=XFOLO(IE)
  193.  9028 CONTINUE
  194.  9051 CONTINUE
  195.  3028 CONTINUE
  196.       SEGSUP WRK1,WRK2,WRK3,WRK4
  197.       GOTO 510
  198. C_______________________________________________________________________
  199. C_______________________________________________________________________
  200. C
  201. C    ELEMENTS COQ6 ET COQ8
  202. C_______________________________________________________________________
  203. C
  204.   41  CONTINUE
  205. C
  206. C      CAS NON PREVU
  207.       GO TO 99
  208. C
  209. C_______________________________________________________________________
  210. C_______________________________________________________________________
  211. C
  212. C  ELEMENT COQ2
  213. C_______________________________________________________________________
  214. C
  215.    44 CONTINUE
  216. C
  217. C      CAS NON PREVU
  218.       GO TO 99
  219. C
  220. C_______________________________________________________________________
  221. C_______________________________________________________________________
  222. C
  223. C  ELEMENT COQ4
  224. C_______________________________________________________________________
  225. C
  226. C
  227.    49 CONTINUE
  228.       IG1=0
  229.       NBNO=NBNN
  230.       NBBB=NBNN
  231.       SEGINI WRK1,WRK2,WRK4
  232. C
  233.       DO 3049 IB=1,NBELEM
  234. C
  235. C  ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  236. C
  237.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  238. C
  239. C  MISE A ZERO DES FORCES  NODALES
  240. C
  241.       CALL ZERO(XFORC,1,LRE)
  242. C
  243. C  CALCUL DE LA MATRICE DE PASSAGE EN REPERE LOCAL
  244. C
  245.       CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  246. C
  247.       IF (IERT .EQ. 3) THEN
  248.          NOPLAN = 1
  249.        ELSE
  250.          NOPLAN = 0
  251.        END IF
  252. C
  253.          MPTVAL=IVACAR
  254.          MELVAL=IVAL(1)
  255.          IBMN=MIN(IB,VELCHE(/2))
  256.          EP=VELCHE(1,IBMN)
  257.          MELVAL=IVAL(2)
  258.          IF (MELVAL.NE.0) THEN
  259.             IBMN=MIN(IB,VELCHE(/2))
  260.             EXCEN =VELCHE(1,IBMN)
  261.          ELSE
  262.             EXCEN=0.D0
  263.          ENDIF
  264. C
  265. C  BOUCLE SUR LES POINTS DE GAUSS
  266. C
  267.           NBPGAM=NBPGAU-1
  268.           DO 4049 IGAU=1,NBPGAM
  269.             CALL NCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,IERT)
  270. *
  271. *           IERT=1 JACOBIANO=<0
  272.             IF (IERT.NE.0) IG1=IB
  273. *
  274.             DJAC=DJAC*POIGAU(IGAU)*EP
  275. *
  276. *  ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL
  277. *
  278.       MPTVAL=IVAFVO
  279.       ICOSOU=IVAL(/1)
  280.       DO 3549 I=1,ICOSOU
  281.          MELVAL=IVAL(I)
  282.          IF (MELVAL.NE.0) THEN
  283.              IGMN=MIN(IGAU,VELCHE(/1))
  284.              IBMN=MIN(IB  ,VELCHE(/2))
  285.              FOVOL(I)=VELCHE(IGMN,IBMN)
  286.          ELSE
  287.              FOVOL(I)=0.D0
  288.          ENDIF
  289.  3549 CONTINUE
  290. *
  291. *  ON LES PASSE DANS LE REPERE LOCAL
  292. *
  293.       CALL MATVEC(FOVOL,XFOLO,BPSS,1)
  294. C
  295. C  ON CALCULE LES FORCES NODALES
  296. C
  297.       DO 3649 J=1,LRE
  298.          r_z =   BGENE(1,J)*XFOLO(1) + BGENE(2,J)*XFOLO(2)
  299.      &         + BGENE(3,J)*XFOLO(3)
  300.          XFORC(J) = XFORC(J) + (r_z * DJAC)
  301.  3649 CONTINUE
  302.  
  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 9052 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.  9052 CONTINUE
  318.  3049 CONTINUE
  319. C
  320. C     IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  321. C
  322.       IF(IG1.NE.0) THEN
  323.          INTERR(1)=IG1
  324.          CALL ERREUR(323)
  325.       ENDIF
  326.       SEGSUP WRK1,WRK2,WRK4
  327.       GOTO 510
  328. C_______________________________________________________________________
  329. C
  330. C  ELEMENT JOINT JOI4
  331. C_______________________________________________________________________
  332. C
  333.    88 CONTINUE
  334. C
  335. C      CAS NON PREVU
  336.       GO TO 99
  337. C
  338. C_______________________________________________________________________
  339. C
  340. C     ELEMENT DST
  341. C_______________________________________________________________________
  342. C
  343.   93  CONTINUE
  344. C
  345. C      CAS NON PREVU
  346.       GO TO 99
  347. C
  348. C_______________________________________________________________________
  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.  

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