Dans cette section : |
Cette rubrique explique la sous-routine MTHNAM comme exemple. La sous-routine MTHNAM convertit un nombre qui représente un mois jusqu'au nom complet de ce mois. La sous-routine est la suivante :
Référence : |
La sous-routine MTHNAM peut être écrite FORTRAN, COBOL, PL/I, BAL Assembler, et C.
Ceci est une version de FORTRAN de la sous-routine MTHNAM où :
est le chiffre en précision double dans l'argument d'entrée.
est le nom du mois. Puisque la chaîne de caractères 'September' contient neuf lettres, MONTH est un tableau à trois éléments. La sous-routine passe les trois éléments de retour vers votre application qui les concatène en un champ.
est un tableau à deux dimensions, 13 sur trois, qui contient les noms de mois. Les trois derniers éléments contiennent le message d'erreur.
est l'entier représentant le mois.
La sous-routine est :
SUBROUTINE MTHNAM (MTH,MONTH) REAL*8 MTH INTEGER*4 MONTH(3),A(13,3),IMTH DATA + A( 1,1)/'JANU'/, A( 1,2)/'ARY '/, A( 1,3)/' '/, + A( 2,1)/'FEBR'/, A( 2,2)/'UARY'/, A( 2,3)/' '/, + A( 3,1)/'MARC'/, A( 3,2)/'H '/, A( 3,3)/' '/, + A( 4,1)/'APRI'/, A( 4,2)/'L '/, A( 4,3)/' '/, + A( 5,1)/'MAY '/, A( 5,2)/' '/, A( 5,3)/' '/, + A( 6,1)/'JUNE'/, A( 6,2)/' '/, A( 6,3)/' '/, + A( 7,1)/'JULY'/, A( 7,2)/' '/, A( 7,3)/' '/, + A( 8,1)/'AUGU'/, A( 8,2)/'ST '/, A( 8,3)/' '/, + A( 9,1)/'SEPT'/, A( 9,2)/'EMBE'/, A( 9,3)/'R '/, + A(10,1)/'OCTO'/, A(10,2)/'BER '/, A(10,3)/' '/, + A(11,1)/'NOVE'/, A(11,2)/'MBER'/, A(11,3)/' '/, + A(12,1)/'DECE'/, A(12,2)/'MBER'/, A(12,3)/' '/, + A(13,1)/'**ER'/, A(13,2)/'ROR*'/, A(13,3)/'* '/ IMTH=MTH+0.000001 IF (IMTH .LT. 1 .OR. IMTH .GT. 12) IMTH=13 DO 1 I=1,3 1 MONTH(I)=A(IMTH,I) RETURN END
Ceci est une version de COBOL de la sous-routine MTHNAM où :
est un champ qui contient les noms de mois et le message d'erreur.
est un tableau à 13 éléments qui redéfinit le champ MONTH-TABLE. Chaque élément (appelé A) contient le nom d'un mois et le dernier élément contient le message d'erreur.
est un élément dans le tableau MLINE.
est un champ entier qui indexe MLINE.
est l'entier représentant le mois.
est le chiffre en précision double dans l'argument d'entrée.
est le nom du mois qui correspond à l'entier dans IMTH.
La sous-routine est :
IDENTIFICATION DIVISION.
PROGRAM-ID. MTHNAM.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MONTH-TABLE.
05 FILLER PIC X(9) VALUE 'JANUARY '.
05 FILLER PIC X(9) VALUE 'FEBRUARY '.
05 FILLER PIC X(9) VALUE 'MARCH '.
05 FILLER PIC X(9) VALUE 'APRIL '.
05 FILLER PIC X(9) VALUE 'MAY '.
05 FILLER PIC X(9) VALUE 'JUNE '.
05 FILLER PIC X(9) VALUE 'JULY '.
05 FILLER PIC X(9) VALUE 'AUGUST '.
05 FILLER PIC X(9) VALUE 'SEPTEMBER'.
05 FILLER PIC X(9) VALUE 'OCTOBER '.
05 FILLER PIC X(9) VALUE 'NOVEMBER '.
05 FILLER PIC X(9) VALUE 'DECEMBER '.
05 FILLER PIC X(9) VALUE '**ERROR**'.
01 MLIST REDEFINES MONTH-TABLE.
05 MLINE OCCURS 13 TIMES INDEXED BY IX.
10 A PIC X(9).
01 IMTH PIC S9(5) COMP.
LINKAGE SECTION.
01 MTH COMP-2.
01 MONTH PIC X(9).
PROCEDURE DIVISION USING MTH, MONTH.
BEG-1.
ADD 0.000001 TO MTH.
MOVE MTH TO IMTH.
IF IMTH < +1 OR > 12
SET IX TO +13
ELSE
SET IX TO IMTH.
MOVE A (IX) TO MONTH.
GOBACK.
Ceci est une version de PL/I de la sous-routine MTHNAM où :
est le chiffre en précision double dans l'argument d'entrée.
est le nom du mois qui correspond à l'entier dans MONTHNUM.
est l'entier représentant le mois.
est un tableau à 13 éléments qui contient les noms de mois. Le dernier élément contient le message d'erreur.
La sous-routine est :
MTHNAM: PROC(MTHNUM,FULLMTH) OPTIONS(COBOL);
DECLARE MTHNUM DECIMAL FLOAT (16) ;
DECLARE FULLMTH CHARACTER (9) ;
DECLARE MONTHNUM FIXED BIN (15,0) STATIC ;
DECLARE MONTH_TABLE(13) CHARACTER (9) STATIC
INIT ('JANUARY',
'FEBRUARY',
'MARCH',
'APRIL',
'MAY',
'JUNE',
'JULY',
'AUGUST',
'SEPTEMBER',
'OCTOBER',
'NOVEMBER',
'DECEMBER',
'**ERROR**') ;
MONTHNUM = MTHNUM + 0.00001 ;
IF MONTHNUM < 1 | MONTHNUM > 12 THEN
MONTHNUM = 13 ; FULLMTH = MONTH_TABLE(MONTHNUM) ;
RETURN;
END MTHNAM;
Ceci est une version de Assembler BAL de la sous-routine MTHNAM :
* =====================================================================
*
* A SIMPLE MAIN ASSEMBLE ROUTINE THAT CALLS THE LE CALLABLE SERVICES
*
* =====================================================================
MTHNAM CEEENTRY PPA=MAINPPA,AUTO=WORKSIZE,MAIN=NO
USING WORKAREA,13
*
L 3,0(0,1) LOAD ADDR OF FIRST ARG INTO R3
LD 4,=D'0.0' CLEAR OUT FPR4 AND FPR5
LE 6,0(0,3) FP NUMBER IN FPR6
LPER 4,6 ABS VALUE IN FPR4
AW 4,=D'0.00001' ADD ROUNDING CONSTANT
AW 4,DZERO SHIFT OUT FRACTION
STD 4,FPNUM MOVE TO MEMORY
L 2,FPNUM+4 INTEGER PART IN R2
TM 0(3),B'10000000' CHECK SIGN OF ORIGINAL NO
BNO POS BRANCH IF POSITIVE
LCR 2,2 COMPLEMENT IF NEGATIVE
*
POS LR 3,2 COPY MONTH NUMBER INTO R3
C 2,=F'0' IS IT ZERO OR LESS?
BNP INVALID YES. SO INVALID
C 2,=F'12' IS IT GREATER THAN 12?
BNP VALID NO. SO VALID
INVALID LA 3,13(0,0) SET R3 TO POINT TO ITEM 13 (ERROR)
*
VALID SR 2,2 CLEAR OUT R2
M 2,=F'9' MULTIPLY BY SHIFT IN TABLE
*
LA 6,MTH(3) GET ADDR OF ITEM IN R6 L 4,4(0,1) GET ADDR OF SECOND ARG IN R4
MVC 0(9,4),0(6) MOVE IN TEXT
*
* TERMINATE THE CEE ENVIRONMENT AND RETURN TO THE CALLER
*
CEETERM RC=0
* ====================================================================
* CONSTANTS
* ====================================================================
DS 0D ALIGNMENT
FPNUM DS D FLOATING POINT NUMBER
DZERO DC X'4E00000000000000' SHIFT CONSTANT
MTH DC CL9'DUMMYITEM' MONTH TABLE
DC CL9'JANUARY'
DC CL9'FEBRUARY'
DC CL9'MARCH'
DC CL9'APRIL'
DC CL9'MAY'
DC CL9'JUNE'
DC CL9'JULY'
DC CL9'AUGUST'
DC CL9'SEPTEMBER'
DC CL9'OCTOBER'
DC CL9'NOVEMBER'
DC CL9'DECEMBER'
DC CL9'**ERROR**'
*
MAINPPA CEEPPA CONSTANTS DESCRIBING THE CODE BLOCK
* ====================================================================
* THE WORKAREA AND DSA
* ====================================================================
WORKAREA DSECT
ORG *+CEEDSASZ LEAVE SPACE FOR THE DSA FIXED PART
PLIST DS 0D
PARM1 DS A
PARM2 DS A
PARM3 DS A
PARM4 DS A
PARM5 DS A
*
FOCPARM1 DS F SAVE FIRST PARAMETER PASSED
FOCPARM2 DS F SAVE SECOND PARAMETER PASSED
*
DS 0D
WORKSIZE EQU *-WORKAREA
CEEDSA MAPPING OF THE DYNAMIC SAVE AREA
CEECAA MAPPING OF THE COMMON ANCHOR AREA
*
END MTHNAM NOMINATE MTHNAM AS THE ENTRY POINT
/*
Ceci est une version du language C de la sous-routine MTHNAM :
void mthnam(double *,char *);
void mthnam(mth,month)
double *mth;
char *month;
{
char *nmonth[13] = {"January ",
"February ",
"March ",
"April ",
"May ",
"June ",
"July ",
"August ",
"September",
"October ",
"November ",
"December ",
"**Error**"};
int imth, loop;
imth = *mth + .00001;
imth = (imth < 1 || imth > 12 ? 13 : imth);
for (loop=0;loop < 9;loop++)
month[loop] = nmonth[imth-1][loop];
}
Vous pouvez appeler la sous-routine MTHNAM d'une requête de rapport.
La commande DEFINE extrait la portion de mois de la date de règlement. La sous-routine MTHNAM la convertit ensuite en nom complet du mois, et stocke le nom dans le champ PAY_MONTH. La requête du rapport imprime le salaire mensuel de Alfred Stevens.
DEFINE FILE EMPLOYEE MONTH_NUM/M = PAY_DATE; PAY_MONTH/A12 = MTHNAM (MONTH_NUM, PAY_MONTH); END TABLE FILE EMPLOYEE PRINT PAY_MONTH GROSS BY EMP_ID BY FIRST NAME BY LAST_NAME BY PAY_DATE IF LN IS STEVENS END
La sortie est :
EMP_ID FIRST NAME LAST_NAME PAY_DATE PAY_MONTH GROSS
------- ---------- --------- -------- --------- -------
071382660 ALFRED STEVENS 81/11/30 NOVEMBER $833.33
81/12/31 DECEMBER $833.33
82/01/29 JANUARY $916.67
82/02/26 FEBRUARY $916.67
82/03/31 MARCH $916.67
82/04/30 APRIL $916.67
82/05/28 MAY $916.67
82/06/30 JUNE $916.67
82/07/30 JULY $916.67
82/08/31 AUGUST $916.67
| Information Builders |