program foldadp
c
c     folds an ADP ON29 (upper air) or ON124 (surface) file
c       ~dss/bin/ftn/.foldadp.f
c
c     written by Dennis Joseph - 2000?
c     modified by Gregg Walters and Chi-Fan Shih - May 2004
c     modified by Gregg Walters Jun 2007, to additionally handle blocks with
c       6432 and 5120 bytes/characters
c
c     compile with f77 or f90
c
c     your input file must be named "fort.11"
c     the output will be written to a file named "fort.12"
c
      character nb*30000, iunder*1
c
      write (*,*) ' '
      write (*,*) 'NOTE: YOUR INPUT FILE SHOULD BE NAMED fort.11'
      write (*,*) ' '
      write (*,*) 'ARE YOU RUNNING ON A PC UNDER MS WINDOWS?'
      write (*,*) '  ANSWER Y (for yes) OR N (for no)'
   3  continue
      read (*,8003)  iunder
8003  format (a1)
      if (iunder.eq.'Y'.or.iunder.eq.'y')  then
          ipc = 4       ! ipc = 4 to run on a PC under MS Windows
      else
          ipc = 1       ! ipc = 1 UNIX, Linux, etc.
      endif
   5  continue
      write (*,*) ' '
      write (*,*) 'PLEASE ENTER RECORD SIZE: 6440 , 6432 or 5120'
      read (*,8005)  ireclen
8005  format (i4)
      if (ireclen.eq.6440)  go to 7
      if (ireclen.eq.6432)  go to 7
      if (ireclen.eq.5120)  go to 7
      write (*,*) ' '
      write (*,*) 'PLEASE TRY AGAIN'
      go to 5
   7  continue
      len = ireclen / ipc
      open (11,access='direct',recl=len)
      nr = 1
   10 continue
      read (11,rec=nr,err=90)  nb(1:ireclen)
      if (ipc.eq.1)  then
        if (ireclen.eq.6440)  then
          write (12,9070)  nb(1:ireclen)
9070      format (a6440)
        endif
        if (ireclen.eq.6432)  then
          write (12,9071)  nb(1:ireclen)
9071      format (a6432)
        endif
        if (ireclen.eq.5120)  then
          write (12,9072)  nb(1:ireclen)
9072      format (a5120)
        endif
      else
        if (ireclen.eq.6440)  then
          write (12,9080)  nb(1:ireclen), char(12)
9080      format (a6440,a1)
        endif
        if (ireclen.eq.6432)  then
          write (12,9081)  nb(1:ireclen), char(12)
9081      format (a6432,a1)
        endif
        if (ireclen.eq.5120)  then
          write (12,9082)  nb(1:ireclen), char(12)
9082      format (a5120,a1)
        endif
      endif
      nr = nr + 1
      go to 10
   90 continue
      nr = nr - 1
      write (*,9090)  nr, ireclen
9090  format (/'folded ',i9,' ADP ON29',i6,' byte records')
      end