Télécharger la plaquette Cast3M


fr en

Télécharger gnfl1.eso

Retour à la liste

Numérotation des lignes : 

gnfl1

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

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