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

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