Télécharger la plaquette Cast3M


fr en

Télécharger fsurpo.eso

Retour à la liste

Numérotation des lignes : 

fsurpo

  1. C FSURPO    SOURCE    CB215821  24/04/12    21:16:08     11897          
  2.  
  3.       SUBROUTINE FSURPO(IPMODL,IPCHPS,IPVECT,IVPROJ, IPCHPF)
  4.  
  5. *_______________________________________________________________________
  6. *
  7. *   CALCULE LES FORCES NODALES EQUIVALENTES SUR DES POUTRES
  8. *
  9. *   ENTREES :
  10. *   ---------
  11. *    IPMODL   MODELE SUR LEQUEL S APPLIQUE LA DENSITE DE FORCES
  12. *    IPCHPS   CHPOINT CONTENANT LES VALEURS DE LA DENSITE DE FORCE AUX
  13. *             NOEUDS DU MODELE, SINON =0 (IPVECT NON NUL)
  14. *    IPVECT   VECTEUR (POINT) DEFINISSANT LA DENSITE DE FORCE CONSTANTE
  15. *             (=0 SI IPCHPS NON NUL)
  16. *    IVPROJ   VECTEUR (POINT) POUR LA PROJECTION (?)
  17. *
  18. *   SORTIES :
  19. *   ---------
  20. *    IPCHPF   CHPOINT DES FORCES NODALES EQUIVALENTES
  21. *             = 0 EN CAS D'ERREUR (ET IERR NON NUL AUSSI DANS CE CAS)
  22. *
  23. *   I. Politopoulos  Mars 1998
  24. *_______________________________________________________________________
  25. *
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8(A-H,O-Z)
  28.  
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32.  
  33. -INC SMMODEL
  34. -INC SMCHAML
  35. -INC SMLMOTS
  36. -INC SMCOORD
  37. -INC SMELEME
  38. -INC TMTRAV
  39.  
  40.       SEGMENT indic(nbpts)
  41.  
  42.       REAL*8 xe(3,2),vf(3)
  43.  
  44.       IPCHPF = 0
  45. *
  46. * --> VERIFICATIONS SUR LA COMPATIBILITE MODE DE CALCUL/DIMENSION
  47. *
  48.       iret = 0
  49.       IF (IDIM.EQ.3) THEN
  50.         IF (IFOUR.NE.2) iret = 1
  51.       ELSE IF (IDIM.EQ.2) THEN
  52.         IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) iret = 1
  53.       ELSE
  54.         iret = 1
  55.       ENDIF
  56.       IF (iret.NE.0) THEN
  57.         CALL ERREUR(21)
  58.         RETURN
  59.       ENDIF
  60. *
  61. * --> VERIFICATIONS SUR LE VECTEUR DE PROJECTION SI FOURNI
  62. *
  63.       IF (IVPROJ.NE.0) THEN
  64.         IREFP = (IVPROJ-1)*(IDIM+1)
  65.         VP1 = XCOOR(IREFP+1)
  66.         VP2 = XCOOR(IREFP+2)
  67.         IF (IDIM.EQ.2) THEN
  68.           VP3 = 0.D0
  69.         ELSE
  70.           VP3 = XCOOR(IREFP+3)
  71.         ENDIF
  72.         vlong = VP1*VP1 + VP2*VP2 + VP3*VP3
  73.         IF (vlong.LE.0.D0) THEN
  74.           CALL ERREUR(277)
  75.           RETURN
  76.         ENDIF
  77.         vlong = SQRT(vlong)
  78.         VP1 = VP1 / vlong
  79.         VP2 = VP2 / vlong
  80.         VP3 = VP3 / vlong
  81.       ENDIF
  82. *
  83. * SI on a donne un vecteur comme densite de forces, il faut le trans-
  84. * former en chpoint defini sur le maillage soustendant le modele :
  85. *
  86.       indic = 0
  87.       IF (IPVECT.NE.0) THEN
  88.         IREFP = (IPVECT-1)*(IDIM+1)
  89.         vf(1) = XCOOR(IREFP+1)
  90.         vf(2) = XCOOR(IREFP+2)
  91.         IF (IDIM.EQ.2) THEN
  92.           vf(3) = 0.D0
  93.         ELSE
  94.           vf(3) = XCOOR(IREFP+3)
  95.         ENDIF
  96.         vlong = vf(1)*vf(1) + vf(2)*vf(2) + vf(3)*vf(3)
  97.         IF (vlong.LE.0.D0) THEN
  98.           CALL ERREUR(277)
  99.           RETURN
  100.         ENDIF
  101. *
  102.         SEGINI,indic
  103. *
  104.         NNNOE = 0
  105.       ENDIF
  106.  
  107. * On cree un champ de materiau bidon (masse volumique)
  108.       MMODEL=IPMODL
  109.       SEGACT,MMODEL
  110. *
  111.       N1 = KMODEL(/1)
  112.       L1 = 16
  113.       N3 = 6
  114.       SEGINI,mchelm
  115.       titche = 'CARACTERISTIQUES'
  116.       ifoche = IFOUR
  117.  
  118.       IF (IDIM.EQ.3) THEN
  119.         N2 = 5
  120. *     ELSE IF (IDIM.EQ.2) THEN
  121.       ELSE
  122.         N2 = 3
  123.       ENDIF
  124.  
  125.       n1ptel = 1
  126.       n1el   = 1
  127.       n2ptel = 0
  128.       n2el   = 0
  129.  
  130.       DO 10 I = 1, N1
  131.  
  132.         IMODEL=KMODEL(I)
  133.         SEGACT,IMODEL
  134.  
  135. *        mele = nefmod
  136.         meleme = imamod
  137. *
  138.         imache(i) = imamod
  139.         conche(i) = conmod
  140. *
  141.         infche(i,1) = 0
  142.         infche(i,2) = 0
  143.         infche(i,3) = 0
  144.         infche(i,4) = infmod(6)
  145.         infche(i,5) = 0
  146.         infche(i,6) = 4
  147. *
  148.         SEGINI,mchaml
  149.         ichaml(i) = mchaml
  150. *
  151.         nomche(1) = 'RHO     '
  152.         nomche(2) = 'SECT    '
  153.         nomche(3) = 'INRZ    '
  154.         IF (IDIM.EQ.3) THEN
  155.           nomche(4) = 'INRY    '
  156.           nomche(5) = 'TORS    '
  157.         ENDIF
  158. *
  159.         DO 20 j = 1, N2
  160. * si projection
  161.           IF (j.EQ.1 .AND. IVPROJ.NE.0) THEN
  162.             SEGACT,meleme
  163.             nbelem = num(/2)
  164.             n1el = nbelem
  165.             SEGINI,melval
  166.             DO 50 iel = 1, nbelem
  167.               CALL DOXE(xcoor,IDIM,2,num,iel,xe)
  168.               vl1 = xe(1,2) - xe(1,1)
  169.               vl2 = xe(2,2) - xe(2,1)
  170.               vl3 = xe(3,2) - xe(3,1)
  171.               vlong = vl1*vl1 + vl2*vl2 + vl3*vl3
  172.               xsin  = vl1*vp1 + vl2*vp2 + vl3*vp3
  173.               xcos = SQRT( 1.d0 - (xsin*xsin / vlong) )
  174.               velche(1,iel) = xcos
  175.  50         CONTINUE
  176.             SEGDES,meleme
  177.           ELSE
  178.             n1el = 1
  179.             SEGINI,melval
  180.             velche(1,1) = 1.d0
  181.           ENDIF
  182.           ielval(j) = melval
  183.           typche(j) = 'REAL*8'
  184.  20     CONTINUE
  185.  
  186. * Si on a donne un vecteur comme densite de forces, il faut le
  187. * transformer en chpoint
  188.         IF (IPVECT.NE.0) then
  189.           SEGACT,meleme
  190.           nbnoe = num(/1)
  191.           nbele = num(/2)
  192.           DO 3 iel = 1, nbele
  193.             DO 3 n = 1, nbnoe
  194.               inoe = num(n,iel)
  195.               IF (indic(inoe) .EQ. 0) THEN
  196.                 indic(inoe) = 1
  197.                 NNNOE = NNNOE + 1
  198.               ENDIF
  199.  3        CONTINUE
  200.           SEGDES,meleme
  201.         ENDIF
  202.  
  203.         SEGDES,IMODEL
  204. *
  205.  10   CONTINUE
  206.  
  207.       SEGDES,MMODEL
  208.  
  209. * on ne se casse pas trop la tete. On calcule la force en passant
  210. * par la masse
  211.       CALL MASSE1(ipmodl,mchelm,ipmas,iret,0)
  212.       CALL DTCHAM(mchelm)
  213.       IF (IERR.NE.0 .OR. iret.NE.1) RETURN
  214.  
  215.       IF (IPVECT.NE.0) THEN
  216.         NNIN = IDIM
  217.         SEGINI,mtrav
  218.         inco(1) = 'UX  '
  219.         inco(2) = 'UY  '
  220.         IF (IDIM.EQ.3) THEN
  221.           inco(3) = 'UZ  '
  222.         ENDIF
  223.         ii = 0
  224.         DO inoe = 1, nbpts
  225.           IF (indic(inoe) .EQ. 1) THEN
  226.             ii = ii + 1
  227.             igeo(ii)= inoe
  228.             DO 4 k = 1, IDIM
  229.               bb(k,ii) = vf(k)
  230.               ibin(k,ii) = 1
  231.  4          CONTINUE
  232.             IF (ii.EQ.NNNOE) GOTO 401
  233.           ENDIF
  234.         ENDDO
  235.  401    CONTINUE
  236.         CALL CRECHP(mtrav,ipchp2)
  237.         SEGSUP,mtrav,indic
  238.       ELSE
  239. * noms des variables possibles
  240. * et de leurs duales
  241.         jgn = 4
  242.         IF (IDIM.EQ.3) THEN
  243.           jgm = 6
  244.           SEGINI,mlmot1
  245.           mlmot1.mots(1) = 'FX  '
  246.           mlmot1.mots(2) = 'FY  '
  247.           mlmot1.mots(3) = 'FZ  '
  248.           mlmot1.mots(4) = 'MX  '
  249.           mlmot1.mots(5) = 'MY  '
  250.           mlmot1.mots(6) = 'MZ  '
  251.           SEGINI,mlmot2
  252.           mlmot2.mots(1) = 'UX  '
  253.           mlmot2.mots(2) = 'UY  '
  254.           mlmot2.mots(3) = 'UZ  '
  255.           mlmot2.mots(4) = 'RX  '
  256.           mlmot2.mots(5) = 'RY  '
  257.           mlmot2.mots(6) = 'RZ  '
  258. c*      ELSE IF (IDIM.EQ.2) THEN
  259.         ELSE
  260.           jgm = 3
  261.           SEGINI,mlmot1
  262.           mlmot1.mots(1) = 'FX  '
  263.           mlmot1.mots(2) = 'FY  '
  264.           mlmot1.mots(3) = 'MZ  '
  265.           SEGINI,mlmot2
  266.           mlmot2.mots(1) = 'UX  '
  267.           mlmot2.mots(2) = 'UY  '
  268.           mlmot2.mots(3) = 'RZ  '
  269.         ENDIF
  270.         iplm1 = mlmot1
  271.         iplm2 = mlmot2
  272.         CALL NOMC2(IPCHPS,iplm1,iplm2,ipchp2)
  273.         SEGSUP,mlmot1,mlmot2
  274.       ENDIF
  275.  
  276.       CALL MUCPRI(ipchp2,ipmas, IPCHPF)
  277.  
  278.       CALL DTCHPO(ipchp2)
  279.       CALL ECRCHA('ELEM')
  280.       CALL DTRIGI(ipmas)
  281.  
  282.       RETURN
  283.       END
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  

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