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    PV090527  26/07/20    21:15:02     12601          
  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   iel = 1, nbele
  193.             DO   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.             enddo 
  200.           enddo 
  201. ***       SEGDES,meleme
  202.         ENDIF
  203.  
  204. ***     SEGDES,IMODEL
  205. *
  206.  10   CONTINUE
  207.  
  208. ***   SEGDES,MMODEL
  209.  
  210. * on ne se casse pas trop la tete. On calcule la force en passant
  211. * par la masse
  212.       CALL MASSE1(ipmodl,mchelm,ipmas,iret,0)
  213.       CALL DTCHAM(mchelm)
  214.       IF (IERR.NE.0 .OR. iret.NE.1) RETURN
  215.  
  216.       IF (IPVECT.NE.0) THEN
  217.         NNIN = IDIM
  218.         SEGINI,mtrav
  219.         inco(1) = 'UX  '
  220.         inco(2) = 'UY  '
  221.         IF (IDIM.EQ.3) THEN
  222.           inco(3) = 'UZ  '
  223.         ENDIF
  224.         ii = 0
  225.         DO inoe = 1, nbpts
  226.           IF (indic(inoe) .EQ. 1) THEN
  227.             ii = ii + 1
  228.             igeo(ii)= inoe
  229.             DO 4 k = 1, IDIM
  230.               bb(k,ii) = vf(k)
  231.               ibin(k,ii) = 1
  232.  4          CONTINUE
  233.             IF (ii.EQ.NNNOE) GOTO 401
  234.           ENDIF
  235.         ENDDO
  236.  401    CONTINUE
  237.         CALL CRECHP(mtrav,ipchp2)
  238.         SEGSUP,mtrav,indic
  239.       ELSE
  240. * noms des variables possibles
  241. * et de leurs duales
  242.         jgn = 4
  243.         IF (IDIM.EQ.3) THEN
  244.           jgm = 6
  245.           SEGINI,mlmot1
  246.           mlmot1.mots(1) = 'FX  '
  247.           mlmot1.mots(2) = 'FY  '
  248.           mlmot1.mots(3) = 'FZ  '
  249.           mlmot1.mots(4) = 'MX  '
  250.           mlmot1.mots(5) = 'MY  '
  251.           mlmot1.mots(6) = 'MZ  '
  252.           SEGINI,mlmot2
  253.           mlmot2.mots(1) = 'UX  '
  254.           mlmot2.mots(2) = 'UY  '
  255.           mlmot2.mots(3) = 'UZ  '
  256.           mlmot2.mots(4) = 'RX  '
  257.           mlmot2.mots(5) = 'RY  '
  258.           mlmot2.mots(6) = 'RZ  '
  259. c*      ELSE IF (IDIM.EQ.2) THEN
  260.         ELSE
  261.           jgm = 3
  262.           SEGINI,mlmot1
  263.           mlmot1.mots(1) = 'FX  '
  264.           mlmot1.mots(2) = 'FY  '
  265.           mlmot1.mots(3) = 'MZ  '
  266.           SEGINI,mlmot2
  267.           mlmot2.mots(1) = 'UX  '
  268.           mlmot2.mots(2) = 'UY  '
  269.           mlmot2.mots(3) = 'RZ  '
  270.         ENDIF
  271.         iplm1 = mlmot1
  272.         iplm2 = mlmot2
  273.         CALL NOMC2(IPCHPS,iplm1,iplm2,ipchp2)
  274.         SEGSUP,mlmot1,mlmot2
  275.       ENDIF
  276.  
  277.       CALL MUCPRI(ipchp2,ipmas, IPCHPF)
  278.  
  279.       CALL DTCHPO(ipchp2)
  280.       CALL ECRCHA('ELEM')
  281.       CALL DTRIGI(ipmas)
  282.  
  283.       RETURN
  284.       END
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  

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