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

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