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/21    21:16:42     12166          
  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. -INC TMPTVAL
  43.  
  44.       segment netn(notn)
  45.       segment ietn(letn)
  46.  
  47.       SEGMENT MWORK
  48.         REAL*8 XE(3,NBNN)
  49.       ENDSEGMENT
  50.  
  51.       idimp1 = IDIM+1
  52. *   prob optimiseur il faut initialiser melva1
  53.       MELVA1=IVAFOR
  54.       IF (IPTVPR.NE.0) THEN
  55.         MELVA1=IPTVPR
  56. c*        SEGACT,MELVA1                            <- ACTIF EN E/S
  57.         IG11 = MELVA1.VELCHE(/1)
  58.         IB12 = MELVA1.VELCHE(/2)
  59.       ENDIF
  60.  
  61.       MINTE=IPTINT
  62. C*      SEGACT,MINTE                               <- ACTIF EN E/S
  63.       NBPGAU=POIGAU(/1)
  64.  
  65.       MELEME = IPMAIL
  66. c*      SEGACT,MELEME                              <- ACTIF EN E/S
  67.       NBNN   = meleme.NUM(/1)
  68.       NBELEM = meleme.NUM(/2)
  69.  
  70.       SEGINI,MWORK
  71.  
  72.       netn = netn1
  73.       ietn = ietn1
  74.       ipt1 = ipmaim
  75.       IF (IPT1.GT.0) THEN
  76.         if (netn.eq.0 .or. ietn.eq.0) then
  77.           write(ioimp,*) 'FPMA2D : incompatibilite netn, ietn & IPMAIM'
  78.         endif
  79. c*        SEGACT,IPT1                                <- ACTIF en E/S
  80.         nbnn1 = ipt1.num(/1)
  81.         nbel1 = ipt1.num(/2)
  82.       ELSE
  83.         if (netn.gt.0 .or. ietn.gt.0) then
  84.           write(ioimp,*) 'FPMA2D : incompatibilite netn, ietn & IPMAIM'
  85.         endif
  86.       ENDIF
  87. C
  88. C     BOUCLE SUR LES ELEMENTS
  89. C
  90.       DO IB = 1, NBELEM
  91.  
  92.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  93.  
  94.         XFLOT = +1.D0
  95.         IF (netn.GT.0) THEN
  96.           DO inf = 1, nbnn
  97.             ip = meleme.num(inf,ib)
  98.             ideb = netn(ip)+1
  99.             ifin = netn(ip+1)
  100.             do itn = ideb, ifin
  101.               IEM = ietn(itn)
  102.               jne = 0
  103.               do i = 1, nbnn
  104.                 ino = meleme.num(i,ib)
  105.                 do i1 = 1, nbnn1
  106.                   if (ino.eq.ipt1.num(i1,IEM)) jne=jne+1
  107.                 enddo
  108.               enddo
  109.               if (jne.eq.nbnn) goto 170
  110.             enddo
  111.           ENDDO
  112.           CALL ERREUR(26)
  113.           GOTO 9900
  114.  170      continue
  115.           XG = 0.D0
  116.           YG = 0.D0
  117.           DO I = 1, NBNN1
  118.             ino = (IPT1.NUM(I,IEM)-1)*idimp1
  119.             XG=XG+XCOOR(ino+1)
  120.             YG=YG+XCOOR(ino+2)
  121.           ENDDO
  122.           XG=XG / NBNN1
  123.           YG=YG / NBNN1
  124.  
  125.           XK=0.D0
  126.           YK=0.D0
  127.           DO i = 1,NBNN
  128.             XK=XK+XE(1,I)
  129.             YK=YK+XE(2,I)
  130.           ENDDO
  131.           XK=XK/NBNN
  132.           YK=YK/NBNN
  133.  
  134.           V_1 = XG - XK
  135.           V_2 = YG - YK
  136.           r_z = 1.D0 / SQRT(V_1*V_1+V_2*V_2)
  137.           V_1 = V_1 * r_z
  138.           V_2 = V_2 * r_z
  139.         ENDIF
  140. C
  141. C     BOUCLE SUR LES POINTS DE GAUSS
  142. C
  143.         DO IGAU = 1, NBPGAU
  144. C
  145. C   RECUPERATION DE L'EPAISSEUR
  146. C
  147.           DIM3=1.D0
  148.           MPTVAL=IVACAR
  149.           IF (IVACAR.NE.0 .AND. IFOUR.EQ.-2) THEN
  150.             MELVAL=IVAL(1)
  151.             IF (MELVAL.NE.0) THEN
  152.               IGMN=MIN(IGAU,VELCHE(/1))
  153.               IBMN=MIN(IB,VELCHE(/2))
  154.               DIM3=VELCHE(IGMN,IBMN)
  155.             ENDIF
  156.           ENDIF
  157.  
  158.           VNQSI1 = 0.D0
  159.           VNQSI2 = 0.D0
  160.           R = 0.D0
  161.           DO I = 1, NBNN
  162.             VNQSI1 = VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  163.             VNQSI2 = VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  164.             R      = R+SHPTOT(1,I,IGAU)*XE(1,I)
  165.           ENDDO
  166.  
  167.           VNN1 = -VNQSI2
  168.           VNN2 =  VNQSI1
  169.  
  170.           if (igau.eq.1.and.netn.gt.0) then
  171.             vnnn = 1.D0 / sqrt(vnn1*vnn1+vnn2*vnn2)
  172.             test = v_1*(vnn1*vnnn) + v_2*(vnn2*vnnn)
  173.             if (test.lt.0d0) xflot = -1.d0
  174.           endif
  175.  
  176.           IF (IFOUR.LT.0) THEN
  177.             R=1.D0
  178.           ELSEIF (IFOUR.EQ.0.OR.(IFOUR.EQ.1
  179.      +              .AND.NIFOUR.EQ.0)) THEN
  180.              R=X2PI*R
  181.           ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  182.              R=XPI*R
  183.           ENDIF
  184.           r_z = POIGAU(IGAU) * R * DIM3 * XFLOT
  185.           IF (IPTVPR.NE.0) THEN
  186.             IGMN=MIN(IGAU,IG11)
  187.             IBMN=MIN(IB  ,IB12)
  188.             r_z = r_z * MELVA1.VELCHE(IGMN,IBMN)
  189.           ELSE
  190.             r_z = r_z * XP
  191.           ENDIF
  192.           T1 = r_z * VNN1
  193.           T2 = r_z * VNN2
  194.  
  195.           MPTVAL=IVAFOR
  196.           MELVAL=IVAL(1)
  197.           DO i=1,NBNN
  198.             VELCHE(i,IB) = VELCHE(i,IB) + SHPTOT(1,i,IGAU)*T1
  199.           ENDDO
  200.           MELVAL=IVAL(2)
  201.           DO i=1,NBNN
  202.             VELCHE(i,IB) = VELCHE(i,IB) + SHPTOT(1,i,IGAU)*T2
  203.           ENDDO
  204.  
  205.         ENDDO
  206.  
  207.       ENDDO
  208.  
  209.  9900 CONTINUE
  210.       SEGSUP,MWORK
  211. c*      SEGDES,MINTE                               <- ACTIF en E/S
  212. c*      SEGDES,MELEME                              <- ACTIF en E/S
  213. c*      IF (IPTVPR.NE.0) SEGDES,MELVA1             <- ACTIF en E/S
  214.  
  215.       RETURN
  216.       END
  217.  
  218.  
  219.  

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