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    OF166741  25/02/21    21:15:33     12166          
  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 7028 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.          XFORC(J) = XFORC(J) + (r_z*DJAC)
  179.  6028 CONTINUE
  180. C
  181. C     TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL
  182. C
  183.       CALL TRPOSE(BPSS)
  184.       CALL MATVEC(XFORC,XFOLO,BPSS,6)
  185.       IE=0
  186.       MPTVAL=IVAFOR
  187.       DO 9028 IGAU=1,NBNN
  188.       DO 9028 ICOMP=1,6
  189.         IE=IE+1
  190.         MELVAL=IVAL(ICOMP)
  191.         VELCHE(IGAU,IB)=XFOLO(IE)
  192.  9028 CONTINUE
  193.  3028 CONTINUE
  194.       SEGSUP WRK1,WRK2,WRK3,WRK4
  195.       GOTO 510
  196. C_______________________________________________________________________
  197. C_______________________________________________________________________
  198. C
  199. C    ELEMENTS COQ6 ET COQ8
  200. C_______________________________________________________________________
  201. C
  202.   41  CONTINUE
  203. C
  204. C      CAS NON PREVU
  205.       GO TO 99
  206. C
  207. C_______________________________________________________________________
  208. C_______________________________________________________________________
  209. C
  210. C  ELEMENT COQ2
  211. C_______________________________________________________________________
  212. C
  213.    44 CONTINUE
  214. C
  215. C      CAS NON PREVU
  216.       GO TO 99
  217. C
  218. C_______________________________________________________________________
  219. C_______________________________________________________________________
  220. C
  221. C  ELEMENT COQ4
  222. C_______________________________________________________________________
  223. C
  224. C
  225.    49 CONTINUE
  226.       IG1=0
  227.       NBNO=NBNN
  228.       NBBB=NBNN
  229.       SEGINI WRK1,WRK2,WRK4
  230. C
  231.       DO 3049 IB=1,NBELEM
  232. C
  233. C  ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  234. C
  235.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  236. C
  237. C  MISE A ZERO DES FORCES  NODALES
  238. C
  239.       CALL ZERO(XFORC,1,LRE)
  240. C
  241. C  CALCUL DE LA MATRICE DE PASSAGE EN REPERE LOCAL
  242. C
  243.       CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  244. C
  245.       IF (IERT .EQ. 3) THEN
  246.          NOPLAN = 1
  247.        ELSE
  248.          NOPLAN = 0
  249.        END IF
  250. C
  251.          MPTVAL=IVACAR
  252.          MELVAL=IVAL(1)
  253.          IBMN=MIN(IB,VELCHE(/2))
  254.          EP=VELCHE(1,IBMN)
  255.          MELVAL=IVAL(2)
  256.          IF (MELVAL.NE.0) THEN
  257.             IBMN=MIN(IB,VELCHE(/2))
  258.             EXCEN =VELCHE(1,IBMN)
  259.          ELSE
  260.             EXCEN=0.D0
  261.          ENDIF
  262. C
  263. C  BOUCLE SUR LES POINTS DE GAUSS
  264. C
  265.           NBPGAM=NBPGAU-1
  266.           DO 4049 IGAU=1,NBPGAM
  267.             CALL NCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,IERT)
  268. *
  269. *           IERT=1 JACOBIANO=<0
  270.             IF (IERT.NE.0) IG1=IB
  271. *
  272.             DJAC=DJAC*POIGAU(IGAU)*EP
  273. *
  274. *  ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL
  275. *
  276.       MPTVAL=IVAFVO
  277.       ICOSOU=IVAL(/1)
  278.       DO 3549 I=1,ICOSOU
  279.          MELVAL=IVAL(I)
  280.          IF (MELVAL.NE.0) THEN
  281.              IGMN=MIN(IGAU,VELCHE(/1))
  282.              IBMN=MIN(IB  ,VELCHE(/2))
  283.              FOVOL(I)=VELCHE(IGMN,IBMN)
  284.          ELSE
  285.              FOVOL(I)=0.D0
  286.          ENDIF
  287.  3549 CONTINUE
  288. *
  289. *  ON LES PASSE DANS LE REPERE LOCAL
  290. *
  291.       CALL MATVEC(FOVOL,XFOLO,BPSS,1)
  292. C
  293. C  ON CALCULE LES FORCES NODALES
  294. C
  295.       DO 3649 J=1,LRE
  296.          r_z =   BGENE(1,J)*XFOLO(1) + BGENE(2,J)*XFOLO(2)
  297.      &         + BGENE(3,J)*XFOLO(3)
  298.          XFORC(J) = XFORC(J) + (r_z * DJAC)
  299.  3649 CONTINUE
  300.  
  301.  4049     CONTINUE
  302. C
  303. C  TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL
  304. C
  305.       CALL TRPOSE(BPSS)
  306.       CALL MATVEC(XFORC,XFOLO,BPSS,8)
  307.       IE=0
  308.       MPTVAL=IVAFOR
  309.       DO 9049 NODE=1,4
  310.       DO 9049 ICOMP=1,6
  311.         IE=IE+1
  312.         MELVAL=IVAL(ICOMP)
  313.         VELCHE(NODE,IB)=XFOLO(IE)
  314.  9049 CONTINUE
  315.  3049 CONTINUE
  316. C
  317. C     IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  318. C
  319.       IF(IG1.NE.0) THEN
  320.          INTERR(1)=IG1
  321.          CALL ERREUR(323)
  322.       ENDIF
  323.       SEGSUP WRK1,WRK2,WRK4
  324.       GOTO 510
  325. C_______________________________________________________________________
  326. C
  327. C  ELEMENT JOINT JOI4
  328. C_______________________________________________________________________
  329. C
  330.    88 CONTINUE
  331. C
  332. C      CAS NON PREVU
  333.       GO TO 99
  334. C
  335. C_______________________________________________________________________
  336. C
  337. C     ELEMENT DST
  338. C_______________________________________________________________________
  339. C
  340.   93  CONTINUE
  341. C
  342. C      CAS NON PREVU
  343.       GO TO 99
  344. C
  345. C_______________________________________________________________________
  346.    99 CONTINUE
  347.       MOTERR(1:4)=NOMTP(MELE)
  348.       MOTERR(5:9)='CNEQ2'
  349.       CALL ERREUR(86)
  350.  
  351.   510 CONTINUE
  352.       RETURN
  353.       END
  354.  
  355.  
  356.  

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