Télécharger la plaquette Cast3M


fr en

Télécharger dfour1.eso

Retour à la liste

Numérotation des lignes : 

dfour1

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

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