Fortran
Angel
-
matt -
matt -
Bonjour,
comment sa marche le tableau en fortran, j'ai lit plusieur exemple mais j'ai pas bien compris
si quelqu'un peut me donner un exemple de tableau je vous remercie parce que je suis perdu et je peut pas comprendre bien le tableau en fortran parce que en c je commence par 0 -> tab[0]
et en fortran j'ai pas un bien idee
eh faite je travaille sur un code c qui est transforme de code fortran et ce code plein des tableau et les parametres des ces tableau sont les sortis/entres des blocs et tous sont en decalage qui me fait un probleme
c'est pour cela j'aimerais savoir le differences entre les tableaux en c et les tableaux en fortran
comment sa marche le tableau en fortran, j'ai lit plusieur exemple mais j'ai pas bien compris
si quelqu'un peut me donner un exemple de tableau je vous remercie parce que je suis perdu et je peut pas comprendre bien le tableau en fortran parce que en c je commence par 0 -> tab[0]
et en fortran j'ai pas un bien idee
eh faite je travaille sur un code c qui est transforme de code fortran et ce code plein des tableau et les parametres des ces tableau sont les sortis/entres des blocs et tous sont en decalage qui me fait un probleme
c'est pour cela j'aimerais savoir le differences entre les tableaux en c et les tableaux en fortran
Configuration: Windows XP Internet Explorer 6.0
3 réponses
-
Bonsoir,
Je te joins un programme Fortran qui utilise pas mal de tableaux. Il n'est pas nécessaire de comprendre sa finalité (certaines séquences sont d'ailleurs cohérentes mais non finalisées) , il suffit de "suivre" la description et l'utilisation d'un ou plusieurs tableaux.
En espérant que cela te sera utile .............. Il s'agit de ma façon d'utiliser les tableaux...C NOM: FORTRANS. C AUTEUR: CH. C LANGAGE: FORTRAN 77. C DESCRIPTION: Force 2.0 (G77) C DATE: Début le 02/06/2008 C Références : C C(FIV) Livre : fortran IV de M. DREYFUS (DUNOD Paris 1970) C(ILF) Livre : Initiation au langage fortran (DUNOD Paris 1970) C(IBM) IBM : Common Programming interface-FORTRAN Référence (1990) C C(WE1) https://perso.imt-mines-albi.fr/~gaborit/lang/CoursDeFortran/ C(WE2) https://docs.oracle.com/pls/topic/lookup?ctx=dsc&id=/app/docs/doc/802-2998/6i6u3logs?a=view C(WE3) http://www-ipst.u-strasbg.fr/pat/program/fortran/ C __________________________________________________________________ C C Ce programme n'a aucun objectif fonctionnel particulier, il se C propose d'effectuer, après les avoir isolés, une transcodifica- C tion de groupes de caractères présents dans une chaîne caracté- C risant des formules. A l'issue de cette transcodification un C fichier est créé. PROGRAM FORTRANS IMPLICIT NONE C-------------------- C CHARACTER ENREG_F*80 /' '/ CHARACTER ZONE_GRP*64 /' '/ CHARACTER C_XX*1 /' '/ CHARACTER IO_ORDRE*16 CHARACTER EXT_OUT*12 CHARACTER FMT_OUT*32 /'(A25, 1X, A25, 1X, A28)'/ CHARACTER F_NAME_IN*16, F_NAME_OUT*16, NOM_PGM*8 CHARACTER TAB_RANG_OK*32 /' '/!Table de passation de valeurs C Numéric Type (p.15 IBM) INTEGER IND_F INTEGER ISAVE_POS INTEGER IPOS_TRANS INTEGER IVAL_NUM INTEGER IND_GRP INTEGER NB_POSTES_VALID INTEGER NB_POSTES INTEGER INDIC_ANOM INTEGER SAVIND_ANOM INTEGER INDIC_INFOS INTEGER CPT_ENREG INTEGER IO_RC INTEGER IS_KO_OK INTEGER IS_I INTEGER K INTEGER II C Comptage du nb. de c.par groupe et position des groupes. INTEGER ICPT_CAR INTEGER IPOS_GRP INTEGER ICPT_GRP INTEGER ISAVE_CPT_CAR C Variables permettant de borner les tables (voir PARAMETER). INTEGER LONG_TABS INTEGER LONG_DIMS INTEGER ZONE_L_DIMS C Variables de définition des unités (unit) (voir PARAMETER). INTEGER DATA_UT_IN INTEGER DATA_UT_OUT C (WE3) Variables communes. COMMON /VAR_INIT/ S IND_F, ICPT_CAR, ICPT_GRP, ISAVE_CPT_CAR, S ISAVE_POS,IPOS_TRANS, IVAL_NUM, IND_GRP COMMON /ANOM_INIT/ S NB_POSTES_VALID, NB_POSTES, INDIC_ANOM, S INDIC_INFOS, SAVIND_ANOM, CPT_ENREG, IO_RC C----------------------------------------------------------------------- C Constantes (p.40 IBM) PARAMETER ( DATA_UT_IN = 10, S F_NAME_IN = 'reactions.txt', S DATA_UT_OUT = 11, S EXT_OUT = '', S LONG_TABS = 256, S LONG_DIMS = 32, S NOM_PGM = 'FORTRANS' ) C----------------------------------------------------------------------- C Déclaration des tableaux (p.21 IBM) DIMENSION TAB_GRP (LONG_TABS) !Tableau des groupes de c. CHARACTER TAB_GRP*32 !et signes valides. DIMENSION TAB_VAL_GRP (LONG_TABS)!Tableau des valeurs affec- INTEGER TAB_VAL_GRP ! tées aux groupes de c.et signes C Tableau de stockage résultats intermédiaires:TAB_GRP<=>TAB_VAL_GRP INTEGER*8 TAB_INT_VAL (LONG_DIMS) !Tableau intermédiaire . C Tableaux de stockage. DIMENSION TAB_FORM_INIT (LONG_TABS) ! Tableau des formules CHARACTER TAB_FORM_INIT*80 ! d'origine (idem fichier) C Tableaux de stockage des résultats des transcodifications. DIMENSION TAB_FORM (LONG_TABS) CHARACTER TAB_FORM*32 !Tableau des formules sans opérateurs. INTEGER*8 TAB_VAL_NUM (LONG_TABS) !Tableau valeurs<=>formules DIMENSION TAB_CHAR_NUM (LONG_TABS)!Tableau des valeurs des for CHARACTER TAB_CHAR_NUM*32 ! mules en mode caractères. INTEGER AV_POSTES_FLECHE (LONG_TABS) !nb.positions avant ->. INTEGER AV2_POSTES_FLECHE (LONG_TABS) !nb.positions avant ->. C DIMENSION TAB_ANOM2 (10) C INTEGER TAB_ANOM2 C Tableaux des messages affichés en fin d"exécution. DIMENSION TAB_ANOM (LONG_DIMS) !Tableau des meessages CHARACTER TAB_ANOM*80 !d'anomalies détectées. C Tableaux des messages d'information. DIMENSION TAB_INFOS (LONG_DIMS) !Tableau des meessages CHARACTER TAB_INFOS*80 !d'informations. C Tableaux de définition des codes et des équivalences numériques. DATA (TAB_GRP (K), K = 1,23,1) / S 'H1', 'a', 'H2+', 'H3', 'b', 'H4+', S 'H5', 'c', 'H6+', 'H7', 'd', 'H8+', S 'H2', 'e', 'abcde', 'x','H9+','->', S '£', S '+', '-', ' ', S '$' / C '£' Borne identifiant la fin des groupes à transcoder. C '$' Borne identifiant la fin du tableau. C Les groupes de caractères compris entre le début du tableau et'£' C génèrent une transcodification (voir TAB_VAL_GRP ci-dessous) C Les groupes de caractères compris entre '£' et '$' ne génèrent C aucune transcodification. C Equivalences numériques(POSITIONNELLES avec TAB_GRP ex: H2 = 03): C Taleaux de définition des équivalences numériques des groupes à C transcoder. DATA (TAB_VAL_GRP (K), K = 1,18,1) / S 01, 02, 03, 04, 05, 06, S 07, 08, 09, 10, 11, 12, S 13, 14, 15, 16, 17, 0 / C Initialisation des tableaux de stockage des résultats de transco. C ---------------------------------------------------------------------- DATA (TAB_FORM_INIT (K), K = 1,LONG_TABS,1) /LONG_TABS * ' '/ DATA (TAB_FORM (K), K = 1,LONG_TABS,1) /LONG_TABS * ' '/ DATA (TAB_VAL_NUM (K), K = 1,LONG_TABS,1) /LONG_TABS * 0/ DATA (TAB_CHAR_NUM (K), K = 1,LONG_TABS,1) /LONG_TABS * ' '/ DATA (AV_POSTES_FLECHE (K), K = 1,LONG_TABS,1) /LONG_TABS * -1/ DATA (AV2_POSTES_FLECHE (K), K = 1,LONG_TABS,1) /LONG_TABS * -1/ DATA (TAB_INFOS (K), K = 1,LONG_DIMS,1) /LONG_DIMS * ' '/ DATA (TAB_ANOM (K), K = 1,LONG_DIMS,1) /LONG_DIMS * ' '/ C----------------------------------------------------------------------- C Appel de sous programmes externes : C ----------------------------------------------------- C Modification de la taille de la fenetre Windows (DOS) CALL SYSTEM ('MODE CON COLS=150 LINES=90') CALL SYSTEM ('ERASE VVVV.TXT') C*********************************************************************** C SEQUENCE PRINCIPALE. C*********************************************************************** PRINT *, NOM_PGM CALL INIT_GEN () CALL CONTROL_GEN (TAB_GRP, TAB_ANOM, LONG_TABS, S DATA_UT_IN, F_NAME_IN ) print 1000 print 1010 C Boucle de lectures des enregistrements du fichier en INPUT. DO WHILE (IO_RC == 0) C .AND. INDIC_ANOM == 0) C ---------------------- C READ -WRITE (p 77 IBM) IO_ORDRE = ' READ_IN' READ (UNIT = DATA_UT_IN, FMT = 500, S IOSTAT = IO_RC, ERR = 15) S ENREG_F IF (IO_RC .eq. -1) THEN C Ecriture en table des messages d'information. CALL AFFICH_STATINFOS (TAB_INFOS, F_NAME_IN, INDIC_INFOS, S IO_ORDRE, LONG_TABS, CPT_ENREG, S IO_RC ) ELSE CPT_ENREG = CPT_ENREG + 1 IF (CPT_ENREG > LONG_TABS - 1) THEN C IF (CPT_ENREG > 2 ) THEN IF (SAVIND_ANOM == 0 ) THEN SAVIND_ANOM = INDIC_ANOM + 1 INDIC_ANOM = INDIC_ANOM + 2 END IF WRITE (TAB_ANOM (SAVIND_ANOM), 040) S CPT_ENREG - (LONG_TABS - 1), LONG_TABS - 1, S F_NAME_IN WRITE (TAB_ANOM (SAVIND_ANOM + 1), 041) END IF C Sauvegarde dans TAB_FORM_INIT des enregistrements lus: TAB_FORM_INIT (CPT_ENREG) = ENREG_F C Initialisation des éléments utiles au traitement d'1 enreg. CALL INIT_VAR (TAB_INT_VAL, LONG_DIMS) C Boucle d'exploration des caractères d'un même enregistrement. DO WHILE (IND_F <= LEN (ENREG_F) ) C_XX = ENREG_F (IND_F:1) C Identification des caractères significatifs (# de space) IF (C_XX .eq. ' ' .AND. IND_F < LEN(ENREG_F)) THEN C Traitement du groupe venant d'être identifié (ICPT_CAR). IF (ICPT_CAR > 0) THEN ZONE_GRP (1:ICPT_CAR) = S ENREG_F (ISAVE_POS:ISAVE_POS + ICPT_CAR) ISAVE_POS = IND_F + 1 ISAVE_CPT_CAR = ICPT_CAR ICPT_CAR = 0 IF (ZONE_GRP (1:2)== '->') THEN AV2_POSTES_FLECHE (CPT_ENREG) = ICPT_GRP END IF ICPT_GRP = ICPT_GRP + 1 C Elimination des espaces superflus (> 1) entre 2 groupes. ELSE ISAVE_POS = ISAVE_POS + 1 END IF ELSE C Comptage du nb.de c. constituant le groupe en cours. ICPT_CAR = ICPT_CAR + 1 C????????????? IF (ZONE_GRP (1:1) .ne. ' ' .OR. IND_F == 1) THEN IF (ZONE_GRP (1:1) .ne. ' ' ) THEN C Recherche d'égalité entre TAB_GRP <=> groupe en cours. CALL CHERCH_GRP (ZONE_GRP, TAB_GRP, IS_KO_OK, S NB_POSTES, NB_POSTES_VALID, IPOS_GRP) C Le groupe existe (OK) ou pas (KO) en table TAB_GRP ? IF (IS_KO_OK == 1 ) THEN IF (ZONE_GRP (1:2)== '->') THEN AV_POSTES_FLECHE (CPT_ENREG) = IND_GRP ELSE C Formatage TAB_FORM Table formules sans opérateur: IND_GRP = IND_GRP + 1 TAB_FORM (CPT_ENREG) = S TAB_FORM (CPT_ENREG) (1:IPOS_TRANS) // S ZONE_GRP (1:ISAVE_CPT_CAR) IPOS_TRANS = IPOS_TRANS + ISAVE_CPT_CAR + 1 C Correspondance groupe <=> valeur numérique TAB_INT_VAL (IND_GRP) = TAB_VAL_GRP (IPOS_GRP) END IF C KO ELSE IF (IS_KO_OK == 0) THEN C Groupe inconnu dans table TAB_GRP. INDIC_ANOM = INDIC_ANOM + 1 WRITE (TAB_ANOM (INDIC_ANOM), 060) S ZONE_GRP (1:10), S ENREG_F (1:32) END IF ! Fin du précédent IF END IF ! Fin du test OK KO ZONE_GRP = ' ' END IF ! Fin du test ZONE_GRP (1:1) END IF ! Fin du test ident. des c. IND_F = IND_F + 1 END DO ! Fin de la Boucle d'exploration des c. d'un enreg. C Traitement effectué uniquement s'il n'existe aucune anomalie. IF (INDIC_ANOM == 0 ) THEN C Par enregistrement génération d'une valeur alpha/numérique. ZONE_L_DIMS = LONG_DIMS CALL GENER_VAL (TAB_INT_VAL, ZONE_L_DIMS, S TAB_RANG_OK, IVAL_NUM, EXT_OUT ) TAB_CHAR_NUM (CPT_ENREG) = TAB_RANG_OK TAB_VAL_NUM (CPT_ENREG) = IVAL_NUM END IF END IF ! Fin normale de fichier. END DO ! Fin de la Boucle de lecture du fichier. C Affichage des messages d'Information/Anomalie en fin d'exécution. CALL AFFICH_STATANO ( TAB_ANOM, TAB_INFOS, INDIC_ANOM, S INDIC_INFOS ) C Séquence itérative d'écriture des fichiers: 1 fichier par formule II = 1 C DO WHILE ( II <= CPT_ENREG ) C F_NAME_OUT = TAB_CHAR_NUM (II) F_NAME_OUT = 'VVVV.TXT' IO_ORDRE = 'OPEN_NOFORM' OPEN (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FILE = F_NAME_OUT, STATUS = 'NEW', S ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED', S ERR = 15) IO_ORDRE = 'OPEN_NOFORM' II = 1 DO WHILE ( II <= CPT_ENREG ) IO_ORDRE = 'WRITE_NOFORM' WRITE (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FMT = FMT_OUT, ERR = 15) S TAB_CHAR_NUM (II), ! Si changement modifier le format S TAB_FORM (II), ! FMT_OUT en conséquence. S TAB_FORM_INIT (II) C Contenu de chaque enreg. (à déterminer précisément) II = II + 1 END DO IO_ORDRE = 'CLOSE_NOFORM' CLOSE (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S ERR = 15, STATUS = 'KEEP') IO_ORDRE = 'OPEN_NOFORM' OPEN (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FILE = F_NAME_OUT, STATUS = 'OLD', S ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED', S ERR = 15) IO_ORDRE = 'OPEN_NOFORM' IO_ORDRE = 'REWIND' REWIND (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, ERR = 15) II = 1 DO WHILE (IO_RC .ne. -1 ) IO_ORDRE = 'READ' READ (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FMT = FMT_OUT, ERR = 15) S TAB_CHAR_NUM (II), ! Si changement modifier le format S TAB_FORM (II), ! FMT_OUT en conséquence. S TAB_FORM_INIT (II) IF (IO_RC .eq. -1) THEN INDIC_ANOM = INDIC_ANOM + 1 WRITE (TAB_ANOM (INDIC_ANOM), 030) NOM_PGM, S IO_RC, S IO_ORDRE INDIC_ANOM = INDIC_ANOM + 1 WRITE (TAB_ANOM (INDIC_ANOM), 031) CPT_ENREG C ELSE C PRINT *,'*TAB_CHAR_NUM (II) ', TAB_CHAR_NUM (II),' II ',II ENDIF II = II + 1 END DO IO_ORDRE = 'OPEN_DIR' OPEN (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FILE = F_NAME_OUT, STATUS = 'OLD', S ACCESS = 'DIRECT', FORM = 'FORMATTED', S ERR = 15, RECL = 78) IO_ORDRE = 'REWIND' REWIND (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, ERR = 15) C print *,'0000000000000000',TAB_CHAR_NUM (50) C print *,TAB_FORM (50) ! FMT_OUT en conséquence. C print *,TAB_FORM_INIT (50) IO_ORDRE = 'READ_DIR' READ (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FMT = FMT_OUT, REC = 1, S ERR = 15) S TAB_CHAR_NUM (50), S TAB_FORM (50), S TAB_FORM_INIT (50) C print *,'TAB_CHAR_NUM (50)', TAB_CHAR_NUM (50) C print *,'TAB_FORM (50)', TAB_FORM (50) C print *,'TAB_FORM_INIT (50)', TAB_FORM_INIT (50) (1:32) C pause go to 005 C------recherche d'une formule sur sa cle ------------------------ 00101 CONTINUE IO_ORDRE = 'REWIND' REWIND (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, ERR = 15) CPT_ENREG = 0 II = 1 TAB_CHAR_NUM (1) = ' ' DO WHILE (IO_RC .ne. -1 .AND. TAB_CHAR_NUM (1) S .ne. '12322') IO_ORDRE = 'READ' READ (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FMT = FMT_OUT, ERR = 15) S TAB_CHAR_NUM (1), ! Si changement modifier le format S TAB_FORM (1), ! FMT_OUT en conséquence. S TAB_FORM_INIT (1) IF (IO_RC .eq. -1) THEN PRINT *,F_NAME_OUT, ': Fin normale de fichier RC : ', S IO_RC,' SUR ORDRE : ', IO_ORDRE PRINT *,F_NAME_OUT,': Nb.d''enregistrements lus/affiches: ', S CPT_ENREG ELSE PRINT *, 'TAB_CHAR_NUM (1) ', TAB_CHAR_NUM (1) CPT_ENREG = CPT_ENREG + 1 ENDIF II = II + 1 END DO C call rien (II) C call rien2 (II) PAUSE C ENDFILE (p 88 IBM) IO_ORDRE = 'CLOSE_NOFORM' CLOSE (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S ERR = 15, STATUS = 'KEEP') C GO TO 001 C--------------------------------------------------------------------- II = 1 DO WHILE ( II <= CPT_ENREG ) F_NAME_OUT = TAB_CHAR_NUM (II) (1:16) IO_ORDRE = 'OPEN_NOFORM' OPEN (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FILE = F_NAME_OUT, STATUS = 'NEW', S ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED', S ERR = 15) IO_ORDRE = 'OPEN_NOFORM' IO_ORDRE = 'WRITE_NOFORM' WRITE (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S FMT = FMT_OUT, ERR = 15) S TAB_CHAR_NUM (II), ! Si changement modifier le format S TAB_FORM (II), ! FMT_OUT en conséquence. S TAB_FORM_INIT (II) C Contenu de chaque enreg. (à déterminer précisément) IO_ORDRE = 'CLOSE_NOFORM' CLOSE (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S ERR = 15, STATUS = 'KEEP') II = II + 1 END DO C--------------------------------------------------------------------- C ENDFILE (p 88 IBM) 005 ENDFILE (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, ERR = 15) IO_ORDRE = 'CLOSE_NOFORM' CLOSE (UNIT = DATA_UT_OUT, IOSTAT = IO_RC, S ERR = 15, STATUS = 'KEEP') IO_ORDRE = 'CLOSE_IN' CLOSE (UNIT = DATA_UT_IN, IOSTAT = IO_RC, S ERR = 15, STATUS = 'KEEP') C001 print *, ' ' print *, ' ' print *, ' ' print *, 'TAB_FORM_INIT : Table des formules avant compactage: ' IS_I = 1 do while (IS_I <= CPT_ENREG ) print *,TAB_FORM_INIT (IS_I) (1:42), 'nb.groupes avant -> ', S AV2_POSTES_FLECHE (IS_I), S '==> ', IS_I IS_I = IS_I + 1 end do print *, ' ' print *, 'TAB_FORM : Table des formules sans operateurs : ' IS_I = 1 do while (IS_I <= CPT_ENREG ) print *,TAB_FORM (IS_I), 'nb.groupes avant -> ', S AV_POSTES_FLECHE (IS_I), S '==> ', IS_I IS_I = IS_I + 1 end do print *, ' ' print *, 'TAB_VAL_NUM : Table des valeurs des formules : ' IS_I = 1 do while (IS_I <= CPT_ENREG ) print *, TAB_VAL_NUM (IS_I) IS_I = IS_I + 1 end do print *, ' ' C print *, 'TAB_CHAR_NUM : Table des valeurs des formules : ' print *, 'TAB_CHAR_NUM : Table des noms de fichiers/formules : ' IS_I = 1 do while (IS_I <= CPT_ENREG ) print *, TAB_CHAR_NUM (IS_I) IS_I = IS_I + 1 end do C----------------------------------------------------------------------- C ----------------------------------- C FORMAT (p 92 IBM) (p 77 fortran IV) C (WE3) Entrées Sortie et Formats (quatre cinquième de page web). C FORMATS des messages d'anomalie/information (TAB_ANOM TAB_INFOS) 030 FORMAT ('--Fin normale de fichier ', A15, S 'RC : ', I2, S ' SUR ORDRE :', A16 ) 031 FORMAT ('Nb. d''enregistrements traités : ', I4, S ' pour un max. de ', I4 ) 040 FORMAT ( I4, S ' PLUS DE ', I4, S ' ENREGISTREMENTS DANS LE FICHIER ', A15 ) 041 FORMAT ( S ' (Affecter une valeure superieure a la variable LONG_TABS.)') 060 FORMAT ( A6, S ' INCONNU DANS TABLE TAB_GRP.', S ' FORMULE: ', A32 ) 500 FORMAT ( A80 ) 1000 FORMAT ( S '0 1 2 3 4 5 ', S ' 6 7 8' ) 1010 FORMAT ( S '1---5----0----5----0----5----0----5----0----5----0----5', S '----0----5----0----5----0', / ) GO TO 110 15 PRINT *,' ' PRINT *, 'ANOMALIE ENTREE/SORTIE FS : ', IO_RC, ' SUR ORDRE :' S ,IO_ORDRE 110 CONTINUE STOP END C*********************************************************************** C S.P.APPELES PAR UN ORDRE CALL PRESENT DANS LA SEQUENCE PRINCIPALE. C*********************************************************************** C----------------------------------------------------------------------- C S.P. d'initialisation des variables utiles au traitement. C----------------------------------------------------------------------- SUBROUTINE INIT_GEN () IMPLICIT NONE INTEGER NB_POSTES_VALID INTEGER NB_POSTES INTEGER INDIC_ANOM INTEGER INDIC_INFOS INTEGER SAVIND_ANOM INTEGER CPT_ENREG INTEGER IO_RC COMMON /ANOM_INIT/ S NB_POSTES_VALID, NB_POSTES, INDIC_ANOM, S INDIC_INFOS, SAVIND_ANOM, CPT_ENREG, IO_RC NB_POSTES_VALID = 1 NB_POSTES = 1 INDIC_ANOM = 0 INDIC_INFOS = 0 SAVIND_ANOM = 0 CPT_ENREG = 0 IO_RC = 0 RETURN END C----------------------------------------------------------------------- C S.P. effectuant les principaux contrôles. C----------------------------------------------------------------------- SUBROUTINE CONTROL_GEN (TAB_GRP, TAB_ANOM, LONG_TABS, S DATA_UT_IN, F_NAME_IN ) IMPLICIT NONE CHARACTER IO_ORDRE*16 CHARACTER F_NAME_IN*16 DIMENSION TAB_GRP (*) !Tableau des signes et CHARACTER TAB_GRP*32 !groupes de c. valides. DIMENSION TAB_ANOM (*) !Tableau des meessages CHARACTER TAB_ANOM*80 !d'anomalies détectées. CHARACTER SYMB_FINGRP INTEGER NB_POSTES_VALID INTEGER NB_POSTES INTEGER INDIC_ANOM INTEGER INDIC_INFOS INTEGER SAVIND_ANOM INTEGER CPT_ENREG INTEGER IO_RC INTEGER DATA_UT_IN INTEGER LONG_TABS COMMON /ANOM_INIT/ S NB_POSTES_VALID, NB_POSTES, INDIC_ANOM, S INDIC_INFOS, SAVIND_ANOM, CPT_ENREG, IO_RC C Contrôle de présence du fichier en entrée (ouverture si OK) IO_ORDRE = 'OPEN_IN' OPEN (UNIT = DATA_UT_IN, IOSTAT = IO_RC, S FILE = F_NAME_IN, STATUS = 'OLD', S ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED' ) IF (IO_RC .ne. 0) THEN INDIC_ANOM = INDIC_ANOM + 1 WRITE (TAB_ANOM (INDIC_ANOM), 010) F_NAME_IN, S IO_RC, S IO_ORDRE END IF C Recherche la position de la borne £ de fin des groupes à retenir. NB_POSTES_VALID = 1 DO WHILE (TAB_GRP (NB_POSTES_VALID) (1:1) .ne. '£' .AND. S NB_POSTES_VALID <= LONG_TABS ) NB_POSTES_VALID = NB_POSTES_VALID + 1 IF (NB_POSTES_VALID > LONG_TABS) THEN INDIC_ANOM = INDIC_ANOM + 1 SYMB_FINGRP = '£' C ------------------------- C Internal Files (p 76 IBM) WRITE (TAB_ANOM (INDIC_ANOM), 020) SYMB_FINGRP END IF END DO C Recherche de la position de la borne $ de fin du tableau. NB_POSTES = 1 DO WHILE (TAB_GRP (NB_POSTES) (1:1) .ne. '$' .AND. S NB_POSTES <= LONG_TABS ) NB_POSTES = NB_POSTES + 1 IF (NB_POSTES > LONG_TABS) THEN INDIC_ANOM = INDIC_ANOM + 1 SYMB_FINGRP = '$' WRITE (TAB_ANOM (INDIC_ANOM), 020) SYMB_FINGRP END IF END DO 010 FORMAT ('--ERREUR A L''OUVERTURE DU FICHIER: ', A15, S ' RC : ', I2, S ' SUR ORDRE :', A16 ) 020 FORMAT ('ABSENCE DE BORNE DE FIN DE GROUPES (', A, S ') TABLE TAB_GRP.' ) RETURN END C----------------------------------------------------------------------- C S.P.d'initialisation des variables utiles au traitement d'1 enreg C----------------------------------------------------------------------- SUBROUTINE INIT_VAR (TAB_INT_VAL, LONG_DIMS) IMPLICIT NONE INTEGER IND_F INTEGER ICPT_CAR INTEGER ICPT_GRP INTEGER ISAVE_CPT_CAR INTEGER ISAVE_POS INTEGER IPOS_TRANS INTEGER IVAL_NUM INTEGER IND_GRP INTEGER LONG_DIMS INTEGER*8 TAB_INT_VAL (*) !Tableau de résultats intermédiaires. INTEGER II /1/ COMMON /VAR_INIT/ S IND_F, ICPT_CAR, ICPT_GRP, ISAVE_CPT_CAR, S ISAVE_POS, IPOS_TRANS, IVAL_NUM, IND_GRP IND_F = 1 ICPT_CAR = 0 ICPT_GRP = 0 ISAVE_CPT_CAR = 0 ISAVE_POS = 1 IPOS_TRANS = 0 IVAL_NUM = 0 IND_GRP = 0 II = 1 DO WHILE (II <= LONG_DIMS) TAB_INT_VAL (II) = -1 II = II + 1 END DO RETURN END C----------------------------------------------------------------------- C S.P. de recherche d'égalité entre TAB_GRP <=> groupe en cours. C----------------------------------------------------------------------- SUBROUTINE CHERCH_GRP ( GRP, TAB_GRP, IS_KO_OK, NB_POSTES, S NB_POSTES_VALID, IS_POS_GRP ) IMPLICIT NONE CHARACTER GRP*64 INTEGER IS_POS_GRP INTEGER NB_POSTES_VALID INTEGER NB_POSTES INTEGER IS_KO_OK DIMENSION TAB_GRP(*) !Tableau des groupes de caractères et CHARACTER TAB_GRP*32 !signes valides.(voir dimension en main) IS_KO_OK = 2 IS_POS_GRP = 1 DO WHILE ( IS_POS_GRP < NB_POSTES .AND. S TAB_GRP (IS_POS_GRP) .ne. GRP ) IS_POS_GRP = IS_POS_GRP + 1 END DO IF (IS_POS_GRP < NB_POSTES_VALID) THEN IS_KO_OK = 1 ELSE IF (IS_POS_GRP == NB_POSTES) THEN IS_KO_OK = 0 END IF END IF RETURN END C----------------------------------------------------------------------- C S.P. de génération d'une valeur numérique par formule C----------------------------------------------------------------------- SUBROUTINE GENER_VAL ( TAB_VAL, IS_POS_VAL, TAB_RANG, S IS_VAL_NUM, S_EXT_OUT ) IMPLICIT NONE CHARACTER*16 ZONE_CHARNUM CHARACTER*1 CS_XX CHARACTER S_EXT_OUT*12 CHARACTER TAB_RANG*32 INTEGER IS_IND_CAR /0/ INTEGER IS_VAL9 /0/ INTEGER IND_RANG /0/ INTEGER IS_RANG /0/ INTEGER IS_SYSNUM /10/ INTEGER IS_VAL_NUM INTEGER IS_POS_VAL INTEGER*8 TAB_VAL (*) TAB_RANG = ' ' IND_RANG = LEN (TAB_RANG) IS_RANG = 0 IS_VAL_NUM = 0 DO WHILE (IS_POS_VAL > 0 ) IF (TAB_VAL (IS_POS_VAL) > -1) THEN WRITE (ZONE_CHARNUM, '(I5)') TAB_VAL (IS_POS_VAL) IS_IND_CAR = LEN (ZONE_CHARNUM ) DO WHILE (IS_IND_CAR > 0 ) CS_XX = ZONE_CHARNUM (IS_IND_CAR:1) IF (CS_XX .ne. ' ') THEN IND_RANG = IND_RANG - 1 TAB_RANG = CS_XX // TAB_RANG (1:IND_RANG) IS_VAL9 = ICHAR (CS_XX) - 48 IS_VAL_NUM = IS_VAL_NUM + S ( IS_VAL9 * (IS_SYSNUM**IS_RANG ) ) IS_RANG = IS_RANG + 1 END IF IS_IND_CAR = IS_IND_CAR - 1 END DO END IF IS_POS_VAL = IS_POS_VAL - 1 END DO C print *, 'TAB_RANG ',TAB_RANG C Ajout de l'extension au nom des fichiers?????????????????. C TAB_RANG = TAB_RANG (1:IS_RANG) // S_EXT_OUT C----- COMMENTAIRES: C ------------- C Tableau de stockage résultats intermédiaires:TAB_GRP<=>TAB_VAL_GRP C TAB_VAL à ce niveau se présente sous forme: (-1 =poste inutilisé) C 13 3 6 3 14 14 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 C Attribution d'un identifiant numérique à chaque formule par con- C caténation des valeurs associées à chacun des groupes la consti- C tuant. Ex: (Un élément de TAB_VAL ci dessus): C Concaténation de 14 14 3 6 3 13 ==> 133631414 C Chaque valeur attribuée à un groupe est d'abord transcrite en C "mode caractères" afin d'en extraire, un à un, le(s) chiffre(s) C le composant. (Ex: valeur du groupe: "13" ==> "3" puis "1"). Dans C un second temps la fonction ICHAR permet de ré-attribuer à chacun C d'eux leur identité numérique (type) nécessaire au calcul: C C Chaque caractère numérique est ensuite évalué de manière classi- C que en terme de puissance de 10 relativement au rang* qu'il C occupe dans la suite de chiffres ainsi constituée. C * Position évaluée et comptée de 0 à n de la droite vers la gauche. C----------------------------------------------------------------------- RETURN END C----------------------------------------------------------------------- C S.P.Affichage en fin d'exécution messages d'Information/Anomalie. C----------------------------------------------------------------------- SUBROUTINE AFFICH_STATANO ( TAB_ANOM, TAB_INFOS, INDIC_ANOM, S INDIC_INFOS ) IMPLICIT NONE INTEGER INDIC_ANOM INTEGER INDIC_INFOS INTEGER II /1/ DIMENSION TAB_ANOM (*) !Tableau des messages d'anomalies CHARACTER TAB_ANOM*80 DIMENSION TAB_INFOS (*) !Tableau des messages d'informations. CHARACTER TAB_INFOS*80 II = 1 IF (INDIC_ANOM .ne. 0 ) THEN WRITE (*, 010) INDIC_ANOM DO WHILE (II <= INDIC_ANOM ) WRITE (*, 020) TAB_ANOM (II) II = II + 1 END DO ELSE DO WHILE (II <= INDIC_INFOS) WRITE (*, 020) TAB_INFOS (II) II = II + 1 END DO END IF 010 FORMAT (///, S ' COMPTE RENDU DES ANOMALIE(S) DETECTEE(S) ', S I2, S ' LIGNE(S):' / ) 020 FORMAT ('/- ', A80 ) RETURN END C----------------------------------------------------------------------- C S.P. Ecriture en table des messages d'Information. C----------------------------------------------------------------------- SUBROUTINE AFFICH_STATINFOS (TAB_INFOS, F_NAME_IN, INDIC_INFOS, S IO_ORDRE, LONG_TABS, CPT_ENREG, S IO_RC ) IMPLICIT NONE CHARACTER F_NAME_IN*16 CHARACTER IO_ORDRE*16 INTEGER INDIC_INFOS INTEGER IO_RC INTEGER CPT_ENREG INTEGER LONG_TABS DIMENSION TAB_INFOS (*) !Tableau des messages d'informations. CHARACTER TAB_INFOS*80 INDIC_INFOS = INDIC_INFOS + 1 WRITE (TAB_INFOS (INDIC_INFOS), *) ' ' INDIC_INFOS = INDIC_INFOS + 1 WRITE (TAB_INFOS (INDIC_INFOS), 010) F_NAME_IN, S IO_RC, S IO_ORDRE INDIC_INFOS = INDIC_INFOS + 1 WRITE (TAB_INFOS (INDIC_INFOS), 011) CPT_ENREG, S LONG_TABS - 1 010 FORMAT ('Fin normale de fichier ', A15, S 'RC : ', I2, S ' SUR ORDRE :', A16 ) 011 FORMAT ('Nb. d''enregistrements traités : ', I4, S ' pour un max. de ', I4 ) RETURN END
-
Bonjour mon ami,
Tu as un très bon tutoriel à lire pour apprendre les tableau sur MATLAB ici : https://briot-jerome.developpez.com/matlab/tutoriels/introduction-gestion-matrices/
Bon courage -
bonjour à tous
je suis un débutant en programmation et je veux comprendre le language fortran 77 pour pouvoir faire la progragrammation, aider moi
