psvec.txt

matlab编写的关于fdtd编程的步骤和具体方法

         write(ipost,99)'  iplane 3 eq{'
         write(ipost,99)'    third_axis 1 eq'
         write(ipost,99)'      {/str1 (z) def'
         write(ipost,99)'       /str2 (x) def}'
         write(ipost,99)'      {/str1 (x) def'
         write(ipost,99)'       /str2 (z) def} ifelse} if'
         write(ipost,99)'  /Helvetica findfont 12 scalefont setfont '
         write(ipost,99)'  len inch str1 stringwidth pop 2 div add -2'//
     x               ' moveto str1 show'
         write(ipost,99)'  str2 stringwidth pop -2 div len inch 6 add'//
     x               ' moveto str2 show'
         write(ipost,99)'grestore end} def'
         write(ipost,99)
         write(ipost,99)'%----- Main Program (data) ------'
         write(ipost,99)'/Helvetica findfont 12 scalefont setfont'
         write(ipost,99)'%%Page: 1 1'
         if (landscape) write(ipost,99)'landscape'
         pagenumber = 1
      else
         open (unit=ipost,err=990,file=postfile,status='OLD')
         goto 21
 990     print *, 'File '//postfile//' does not exist'
         print *, 'Do not call the PSVECTOR subroutine with '//
     x            'first_call=.false. if you never'
         print *, 'called it before with the argument postfile = '//
     x            postfile
         stop
c put the pointer at the end of the file. Then go back two lines.
 21      continue
 27      read(ipost,99,end=19) trash
         goto 27
 19      write(ipost,99) 'xxx'
         backspace(unit=ipost)
         backspace(unit=ipost)
         read(ipost,221) trash,pagenumber
 221     format(a28,i7)
         backspace(unit=ipost)
      end if

      if ((.not.first_call).and.(new_page)) then
         pagenumber = pagenumber + 1
         write(ipost,*)
         write(ipost,*) 'showpage'
         write(ipost,203) pagenumber,pagenumber
 203     format('%%Page: ',i4,' ',i4)
         if (landscape) write(ipost,99)'landscape'
      end if

c print all the vectors, but first print header information to
c postscript file, for purpose of making constant vector scale

      write(ipost,99)'%~~Scale Info Beneath.'
      if (units.eq.'A/m') then
         write(ipost,204) xpatch*ypatch,'Magnetic',sizescale
      else
         write(ipost,204) xpatch*ypatch,'Electric',sizescale
      end if
 204  format('%== Number of Vectors: ',i8,'  Type:',a8,'  Sizescale: ',
     x       e9.4)
      do 20 loop = 1,xpatch*ypatch*2,2
         pulse = mod(loop/2 , xpatch) + 1
         bigx = (real(pulse) - real(xpatch+1)/2.0) *locscale *xwidth
         pulse = (loop/2) /xpatch + 1
         bigy = (real(pulse) - real(ypatch+1)/2.0) *locscale *ywidth
         bigx = bigx + psxloc
         bigy = bigy + psyloc
         dummy1 = sqrt(vector(loop)**2 + vector(loop+1)**2)
         dummy1 = dummy1 * sizescale
         dummy2 = atan2(vector(loop+1),vector(loop))/pi180
         write(ipost,100) bigx,bigy,dummy1,dummy2
 100     format (4f8.2,' vector')
 20   continue

c print the scale information

      write(ipost,99)
      write(ipost,*) psxloc-locscale*xwidth*real(xpatch-const)/2.0,
     x     ' inch ',psyloc-locscale*ywidth*real(ypatch-const)/2.0-.4,
     x     ' inch  moveto'
      write(ipost,210) 1./ (sizescale * 2.54),units
 210  format ('(Vector Scale: 1 cm = ',e9.4,' ',a5,') show')
      write(ipost,*) psxloc-locscale*xwidth*real(xpatch-const)/2.0,
     x     ' inch ',psyloc-locscale*ywidth*real(ypatch-const)/2.0-.2,
     x     ' inch  moveto'
      write(ipost,205) 1./(locscale*2.54)
 205  format ('(Scale: 1 cm (diagram) = ',e8.3,' cm (actual)) show')

c print the grid.
c Atef note the .8 is the linewidth of the border, .2 is linewidth of the grid.

      if (grid) then
         if (thick_bound) then
            write(ipost,110) psxloc,psyloc,xpatch-const,ypatch-const,
     -                locscale*xwidth,locscale*ywidth,.8,.2,1
         else
            write(ipost,99)'gsave [4 2 1 2] 0 setdash'
            write(ipost,110) psxloc,psyloc,xpatch-const,ypatch-const,
     -                locscale*xwidth,locscale*ywidth,.4,.2,1
            write(ipost,99)'grestore'
         end if
      else
         if (thick_bound) then
            write(ipost,110) psxloc,psyloc,xpatch-const,ypatch-const,
     -                locscale*xwidth,locscale*ywidth,.8,.2,0
         else
            write(ipost,99)'gsave [4 2 1 2] 0 setdash'
            write(ipost,110) psxloc,psyloc,xpatch-const,ypatch-const,
     -                locscale*xwidth,locscale*ywidth,.4,.2,0
            write(ipost,99)'grestore'
         end if
      end if
 110  format(2f10.4,2i4,4f10.4,i3,'  grid')

