C DEBIT     SOURCE    CHAT      06/08/24    21:25:56     5529           
      SUBROUTINE DEBIT                                                          
*_______________________________________________________________________        
*                                                                               
*                     OPERATEUR DEBIT  ( Inspire de PRESSI )                    
*                                                                               
*       FQ = DEBIT MODEL I D MAIL I   (MOT1)
*                        I CHPDEB I
*                                                                               
*            FQ        CHPOINT CONTENANT LES FORCES NODALES EQUIVALENTES        
*            MODEL     OBJET MMODEL ,MASSIF , SUR LEQUEL S'APPLIQUE             
*                      LA CONDITION DE DEBIT                                    
*            D         VALEUR ALGEBRIQUE DU DEBIT                               
*            MAIL      POUR LES MASSIFS ,OBJET MAILLAGE REPRESENTANT            
*                      LA FACE SUR LAQUELLE S'APPLIQUE LA CONDITION             
*                      DE DEBIT                                                 
*            CHPOT     CHPOINT CONTENANT LES VALEURS ALGEBRIQUES                
*                      DES DEBITS AUX NOEUDS                                    
*            MOT1      NOM DONNE AU RESULAT ( PAR DEFAUT , CELUI DU MODELE)
*______________________________________________________________________         
*                                                                               
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMCHPOI                                                                    
*                                                                               
      CHARACTER*(4) MOSCAL,MOPOI1,MOT1
      REAL*8 XXX                                                                
*                                                                               
      DATA MOSCAL/'SCAL'/,MOPOI1/'POI1'/,MOT1/'    '/
*                                                                               
*     ON LIT UN MMODEL                                                          
*                                                                               
      CALL LIROBJ('MMODEL ',IPMODL,1,IRETM)
      IF (IERR.NE.0) RETURN                                                     

      ICONV=0
*                                                                               
*     ON LIT SOIT UN FLOTTANT ET UN MAILLAGE ,SOIT UN CHPOINT                   
*                                                                               
      CALL LIRREE(XXX,0,IRETOU)                                                 
      IF (IRETOU.EQ.1) THEN                                                     
         CALL LIROBJ('MAILLAGE',IPTGEO,1,IRETOU)                                
         IF (IERR.NE.0) GOTO 666                                                
*                                                                               
         CALL ECRREE (XXX)                                                      
         CALL PROG                                                              
         CALL ECRCHA(MOSCAL)                                                    
         CALL ECRENT(1)                                                         
         CALL ECROBJ('MAILLAGE',IPTGEO)                                         
         CALL ECRCHA(MOPOI1)                                                    
         CALL PRCHAN                                                            
         IF (IERR.NE.0) GOTO 666                                                
         CALL MANUCH                                                            
         CALL LIROBJ('CHPOINT ',ICHPOP,1,IRETOU)                                
         IF (IERR.NE.0) THEN                                                    
            CALL DTCHPO(ICHPOP)                                                 
            GOTO 666                                                            
         ENDIF                                                                  
      ELSE                                                                      
         CALL LIROBJ('CHPOINT ',ICHPOP,1,IRETOU)                                
         IF (IERR.NE.0) GOTO 666                                                
      ENDIF                                                                     
*
      CALL LIRCHA(MOT1,0,IRETOU)
*
      CALL FDEBIT(ICHPOP,IPMODL,IPTFP,MOT1,IRET)
      IF (IRET.EQ.0) GOTO 666                                                   
*                                                                               
*        LE NUMERO DE L HARMONIQUE EST PRIS EGAL A NIFOUR                       
*        POUR TOUTES LES COMPOSANTES DU CHPOINT                                 
*                                                                               
      MCHPOI=IPTFP        
      SEGACT MCHPOI
*         ATTRIBUTION D'UNE NATURE DISCRETE AU CHPO SORTANT 
      NAT = MAX ( 1 , JATTRI(/1) )
      NSOUPO = IPCHP(/1)
      SEGADJ MCHPOI
      JATTRI(1) = 2
*                                                        
      DO 100 IA=1,IPCHP(/1)                                                  
         MSOUPO=IPCHP(IA)                                                       
         SEGACT MSOUPO                                                          
         DO 101 NC=1,NOHARM(/1)                                                 
            NOHARM(NC)=NIFOUR                                                   
101      CONTINUE                                                               
         SEGDES MSOUPO                                                          
100   CONTINUE                                                                  
      SEGDES MCHPOI                                                             
*                                                                               
      CALL ECROBJ('CHPOINT ',IPTFP)                                             
*                                                                               
 666  IF (ICONV.EQ.1) THEN                                                      
         CALL DTMODL(IPMODL)                                                    
      ENDIF                                                                     
      RETURN                                                                    
      END