C DFOUR2    SOURCE    PV        09/03/12    21:19:18     6325           
      SUBROUTINE DFOUR2(IPCHE1,ANGL,IPCHE2)                                     
                                                                                
C====================================================================           
C                                                                               
C   ENTREES                                                                     
C    IPCHE1 = CHAMELEM DE TYPE CONTRAINTES OU DEFORMATIONS                      
C    ANGL   = ANGLE                                                             
C  SORTIES                                                                      
C    IPCHE2   = SI SUCCES , POINTEUR SUR UN MCHAML                              
C             0 SINON                                                           
C                                                                               
C     J BROCHARD MARS  87                                                       
C     NOUVEAUX CHAMELEMS P DOWLATYARI SEP 91                                    
C=====================================================================          
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                    
-INC SMCHAML                                                                    
-INC CCREEL                                                                     
      CHARACTER*4 NOMCOM                                                        
                                                                                
C                                                                               
      ANGL=(ANGL*XPI)/180.D0                                                    
C                                                                               
C-------ON VERIFIE QUE IFOCHE EST BIEN EGAL A 1                                 
C                                                                               
      MCHEL1=IPCHE1                                                             
      SEGACT MCHEL1                                                             
      IF(MCHEL1.IFOCHE.NE.1)THEN                                                
        MOTERR(1:8)='DFOURIER'                                                  
        CALL ERREUR(333)                                                        
        SEGDES MCHEL1                                                     
        RETURN                                                                  
       ENDIF                                                                    
C                                                                               
C    ON VERIFIE QUE LE CHAMP/ELEMENT EST BIEN DE TYPE CONTRAINTE OU             
C    DEFORMATION                                                                
C                                                                               
       IF(MCHEL1.TITCHE.EQ.'CONTRAINTES')THEN                                   
         ITYPE=1                                                                
         L1=11                                                                  
       ELSEIF(MCHEL1.TITCHE.EQ.'DEFORMATIONS')THEN                              
         ITYPE=2                                                                
         L1=12                                                                  
       ELSE                                                                     
          MOTERR(1:8)='DFOURIER'                                                
          CALL ERREUR(334)                                                      
          SEGDES MCHEL1                                                   
          RETURN                                                                
      ENDIF                                                                     
C                                                                               
      N1=MCHEL1.INFCHE(/1)                                                      
      N3=MCHEL1.INFCHE(/2)                                                      
      SEGINI MCHELM                                                             
      IPCHE2=MCHELM                                                             
      TITCHE=MCHEL1.TITCHE                                                      
      IFOCHE=1                                                                  
      NSOUS=N1                                                                  
C                                                                               
C     BOUCLE SUR LES SOUS-ZONES                                                 
C                                                                               
      DO 500 ISOUS=1,NSOUS                                                      
C                                                                               
         CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)                                     
         IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)                                     
         DO  10 IN=1,N3                                                         
           INFCHE(ISOUS,IN)=MCHEL1.INFCHE(ISOUS,IN)                             
   10    CONTINUE                                                               
C                                                                               
C         ON MET NUMERO DE l'HARMONIQUE A ZERO POUR ADDITIONS FUTURS            
C                                                                               
         NHRM=INFCHE(ISOUS,3)                                                   
         INFCHE(ISOUS,3)=0                                                      
C                                                                               
         COSNT=COS(NHRM*ANGL)                                                   
         SINNT=SIN(NHRM*ANGL)                                                   
         IF(NHRM.LT.0) THEN                                                     
           CNT=SINNT                                                            
           SINNT=COSNT                                                          
           COSNT=CNT                                                            
         ENDIF                                                                  
C                                                                               
C       CREATION DU MCHAML DE LA SOUS-ZONE                                      
C                                                                               
         MCHAM1=MCHEL1.ICHAML(ISOUS)                                            
         SEGACT MCHAM1                                                          
         N2=MCHAM1.IELVAL(/1)                                                   
         SEGINI MCHAML                                                          
         ICHAML(ISOUS)=MCHAML                                                   
         DO 100 ICOMP=1,N2                                                      
