program f90_HP5set implicit none integer,parameter::nn=50 integer::i,io,it,ilist,ihead,imenu,icom,ilink,ifoot,kk,kart character(len=120)::fnameL,fnameR(1:nn),fnameW(1:nn) character(len=120)::str1(1:nn),str2(1:nn),dummy character(len=2000)::linebuf character(len=200)::shead(1:50) character(len=200)::smenu(1:500) character(len=200)::scom(1:500) character(len=200)::slink(1:50) character(len=200)::sfoot(1:50) character(len=50)::datime datime=CALLDATE() i=0 open(11,file='inp_flist.txt',status='old') do i=i+1 read(11,*,iostat=io) fnameR(i),str1(i),str2(i) if(io<0)exit dummy=str1(i) call rep_ub(dummy) str1(i)=dummy dummy=str2(i) call rep_ub(dummy) str2(i)=dummy end do ilist=i-1 i=0 open(11,file='inp_head.txt',status='old') do i=i+1 read(11,'(a)',iostat=io) shead(i) if(io<0)exit end do ihead=i-1 i=0 open(11,file='inp_menu.txt',status='old') do i=i+1 read(11,'(a)',iostat=io) smenu(i) if(io<0)exit end do imenu=i-1 i=0 open(11,file='inp_com.txt',status='old') do i=i+1 read(11,'(a)',iostat=io) scom(i) if(io<0)exit end do icom=i-1 i=0 open(11,file='inp_link.txt',status='old') do i=i+1 read(11,'(a)',iostat=io) slink(i) if(io<0)exit end do ilink=i-1 i=0 open(11,file='inp_foot.txt',status='old') do i=i+1 read(11,'(a)',iostat=io) sfoot(i) if(io<0)exit end do ifoot=i-1 do kk=1,ilist dummy=fnameR(kk) fnameL(1:)=dummy(2:) fnameW(kk)='c:\WANtaroHP_F90_html5\'//fnameL open(11,file=fnameR(kk),status='old') open(12, file=fnameW(kk), status='replace') kart=0 do read(11,'(a)',iostat=io) linebuf if(io<0)exit it=0 if(linebuf(1:6)=='')cycle if(linebuf(1:6)=='') it=1 if(linebuf(1:3)=='')it=3 select case(it) case(0) write(12,'(a)') trim(linebuf) case(1) do i=1,ihead dummy=shead(i) if(dummy(1:7)=='')then shead(i)='<title>WANtaroHP ('//trim(adjustl(str1(kk)))//')' end if if(dummy(1:21)=='

')then shead(i)='
WANtaroHP ('//trim(adjustl(str2(kk)))//')
' end if write(12,'(a)') trim(adjustl(shead(i))) end do if(index(fnameL,'index.html')/=0)then linebuf='
Last update: '//trim(adjustl(datime))//& ' (First upload of English pages: 13th November, 2012)
' write(12,'(a)') trim(adjustl(linebuf)) end if write(12,'()') write(12,'(a)') '
' do i=1,imenu write(12,'(a)') trim(adjustl(smenu(i))) end do if(0' write(12,'()') write(12,'(a)') '
' case(2) if(1<=kart)then write(12,'(a)') '' do i=1,ilink write(12,'(a)') trim(adjustl(slink(i))) end do end if kart=kart+1 write(12,'()') write(12,'()') write(12,'()') write(12,'(a)') '
' write(12,'(a)') trim(adjustl(linebuf)) case(3) do i=1,ifoot write(12,'(a)') trim(adjustl(sfoot(i))) end do end select if(linebuf(1:7)=='')exit end do close(12) close(11) end do stop contains character(len=50) function CALLDATE() character(len=8)::date character(len=10)::time character(len=5)::zone integer::values(1:8) integer::i character(len=4)::ye character(len=4)::da character(len=10)::mo character(len=5)::ti character(len=10)::str character(len=50)::datime call DATE_AND_TIME(date,time,zone,values) ye=date(1:4) mo=date(5:6) da=date(7:8) ti=time(1:2)//':'//time(3:4) if(trim(adjustl(mo))=='01')mo='January' if(trim(adjustl(mo))=='02')mo='February' if(trim(adjustl(mo))=='03')mo='March' if(trim(adjustl(mo))=='04')mo='April' if(trim(adjustl(mo))=='05')mo='May' if(trim(adjustl(mo))=='06')mo='June' if(trim(adjustl(mo))=='07')mo='July' if(trim(adjustl(mo))=='08')mo='August' if(trim(adjustl(mo))=='09')mo='September' if(trim(adjustl(mo))=='10')mo='October' if(trim(adjustl(mo))=='11')mo='November' if(trim(adjustl(mo))=='12')mo='December' CALLDATE=trim(adjustl(da))//' '//trim(adjustl(mo))//' '//trim(adjustl(ye))//' at '//trim(adjustl(ti)) end function CALLDATE subroutine rep_ub(s) !Replaceing underbar with space character (*), intent (inout) :: s integer i do i = 1, len(s) if (s(i:i)=='_') s(i:i)=' ' end do end subroutine rep_ub end program f90_HP5set