2018-06-26 15:20:39 -04:00
|
|
|
program encode77
|
2018-06-21 10:51:19 -04:00
|
|
|
|
2018-07-05 14:07:17 -04:00
|
|
|
use packjt77
|
|
|
|
|
|
2018-06-29 12:02:29 -04:00
|
|
|
character*80 msg0
|
|
|
|
|
character msg*37,cerr*1
|
2018-06-26 15:20:39 -04:00
|
|
|
character*77 c77
|
2018-07-29 16:34:21 -04:00
|
|
|
character*80 infile
|
2018-09-18 13:28:41 -04:00
|
|
|
logical unpk77_success
|
2018-06-21 10:51:19 -04:00
|
|
|
|
2018-06-27 16:41:58 -04:00
|
|
|
nargs=iargc()
|
2018-07-29 16:34:21 -04:00
|
|
|
if(nargs.ne.1 .and.nargs.ne.2) then
|
|
|
|
|
print*,'Usage: encode77 "message"'
|
|
|
|
|
print*,' encode77 -f <infile>'
|
|
|
|
|
go to 999
|
|
|
|
|
endif
|
|
|
|
|
call getarg(1,msg0)
|
|
|
|
|
if(nargs.eq.2) then
|
|
|
|
|
call getarg(2,infile)
|
|
|
|
|
open(10,file=infile,status='old')
|
|
|
|
|
write(*,1000)
|
|
|
|
|
1000 format('i3.n3 Err Message to be encoded Decoded message' &
|
|
|
|
|
/80('-'))
|
|
|
|
|
endif
|
2018-06-28 13:17:32 -04:00
|
|
|
|
2018-06-21 10:51:19 -04:00
|
|
|
do iline=1,999
|
2018-07-29 16:34:21 -04:00
|
|
|
if(nargs.eq.2) read(10,1002,end=999) msg0
|
|
|
|
|
1002 format(a80)
|
2018-06-29 12:02:29 -04:00
|
|
|
if(msg0(1:1).eq.'$') exit
|
|
|
|
|
if(msg0.eq.' ') cycle
|
|
|
|
|
if(msg0(2:2).eq.'.' .or. msg0(3:3).eq.'.') cycle
|
|
|
|
|
if(msg0(1:3).eq.'---') cycle
|
|
|
|
|
msg0=adjustl(msg0)
|
2018-07-29 19:39:55 -04:00
|
|
|
i3=-1
|
|
|
|
|
n3=-1
|
2018-06-29 12:02:29 -04:00
|
|
|
call pack77(msg0(1:37),i3,n3,c77)
|
2018-09-18 13:28:41 -04:00
|
|
|
call unpack77(c77,msg,unpk77_success)
|
2018-06-21 10:51:19 -04:00
|
|
|
cerr=' '
|
2018-06-29 12:02:29 -04:00
|
|
|
if(msg.ne.msg0(1:37)) cerr='*'
|
|
|
|
|
if(i3.eq.0) write(*,1004) i3,n3,cerr,msg0(1:37),msg
|
2018-06-28 14:12:05 -04:00
|
|
|
1004 format(i2,'.',i1,2x,a1,3x,a37,1x,a37)
|
2018-06-29 12:02:29 -04:00
|
|
|
if(i3.ge.1) write(*,1005) i3,cerr,msg0(1:37),msg
|
2018-06-28 14:12:05 -04:00
|
|
|
1005 format(i2,'.',3x,a1,3x,a37,1x,a37)
|
2018-06-27 16:41:58 -04:00
|
|
|
if(nargs.eq.1) exit
|
2018-06-21 10:51:19 -04:00
|
|
|
enddo
|
|
|
|
|
|
2018-06-26 15:20:39 -04:00
|
|
|
999 end program encode77
|
2018-06-21 10:51:19 -04:00
|
|
|
|
|
|
|
|
include '../chkcall.f90'
|
