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

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