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    PV090527  26/04/30    21:15:36     12529          
  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      J=1,LPP
  188.           JX = J + LPPDEC
  189.           JB = J + NBBDEC
  190.          DO      K=1,NSTBE
  191.             KB = K + NSTDEC
  192.             XFORC(JX)=XFORC(JX)+ DJAC*BGENE(KB,JB)*VECO(KB)
  193.          enddo    
  194.          enddo    
  195.  9179 CONTINUE
  196. *
  197.  5079 CONTINUE
  198. *
  199.       IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  200. *
  201. C
  202. C     ON RANGE XFORC DANS MELVAL
  203. C
  204.       IE=0
  205.       MPTVAL=IVAFOR
  206. C
  207.       DO 4179 IPR=1,IDECAP
  208.         MELVAL=IVAL(IPR)
  209.         DO 4079 IGAU=1,NBSOM(IELE)
  210.           IE=IE+1
  211.           IGAV  = IBSOM(NSPOS(IELE)+IGAU-1)
  212.           VELCHE(IGAV,IB)=XFORC(IE)
  213.  4079   CONTINUE
  214.  4179 CONTINUE
  215. C
  216.  3079 CONTINUE
  217.       IF(I195.NE.0) INTERR(1)=I195
  218.       IF(I195.NE.0) CALL ERREUR(195)
  219.       IF(I259.NE.0) INTERR(1)=I259
  220.       IF(I259.NE.0) CALL ERREUR(259)
  221.       SEGSUP WRK1,WRK2,WRK5
  222.       GOTO 510
  223. C
  224. C_______________________________________________________________________
  225. C
  226. C     JOINTS POREUX
  227. C_______________________________________________________________________
  228. C
  229.   80  CONTINUE
  230. C
  231. C    POUR CES ELEMENTS  NBBB = NOMBRE DE NOEUDS
  232. C                       NBNO = NOMBRE DE FONCTIONS DE FORME
  233. C
  234.       DIM3=1.D0
  235.       NBNO=IPORE
  236.       NBBB=NBNN
  237.       LPP=(NBNO-NBBB)*3/2
  238.       LRN =LPP*IDECAP
  239.       LRE=LRN
  240.       NSTBE=3
  241.       IF(IFOUR.EQ.2) NSTBE=4
  242.       NSTB=NSTBE*IDECAP
  243.       NSTN=1
  244.       NMIL=LPP-NBSOM(IELE)
  245.  
  246. *      PRINT *,'NSTBE=',NSTBE
  247. *      PRINT *,'NSTB=',NSTB
  248. *      PRINT *,'IDECAP=',IDECAP
  249. *      PRINT *,'LPP   =',LPP
  250. *      PRINT *,'LRN   =',LRN
  251. *      PRINT *,'LRE   =',LRE
  252. *      PRINT *,'NDDL  =',NDDL
  253. *      PRINT *,'NBNO  =',NBNO
  254. *      PRINT *,'NBBB  =',NBBB
  255. *      PRINT *,'NSTN  =',NSTN
  256. *      PRINT *,'IFOUR =',IFOUR
  257. *      PRINT *,'NMIL  =',NMIL
  258.  
  259.       SEGINI WRK1,WRK2,WRK3,WRK5
  260.       I195=0
  261.       I259=0
  262. C
  263.       DO 3080  IB=1,NBELEM
  264. C
  265. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  266. C
  267.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  268. C
  269. C     CALCUL DES AXES LOCAUX ET DES CORDONNES LOCALES
  270. C
  271.       CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS)
  272. C
  273. C     MISE A 0 DES FORCES NODALES
  274. C
  275.       CALL ZERO(XFORC,1,LRN)
  276. C
  277. C     BOUCLE SUR LES POINTS DE GAUSS
  278. C
  279.       ISDJC=0
  280.       DO 5080  IGAU=1,NBPGAU
  281. C
  282. C   RECUPERATION DE L'EPAISSEUR
  283. C
  284. *     IF (IFOUR.EQ.-2)THEN
  285. *       MPTVAL=IVACAR
  286. *       IF (IVACAR.NE.0) THEN
  287. *        MELVAL=IVAL(1)
  288. *        IF (MELVAL.NE.0) THEN
  289. *         IGMN=MIN(IGAU,VELCHE(/1))
  290. *         IBMN=MIN(IB,VELCHE(/2))
  291. *         DIM3=VELCHE(IGMN,IBMN)
  292. *        ELSE
  293. *         DIM3=1.D0
  294. *        ENDIF
  295. *       ENDIF
  296. *     ENDIF
  297. C
  298.       CALL BNQORJ(IGAU,NBNO,NBBB,LRE,IFOUR,NSTB,NSTN,XE,XEL,
  299.      .             SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,IDECAP,1)
  300.  
  301.       IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  302.       IF(DJAC.EQ.0.D0) I259=IB
  303.       DJAC=ABS(DJAC)*POIGAU(IGAU)
  304.  
  305. C
  306. C     ON RECUPERE LES VE_CO
  307. C
  308.       MPTVAL=IVAVCO
  309.       NCOSOU=IVAL(/1)
  310.  
  311.       DO 8080 I=1,NCOSOU
  312.          IF (IVAL(I).NE.0) THEN
  313.              MELVAL=IVAL(I)
  314.              IGMN=MIN(IGAU,VELCHE(/1))
  315.              IBMN=MIN(IB  ,VELCHE(/2))
  316.              VECO(I)=VELCHE(IGMN,IBMN)
  317.          ELSE
  318.              VECO(I)=0.D0
  319.          ENDIF
  320.  8080  CONTINUE
  321.  
  322. *
  323. *     CALCUL DES FORCES NODALES EQUIVALENTES
  324. *
  325.        DO 9180 IPR=1,IDECAP
  326.          LPPDEC=(IPR-1)*LPP
  327.          NSTDEC=(IPR-1)*NSTBE
  328.          DO      J=1,LPP
  329.           JJ = J + LPPDEC
  330.           DO      K=1,NSTBE
  331.             KB = K + NSTDEC
  332.             XFORC(JJ)=XFORC(JJ)+ DJAC*BGENE(KB,JJ)*VECO(KB)
  333.           enddo  
  334.          enddo  
  335.  9180  CONTINUE
  336. *
  337.  5080 CONTINUE
  338. *
  339.  
  340. *        WRITE(6,78655) (VECO(IE),IE=1,NSTBE)
  341. *78655 FORMAT( 2X, 'VECTEUR VECO' /(4(1X,1PE12.5)/))
  342.  
  343. *        WRITE(6,78654) (XFORC(IE),IE=1,LPP)
  344. *78654 FORMAT( 2X, 'VECTEUR XFORC' /(4(1X,1PE12.5)/))
  345.  
  346.       IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  347. C
  348. C     ON RANGE XFORC DANS MELVAL
  349. C
  350. *     PRINT *, 'NBSOM(IELE) =', NBSOM(IELE)
  351.  
  352.       IE=0
  353.       MPTVAL=IVAFOR
  354.       DO 4180 IPR=1,IDECAP
  355.         MELVAL=IVAL(IPR)
  356.         DO 4080 I=1,NBSOM(IELE)
  357.           IE=IE+1
  358.           IGAV  = IBSOM(NSPOS(IELE)+I-1)
  359.           VELCHE(IGAV,IB)=XFORC(IE)
  360.  4080   CONTINUE
  361. *
  362.         DO 4081 IGAU=1,NMIL
  363.           IE=IE+1
  364.           IGAV  = NBBB - NMIL + IGAU
  365.           VELCHE(IGAV,IB)=XFORC(IE)
  366.  4081   CONTINUE
  367. *
  368.  4180 CONTINUE
  369. C
  370.  3080 CONTINUE
  371.       IF(I195.NE.0) INTERR(1)=I195
  372.       IF(I195.NE.0) CALL ERREUR(195)
  373.       IF(I259.NE.0) INTERR(1)=I259
  374.       IF(I259.NE.0) CALL ERREUR(259)
  375.       SEGSUP WRK1,WRK2,WRK3,WRK5
  376.       GOTO 510
  377. C_______________________________________________________________________
  378. C
  379.   99  CONTINUE
  380.       MOTERR(1:4)=NOMTP(MELE)
  381.       MOTERR(5:8)='GNFL'
  382.       CALL ERREUR(86)
  383. C
  384.   510 CONTINUE
  385.       RETURN
  386.       END
  387.  
  388.  
  389.  
  390.  
  391.  

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