       identification division.

       program-id. example1.

       environment division.

       configuration section.

       input-output section.

       file-control.
           select textin assign textin
                  access mode is sequential
                  file status is textin-fs.

           select textout assign textout
                  access mode is sequential
                  file status is textout-fs.

       data division.

       file section.

       fd textin                   block 0
                                   recording f.
       01  filler                  pic  x(55).

       fd textout                  block 0
                                   recording f.
       01  out-rec                 pic  x(77).


       working-storage section.

      *    counters

       01  blanks                  pic s9(04) comp value zero.
       01  chars                   pic s9(04) comp value zero.
       01  ind                     pic s9(04) comp value zero.
       01  text-len                pic s9(04) comp value zero.
      *    op. 9,10,11
       01  total-blanks            pic s9(04) comp value zero.
       01  total-chars             pic s9(04) comp value zero.
       01  total-len               pic s9(04) comp value zero.

      *    switches

       01  char-flag               pic  x          value space.
           88  char-not-found                      value 'N'.
           88  char-found                          value 'F'.
       01  eof-flag                pic  x          value 'D'.
       01  textin-fs               pic  x(02)      value spaces.
           88  textin-fs-ok                        value '00'.
           88  textin-fs-end                       value '10'.
       01  textout-fs              pic  x(02)      value spaces.
           88  textout-fs-ok                       value '00'.

      *    records

       01  in-string               pic  x(55)      value spaces.
       01  out-line.
           05  out-string          pic  x(55)      value spaces.
           05  filler              pic  x(02)      value spaces.
           05  chars-9             pic  z(03)9     value zero.
           05  filler              pic  x(04)      value spaces.
           05  blanks-9            pic  z(03)9     value zero.
           05  filler              pic  x(04)      value spaces.
           05  len-9               pic  z(03)9     value zero.
       01  header-line.
           05  filler              pic  x(55)      value 'Text'.
           05  filler              pic  x(22)      value
                                   ' chars  blanks  length'.
       01  empty-line              pic  x(77)      value spaces.
       01  footer-line.
           05  filler              pic  x(55)      value spaces.
           05  filler              pic  x(22)      value
                                   '  ====    ====    ===='.


      *------------------*
       procedure division.
      *------------------*
       main section.
      *    op. 1 & 2: open input & output files
           open input  textin
           open output textout

      *    op. 6: read 1st input record
           perform text-read

      *    op. 7,8: generate header
           write out-rec from header-line
           write out-rec from empty-line

      *    I1: build extended strings
           perform until eof-flag = 'E'
      *       op. 12,13
              move zero to chars
                           blanks

      *       I2: process input string & op. 15 / 16
              perform varying ind from 1 by 1
                      until ind > text-len
      *          S3: blank found?
                 if in-string(ind:1) = space
      *             op. 18
                    add 1 to blanks
                 else
      *             op. 17
                    add 1 to chars
                 end-if
              end-perform

      *       op. 19,20,21,22,23
              add  chars       to total-chars
              add  blanks      to total-blanks
              add  text-len    to total-len
              move in-string   to out-string
              move chars       to chars-9
              move blanks      to blanks-9
              move text-len    to len-9

      *       op. 24
              write out-rec from out-line

      *       op. 6: read next input record
              perform text-read
           end-perform

      *    generate footer
      *    op. 25
           move total-chars  to chars-9
           move total-blanks to blanks-9
           move total-len    to len-9

      *    op. 26
           write out-rec from footer-line

      *    op. 27
           move spaces   to   out-string (1:49)
           move 'totals' to   out-string (50:6)
           write out-rec from out-line

      *    op. 3,4,5: close input & output files, stop
           close textin
           close textout
           stop run.

      * The section text-read prepares the input data for the main section and
      * it sets the end indicator when EOF is reached.
      * For each existing record, text-read determines its length without
      * trailing blanks.
      * Read errors cause an error message to be written before the program
      * terminates with the return code 16.

       text-read section.

           read textin into in-string

           if textin-fs-ok
      *       op. 14 (initial)
              move zero           to text-len
              set  char-not-found to true

              perform varying ind from 55 by -1
                      until ind < 1 or
                            char-found
                 if not in-string(ind:1) = space
      *             op. 14 (final)
                    move ind        to text-len
                    set  char-found to true
                 end-if
              end-perform
           else
              if textin-fs-end
                 move 'E' to eof-flag
              else
                 display '++++ textin-fs = ' textin-fs
                 move 16 to return-code
                 stop run
              end-if
           end-if
           continue.
