Télécharger la plaquette Cast3M


fr en

Télécharger fpma2d.eso

Retour à la liste

Numérotation des lignes : 

fpma2d

  1. C FPMA2D    SOURCE    OF166741  25/02/06    21:15:04     12146          
  2.  
  3. C____________________________________________________________________
  4. C   CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS
  5. C   MASSIFS BIDIMENSIONNELS
  6. C
  7. C   ENTREES :
  8. C   ---------
  9. C
  10. C    IPTVPR  POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  11. C            0  SI ON A DONNE UNE VALEUR CONSTANTE
  12. C    IPMAIL  POINTEUR SUR UN OBJET GEOMETRIQUE
  13. C    IPTINT  POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  14. C            (ACTIF EN ENTREE ET EN SORTIE SANS MODIFICATION)
  15. C    IVAFOR  POINTEUR SUR UN MPTVAL ET LES MELVALS CONTENANT LES FORCES
  16. C            NODALE RESULTANTES
  17. C    IVACAR  POINTEUR SUR UN MELVAL DE CARACTERISTIQUES
  18. C
  19. C      JACQUELINE BROCHARD  AVRIL 85
  20. C
  21. C      PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 17 09 90
  22. C
  23. C____________________________________________________________________
  24.  
  25.       SUBROUTINE FPMA2D(IPTVPR,IPMAIL,ipmaim,IPTINT,IVAFOR,IVACAR,XP
  26.      &                 ,netn1,ietn1)
  27.  
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8 (A-H,O-Z)
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCREEL
  34. C= Quelques constantes (2.Pi)
  35.       PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  36.  
  37. -INC SMCHAML
  38. -INC SMELEME
  39. -INC SMINTE
  40. -INC SMCOORD
  41.  
  42.       segment netn(notn)
  43.       segment ietn(letn)
  44.  
  45.       SEGMENT MWORK
  46.         REAL*8 XE(3,NBNN)
  47.       ENDSEGMENT
  48.  
  49.       SEGMENT MPTVAL
  50.         INTEGER IPOS(NS),NSOF(NS)
  51.         INTEGER      IVAL(NCOSOU)
  52.         CHARACTER*16 TYVAL(NCOSOU)
  53.       ENDSEGMENT
  54.  
  55.       idimp1 = IDIM+1
  56. *   prob optimiseur il faut initialiser melva1
  57.       MELVA1=IVAFOR
  58.       IF (IPTVPR.NE.0) THEN
  59.         MELVA1=IPTVPR
  60. c*        SEGACT,MELVA1                            <- ACTIF EN E/S
  61.         IG11 = MELVA1.VELCHE(/1)
  62.         IB12 = MELVA1.VELCHE(/2)
  63.       ENDIF
  64.  
  65.       MINTE=IPTINT
  66. C*      SEGACT,MINTE                               <- ACTIF EN E/S
  67.       NBPGAU=POIGAU(/1)
  68.  
  69.       MELEME = IPMAIL
  70. c*      SEGACT,MELEME                              <- ACTIF EN E/S
  71.       NBNN   = meleme.NUM(/1)
  72.       NBELEM = meleme.NUM(/2)
  73.  
  74.       SEGINI,MWORK
  75.  
  76.       netn = netn1
  77.       ietn = ietn1
  78.       ipt1 = ipmaim
  79.       IF (IPT1.GT.0) THEN
  80.         if (netn.eq.0 .or. ietn.eq.0) then
  81.           write(ioimp,*) 'FPMA2D : incompatibilite netn, ietn & IPMAIM'
  82.         endif
  83. c*        SEGACT,IPT1                                <- ACTIF en E/S
  84.         nbnn1 = ipt1.num(/1)
  85.         nbel1 = ipt1.num(/2)
  86.       ELSE
  87.         if (netn.gt.0 .or. ietn.gt.0) then
  88.           write(ioimp,*) 'FPMA2D : incompatibilite netn, ietn & IPMAIM'
  89.         endif
  90.       ENDIF
  91. C
  92. C     BOUCLE SUR LES ELEMENTS
  93. C
  94.       DO IB = 1, NBELEM
  95.  
  96.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  97.  
  98.         XFLOT = +1.D0
  99.         IF (netn.GT.0) THEN
  100.           DO inf = 1, nbnn
  101.             ip = meleme.num(inf,ib)
  102.             ideb = netn(ip)+1
  103.             ifin = netn(ip+1)
  104.             do itn = ideb, ifin
  105.               IEM = ietn(itn)
  106.               jne = 0
  107.               do i = 1, nbnn
  108.                 ino = meleme.num(i,ib)
  109.                 do i1 = 1, nbnn1
  110.                   if (ino.eq.ipt1.num(i1,IEM)) jne=jne+1
  111.                 enddo
  112.               enddo
  113.               if (jne.eq.nbnn) goto 170
  114.             enddo
  115.           ENDDO
  116.           CALL ERREUR(26)
  117.           GOTO 9900
  118.  170      continue
  119.           XG = 0.D0
  120.           YG = 0.D0
  121.           DO I = 1, NBNN1
  122.             ino = (IPT1.NUM(I,IEM)-1)*idimp1
  123.             XG=XG+XCOOR(ino+1)
  124.             YG=YG+XCOOR(ino+2)
  125.           ENDDO
  126.           XG=XG / NBNN1
  127.           YG=YG / NBNN1
  128.  
  129.           XK=0.D0
  130.           YK=0.D0
  131.           DO i = 1,NBNN
  132.             XK=XK+XE(1,I)
  133.             YK=YK+XE(2,I)
  134.           ENDDO
  135.           XK=XK/NBNN
  136.           YK=YK/NBNN
  137.  
  138.           V_1 = XG - XK
  139.           V_2 = YG - YK
  140.           r_z = 1.D0 / SQRT(V_1*V_1+V_2*V_2)
  141.           V_1 = V_1 * r_z
  142.           V_2 = V_2 * r_z
  143.         ENDIF
  144. C
  145. C     BOUCLE SUR LES POINTS DE GAUSS
  146. C
  147.         DO IGAU = 1, NBPGAU
  148. C
  149. C   RECUPERATION DE L'EPAISSEUR
  150. C
  151.           DIM3=1.D0
  152.           MPTVAL=IVACAR
  153.           IF (IVACAR.NE.0 .AND. IFOUR.EQ.-2) 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.             ENDIF
  160.           ENDIF
  161.  
  162.           VNQSI1 = 0.D0
  163.           VNQSI2 = 0.D0
  164.           R = 0.D0
  165.           DO I = 1, NBNN
  166.             VNQSI1 = VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  167.             VNQSI2 = VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  168.             R      = R+SHPTOT(1,I,IGAU)*XE(1,I)
  169.           ENDDO
  170.  
  171.           VNN1 = -VNQSI2
  172.           VNN2 =  VNQSI1
  173.  
  174.           if (igau.eq.1.and.netn.gt.0) then
  175.             vnnn = 1.D0 / sqrt(vnn1*vnn1+vnn2*vnn2)
  176.             test = v_1*(vnn1*vnnn) + v_2*(vnn2*vnnn) 
  177.             if (test.lt.0d0) xflot = -1.d0
  178.           endif
  179.  
  180.           IF (IFOUR.LT.0) THEN
  181.             R=1.D0
  182.           ELSEIF (IFOUR.EQ.0.OR.(IFOUR.EQ.1
  183.      +              .AND.NIFOUR.EQ.0)) THEN
  184.              R=X2PI*R
  185.           ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  186.              R=XPI*R
  187.           ENDIF
  188.           r_z = POIGAU(IGAU) * R * DIM3 * XFLOT
  189.           IF (IPTVPR.NE.0) THEN
  190.             IGMN=MIN(IGAU,IG11)
  191.             IBMN=MIN(IB  ,IB12)
  192.             r_z = r_z * MELVA1.VELCHE(IGMN,IBMN)
  193.           ELSE
  194.             r_z = r_z * XP
  195.           ENDIF
  196.           T1 = r_z * VNN1
  197.           T2 = r_z * VNN2
  198.  
  199.           MPTVAL=IVAFOR
  200.           MELVAL=IVAL(1)
  201.           DO i=1,NBNN
  202.             VELCHE(i,IB) = VELCHE(i,IB) + SHPTOT(1,i,IGAU)*T1
  203.           ENDDO
  204.           MELVAL=IVAL(2)
  205.           DO i=1,NBNN
  206.             VELCHE(i,IB) = VELCHE(i,IB) + SHPTOT(1,i,IGAU)*T2
  207.           ENDDO
  208.  
  209.         ENDDO
  210.  
  211.       ENDDO
  212.  
  213.  9900 CONTINUE
  214.       SEGSUP,MWORK
  215. c*      SEGDES,MINTE                               <- ACTIF en E/S
  216. c*      SEGDES,MELEME                              <- ACTIF en E/S
  217. c*      IF (IPTVPR.NE.0) SEGDES,MELVA1             <- ACTIF en E/S
  218.  
  219.       RETURN
  220.       END
  221.  
  222.  
  223.  

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