Télécharger dfour1.eso

Retour à la liste

Numérotation des lignes :

  1. C DFOUR1 SOURCE BP208322 15/06/22 21:17:08 8543
  2. SUBROUTINE DFOUR1(ICHPO,ANGL,IRET)
  3. C====================================================================
  4. C
  5. C ENTREES
  6. C ICHPO = CHPOINT DE TYPE FORCES OU DEPLACEMENTS
  7. C ANGL = ANGLE
  8. C SORTIES
  9. C IRET = SI SUCCES , CHPT CONTENANT LES VALEURS POUR L ANGLE DONNE
  10. C 0 SINON
  11. C
  12. C J BROCHARD MARS 87
  13. C=====================================================================
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8(A-H,O-Z)
  16. -INC CCOPTIO
  17. -INC CCREEL
  18. -INC CCHAMP
  19. -INC SMCHPOI
  20. CHARACTER*4 CPV
  21. C
  22. ANGL=(ANGL*XPI)/180.D0
  23. C
  24. C-------ON VERIFIE QUE IFOPOI EST BIEN EGAL A 1
  25. C
  26. MCHPO1=ICHPO
  27. SEGACT MCHPO1
  28. IF (MCHPO1.IFOPOI.NE.1) THEN
  29. MOTERR(1:8)='FOURIER'
  30. CALL ERREUR(333)
  31. IRET=0
  32. GOTO 999
  33. ENDIF
  34. C
  35. C-------BOUCLE SUR LES COMPOSANTES
  36. C ON MULTIPLIE LES VALEURS PAR COSNT POUR LES COMPOSANTES SUIVANTES
  37. C UR,UZ,RT,P,PI,FR,FZ,MT,FP,FPI ET PAR SINNT LES COMPOSANTES SUIVANTES
  38. C UT,RZ,FT,MZ.LES VALEURS SUR LES COMPOSANTES LX ET FLX SONT INCHANGEES
  39. C
  40. NSOUPO=MCHPO1.IPCHP(/1)
  41. NAT=MCHPO1.JATTRI(/1)
  42. SEGINI MCHPOI
  43. IRET=MCHPOI
  44. MTYPOI=MCHPO1.MTYPOI
  45. MOCHDE=MCHPO1.MOCHDE
  46. IFOPOI=1
  47. DO 100 IA=1,NSOUPO
  48. MSOUP1=MCHPO1.IPCHP(IA)
  49. SEGACT MSOUP1
  50. NC=MSOUP1.NOCOMP(/2)
  51. SEGINI MSOUPO
  52. IPCHP(IA)=MSOUPO
  53. IGEOC=MSOUP1.IGEOC
  54. MPOVA1=MSOUP1.IPOVAL
  55. SEGACT MPOVA1
  56. N=MPOVA1.VPOCHA(/1)
  57. SEGINI MPOVAL
  58. IPOVAL=MPOVAL
  59. DO 120 IC=1,NC
  60. NOCOMP(IC)=MSOUP1.NOCOMP(IC)
  61. NOHARM(IC)=MSOUP1.NOHARM(IC)
  62. COSNT=COS(NOHARM(IC)*ANGL)
  63. SINNT=SIN(NOHARM(IC)*ANGL)
  64. IF(NOHARM(IC).LT.0) THEN
  65. CNT=SINNT
  66. SINNT=COSNT
  67. COSNT=CNT
  68. ENDIF
  69. *
  70. * ON METS NOHARM A ZERO POUR POUVOIR ADDITIONNER DES CHPOINTS DE
  71. * SERIE DE FOURRIER DIFFERENTES.(CHARRAS)
  72. *
  73. NOHARM(IC)=0
  74. CPV=NOCOMP(IC)
  75. IF(CPV.EQ.NOMDD(7).OR.CPV.EQ.NOMDD(3).OR.
  76. S CPV.EQ.NOMDD(9).OR.CPV.EQ.NOMDD(14).OR.
  77. S CPV.EQ.NOMDD(15).OR.CPV.EQ.NOMDU(7).OR.
  78. S CPV.EQ.NOMDU(3).OR.CPV.EQ.NOMDU(9).OR.
  79. S CPV.EQ.NOMDU(14).OR.CPV.EQ.NOMDU(15)) THEN
  80. DO 130 IE=1,N
  81. VPOCHA(IE,IC)=MPOVA1.VPOCHA(IE,IC)*COSNT
  82. 130 CONTINUE
  83. ELSE IF(CPV.EQ.NOMDD(8).OR.CPV.EQ.NOMDU(8).OR.
  84. S CPV.EQ.NOMDD(6).OR.CPV.EQ.NOMDU(6)) THEN
  85. DO 131 IE=1,N
  86. VPOCHA(IE,IC)=MPOVA1.VPOCHA(IE,IC)*SINNT
  87. 131 CONTINUE
  88. ELSE IF(CPV.EQ.NOMDD(10).OR.CPV.EQ.NOMDU(10)) THEN
  89. DO 132 IE=1,N
  90. VPOCHA(IE,IC)=MPOVA1.VPOCHA(IE,IC)
  91. 132 CONTINUE
  92. ELSE
  93. MOTERR(1:8)='FOURIER'
  94. CALL ERREUR(335)
  95. IRET=0
  96. SEGSUP MPOVAL,MSOUPO,MCHPOI
  97. SEGDES MPOVA1,MSOUP1
  98. GOTO 999
  99. ENDIF
  100. 120 CONTINUE
  101. 666 CONTINUE
  102. SEGDES MPOVA1,MPOVAL
  103. SEGDES MSOUP1,MSOUPO
  104. 100 CONTINUE
  105. SEGDES MCHPOI
  106. 999 CONTINUE
  107. SEGDES MCHPO1
  108. RETURN
  109. END
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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