Télécharger la plaquette Cast3M


fr en

Télécharger pschpt.eso

Retour à la liste

Numérotation des lignes : 

pschpt

  1. C PSCHPT    SOURCE    CB215821  20/11/25    13:37:50     10792          
  2.       SUBROUTINE PSCHPT(IRAID,IMASS,MTRAV,ICHPT,TYP,ICHP1)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. *                             P S C H P T
  8. *                             -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     calcule le pseudo-mode en d{placement pour un CHPOINT.
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18. -INC CCHAMP
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCHPOI
  23. *
  24. * PARAMETRES:   (e)=entr{e   (s)=sortie
  25. * -----------
  26. *
  27. *     IRAID   (e)  pointeur sur la matrice K de la structure.
  28. *     IMASS   (e)  pointeur sur la matrice M de la structure.
  29. *     MTRAV   (e)  pointeur sur un segment contenant les modes.
  30. *     ICHPT   (e)  pointeur sur le chpoint force.
  31. *     TYP     (e)  = 'FORC', chpoint de type force.
  32. *                  = 'DEPL', chpoint de type d{placement.
  33. *     ICHP1   (s)  pointeur sur le pseudo-mode en d{placement.
  34. *
  35. *
  36.       SEGMENT MTRAV
  37.         REAL*8 FREQ(NBMODE),MN(NBMODE),MW2(NBMODE),
  38.      &         QX(NBMODE),QY(NBMODE),QZ(NBMODE)
  39.         INTEGER DEPL(NBMODE)
  40.       ENDSEGMENT
  41. *
  42. *
  43. * VARIABLES:
  44. * ----------
  45. *
  46.       CHARACTER*(*)      TYP
  47.       CHARACTER*(LOCOMP) NOM,LNOM
  48. *
  49. *
  50. * AUTEUR, DATE DE CREATION:
  51. * -------------------------
  52. *
  53. *     Lionel VIVAN       Avril 1990
  54. *
  55. ************************************************************************
  56. *
  57.       ICHP1  = 0
  58. *
  59.       IF (TYP.EQ.'FORC') THEN
  60.          I5 = 1
  61.          CALL COPIE2(ICHPT,ICHP2)
  62.          MCHPOI = ICHP2
  63.          SEGACT MCHPOI
  64.          NSOU = IPCHP(/1)
  65.          DO 10 I = 1,NSOU
  66.             MSOUPO = IPCHP(I)
  67.             SEGACT MSOUPO
  68.             NC = NOCOMP(/2)
  69. *
  70. *           liste des composantes
  71. *
  72.             DO 20 I4 = 1,NC
  73.                NOM = NOCOMP(I4)
  74.                CALL PLACE(NOMDU,40,INOM,NOM)
  75.                LNOM = NOMDD(INOM)
  76.                IF (I4.EQ.1 .AND. I.EQ.1) THEN
  77.                   CALL ECRCHA(NOM)
  78.                   CALL MOTS
  79.                   IF (IERR.NE.0) RETURN
  80.                   CALL LIROBJ('LISTMOTS',IMOT1,1,IRETOU)
  81.                   IF (IERR.NE.0) RETURN
  82.                   CALL ECRCHA(LNOM)
  83.                   CALL MOTS
  84.                   IF (IERR.NE.0) RETURN
  85.                   CALL LIROBJ('LISTMOTS',IMOT2,1,IRETOU)
  86.                   IF (IERR.NE.0) RETURN
  87.                ELSE
  88.                   I5 = I5 + 1
  89.                   CALL INSER3(IMOT1,I5,NOM)
  90.                   IF (IERR.NE.0) RETURN
  91.                   CALL INSER3(IMOT2,I5,LNOM)
  92.                   IF (IERR.NE.0) RETURN
  93.                ENDIF
  94.  20            CONTINUE
  95. *           end do
  96.             SEGDES MSOUPO
  97.  10         CONTINUE
  98. *           end do
  99.          SEGDES MCHPOI
  100.       ENDIF
  101. *
  102.       SEGACT MTRAV
  103.       NBMODE = FREQ(/1)
  104. *
  105. *     r{solution du syst}me statique
  106. *
  107.       IF (TYP.EQ.'DEPL') THEN
  108.          CALL MUCHPO(ICHPT,-1.D0,ICHP3,1)
  109.          IF (IERR.NE.0) RETURN
  110.          CALL MUCPRI(ICHP3,IMASS,ICHP2)
  111.          IF (IERR.NE.0) RETURN
  112.          CALL DECHPO(ICHP3)
  113.          IF (IERR.NE.0) RETURN
  114.       ENDIF
  115.       CALL ECROBJ('CHPOINT ',ICHP2)
  116.       CALL ECROBJ('RIGIDITE',IRAID)
  117.       CALL RESOU
  118.       IF (IERR.NE.0) RETURN
  119.       CALL LIROBJ('CHPOINT ',ICHPST,1,IRETOU)
  120.       IF (IERR.NE.0) RETURN
  121. *
  122. *     r{solution du syst}me dynamique
  123. *
  124.       DO 30 ID = 1,NBMODE
  125.          IPHI = DEPL(ID)
  126.          IF (TYP.EQ.'FORC') THEN
  127.             CALL XTY1(IPHI,ICHP2,IMOT2,IMOT1,XPHINF)
  128.             IF (IERR.NE.0) RETURN
  129.             XFLOT = XPHINF / MW2(ID)
  130.          ELSE IF (TYP.EQ.'DEPL') THEN
  131.             CALL YTMX(IPHI,ICHPT,IMASS,RNI)
  132.             IF (IERR.NE.0) RETURN
  133.             XFLOT = -1.D0 * RNI / MW2(ID)
  134.          ENDIF
  135.          IF (ID .EQ. 1) THEN
  136.             CALL MUCHPO(IPHI,XFLOT,ICHPDY,1)
  137.             IF (IERR.NE.0) RETURN
  138.          ELSE
  139.             CALL ADCHPO(ICHPDY,IPHI,ICHP4,1D0,XFLOT)
  140.             IF (IERR.NE.0) RETURN
  141.             CALL DECHPO(ICHPDY)
  142.             IF (IERR.NE.0) RETURN
  143.             ICHPDY = ICHP4
  144.          ENDIF
  145.  30      CONTINUE
  146. *     end do
  147. *
  148. *     calcul du pseudo-mode
  149. *
  150.       CALL ADCHPO(ICHPST,ICHPDY,ICHP1,1D0,-1D0)
  151.       IF (IERR.NE.0) RETURN
  152.       CALL DECHPO(ICHPST)
  153.       IF (IERR.NE.0) RETURN
  154.       CALL DECHPO(ICHPDY)
  155.       IF (IERR.NE.0) RETURN
  156.       CALL DECHPO(ICHP2)
  157.       IF (IERR.NE.0) RETURN
  158. *
  159.       SEGDES MTRAV
  160. *
  161.       END
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  

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