Download tacvec.eso

Back to the list

   1 : C TACVEC    SOURCE    CHAT      05/01/13    03:30:54     5004           
   2 :       SUBROUTINE TACVEC (MTABLE,MLREEL,NJG)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C****************************************************************
   6 : C
   7 : C     SIMPLEX: UTILITAIRE DU DRIVER SIMPLE
   8 : C
   9 : C     met dans un vecteur les elements (flottant) d'indice
  10 : C     entier d'une table.
  11 : C
  12 : C     les trous de la table sont consideres comme des zero
  13 : C
  14 : C     P.PEGON 31/8/92
  15 : C
  16 : C****************************************************************
  17 : -INC SMTABLE
  18 : -INC SMLREEL
  19 : C
  20 : C     si NJG=0,
  21 : C     recherche du plus grand indice entier et retour
  22 : C
  23 : C     NJG=0 en sortie indique que l'un des element d'indice entier
  24 : C     n'est pas un flottant
  25 : C
  26 :       IF(NJG.EQ.0)THEN
  27 :         DO 10 IE1=1,MLOTAB
  28 :           IF(MTABTI(IE1).EQ.'ENTIER  ')THEN
  29 :             IF(MTABII(IE1).GE.0)THEN
  30 :               IF(MTABTV(IE1).NE.'FLOTTANT')GOTO 100
  31 :               NJG=MAX(NJG,MTABII(IE1))
  32 :             ENDIF
  33 :           ENDIF
  34 :  10     CONTINUE
  35 :         RETURN
  36 :  100    NJG=0
  37 :         RETURN
  38 :       ENDIF
  39 : C
  40 : C     si NJG>0,
  41 : C     remplissage du vecteur
  42 : C
  42 :       CALL ZERO(PROG,NJG,1)
  43 :       DO 30 IE1=1,MLOTAB
  44 :         IF(MTABTI(IE1).EQ.'ENTIER  ')THEN
  45 :           IF(MTABII(IE1).GE.0)THEN
  46 :             PROG(MTABII(IE1)+1)=RMTABV(IE1)
  47 :           ENDIF
  48 :         ENDIF
  49 :  30   CONTINUE
  50 : C
  51 :       RETURN
  52 :       END
  53 :  

© Cast3M 2003 - All rights reserved.
Disclaimer