#include "../h/licasc.h"


/*
 =======================================================================

     vecasc = lecture d'un "vecteur", au sens licom du terme, dans
              un fichier ascii.

     parametres =
        e  fdfic        = descripteur du fichier ascii,
        e  kser         = numero de la serie contenant le vecteur,
        e  kvec         = numero du vecteur a lire,
        e  iechd        = rang du premier echantillon,
        e  nech         = nombre d'echantillons,
         s rvalt        = tableau des valeurs lues,
         s nechlu       = nombre d'echantillons effectivement lus.

     retourne =
            kerr        = indicateur d'erreur :
                          -3 = serie inexistante,
                          -2 = vecteur inexistant,
                          -1 = rang du premier echantillon superieur au
                               nombre d'echantillons presents,
                           0 = absence d'erreur,
                           1 = nombre d'echantillons demandes superieur
                               au nombre disponible.

     generiques =
         err    = erreur
         crlf   = \n
         par    = parametre lu sur une ligne
      P...      = pointeur
      S...      = structure
        b...    = booleen
       ...t     = tableau

     auteur = marimai.henaff    iut.orsay
     version 1.1 du 02/01/95

 =======================================================================
*/

/* -------------------------------------------------------------------*/
/* ... point d'entree pour programme appelant en FORTRAN .............*/
/* -------------------------------------------------------------------*/

int vecasc_ ( Pluasc, kser, kvec, iechd, nech, rvalt, Pnechlu)
int     *Pluasc;
int *kser, *kvec, *iechd, *nech, *Pnechlu;
float *rvalt;
{
/* ... variables globales ... */

extern  FILE    *fdfic_g;

        /* ... variables locales ... */

        int     kerr;

        /* ... appel du point d'entree C ... */

        kerr = vecasc ( fdfic_g ,kser, kvec, iechd, nech, rvalt,
                        Pnechlu);

        /* ... fin du traitement .................................... */

        return ( kerr);

}


/* -------------------------------------------------------------------*/
/* ... point d'entree pour programme appelant en C ...................*/
/* -------------------------------------------------------------------*/

vecasc ( fdfic, kser, kvec, iechd, nech, rvalt, Pnechlu)
FILE *fdfic;
int *kser, *kvec, *iechd, *nech, *Pnechlu;
float *rvalt;
{
        /* ... variables locales  ... */

        double dpart[NPARM];

        int     kerr ;
        int     bfin, bcrlf ;
        int     bser, bvec ;
        int     iech, ival, ipar, ichr;
        int     lzlig, llig, npar ;
        int     itypt[NPARM], idebt[NPARM], nlont[NPARM] ;

        char    zser[LLIGM], zvec[LLIGM];
        char    zlig[LLIGM] ;
        char    *Pzlig =zlig ;
        char    zligw[LLIGM] ;
        char    *Pzligw =zligw ;

        /* ... initialisations ... */

        bser = 0;
        bvec = 0;
        iech = 0;
        ival = 0;
        kerr = 0 ;
        bfin = 0 ;
        bcrlf = 0 ;
        llig = LLIGM ;
        lzlig = LLIGM ;
        *Pnechlu = 0 ;

        sprintf ( zvec, "%s%d",ZCLEVEC, *kvec ) ;
        sprintf ( zser, "%s%d", ZCLESER, *kser ) ;

        /* ... boucle sur le fichier ... */

        fseek ( fdfic, 0, 0) ;

        while ( !feof ( fdfic) && (bfin == 0) ) {

           fgets ( zlig, LLIGM, fdfic) ;

           /* ... detection de la cle serie ... */

           if ( strncmp ( zlig, zser, 3) == 0) {

              if ( !bser) {
                 bser = 1 ;
              }
              else {
                 bfin = 1 ;
              }
           }
           else {

              /* ... detection d'un commentaire ... */

              if ( strncmp ( zlig, ZCLECOM, strlen ( ZCLECOM)) != 0) {

                 if ( bser == 1) {

                    /* ... detection d'une nouvelle cle serie ... */

                    if ( strncmp ( zlig, ZCLESER, strlen ( ZCLESER)) == 0) {

                       if ( bvec == 0) {
                          kerr = -2 ;
                       }
                       else {
                          if ( iech < *iechd) {
                             kerr = -1 ;
                          }
                       }
                       bfin = 1 ;

                    }
                    else {

                       /* ... detection d'une ligne blanche ... */

                       if ( ! ligspc ( zlig, llig)) {

                          if ( bvec == 0) {

                             /* ... detection de la cle vecteur ... */

                             if (  ligstr ( zlig, llig, zvec, strlen ( zvec)) == 0) {
                                kerr = -2 ;
                                bfin = 1 ;
                             }
                             else {
                                bvec = 1 ;
                             }
                          }
                          else {

                             iech++ ;

                             if ( iech >= *iechd) {

                                /* ... initialisations ... */

                                npar = NPARM ;
                                for ( ipar = 0; ipar < npar; ipar++) {
                                   dpart[ipar] = 0.0 ;
                                   itypt[ipar] = 0 ;
                                   idebt[ipar] = 0 ;
                                   nlont[ipar] = 0 ;
                                }
                                bcrlf = 0 ;

                                /* ... on rajoute des espaces ... */

                                for ( ichr = 0; ichr < llig; ichr++) {
                                   if ( zlig[ichr] == '\n') {
                                      bcrlf = 1 ;
                                   }
                                   if ( bcrlf != 1) {
                                      zligw[ichr] = zlig[ichr] ;
                                   }
                                   else {
                                      strncpy ( zligw+ichr, " ", 1) ;
                                   }
                                }

                                /* ... analyse synthaxique de la ligne ... */

                                anastx ( Pzligw, llig, &npar,
                                    itypt, idebt, nlont, dpart) ;


                                /* ... remplissage du tableau des valeurs ... */

                                if ( itypt[0] == 0) {
                                   ipar = *kvec ;
                                }
                                else {
                                   ipar = *kvec - 1;
                                }
                                rvalt[ival] = dpart[ipar] ;
                                ival++ ;
                                if (ival == *nech) bfin = 1 ;
                             }
                          }
                       }
                    }
                 }
              }
           }
        }

        if (( ival != *nech ) && (kerr == -1)) {
           kerr = 1;
        }
        *Pnechlu = ival ;

        if (bser == 0) {
           kerr = -3 ;
        }

      return ( kerr) ;

}