C                                                                               
         MELVA1=MCHAM1.IELVAL(ICOMP)                                            
         SEGACT MELVA1                                                          
         NBPTEL=MELVA1.VELCHE(/1)                                               
         NEL=MELVA1.VELCHE(/2)                                                  
         NOMCOM=MCHAM1.NOMCHE(ICOMP)                                            
C                                                                               
         IF(NOMCOM.EQ.'SMRR'.OR.NOMCOM.EQ.'SMZZ'.OR.                            
     1      NOMCOM.EQ.'SMTT'.OR.NOMCOM.EQ.'SMRZ'.OR.                            
     2      NOMCOM.EQ. 'N11'.OR.NOMCOM.EQ. 'N22'.OR.                            
     3      NOMCOM.EQ. 'M11'.OR.NOMCOM.EQ. 'M22'.OR.                            
     4      NOMCOM.EQ.'EPRR'.OR.NOMCOM.EQ.'EPZZ'.OR.                            
     5      NOMCOM.EQ.'EPTT'.OR.NOMCOM.EQ.'GARZ'.OR.                            
     6      NOMCOM.EQ.'EPSS'.OR.NOMCOM.EQ.'RTSS'.OR.                            
     7      NOMCOM.EQ.'RTTT')THEN                                               
C                                                                               
             NOMCHE(ICOMP)=NOMCOM                                               
             TYPCHE(ICOMP)='REAL*8'                                             
             N1PTEL=NBPTEL                                                      
             N1EL=NEL                                                           
             N2PTEL=0                                                           
             N2EL=0                                                             
             SEGINI MELVAL                                                      
             IELVAL(ICOMP)=MELVAL                                               
             DO 110 IB=1,NEL                                                    
              DO 110 IGAU=1,NBPTEL                                              
              VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*COSNT                      
  110        CONTINUE                                                           
             SEGDES MELVAL,MELVA1                                         
C                                                                               
          ELSEIF(NOMCOM.EQ.'SMRT'.OR.NOMCOM.EQ.'SMZT'.OR.                       
     1           NOMCOM.EQ. 'N12'.OR.NOMCOM.EQ. 'M12'.OR.                       
     2           NOMCOM.EQ.'GART'.OR.NOMCOM.EQ.'GAZT'.OR.                       
     3           NOMCOM.EQ.'GAST'.OR.NOMCOM.EQ.'RTST')THEN                      
C                                                                               
             NOMCHE(ICOMP)=NOMCOM                                               
             TYPCHE(ICOMP)='REAL*8'                                             
             N1PTEL=NBPTEL                                                      
             N1EL=NEL                                                           
             N2PTEL=0                                                           
             N2EL=0                                                             
             SEGINI MELVAL                                                      
             IELVAL(ICOMP)=MELVAL                                               
             DO 120 IB=1,NEL                                                    
              DO 120 IGAU=1,NBPTEL                                              
              VELCHE(IGAU,IB)=MELVA1.VELCHE(IGAU,IB)*SINNT                      
  120        CONTINUE                                                           
             SEGDES MELVAL,MELVA1                                         
C                                                                               
            ELSE                                                                
             MOTERR(1:4)='DFOU'                                                 
             MOTERR(5:8)=NOMCOM                                                 
             CALL ERREUR(335)                                                   
             SEGSUP MCHAML,MCHELM                                               
             SEGDES MELVA1                                                
             SEGDES MCHAM1,MCHEL1                                   
             RETURN                                                             
            ENDIF                                                               
C                                                                               
  100     CONTINUE                                                              
          SEGDES MCHAML,MCHAM1                                            
C                                                                               
  500  CONTINUE                                                                 
       SEGDES MCHEL1,MCHELM                                               
       RETURN                                                                   
       END