Esope source files

   1 : C XTX       SOURCE    FANDEUR   11/04/12    21:16:22     6938           
   2 :       SUBROUTINE XTX                                                            
   3 : 
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   6 : 
   7 : *_______________________________________________________________________        
   8 : *                                                                               
   9 : *         OPERATEUR XTX : EFFECTUE LA NORME XT.X                                
  10 : *                                                                               
  11 : *   ON RETIRE DU CHPOINT LES MULT. DE LAGRANGE .                                
  12 : *                                                                               
  13 : *   SYNTAXE :  Y = XTX X ;                                                      
  14 : *              Y = XTX FLO1 CHEL1 Y CHEL2 ;                                     
  15 : *                        FLO1 FLO2 FLOTTANT CHEL1 CHEL2 MCHAML                  
  16 : *                                                   OU  CHPOINT                 
  17 : *                        CHEL1 CHEL2 MCHAML OU CHPOINT                          
  18 : *                       EFFECTUE LA NORME DE LA COMBINAISON LINEAIRE            
  19 : *      Y : FLOTTANT                                                             
  20 : *      X : OBJET DE TYPE CHPOINT                                                
  21 : *                                                                               
  22 : *   PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 02/91                      
  23 : *                                                                               
  24 : *_______________________________________________________________________        
  25 : *                                                                               
  26 : -INC CCOPTIO                                                                    
  27 : *                                                                               
  28 :       DFLO1 = 0.
  29 :       DFLO2 = 0.
  30 :       XDRET = 0.
  31 : *
  31 :       CALL LIROBJ('MCHAML',IPCHE1,0,IRETOU)                                     
  32 :       IF(IRETOU.EQ.0) GOTO 1000
  33 : *                                                                               
  34 : *     CAS DE LA SYNTAXE :  XTX FLO1 CHE1 FLO2 CHE2 ;                            
  35 : *                                                                               
  35 :       CALL LIROBJ('MCHAML',IPCHE2,0,IRETOU)                                  
  36 : *
  37 :       IF (IRETOU.EQ.0) THEN
  38 : *                                                                               
  39 : *     CAS Y1 = XTX CHEL1 ;                                                      
  39 :         CALL XTX2(IPCHE1,XDRET,IRET)                                            
  40 : *                                                                               
  41 :       ELSE
  41 :         CALL LIRREE(DFLO1,1,IRETOU)                                             
  42 :         IF(IERR.NE.0) RETURN                                                    
  43 : *                                                                               
  43 :         CALL LIRREE(DFLO2,1,IRETOU)                                             
  44 :         IF(IERR.NE.0) RETURN                                                    
  45 : *                                                                               
  45 :         CALL XTX4(IPCHE1,IPCHE2,DFLO1,DFLO2,XDRET,IRET)                         
  46 : *                                                                               
  47 :       ENDIF                                                                     
  48 :       GOTO 5000                                                                 
  49 : *                                                                               
  50 : *                                                                               
  51 : *     LECTURE D UN CHPOINT                                                      
  52 : *                                                                               
  53 :  1000 CONTINUE                                                                  
  53 :       CALL LIROBJ('CHPOINT ',ICH1,1,IRETOU)                                     
  54 :       IF(IERR.NE.0) RETURN
  55 : *                                                                               
  56 : *      CAS DE LA SYNTAXE Y1 = XTX FLO1 CHP1 FL2 CHP2                            
  57 : *                                                                               
  57 :       CALL LIROBJ('CHPOINT ',ICH2,0,IRETOU)                                     
  58 : *                                                                               
  59 : *      CAS NORMAL Y1 = XTX CHP1 ;                                               
  60 : *                                                                               
  61 :       IF(IRETOU.EQ.0) THEN
  61 :         CALL XTX1(ICH1,XDRET)                                                   
  62 :         IRET = 1
  63 : 
  64 :       ELSE
  64 :         CALL LIRREE(DFLO1,1,IRETOU)                                             
  65 :         IF (IERR.NE.0) RETURN                                                   
  65 :         CALL LIRREE(DFLO2,1,IRETOU)                                             
  66 :         IF (IERR.NE.0) RETURN                                                   
  67 : *                                                                               
  67 :         CALL XTX3(ICH1,ICH2,DFLO1,DFLO2,XDRET,IRET)                             
  68 : *                                                                               
  69 :       ENDIF
  70 : C*    GOTO 5000                                                                 
  71 : *                                                                               
  72 :  5000 CONTINUE                                                                  
  72 :       IF (IRET.NE.0) CALL ECRREE(XDRET)                                         
  73 : 
  74 :       RETURN                                                                    
  75 :       END                                                                       
  76 :  
  77 :  
  78 :