program f90_GMTgra !2D graph by GMT with legend implicit none character::fnameR*50,fnameW*50,fnameF*50 character::xlabel*100,ylabel*100,range*50,scale*50,xga*50,yga*50 character::symb*100,sline*100,dplot*50 integer::i,nplot character*100,allocatable::fn(:),sxp(:),syp(:),sleg(:) integer,allocatable::nline(:),nsymb(:) character::dummy*50,linebuf*1000 character::strP*50 character::ss*100,tmp*100,filename*100 character::dum1*50,dum2*50,dum3*50,dum4*50,dum5*50,dum6*50 integer::j,k,lmax,llen,ipt real(4)::xx,yy,dx,dy,xlen,ylen,sx,sy,scl character::slen1*2,slen2*2 call getarg(1,fnameR) !input file name for control call getarg(2,fnameW) !output file name (batch file name for GMT execution) open(11,file=fnameR,status='old') read(11,'(a)') fnameF !output image file name (eps) read(11,'(a)') xlabel !label of x-axis read(11,'(a)') ylabel !label of y-axis read(11,'(a)') range !range of x-axis/range of y-axis read(11,'(a)') scale !length of x-axis/length of y-axis read(11,'(a)') xga !grid interval and tickmark for x-axis read(11,'(a)') yga !grid interval and tickmark for y-axis read(11,*) nplot,dplot !number of plot data, size of symbol allocate(fn(1:nplot),sxp(1:nplot),syp(1:nplot),sleg(1:nplot)) allocate(nline(1:nplot),nsymb(1:nplot)) do i=1,nplot !data file name, column for x, column for y, line type, symbol, title read(11,*) fn(i),sxp(i),syp(i),nline(i),nsymb(i),sleg(i) end do read(11,*) strP,dx,dy !location of legend, distance from x-axis, distance from y-axis read(11,*) ipt,scl,llen !font size, font w/h, line length (number of characters) close(11) open(12, file=fnameW, status='replace') write(12,'(a)') 'gmtset ANOT_FONT_SIZE 12' write(12,'(a)') 'gmtset LABEL_FONT_SIZE 12' write(12,'(a)') 'gmtset TICK_LENGTH 0c' write(12,'()') linebuf='set fig_out='//trim(fnameF) ; write(12,'(a)') trim(linebuf) linebuf='set xlabel="'//trim(xlabel)//'"' ; write(12,'(a)') trim(linebuf) linebuf='set ylabel="'//trim(ylabel)//'"' ; write(12,'(a)') trim(linebuf) linebuf='set range='//trim(range) ; write(12,'(a)') trim(linebuf) linebuf='set scale='//trim(scale) ; write(12,'(a)') trim(linebuf) linebuf='set xga='//trim(xga) ; write(12,'(a)') trim(linebuf) linebuf='set yga='//trim(yga) ; write(12,'(a)') trim(linebuf) do i=1,nplot write (dummy,'(i2.2)') i linebuf='set inp'//trim(dummy)//'='//fn(i) write(12,'(a)') trim(linebuf) end do write(12,'(a)') 'psbasemap -R%range% -JX%scale% -B%xga%:%xlabel%:/%yga%:%ylabel%:WSen -P -K > %fig_out%' do i=1,nplot sline=LLL(nline(i)) if(0> %fig_out%' write(12,'(a)') trim(linebuf) end if end do do i=1,nplot symb=SSS(nsymb(i)) if(0> %fig_out%' write(12,'(a)') trim(linebuf) end if end do write(12,'(a)') 'call legend.bat' write(12,'(a)') 'echo 0 0 | psxy -R -J -Sp -O >> %fig_out%' write(12,'(a)') 'set range=' write(12,'(a)') 'set scale=' write(12,'(a)') 'set xga=' write(12,'(a)') 'set yga=' write(12,'(a)') 'set xlabel=' write(12,'(a)') 'set ylabel=' write(12,'(a)') 'set inpl=' do i=1,nplot write (dummy,'(i2.2)') i linebuf='set inp'//trim(dummy)//'=' write(12,'(a)') trim(linebuf) end do write(12,'(a)') 'set fig_out=' write(12,'(a)') 'del .gmt*' write(12,'(a)') 'del _*' close(12) !******************************* ! Legend !******************************* j=0 do i=1,len_trim(scale) if(scale(i:i)=='/')exit j=j+1 dum1(j:j)=scale(i:i) end do k=j+2 j=0 do i=k,len_trim(scale) if(scale(i:i)=='/')exit j=j+1 dum2(j:j)=scale(i:i) end do i=len_trim(dum1);if(dum1(i:i)=='l')dum1(i:i)='' i=len_trim(dum2);if(dum2(i:i)=='l')dum2(i:i)='' slen1=dum1 slen2=dum2 read(slen1,*) xlen read(slen2,*) ylen !******************************* ! Calculation anplot output !******************************* lmax=0 do i=1,nplot ss=sleg(i) j=1 do k=1,len_trim(ss) if(ss(k:k)=='@')cycle tmp(j:j)=ss(k:k) j=j+1 end do ss=tmp(1:j-1) if(lmax> %fig_out%' write(12,'(a)') trim(linebuf) write(12,'(a)') 'psxy _legenplot0.txt -R -J -G255/255/255 -W3 -N -O -K>>%fig_out%' !===================================== ! output of line elements !===================================== do i=1,nplot write (dummy,'(i2.2)') i sline=LLL(nline(i)) if(0>%fig_out%' write(12,'(a)') trim(linebuf) end if end do !===================================== ! output of symbol !===================================== do i=1,nplot symb=SSS(nsymb(i)) if(0>%fig_out%' write(12,'(a)') trim(linebuf) end if end do !===================================== ! output of text !===================================== do i=1,nplot write(dum1,*) nplot-i+0.5 write(dum2,*) ipt linebuf='echo 1 '//trim(adjustl(dum1))//' '//trim(adjustl(dum2))//' 0 0 ML '//trim(adjustl(sleg(i)))//& ' | pstext -R -J -N -O -K >> %fig_out%' write(12,'(a)') trim(linebuf) end do close(12) call system(fnameW) stop contains character*100 function LLL(n) integer,intent(in)::n character::sline*100 select case(n) case(0) sline='' case(1) sline='-W5' case(2) sline='-W5t10_5:0' case(3) sline='-W5t15_5_5_5:0' case(4) sline='-W5t5_5:0' end select LLL=sline end function LLL character*100 function SSS(n) integer,intent(in)::n character::symb*100 select case(n) case(0) symb='' case(10) symb='-SC'//trim(dplot)//' -G255 -W3' case(20) symb='-SS'//trim(dplot)//' -G255 -W3' case(30) symb='-ST'//trim(dplot)//' -G255 -W3' case(40) symb='-SC'//trim(dplot)//' -G255 -W3' case(11) symb='-SC'//trim(dplot)//' -G0' case(21) symb='-SS'//trim(dplot)//' -G0' case(31) symb='-ST'//trim(dplot)//' -G0' case(41) symb='-SC'//trim(dplot)//' -G0' end select SSS=symb end function SSS subroutine del_spaces(s) character (*), intent (inout) :: s character (len=len(s)) tmp integer i, j j = 1 do i = 1, len(s) if (s(i:i)==' ') cycle tmp(j:j) = s(i:i) j = j + 1 end do s = tmp(1:j-1) end subroutine del_spaces end program f90_GMTgra