XeBuZer0

Fibonacci's secuence in Cobol (direct)

Dec 22nd, 2019
669
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  7.        IDENTIFICATION DIVISION.
  8.        PROGRAM-ID. XBZ0-FIB.
  9.        AUTHOR JESUS GUSTAVO VARGAS PEREZ (XEBUZER0).
  10.        INSTALLATION EN TU KORA :V .
  11.        DATE-WRITTEN 22-DICIEMBRE-2019.
  12.        DATE-COMPILED 22-DICIEMBRE-2019.
  13.        REMARKS Al chile soy la mera v3rdur4 put05.
  14.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  15.        ENVIRONMENT DIVISION.
  16.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  17.        DATA DIVISION.
  18.             WORKING-STORAGE SECTION.
  19.                 01 WS-NUMBER  PIC 9(18)V9(20) VALUE ZEROS.
  20.                 01 WS-GOLDENRATIO-EQUATION-ROOTS.
  21.                     02 RT1    PIC 9(18)V9(20) VALUE ZEROS.
  22.                     02 RT2    PIC 9(18)V9(20) VALUE ZEROS.
  23.                 01 WS-TOTAL   PIC 9(18)V9(20) VALUE ZEROS.
  24.                 01 WS-RZCU5   PIC 9(18)V9(20) VALUE ZEROS.
  25.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  26.        PROCEDURE DIVISION.
  27.        000-PRINCIPAL.
  28.             PERFORM 100-LEER-NUM.
  29.             PERFORM 200-FIBONACCI.
  30.             PERFORM 300-SALIR.
  31.        000-EXIT.
  32.        EXIT.
  33.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  34.        005-SANITIZAR.
  35.             IF WS-NUMBER < 0 THEN
  36.                 MULTIPLY WS-NUMBER BY -1 GIVING WS-NUMBER.
  37.        005-EXIT.
  38.        EXIT.
  39.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  40.        010-INICIALIZA-RAICES.
  41.             COMPUTE WS-RZCU5 = 5 ** 0.5.
  42.             MOVE WS-RZCU5 TO RT1.
  43.             ADD 1 TO RT1 GIVING RT1.
  44.             DIVIDE RT1 BY 2 GIVING RT1.
  45.             SUBTRACT 1 FROM RT1 GIVING RT2.
  46.             DISPLAY RT1.
  47.             DISPLAY RT2.
  48.             DISPLAY WS-RZCU5.
  49.        010-EXIT.
  50.        EXIT.
  51.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  52.        100-LEER-NUM.
  53.             PERFORM 010-INICIALIZA-RAICES.
  54.             DISPLAY "INGRESE NÚMERO ".
  55.             ACCEPT WS-NUMBER.
  56.        100-EXIT.
  57.        EXIT.
  58.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  59.        200-FIBONACCI.
  60.             PERFORM 250-FIBODIRE.
  61.             DISPLAY "EL NÚMERO DE FIBONACCI ES: " WS-TOTAL.
  62.        200-EXIT.
  63.        EXIT.
  64.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  65.        250-FIBODIRE.
  66.             COMPUTE  RT1 = RT1 ** WS-NUMBER.
  67.             COMPUTE  RT2 = RT2 ** WS-NUMBER.
  68.             ADD RT1 TO RT2 GIVING WS-TOTAL.
  69.             DIVIDE WS-TOTAL BY WS-RZCU5 GIVING WS-TOTAL.
  70.             ADD 0.1 TO WS-TOTAL ROUNDED.
  71.             COMPUTE WS-TOTAL = FUNCTION INTEGER-PART(WS-TOTAL).
  72.        250-EXIT.
  73.        EXIT.
  74.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
  75.        300-SALIR.
  76.             STOP RUN.
  77.        300-EXIT.
  78.        EXIT.
  79.       ***C**** ***O**** ***M**** ***M**** ***E**** ***N**** ***T****
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×