Télécharger la plaquette Cast3M


fr en

Télécharger dfour2.eso

Retour à la liste

Numérotation des lignes : 

dfour2

  1. C DFOUR2    SOURCE    PV090527  25/01/07    14:42:32     12115          
  2.       SUBROUTINE DFOUR2(IPCHE1,ANGL,IPCHE2)
  3.  
  4. C====================================================================
  5. C
  6. C   ENTREES
  7. C    IPCHE1 = CHAMELEM DE TYPE CONTRAINTES OU DEFORMATIONS
  8. C    ANGL   = ANGLE
  9. C  SORTIES
  10. C    IPCHE2   = SI SUCCES , POINTEUR SUR UN MCHAML
  11. C             0 SINON
  12. C
  13. C     J BROCHARD MARS  87
  14. C     NOUVEAUX CHAMELEMS P DOWLATYARI SEP 91
  15. C=====================================================================
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8(A-H,O-Z)
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMCOORD
  22. -INC SMCHAML
  23. -INC CCREEL
  24.       CHARACTER*(LOCOMP) NOMCOM
  25.  
  26. C
  27.       ANGL=(ANGL*XPI)/180.D0
  28. C
  29. C-------ON VERIFIE QUE IFOCHE EST BIEN EGAL A 1
  30. C
  31.       MCHEL1=IPCHE1
  32.       SEGACT MCHEL1
  33.       IF(MCHEL1.IFOCHE.NE.1)THEN
  34.         MOTERR(1:8)='DFOURIER'
  35.         CALL ERREUR(333)
  36.         SEGDES MCHEL1
  37.         RETURN
  38.        ENDIF
  39. C
  40. C    ON VERIFIE QUE LE CHAMP/ELEMENT EST BIEN DE TYPE CONTRAINTE OU
  41. C    DEFORMATION
  42. C
  43.        IF(MCHEL1.TITCHE.EQ.'CONTRAINTES')THEN
  44.          ITYPE=1
  45.          L1=11
  46.        ELSEIF(MCHEL1.TITCHE.EQ.'DEFORMATIONS')THEN
  47.          ITYPE=2
  48.          L1=12
  49.        ELSE
  50.           MOTERR(1:8)='DFOURIER'
  51.           CALL ERREUR(334)
  52.           SEGDES MCHEL1
  53.           RETURN
  54.       ENDIF
  55. C
  56.       N1=MCHEL1.INFCHE(/1)
  57.       N3=MCHEL1.INFCHE(/2)
  58.       SEGINI MCHELM
  59.       IPCHE2=MCHELM
  60.       TITCHE=MCHEL1.TITCHE
  61.       IFOCHE=1
  62.       NSOUS=N1
  63. C
  64. C     BOUCLE SUR LES SOUS-ZONES
  65. C
  66.       DO 500 ISOUS=1,NSOUS
  67. C
  68.          CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)
  69.          IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)
  70.          DO  10 IN=1,N3
  71.            INFCHE(ISOUS,IN)=MCHEL1.INFCHE(ISOUS,IN)
  72.    10    CONTINUE
  73. C
  74. C         ON MET NUMERO DE l'HARMONIQUE A ZERO POUR ADDITIONS FUTURS
  75. C
  76.          NHRM=INFCHE(ISOUS,3)
  77.          INFCHE(ISOUS,3)=0
  78. C
  79.          COSNT=COS(NHRM*ANGL)
  80.          SINNT=SIN(NHRM*ANGL)
  81.          IF(NHRM.LT.0) THEN
  82.            CNT=SINNT
  83.            SINNT=COSNT
  84.            COSNT=CNT
  85.          ENDIF
  86. C
  87. C       CREATION DU MCHAML DE LA SOUS-ZONE
  88. C
  89.          MCHAM1=MCHEL1.ICHAML(ISOUS)
  90.          SEGACT MCHAM1
  91.          N2=MCHAM1.IELVAL(/1)
  92.          SEGINI MCHAML
  93.          ICHAML(ISOUS)=MCHAML
  94.          DO 100 ICOMP=1,N2
  95. C
  96.          MELVA1=MCHAM1.IELVAL(ICOMP)
  97.          SEGACT MELVA1
  98.          NBPTEL=MELVA1.VELCHE(/1)
  99.          NEL=MELVA1.VELCHE(/2)
  100.          NOMCOM=MCHAM1.NOMCHE(ICOMP)
  101. C
  102.          IF(NOMCOM.EQ.'SMRR'.OR.NOMCOM.EQ.'SMZZ'.OR.
  103.      1      NOMCOM.EQ.'SMTT'.OR.NOMCOM.EQ.'SMRZ'.OR.
  104.      2      NOMCOM.EQ. 'N11'.OR.NOMCOM.EQ. 'N22'.OR.
  105.      3      NOMCOM.EQ. 'M11'.OR.NOMCOM.EQ. 'M22'.OR.
  106.      4      NOMCOM.EQ.'EPRR'.OR.NOMCOM.EQ.'EPZZ'.OR.
  107.      5      NOMCOM.EQ.'EPTT'.OR.NOMCOM.EQ.'GARZ'.OR.
  108.      6      NOMCOM.EQ.'EPSS'.OR.NOMCOM.EQ.'RTSS'.OR.
  109.      7      NOMCOM.EQ.'RTTT')THEN
  110. C
  111.              NOMCHE(ICOMP)=NOMCOM
  112.              TYPCHE(ICOMP)='REAL*8'
  113.              N1PTEL=NBPTEL
  114.              N1EL=NEL
  115.              N2PTEL=0
  116.              N2EL=0
  117.              SEGINI MELVAL
  118.              IELVAL(ICOMP)=MELVAL
  119.              DO 110 IB=1,NEL
  120.               DO 110 IGAU=1,NBPTEL
  121.               VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*COSNT
  122.   110        CONTINUE
  123.              SEGDES MELVAL,MELVA1
  124. C
  125.           ELSEIF(NOMCOM.EQ.'SMRT'.OR.NOMCOM.EQ.'SMZT'.OR.
  126.      1           NOMCOM.EQ. 'N12'.OR.NOMCOM.EQ. 'M12'.OR.
  127.      2           NOMCOM.EQ.'GART'.OR.NOMCOM.EQ.'GAZT'.OR.
  128.      3           NOMCOM.EQ.'GAST'.OR.NOMCOM.EQ.'RTST')THEN
  129. C
  130.              NOMCHE(ICOMP)=NOMCOM
  131.              TYPCHE(ICOMP)='REAL*8'
  132.              N1PTEL=NBPTEL
  133.              N1EL=NEL
  134.              N2PTEL=0
  135.              N2EL=0
  136.              SEGINI MELVAL
  137.              IELVAL(ICOMP)=MELVAL
  138.              DO 120 IB=1,NEL
  139.               DO 120 IGAU=1,NBPTEL
  140.               VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*SINNT
  141.   120        CONTINUE
  142.              SEGDES MELVAL,MELVA1
  143. C
  144.             ELSE
  145.              MOTERR(1:4)='DFOU'
  146.              MOTERR(5:8)=NOMCOM
  147.              CALL ERREUR(335)
  148.              SEGSUP MCHAML,MCHELM
  149.              SEGDES MELVA1
  150.              SEGDES MCHAM1,MCHEL1
  151.              RETURN
  152.             ENDIF
  153. C
  154.   100     CONTINUE
  155.           SEGDES MCHAML,MCHAM1
  156. C
  157.   500  CONTINUE
  158.        SEGDES MCHEL1,MCHELM
  159.        RETURN
  160.        END
  161.  
  162.  
  163.  

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