1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
|
000010 Identification Division.
000020 Program-Id. SEARCH-CBL.
*
*********************************************************************
* *
* SEARCH TABLEAU *
* *
*********************************************************************
*
000030 Author. H.JAIDANE.
000040 Environment Division.
000050 Configuration Section.
000060 Source-Computer. IBM-PS2.
000070 Object-Computer. IBM-PS2.
000075 Special-Names.
Input-Output Section.
000090 File-Control.
*
000140 Data Division.
*
000210 Working-Storage Section.
* Pour certains compilteurs, ces Index ne doivent pas être déclarés,
* ils sont générés automatiquement
* par la clause Indexed by.
*77 IDX2 INDEX.
*77 IDX3 INDEX.
77 IDC pic 9999 comp.
77 I pic 9999 comp.
77 IDX2-DEB pic 9999 comp.
77 IDX2-FIN pic 9999 comp.
01 TAB-MOIS.
03 Filler pic x(15) value "01-31-Janvier ".
03 Filler pic x(15) value "02-28-Février ".
03 Filler pic x(15) value "03-31-Mars ".
03 Filler pic x(15) value "04-30-Avril ".
03 Filler pic x(15) value "05-31-Mai ".
03 Filler pic x(15) value "06-30-Juin ".
03 Filler pic x(15) value "07-31-Juillet ".
03 Filler pic x(15) value "08-31-Août ".
03 Filler pic x(15) value "09-30-Septembre".
03 Filler pic x(15) value "10-31-Octobre ".
03 Filler pic x(15) value "11-30-Novembre ".
03 Filler pic x(15) value "12-31-Décembre ".
01 TAB1 redefines TAB-MOIS.
03 ELEM1 occurs 12.
05 NUM1 pic 99.
05 filler pic x.
05 NBJ1 pic 99.
05 filler pic x.
05 LIB1 pic x(9).
01 TAB2 redefines TAB-MOIS.
03 ELEM2 occurs 12
INDEXED BY IDX2.
05 NUM2 pic 99.
05 filler pic x.
05 NBJ2 pic 99.
05 filler pic x.
05 LIB2 pic x(9).
05 LIB20 redefines LIB2.
07 LIB2-1 pic x.
07 LIB2-8 pic x(8).
01 TAB3 redefines TAB-MOIS.
03 ELEM3 occurs 12
indexed by IDX3
ascending key NUM3.
05 NUM3 pic 99.
05 filler pic x.
05 NBJ3 pic 99.
05 filler pic x.
05 LIB3 pic x(9).
000370 Procedure Division.
DEBUT.
TRAIT.
*
* Affichage de la table par un perform en faisant varier un indice
*
display "PERFORM VARIYNG INDICE".
display "----------------------".
perform DISPL-TAB1 varying IDC from 1 by 1 until IDC > 12.
display "--------------------------------------".
stop "faire entrée pour continuer".
*
*
* Affichage de la table par un perform en faisant varier son INDEX
*
display "PERFORM VARIYNG INDEX".
display "---------------------".
perform DISPL-TAB2 varying IDX2 from 1 by 1 until IDX2 > 12.
display "--------------------------------------".
stop "faire entrée pour continuer".
*
*
* Recherche par SEARCH SEQUENTIEL
* et Affichage du mois ayant NBJ = 28
*
display "SEARCH SEQUENTIEL".
display "-----------------".
SET IDX2 to 1.
SEARCH ELEM2
when NBJ2(IDX2) = 28
display NUM2(IDX2) "/" LIB2(IDX2).
display "--------------------------------------".
stop "faire entrée pour continuer".
*
*
* Recherche par SEARCH SEQUENTIEL entre limites 1er CAS : .
* et Affichage du mois ayant NBJ = 28
*
move 1 to IDX2-DEB.
move 6 to IDX2-FIN.
display "SEARCH SEQUENTIEL ENTRE LIMITES : 1er CAS : "
display "IDX2-DEB = " IDX2-DEB " et IDX2-FIN = " IDX2-FIN.
display "-----------------------------------------------".
SET IDX2 to IDX2-DEB.
SEARCH ELEM2
when NBJ2(IDX2) = 28
display NUM2(IDX2) "/" LIB2(IDX2)
when IDX2 > IDX2-FIN next sentence.
display "--------------------------------------".
stop "faire entrée pour continuer".
*
*
* Recherche par SEARCH SEQUENTIEL entre limites 2è CAS : .
* et Affichage du mois ayant NBJ = 28
*
move 7 to IDX2-DEB.
move 12 to IDX2-FIN.
display "SEARCH SEQUENTIEL ENTRE LIMITES : 2è CAS : "
display "IDX2-DEB = " IDX2-DEB " et IDX2-FIN = " IDX2-FIN.
display "-----------------------------------------------".
SET IDX2 to IDX2-DEB.
SEARCH ELEM2
when NBJ2(IDX2) = 28
display NUM2(IDX2) "/" LIB2(IDX2)
when IDX2 > IDX2-FIN next sentence.
display "--------------------------------------".
stop "faire entrée pour continuer".
*
*
* Recherche par SEARCH DICHOTOMIQUE et Affichage du mois 02
*
display "SEARCH DICHOTOMIQUE".
display "-------------------".
SET IDX3 to 1.
SEARCH ALL ELEM3
when NUM3(IDX3) = 02
* LE CHAMP A TESTER DOIT ETRE OBLIGATOIREMENT DANS LA KEY DE LA TABLE
display NBJ3(IDX3) "/" LIB3(IDX3).
display "--------------------------------------".
stop "faire entrée pour continuer".
*
* Recherche par SEARCH SEQUENTIEL encapsulé dans un PERFORM
* et Affichage des mois commençant par "J", "j", "S", "s", "M" ou "m"
* le SEARCH s'exécute plusieurs fois mais le tableau est lui parcouru
* une seule fois, voir l'affichage de l'index
*
display "PERFORM ET SEARCH SEQUENTIEL".
display "----------------------------".
SET IDX2 to 1.
perform SEARCH-TAB2 until IDX2 > 12.
display "--------------------------------------".
stop "faire entrée pour continuer".
*
FIN.
stop run.
SEARCH-TAB2.
* pour pouvoir afficher l'index de départ, initialisé à 1 puis valorisé
* par le dernier index IDX2 + 1
*
set I to IDX2.
display "Index commençant à = " I.
*
SEARCH ELEM2
when LIB2-1(IDX2) = "J" or "j"
or "S" or "s"
or "M" or "m"
display "--> "NUM2(IDX2) "/" LIB2(IDX2).
SET IDX2 UP BY 1.
DISPL-TAB1.
display ELEM1(IDC).
DISPL-TAB2.
display ELEM2(IDX2). |
Partager