c  print the time and third coordinate information

      write(ipost,99)
      if (time_val(1:1).ne.'~') then
         write(ipost,*)psxloc-locscale*xwidth*real(xpatch-const)/2.0-.1,
     -              ' inch ',psyloc-locscale*ywidth*real(ypatch-const)/
     -              2.0,' inch 12 add moveto'
         pulse = 15
         call strlen(time_val,pulse)
         write(ipost,99)'(t = '//time_val(1:pulse)//') dup '//
     x               'stringwidth pop -1 mul 0 rmoveto show'
      end if
      if ((cut_val(1:1).ne.'~').and.(iplane.ge.1).and.(iplane.le.3))
     x           then
         if (iplane.eq.1) trash='z = '
         if (iplane.eq.2) trash='x = '
         if (iplane.eq.3) trash='y = '
         write(ipost,*)psxloc-locscale*xwidth*real(xpatch-const)/2.-.1,
     -              ' inch ',psyloc-locscale*ywidth*real(ypatch-const)/
     -              2.0,' inch moveto'
         pulse = 15
         call strlen(cut_val,pulse)
         write(ipost,99) '('//trash(1:4)//cut_val(1:pulse)//') dup '//
     -                'stringwidth pop -1 mul 0 rmoveto show'
      end if

c  print the axis.

      if ((iplane.ge.1).and.(iplane.le.3)) then
         write(ipost,99)
         pulse = 0
         if (third_comp) pulse = 1
         write(ipost,*)psxloc-locscale*xwidth*real(xpatch-const)/2.0-.5,
     -              ' inch ',psyloc-locscale*ywidth*real(ypatch-const)
     -              /2.0+.4,' inch ',iplane,pulse,' draw_axis'
      end if

c print the titles

      write(ipost,99)'gsave'
      pulse = 80
      call strlen(title1,pulse)
      if ((pulse.gt.1).or.(title1(1:pulse).ne.' ')) then
         write(ipost,99)'   /Helvetica findfont 16 scalefont setfont'
         write(ipost,*)'  ', psxloc,' inch',psyloc+locscale*ywidth*
     -              real(ypatch-const)/2.0,' inch 30 add moveto'
         write(ipost,99)'   ('//title1(1:pulse)//')'
         write(ipost,99)'   dup stringwidth pop -.5 mul 0 rmoveto show'
      end if
      pulse = 80
      call strlen(title2,pulse)
      if ((pulse.gt.1).or.(title2(1:pulse).ne.' ')) then
         write(ipost,99)'   /Helvetica findfont 14 scalefont setfont'
         write(ipost,*)'  ', psxloc,' inch',psyloc+locscale*ywidth*
     -              real(ypatch-const)/2.0,' inch 10 add moveto'
         write(ipost,99)'   ('//title2(1:pulse)//')'
         write(ipost,99)'   dup stringwidth pop -.5 mul 0 rmoveto show'
      end if
      write(ipost,99)'grestore'

      if(last_call) then
         write(ipost,99)
         write(ipost,99)'showpage'
         if (glob_scale) then
            print *, '--- Please Wait, Synchronizing '//postfile
            min_e_scale = 1.e+30
            min_h_scale = 1.e+30
            rewind(unit=ipost)
            open (unit=iscratch,status='SCRATCH')
c begin infinite loop
 22         read(ipost,99,end=999) trash
            pulse = 80
            call strlen(trash,pulse)
            write(iscratch,99) trash(1:pulse)
            if (trash(1:3).eq.'%~~') then
               read (ipost,207) trash,pulse,trash,trash,dummy1
 207  format(a23,i8,a7,a21,e9.4)
               if ((trash(1:8).eq.'Magnetic').and.
     x             (dummy1.lt.min_h_scale)) then
                  min_h_scale = dummy1
               end if
               if ((trash(1:8).eq.'Electric').and.
     x             (dummy1.lt.min_e_scale)) then
                  min_e_scale = dummy1
               end if
               backspace(unit=ipost)
               read(ipost,99) trash
               pulse = 80
               call strlen(trash,pulse)
               write(iscratch,99) trash(1:pulse)
            end if
c end infintite loop
            goto 22
c transfer from the scratch file back to the postscript file
 999        rewind(unit=iscratch)
            rewind(unit=ipost)
cc begin infinite loop
 23         read(iscratch,99,end=998) trash
            pulse = 80
            call strlen(trash,pulse)
            write(ipost,99) trash(1:pulse)
            if (trash(1:3).eq.'%~~') then
               read (iscratch,207) trash,pulse,trash,trash,dummy1
               if (trash(1:8).eq.'Magnetic') then
                  dummy2 = min_h_scale / dummy1
                  units2 = 'A/m'
               else
                  dummy2 = min_e_scale / dummy1
                  units2 = 'V/m'
               end if
               write(ipost,204) pulse,trash, dummy2 * dummy1
               do 60 loop=1,pulse
                  read(iscratch,240) bigx,bigy,dummy1,dummy3,trash
                  write(ipost,100) bigx,bigy,dummy1*dummy2,dummy3
 60            continue
 240           format (4f8.2,a20)
               do 65 loop=1,2
                  read(iscratch,99) trash
                  pulse = 80
                  call strlen(trash,pulse)
                  write(ipost,99) trash(1:pulse)
 65            continue
               read(iscratch,99) trash
               if (units2.eq.'A/m') then
                  write(ipost,210) 1./ (min_h_scale * 2.54),units2
               else
                  write(ipost,210) 1./ (min_e_scale * 2.54),units2
               end if
            end if
            goto 23
c end infinite loop
 998        close(unit=iscratch)
            print *, 'Done Synchronizing '//postfile
         end if
      else
         write(ipost,220) pagenumber
 220     format('% The current page number is',i7)
      end if

      close (unit=ipost)

      return
      end

c----------------------------------------------
c Purpose of Subroutine:
c    find the length of a string
c    max length of string is given by the 
c    parameter max.
c----------------------------------------------
      subroutine strlen(trash,num)
      implicit none
      integer num,max
      parameter(max=80)
      character*80 trash

c      num=max
      do while ((num.gt.1).and.(trash(num:num).eq.' '))
         num = num - 1
      end do
      return
      end