XeBuZer0

Fibonacci's secuence in Cobol (direct)

Dec 22nd, 2019 (edited)
1,540
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 3.28 KB | None | 0 0
  1.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  2.       * PROGRAMA QUE CALCULA LA SUCESIÓN DE FIBONACCI. CALCULA SIN *
  3.       * PROBLEMAS HASTA EL 85. PUEDE QUE PARA NÚMEROS MÁS GRANDES  *
  4.       * SE TENGA QUE UTILIZAR OTRO COMPILADOR DISTINTO A GNUCOBOL. *
  5.       * LICENCIADO BAJO GNU GENERAL PUBLIC LICENCE (GNU GPL) 3.0  *
  6.       ******** ********  F v q _ U k r a N a z i s  ******* ********
  7.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  8.        IDENTIFICATION DIVISION.
  9.        PROGRAM-ID. XBZ0-FIB.
  10.        AUTHOR JESUS GUSTAVO VARGAS PEREZ (XEBUZER0).
  11.        INSTALLATION EN TU KORA :V .
  12.        DATE-WRITTEN 22-DICIEMBRE-2019.
  13.        DATE-COMPILED 22-DICIEMBRE-2019.
  14.        REMARKS Al chile soy la mera v3rdur4 put05.
  15.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  16.        ENVIRONMENT DIVISION.
  17.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  18.        DATA DIVISION.
  19.             WORKING-STORAGE SECTION.
  20.                 01 WS-NUMBER  PIC 9(18)V9(20) VALUE ZEROS.
  21.                 01 WS-GOLDENRATIO-EQUATION-ROOTS.
  22.                     02 RT1    PIC 9(18)V9(20) VALUE ZEROS.
  23.                     02 RT2    PIC 9(18)V9(20) VALUE ZEROS.
  24.                 01 WS-TOTAL   PIC 9(18)V9(20) VALUE ZEROS.
  25.                 01 WS-RZCU5   PIC 9(18)V9(20) VALUE ZEROS.
  26.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  27.        PROCEDURE DIVISION.
  28.        000-PRINCIPAL.
  29.             PERFORM 100-LEER-NUM.
  30.             PERFORM 200-FIBONACCI.
  31.             PERFORM 300-SALIR.
  32.        000-EXIT.
  33.        EXIT.
  34.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  35.        005-SANITIZAR.
  36.             IF WS-NUMBER < 0 THEN
  37.                 MULTIPLY WS-NUMBER BY -1 GIVING WS-NUMBER.
  38.        005-EXIT.
  39.        EXIT.
  40.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  41.        010-INICIALIZA-RAICES.
  42.             COMPUTE WS-RZCU5 = 5 ** 0.5.
  43.             MOVE WS-RZCU5 TO RT1.
  44.             ADD 1 TO RT1 GIVING RT1.
  45.             DIVIDE RT1 BY 2 GIVING RT1.
  46.             SUBTRACT 1 FROM RT1 GIVING RT2.
  47.             DISPLAY RT1.
  48.             DISPLAY RT2.
  49.             DISPLAY WS-RZCU5.
  50.        010-EXIT.
  51.        EXIT.
  52.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  53.        100-LEER-NUM.
  54.             PERFORM 010-INICIALIZA-RAICES.
  55.             DISPLAY "INGRESE NÚMERO ".
  56.             ACCEPT WS-NUMBER.
  57.        100-EXIT.
  58.        EXIT.
  59.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  60.        200-FIBONACCI.
  61.             PERFORM 250-FIBODIRE.
  62.             DISPLAY "EL NÚMERO DE FIBONACCI ES: " WS-TOTAL.
  63.        200-EXIT.
  64.        EXIT.
  65.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  66.        250-FIBODIRE.
  67.             COMPUTE  RT1 = RT1 ** WS-NUMBER.
  68.             COMPUTE  RT2 = RT2 ** WS-NUMBER.
  69.             ADD RT1 TO RT2 GIVING WS-TOTAL.
  70.             DIVIDE WS-TOTAL BY WS-RZCU5 GIVING WS-TOTAL.
  71.             ADD 0.1 TO WS-TOTAL ROUNDED.
  72.             COMPUTE WS-TOTAL = FUNCTION INTEGER-PART(WS-TOTAL).
  73.        250-EXIT.
  74.        EXIT.
  75.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  76.        300-SALIR.
  77.             STOP RUN.
  78.        300-EXIT.
  79.        EXIT.
  80.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
Add Comment
Please, Sign In to add comment