Download ltl.eso

Back to the list

   1 : C LTL       SOURCE    CHAT      05/01/13    01:25:53     5004           
   2 :       SUBROUTINE LTL
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT  REAL*8(A-H,O-Z)
   5 : C======================================================================
   6 : C  =  CALCUL DU PRODUIT SCALAIRE DE DEUX LISTREEL                     =
   7 : C  =                                                                  =
   8 : C  =  SYNTAXE :                                                       =
   9 : C  =                                                                  =
  10 : C  =    FLOT = LTL  LIST1 (LIST2 FLOT1 FLOT2)  ;                      =
  11 : C  =                                                                  =
  12 : C  =    LIST1, LIST2        : LISTREEL                                =
  13 : C  =                                                                  =
  14 : C  =    FLOT, FLOT1, FLOT2  : FLOTTANT                                =
  15 : C  =                                                                  =
  16 : C  =    FLOT = (FLOT1*LIST1) SCALAIRE (FLOT2*LIST2)                   =
  17 : C  =                                                                  =
  18 : C  =    SI LIST2 N'EST PAS DONNE,            LIST2=LIST1              =
  19 : C  =    SI FLOT2 N'EST PAS DONNE,            FLOT2=1.                 =
  20 : C  =    ST FLOT1 ET FLOT2 NE SONT PAS DONNE ,FLOT1=FLOT2=1.           =
  21 : C  =                                                                  =
  22 : C  =  CREATION    : 24/09/90                                          =
  23 : C  =  PROGRAMMEUR : P.P.                                              =
  24 : C======================================================================
  25 : C
  26 : -INC CCOPTIO
  27 : -INC SMLREEL
  28 : C
  29 :       FLOT1=1.D0
  30 : C
  30 :       CALL LIROBJ('LISTREEL',MLREE1,1,IRET)
  31 :       IF(IRET.EQ.0) GOTO 666
  32 : C
  32 :       CALL LIROBJ('LISTREEL',MLREE2,0,IRET)
  33 :       IF(IRET.EQ.0) MLREE2=0
  34 :       IF(MLREE1.EQ.MLREE2) MLREE2=0
  35 : C
  35 :       CALL LIRREE(FLOT,0,IRET)
  36 :       IF(IRET.NE.0)THEN
  37 :         FLOT1=FLOT
  37 :         CALL LIRREE(FLOT,0,IRET)
  38 :         IF(IRET.NE.0)FLOT1=FLOT*FLOT1
  39 :       ENDIF
  40 : C
  41 :       SEGACT, MLREE1
  42 :       NPT=MLREE1.PROG(/1)
  43 :       IF (MLREE2.NE.0)THEN
  44 :         SEGACT, MLREE2
  45 :         NPTT=MLREE2.PROG(/1)
  46 :         IF(NPT.NE.NPTT)THEN
  46 :           CALL ERREUR(577)
  47 :           SEGDES, MLREE1, MLREE2
  48 :           GOTO 666
  49 :         ENDIF
  50 :       ENDIF
  51 : C
  52 :       FLOT=0.D0
  53 :       IF (MLREE2.EQ.0)THEN
  54 :         DO 10 IE1=1,NPT
  55 :           FLOT=FLOT+FLOT1*MLREE1.PROG(IE1)**2
  56 :  10     CONTINUE
  57 :         SEGDES, MLREE1
  58 :       ELSE
  59 :         DO 11 IE1=1,NPT
  60 :           FLOT=FLOT+FLOT1*MLREE1.PROG(IE1)*MLREE2.PROG(IE1)
  61 :  11     CONTINUE
  62 :         SEGDES, MLREE1, MLREE2
  63 :       ENDIF
  64 : C
  64 :       CALL ECRREE(FLOT)
  65 : C
  66 :  666  RETURN
  67 :       END
  68 :  
  69 :  
  70 :  
  71 :  

© Cast3M 2003 - All rights reserved.
Disclaimer