H ALWNULL(*USRCTL)
     FproducteurIF   E           K DISK
     FappellatioIF   E           K DISK    rename(appel00001 : appelf1)
     Fvini1     IF   E           K DISK
     fcavei1    if   e           K DISK
     FINFOCENTREO    E             DISK
      *
     DTbcepage         S                   dim(50) like(vin_c00001)
     DTbnb             S              3  0 dim(50)
      *
     DWcepage          S                   like(vin_c00001)
     Dx                S              2  0
     Di                S              2  0
     Dmaxnb            S              3  0
     Dmax_i            S                   like(i)

      /free
       read producteur;

       dow not %eof;
         clear tbcepage;
         clear tbnb;

         chain appel_code appellatio;
         exsr calcul_vin;
         write infocf1;
         read producteur;
       ENDDO;
       *inlr=*on;

       begsr calcul_vin;
        // calcul nbr de vins d'un producteur
         nbvin = 0;
         encave = 'Non';
		 // le stgaiaire doit trouver qu'il faut in index classant les vins par PR_CODE
         chain pr_code vini1;
          if %found;
            dou %eof;
              // pour chaque vin trt des cepages
			  // on voit que les variables sont globales avec les s/pgm
              wcepage = vin_c00001;
              exsr trtcepage;
              wcepage = vin_c00002;
              exsr trtcepage;
              wcepage = vin_c00003;
              exsr trtcepage;
              wcepage = vin_c00004;
              exsr trtcepage;

             // comptage et vérif est-il en cave ?
            nbvin = nbvin+1;
            chain vin_code cavei1;
             if %found;
               encave='Oui';
             ENDIF;
            reade pr_code vini1 ;
            ENDDO;
          // recupération du cepage le plus utilisé
           exsr calccepage;
          endif;
       ENDSR;

       begsr trtcepage;
           //recherche cepages et nb par cepage
           if wcepage<>*blanks;         //ignorer cépages à blanc
            x=%lookup(wcepage:tbcepage);
            if x > 0;
               tbnb(x) = tbnb(x) + 1;
             else;
               x=%lookup(*blanks:tbcepage); //recherche 1er poste libre
               tbcepage(x)=wcepage;
               tbnb(x)=1;
             endif;
            endif;
       ENDSR;

       begsr calccepage;
       // recup cepage ayant le + grand nb de vins
            maxnb = 0;
            max_i = 0;
            for i=1 to %elem(tbnb);
              if tbnb(i)>maxnb;
                maxnb=tbnb(i);
                max_i= i;
              ENDIF;
            ENDFOR;
           if max_i > 0;
            nbcepage=%lookup(*blanks:tbcepage)-1;
            cepage=tbcepage(max_i);
           endif;
       ENDSR;
      /end-free