program f90_HSVrgbHEX implicit none integer::H,S,V integer::R,G,B character(len=7)::HEX character(len=13)::RGB integer::i,j character(len=50)::fnameW character(len=50)::fnameF character(len=3)::dum1,dum2,dum3 fnameW='bat_imk_ctl.bat' open(12, file=fnameW, status='replace') do i=1,12 H=(i-1)*30 do j=1,6 select case (j) case(1) S=255;V=255 case(2) S=128;V=255 case(3) S= 64;V=255 case(4) S= 64;V=192 case(5) S= 32;V=192 case(6) S= 16;V=192 end select call HSVtoRGB(H,S,V,R,G,B) HEX='#'//C10to16(R)//C10to16(G)//C10to16(B) write(dum1,'(i3)') R write(dum2,'(i3)') G write(dum3,'(i3)') B RGB='('//trim(adjustl(dum1))//','//trim(adjustl(dum2))//','//trim(adjustl(dum3))//')' write(fnameF,'("fig_gmt_",i2.2,i2.2,".png")') i,j write(12,'("set col1=",a7)') HEX write(12,'("set col2=",a13)') RGB write(12,'(a)') 'set fig='//trim(adjustl(fnameF)) write(12,'(a)') 'call bat_imk_exe' write(12,'()') end do end do close(12) ! Execute a batch file for ImagiMagick call system("bat_imK_ctl.bat") fnameW='col.html' open(12, file=fnameW, status='replace') write(12,'(a)') '' write(12,'(a)') '' write(12,'()') write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' do i=1,12 write(dum1,'(i3)') (i-1)*30 write(12,'(a)') '' write(12,'(a)') '' do j=1,6 write(fnameF,'("fig_gmt_",i2.2,i2.2,".png")') i,j write(12,'(a)') '' end do write(12,'(a)') '' end do write(12,'(a)') '
H S=255S=128S= 64S= 64S= 32S= 16
(deg)V=255V=255V=255V=192V=192V=192
'//trim(adjustl(dum1))//'LM
' write(12,'()') write(12,'(a)') '' write(12,'(a)') '' close(12) stop contains !------------------------------------------------- subroutine HSVtoRGB(hh,ss,vv,R,G,B) !------------------------------------------------- integer,intent(in)::hh,ss,vv integer,intent(out)::R,G,B real(4)::ff integer::ii,pp,qq,tt ii = mod(real(hh)/60.0,6.0) ff = real(hh)/60.0-real(int(real(hh)/60.0)) pp = nint(vv*(1.0-(ss/255.0))) qq = nint(vv*(1.0-(ss/255.0)*ff)) tt = nint(vv*(1.0-(ss/255.0)*(1.0-ff))) R=0; G=0; B=0 select case (ii) case(0) R=vv; G=tt; B=pp case(1) R=qq; G=vv; B=pp case(2) R=pp; G=vv; B=tt case(3) R=pp; G=qq; B=vv case(4) R=tt; G=pp; B=vv case(5) R=vv; G=pp; B=qq end select end subroutine HSVtoRGB !------------------------------------------------- character(len=2) function C10to16(num) !------------------------------------------------- integer,intent(in)::num integer,parameter::n=10 integer::r(1:n) integer::i,m integer::numd=16 character(len=1)::snum(1:n) character(len=200)::ans integer::num0,qq num0=num do i=1,n qq=num0/numd r(i)=num0-numd*qq if(qq==0)exit num0=qq end do m=i do i=m,1,-1 if(r(i)==10)snum(i)='A' if(r(i)==11)snum(i)='B' if(r(i)==12)snum(i)='C' if(r(i)==13)snum(i)='D' if(r(i)==14)snum(i)='E' if(r(i)==15)snum(i)='F' if(r(i)<=9)then write(snum(i),'(i1.1)') r(i) end if end do ans='' do i=m,1,-1 ans=trim(adjustl(ans))//snum(i) end do if(len_trim(ans)==1)ans='0'//trim(ans) C10to16=ans end function C10to16 !------------------------------------------------- end program f90_HSVrgbHEX