昔懐かしい XY-plotter 方式（ペンアップ・ペンダウン・直線移動）で作図するようにすれば、デバイスによらないで共通の絵が描けるはずです。
字のフォントを用意するのが面倒ですが、我慢して作りました。アルファベットは１０画以内、ギリシア文字は１５画以内になるように縛りを入れました。
Win32 （終点を描かないという仕様になっているようです。）
chrome
firefox
ie9
opera
意外にブラウザ毎のHTML5のcanvasの互換性が無い部分があるようです。
postscript用もやっつけで出来たｗ
ソース
module uho_win use ifwina use ifwinty use ifmt, only : RTL_CRITICAL_SECTION implicit none private public :: lpCriticalSection, Thread_Proc, wnd type (RTL_CRITICAL_SECTION) :: lpCriticalSection type :: t_wnd_win integer (HANDLE) :: hWnd integer (HANDLE) :: hDC integer (LPINT) :: hThread integer (LPDWORD):: id integer (HANDLE) :: hPen end type t_wnd_win type, extends(t_wnd_win) :: t_wnd ! F2003 character (LEN = 80) :: title = 'Fortran Plot' integer :: nsize_x = 320, nsize_y = 240 real :: xmin = 0.0, xmax = 1.0, ymin = 0.0, ymax = 1.0 end type t_wnd type (t_wnd), save :: wnd ! global variable contains !-------------------------------------------------------------------------------- integer(4) function WinMain( hInstance, nCmdShow ) implicit none integer (HANDLE), intent(in) :: hInstance integer (SINT) , intent(in) :: nCmdShow type (T_WNDCLASS) :: wc type (T_MSG) :: mesg integer (HANDLE) :: hWndMain integer (BOOL) :: iretb character (LEN = 256) :: ClassName = 'Fortran'//char(0) integer :: iwindow_frame_x, iwindow_frame_y ! Init Main window iwindow_frame_x = 2 * GetSystemMetrics(SM_CXFIXEDFRAME) !side line = 6, title bar = 25 iwindow_frame_y = 2 * GetSystemMetrics(SM_CYFIXEDFRAME) + GetSystemMetrics(SM_CYCAPTION) ! WinMain = -1 ! Error code wc%lpszClassName = loc(ClassName) ! non-standard Fortran :: LOC(xxx) = TRANSFER(C_LOC(xxx), iii) wc%lpfnWndProc = loc(MainWndProc) ! CALLBACK procedure name wc%style = ior(CS_VREDRAW , CS_HREDRAW) wc%hInstance = hInstance wc%hIcon = NULL wc%hCursor = LoadCursor( NULL, IDC_ARROW ) wc%hbrBackground = ( COLOR_WINDOW + 1 ) if ( RegisterClass(wc) == 0 ) return ! initialize window ! Init instance WinMain = -2 ! Error code hWndMain = CreateWindowEx( 0, ClassName, & trim(wnd%title)//char(0), & int(ior(WS_OVERLAPPED, WS_SYSMENU)), & CW_USEDEFAULT, CW_USEDEFAULT, & wnd%nsize_x + iwindow_frame_x, & wnd%nsize_y + iwindow_frame_y, & 0, 0, & hInstance, & NULL ) if (hWndMain == 0) return iretb = ShowWindow( hWndMain, nCmdShow ) iretb = UpdateWindow( hWndMain ) ! Message Loop do while ( GetMessage (mesg, NULL, 0, 0) ) iretb = TranslateMessage( mesg ) iretb = DispatchMessage( mesg ) end do WinMain = mesg%wParam return end function WinMain !---------------------------------------------------------- integer (LRESULT) function MainWndProc( hWnd, mesg, wParam, lParam ) !DEC$ ATTRIBUTES STDcall, DECORATE, ALIAS : 'MainWndProc' :: MainWndProc implicit none integer (HANDLE) , intent(in) :: hWnd integer (UINT) , intent(in) :: mesg integer (fwParam), intent(in) :: wParam integer (flParam), intent(in) :: lParam ! integer (HANDLE) :: hDC, hBmp integer (BOOL) :: iretb type (T_PAINTSTRUCT) :: ps type (T_RECT) :: rc ! MainWndProc = 0 select case ( mesg ) case (WM_CREATE) wnd%hWnd = hWnd hDC = GetDC(hWnd) wnd%hDC = CreateCompatibleDC(hDC) iretb = GetClientRect(hWnd, rc) hBmp = CreateCompatibleBitmap(hDC, rc%right - rc%left, rc%bottom - rc%top) iretb = SelectObject(wnd%hDC, hBmp) iretb = PatBlt(wnd%hDC, 0, 0, rc%right - rc%left, rc%bottom - rc%top, WHITENESS) iretb = ReleaseDC(hWnd, hDC) iretb = DeleteObject(hBmp) case (WM_DESTROY) iretb = DeleteObject( wnd%hDC ) call PostQuitMessage( 0 ) case (WM_PAINT) call EnterCriticalSection( loc(lpCriticalSection) ) hDC = BeginPaint( wnd%hWnd, ps ) iretb = GetClientRect( wnd%hWnd, rc ) iretb = BitBlt(hDC, 0, 0, rc%right - rc%left, rc%bottom - rc%top, wnd%hDC, 0, 0, SRCCOPY) iretb = endPaint( wnd%hWnd, ps ) call LeaveCriticalSection( loc(lpCriticalSection) ) case (WM_RBUTTONUP) iretb = DeleteObject( wnd%hDC ) call PostQuitMessage( 0 ) case default MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam ) end select return end function MainWndProc !------------------------------------------------------------------------------------- integer (LONG) function Thread_Proc(lp_ThreadParameter) !DEC$ ATTRIBUTES STDcall, ALIAS:"_thread_proc" :: Thread_Proc integer (LPINT), intent(in) :: lp_ThreadParameter integer :: hInst hInst = GetModuleHandle(NULL) Thread_Proc = WinMain(hInst, SW_SHOWNORMAL) return end function Thread_Proc !------------------------------------------------------------------------------------- end module uho_win !================================================================================= module uhoplot use ifwina use ifwinty use uho_win implicit none private public :: wnd public :: gr_on, gr_off, gr_show, gr_pen, gr_move, gr_line, irgb contains !------------------------------------------------------------------------------------- subroutine gr_on(text, nx, ny) use IFMT, only : CreateThread ! multithread module character (LEN = *), intent(in), optional :: text integer , intent(in), optional :: nx, ny integer (BOOL) :: iretb integer (HANDLE) :: hBmp type (T_RECT) :: rc if ( present(text) ) wnd%title = TRIM(text) if ( present(nx) ) wnd%nsize_x = nx if ( present(ny) ) wnd%nsize_y = ny call InitializeCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC wnd%hThread = CreateThread(NULL, 0, Thread_Proc, NULL, CREATE_SUSPENDED, wnd%id) iretb = SetThreadPriority(wnd%hThread, THREAD_PRIORITY_BELOW_NORMAL) iretb = ResumeThread(wnd%hThread) call sleep(100) ! wait for Window initialization iretb = GetClientRect(wnd%hWnd, rc) hBmp = CreateCompatibleBitmap(wnd%hDC, rc%right - rc%left, rc%bottom - rc%top) iretb = SelectObject(wnd%hDC, hBmp) iretb = DeleteObject(hBmp) iretb = PatBlt(wnd%hDC, 0, 0, rc%right - rc%left, rc%bottom - rc%top, WHITENESS) wnd%hPen = CreatePen(PS_SOLID, 1, 0) return end subroutine gr_on !------------------------------------------------------------------------------------- subroutine gr_off(isec) integer (DWORD), intent(in), optional :: isec integer (BOOL) :: iretb integer (DWORD) :: iwait if (present(isec)) THEN iwait = isec * 1000 else iwait = INFINITE end if call gr_show() iretb = DeleteObject(wnd%hPen) iretb = WaitForSingleObject(wnd%hThread, iwait) iretb = CloseHandle(wnd%hThread) iretb = PostMessage(wnd%hWnd, WM_DESTROY, NULL, NULL) wnd%hThread = NULL call DeleteCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC return end subroutine gr_off !------------------------------------------------------------------------------------- subroutine gr_show() integer (BOOL):: iretb call EnterCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = InvalidateRect(wnd%hWnd, NULL, FALSE) call LeaveCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC return end subroutine gr_show !------------------------------------------------------------------------------------- subroutine gr_pen(icol, iwidth) integer, intent(in), optional :: icol, iwidth integer :: jcol, jwidth integer (BOOL) :: iretb jcol = 0 ! irgb(0, 0, 0) jwidth = 1 ! line width 1 dot if ( present(icol) ) jcol = icol if ( present(iwidth) ) jwidth = iwidth call EnterCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = DeleteObject(wnd%hPen) wnd%hPen = CreatePen(PS_SOLID, jwidth, jcol) iretb = SelectObject(wnd%hDC, wnd%hPen) call LeaveCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC return end subroutine gr_pen !------------------------------------------------------------------------------------- integer function irgb(ir, ig, ib) integer, intent(in) :: ir, ig, ib irgb = ir + (ig + (ib * 256)) * 256 return end function irgb !---------------------------------------------------------------- subroutine gr_move(ix, iy) integer, intent(in) :: ix, iy integer (BOOL):: iretb call EnterCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = MoveToEx(wnd%hDC, ix, iy, NULL) call LeaveCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC return end subroutine gr_move !---------------------------------------------------------------- subroutine gr_line(ix, iy) integer, intent(in) :: ix, iy integer (BOOL):: iretb call EnterCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = LineTo(wnd%hDC, ix, iy) call LeaveCriticalSection( loc(lpCriticalSection) ) ! non-standard Fortran :: LOC return end subroutine gr_line !---------------------------------------------------------------- end module uhoplot !===================================================================================== module uhoHTML5 use uho_win implicit none ! private ! public :: gr_on, gr_off, gr_show, gr_pen, gr_move, gr_line, irgb integer :: iw = 9 contains !---------------------------------------------------------------- subroutine html_on(text, nx, ny) character (LEN = *), intent(in), optional :: text integer , intent(in), optional :: nx, ny if ( present(text) ) wnd%title = TRIM(text) if ( present(nx) ) wnd%nsize_x = nx if ( present(ny) ) wnd%nsize_y = ny open(iw, file = 'uhoHTML5.html') write(iw, '(a)') '<!DOCTYPE html>' write(iw, '(a)') '<html>' write(iw, '(a)') '<head>' write(iw, '(a)') '<meta charset="Shift_JIS">' write(iw, '(3a)') '<title>', trim(wnd%title), '</title>' write(iw, '(a)') '<script type="text/javascript">' write(iw, '(a)') '<!--' write(iw, '(a)') 'function plotter() {' write(iw, '(a)') "var canvas = document.getElementById('figure1');" write(iw, '(a)') "var context = canvas.getContext('2d');" write(iw, '(a)') '//' write(iw, '(a)') 'context.scale(1, 1);' write(iw, '(a)') 'context.lineWidth = 1;' write(iw, '(a)') "context.strokeStyle = 'rgb(0, 0, 0)';" write(iw, '(a)') 'context.lineCap = "butt";' write(iw, '(a)') 'context.beginPath();' return end subroutine html_on !------------------------------------------------------------------------------------- subroutine html_off() write(iw, '(a)') 'context.stroke();' write(iw, '(a)') '}' write(iw, '(a)') '//-->' write(iw, '(a)') '</script>' write(iw, '(a)') '</head>' write(iw, '(a)') '<body onLoad="plotter()">' write(iw, '(a, i6, a, i6, a)') '<canvas id="figure1" width="', wnd%nsize_x, '" height="', wnd%nsize_y, '">>' write(iw, '(a)') '</canvas>' write(iw, '(a)') '</body>' write(iw, '(a)') '</html>' return end subroutine html_off !------------------------------------------------------------------------------------- subroutine html_show() return end subroutine html_show !------------------------------------------------------------------------------------- subroutine html_pen(icol, iwidth) integer, intent(in), optional :: icol, iwidth integer :: jcol, jwidth jcol = 0 ! irgb(0, 0, 0) jwidth = 1 ! line width 1 dot if ( present(icol) ) jcol = icol if ( present(iwidth) ) jwidth = iwidth write(iw, '(a)') 'context.stroke();' write(iw, '(a, 3(i3, a))') "context.strokeStyle = 'rgb(", mod(jcol, 256), ',', mod(jcol / 256, 256), ',', mod(jcol / 256**2, 256), ")';" write(iw, '(a, i5, a)') 'context.lineWidth =', jwidth, ';' write(iw, '(a)') 'context.beginPath();' return end subroutine html_pen !------------------------------------------------------------------------------------- subroutine html_move(ix, iy) integer, intent(in) :: ix, iy write(iw, '(a, i10, a, i10, a)') 'context.moveTo(', ix, ',', iy, ');' return end subroutine html_move !---------------------------------------------------------------- subroutine html_line(ix, iy) integer, intent(in) :: ix, iy write(iw, '(a, i10, a, i10, a)') 'context.lineTo(', ix, ',', iy, ');' return end subroutine html_line !---------------------------------------------------------------- end module uhoHTML5 !===================================================================================== module plotter use uhoplot use uhoHTML5 implicit none !private public :: gr_on, gr_off, gr_pen, gr_line, irgb public :: move, move_rel, draw, draw_rel public :: init_fonts, draw_font, num, alpha1, alpha2, greek1, greek2, mark integer, save :: ixpen = 0, iypen = 0 ! integer, parameter :: UP = 1, DOWN = 0 type :: t_xyp integer :: ix, iy, ipen end type t_xyp type :: t_font type (t_xyp), allocatable :: pen(:) end type t_font type (t_font) :: num(0:9), mark(20) type (t_font) :: alpha1(26), alpha2(26), greek1(26), greek2(26) contains !---------------------------------------------------------------- subroutine init_fonts() ! mark ! . allocate( mark(1)%pen(5) ) associate( p => mark(1)%pen ) ! F2003 p(1) = t_xyp( 1, 0, UP ) p(2) = t_xyp( 0, 1, DOWN ) p(3) = t_xyp( 1, 0, DOWN ) p(4) = t_xyp( 0,-1, DOWN ) p(5) = t_xyp(-1, 0, DOWN ) end associate ! , allocate( mark(2)%pen(6) ) associate( p => mark(2)%pen ) ! F2003 p(1) = t_xyp( 2, 0, UP ) p(2) = t_xyp( 0, 1, DOWN ) p(3) = t_xyp( 1, 0, DOWN ) p(4) = t_xyp( 0,-1, DOWN ) p(5) = t_xyp(-2,-2, DOWN ) p(6) = t_xyp( 1, 2, DOWN ) end associate ! % allocate( mark(3)%pen(12) ) associate( p => mark(3)%pen ) ! F2003 p(1) = t_xyp( 1, 2, UP ) p(2) = t_xyp( 4, 4, DOWN ) p(3) = t_xyp(-3, 1, UP ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp(-1,-1, DOWN ) p(6) = t_xyp(-1, 1, DOWN ) p(7) = t_xyp( 1, 1, DOWN ) p(8) = t_xyp( 2,-4, UP ) p(9) = t_xyp( 1,-1, DOWN ) p(10) = t_xyp(-1,-1, DOWN ) p(11) = t_xyp(-1, 1, DOWN ) p(12) = t_xyp( 1, 1, DOWN ) end associate ! * allocate( mark(4)%pen(6) ) associate( p => mark(4)%pen ) ! F2003 p(1) = t_xyp( 1, 7, UP ) p(2) = t_xyp( 4,-4, DOWN ) p(3) = t_xyp(-4, 0, UP ) p(4) = t_xyp( 4, 4, DOWN ) p(5) = t_xyp(-2, 1, UP ) p(6) = t_xyp( 0,-6, DOWN ) end associate ! / allocate( mark(5)%pen(2) ) associate( p => mark(5)%pen ) ! F2003 p(1) = t_xyp( 1, 2, UP ) p(2) = t_xyp( 4, 6, DOWN ) end associate ! + allocate( mark(6)%pen(4) ) associate( p => mark(6)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp(-2, 3, UP ) p(4) = t_xyp( 0,-6, DOWN ) end associate ! -- minus allocate( mark(7)%pen(2) ) associate( p => mark(7)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 4, 0, DOWN ) end associate ! - hyphen allocate( mark(8)%pen(2) ) associate( p => mark(8)%pen ) ! F2003 p(1) = t_xyp( 2, 5, UP ) p(2) = t_xyp( 2, 0, DOWN ) end associate ! = allocate( mark(9)%pen(4) ) associate( p => mark(9)%pen ) ! F2003 p(1) = t_xyp( 1, 6, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp(-4,-2, UP ) p(4) = t_xyp( 4, 0, DOWN ) end associate ! ~ allocate( mark(10)%pen(6) ) associate( p => mark(10)%pen ) ! F2003 p(1) = t_xyp( 0, 5, UP ) p(2) = t_xyp( 1, 1, DOWN ) p(3) = t_xyp( 1, 0, DOWN ) p(4) = t_xyp( 2,-2, DOWN ) p(5) = t_xyp( 1, 0, DOWN ) p(6) = t_xyp( 1, 1, DOWN ) end associate ! ( allocate( mark(11)%pen(6) ) associate( p => mark(11)%pen ) ! F2003 p(1) = t_xyp( 4, 9, UP ) p(2) = t_xyp(-1,-1, DOWN ) p(3) = t_xyp(-1,-2, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp( 1,-2, DOWN ) p(6) = t_xyp( 1,-1, DOWN ) end associate ! ) allocate( mark(12)%pen(6) ) associate( p => mark(12)%pen ) ! F2003 p(1) = t_xyp( 2, 9, UP ) p(2) = t_xyp( 1,-1, DOWN ) p(3) = t_xyp( 1,-2, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp(-1,-2, DOWN ) p(6) = t_xyp(-1,-1, DOWN ) end associate ! { allocate( mark(13)%pen(9) ) associate( p => mark(13)%pen ) ! F2003 p(1) = t_xyp( 5, 9, UP ) p(2) = t_xyp(-1, 0, DOWN ) p(3) = t_xyp(-1,-1, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp(-1,-1, DOWN ) p(6) = t_xyp( 1,-1, DOWN ) p(7) = t_xyp( 0,-2, DOWN ) p(8) = t_xyp( 1,-1, DOWN ) p(9) = t_xyp( 1, 0, DOWN ) end associate ! } allocate( mark(14)%pen(9) ) associate( p => mark(14)%pen ) ! F2003 p(1) = t_xyp( 2, 9, UP ) p(2) = t_xyp( 1, 0, DOWN ) p(3) = t_xyp( 1,-1, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp( 1,-1, DOWN ) p(6) = t_xyp(-1,-1, DOWN ) p(7) = t_xyp( 0,-2, DOWN ) p(8) = t_xyp(-1,-1, DOWN ) p(9) = t_xyp(-1, 0, DOWN ) end associate ! [ allocate( mark(15)%pen(4) ) associate( p => mark(15)%pen ) ! F2003 p(1) = t_xyp( 5, 9, UP ) p(2) = t_xyp(-2, 0, DOWN ) p(3) = t_xyp( 0,-8, DOWN ) p(4) = t_xyp( 2, 0, DOWN ) end associate ! ] allocate( mark(16)%pen(4) ) associate( p => mark(16)%pen ) ! F2003 p(1) = t_xyp( 2, 9, UP ) p(2) = t_xyp( 2, 0, DOWN ) p(3) = t_xyp( 0,-8, DOWN ) p(4) = t_xyp(-2, 0, DOWN ) end associate ! ' allocate( mark(17)%pen(2) ) associate( p => mark(17)%pen ) ! F2003 p(1) = t_xyp( 3, 9, UP ) p(2) = t_xyp( 0,-3, DOWN ) end associate ! " allocate( mark(18)%pen(4) ) associate( p => mark(18)%pen ) ! F2003 p(1) = t_xyp( 3, 9, UP ) p(2) = t_xyp( 0,-3, DOWN ) p(3) = t_xyp( 1, 0, UP ) p(4) = t_xyp( 0, 3, DOWN ) end associate ! ^ allocate( mark(19)%pen(3) ) associate( p => mark(19)%pen ) ! F2003 p(1) = t_xyp( 2, 7, UP ) p(2) = t_xyp( 2, 2, DOWN ) p(3) = t_xyp( 2,-2, DOWN ) end associate ! \ allocate( mark(20)%pen(2) ) associate( p => mark(20)%pen ) ! F2003 p(1) = t_xyp( 5, 2, UP ) p(2) = t_xyp(-4, 6, DOWN ) end associate ! num ! 0 allocate( num(0)%pen(6) ) associate( p => num(0)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( 0, 8, DOWN ) p(4) = t_xyp(-4, 0, DOWN ) p(5) = t_xyp( 0,-8, DOWN ) p(6) = t_xyp( 4, 8, DOWN ) end associate ! 1 allocate( num(1)%pen(5) ) associate( p => num(1)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( -2, 0, UP ) p(4) = t_xyp( 0, 8, DOWN ) p(5) = t_xyp( -2,-4, DOWN ) end associate ! 2 allocate( num(2)%pen(7) ) associate( p => num(2)%pen ) ! F2003 p(1) = t_xyp( 5, 1, UP ) p(2) = t_xyp(-4, 0, DOWN ) p(3) = t_xyp( 0, 4, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp( 0, 4, DOWN ) p(6) = t_xyp(-4, 0, DOWN ) p(7) = t_xyp( 0,-2, DOWN ) end associate ! 3 allocate( num(3)%pen(7) ) associate( p => num(3)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( 0, 4, DOWN ) p(4) = t_xyp(-4, 0, DOWN ) p(5) = t_xyp( 4, 0, UP ) p(6) = t_xyp( 0, 4, DOWN ) p(7) = t_xyp(-4, 0, DOWN ) end associate ! 4 allocate( num(4)%pen(5) ) associate( p => num(4)%pen ) ! F2003 p(1) = t_xyp( 4, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp(-4, 0, UP ) p(4) = t_xyp( 0,-4, DOWN ) p(5) = t_xyp( 6, 0, DOWN ) end associate ! 5 allocate( num(5)%pen(6) ) associate( p => num(5)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( 0, 4, DOWN ) p(4) = t_xyp(-4, 0, DOWN ) p(5) = t_xyp( 0, 4, DOWN ) p(6) = t_xyp( 4, 0, DOWN ) end associate ! 6 allocate( num(6)%pen(6) ) associate( p => num(6)%pen ) ! F2003 p(1) = t_xyp( 5, 9, UP ) p(2) = t_xyp(-4, 0, DOWN ) p(3) = t_xyp( 0,-8, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp( 0, 4, DOWN ) p(6) = t_xyp(-4, 0, DOWN ) end associate ! 7 allocate( num(7)%pen(4) ) associate( p => num(7)%pen ) ! F2003 p(1) = t_xyp( 3, 1, UP ) p(2) = t_xyp( 1, 4, DOWN ) p(3) = t_xyp( 2, 4, DOWN ) p(4) = t_xyp(-6, 0, DOWN ) end associate ! 8 allocate( num(8)%pen(7) ) associate( p => num(8)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 0, 4, DOWN ) p(3) = t_xyp( 4, 0, DOWN ) p(4) = t_xyp( 0,-8, DOWN ) p(5) = t_xyp(-4, 0, DOWN ) p(6) = t_xyp( 0, 4, DOWN ) p(7) = t_xyp( 4, 0, DOWN ) end associate ! 9 allocate( num(9)%pen(6) ) associate( p => num(9)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( 0, 8, DOWN ) p(4) = t_xyp(-4, 0, DOWN ) p(5) = t_xyp( 0,-4, DOWN ) p(6) = t_xyp( 4, 0, DOWN ) end associate ! Greek ! alpha allocate( greek2(1)%pen(8) ) associate( p => greek2(1)%pen ) ! F2003 p(1) = t_xyp( 5, 7, UP ) p(2) = t_xyp(-2,-6, DOWN ) p(3) = t_xyp(-2, 0, DOWN ) p(4) = t_xyp(-1, 2, DOWN ) p(5) = t_xyp( 1, 3, DOWN ) p(6) = t_xyp( 0, 0, DOWN ) p(7) = t_xyp( 2, 0, DOWN ) p(8) = t_xyp( 2,-5, DOWN ) end associate ! beta allocate( greek2(2)%pen(13) ) associate( p => greek2(2)%pen ) ! F2003 p(1) = t_xyp( 0, 0, UP ) p(2) = t_xyp( 2, 8, DOWN ) p(3) = t_xyp( 1, 0, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp( 0,-1, DOWN ) p(6) = t_xyp(-1,-1, DOWN ) p(7) = t_xyp(-2, 0, DOWN ) p(8) = t_xyp( 2, 0, UP ) p(9) = t_xyp( 1,-1, DOWN ) p(10) = t_xyp( 0,-2, DOWN ) p(11) = t_xyp(-1,-1, DOWN ) p(12) = t_xyp(-2, 0, DOWN ) p(13) = t_xyp(-2, 1, DOWN ) end associate ! gamma allocate( greek2(3)%pen(7) ) associate( p => greek2(3)%pen ) ! F2003 p(1) = t_xyp( 0, 5, UP ) p(2) = t_xyp( 1, 1, DOWN ) p(3) = t_xyp( 1, 0, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp(-2,-4, DOWN ) p(6) = t_xyp( 2, 4, UP ) p(7) = t_xyp( 2, 1, DOWN ) end associate ! delta allocate( greek2(4)%pen(11) ) associate( p => greek2(4)%pen ) ! F2003 p(1) = t_xyp( 5, 7, UP ) p(2) = t_xyp(-2, 1, DOWN ) p(3) = t_xyp(-1,-1, DOWN ) p(4) = t_xyp( 0,-1, DOWN ) p(5) = t_xyp( 2,-2, DOWN ) p(6) = t_xyp( 0,-2, DOWN ) p(7) = t_xyp(-1,-1, DOWN ) p(8) = t_xyp(-1, 0, DOWN ) p(9) = t_xyp(-1, 1, DOWN ) p(10) = t_xyp( 0, 1, DOWN ) p(11) = t_xyp( 2, 2, DOWN ) end associate ! epsilon allocate( greek2(5)%pen(13) ) associate( p => greek2(5)%pen ) ! F2003 p(1) = t_xyp( 5, 6, UP ) p(2) = t_xyp(-1, 1, DOWN ) p(3) = t_xyp(-1, 0, DOWN ) p(4) = t_xyp(-1,-1, DOWN ) p(5) = t_xyp( 0,-1, DOWN ) p(6) = t_xyp( 1,-1, DOWN ) p(7) = t_xyp( 1, 0, UP ) p(8) = t_xyp(-2, 0, DOWN ) p(9) = t_xyp(-1,-1, DOWN ) p(10) = t_xyp( 0,-1, DOWN ) p(11) = t_xyp( 1,-1, DOWN ) p(12) = t_xyp( 2, 0, DOWN ) p(13) = t_xyp( 1, 1, DOWN ) end associate ! zeta allocate( greek2(6)%pen(12) ) associate( p => greek2(6)%pen ) ! F2003 p(1) = t_xyp( 1, 8, UP ) p(2) = t_xyp( 1,-1, DOWN ) p(3) = t_xyp( 1, 0, DOWN ) p(4) = t_xyp( 2, 1, DOWN ) p(5) = t_xyp(-2,-1, DOWN ) p(6) = t_xyp(-1,-3, DOWN ) p(7) = t_xyp( 0,-2, DOWN ) p(8) = t_xyp( 1,-1, DOWN ) p(9) = t_xyp( 1, 0, DOWN ) p(10) = t_xyp( 1,-1, DOWN ) p(11) = t_xyp(-1,-1, DOWN ) p(12) = t_xyp(-2, 0, DOWN ) end associate ! eta allocate( greek2(7)%pen(12) ) associate( p => greek2(7)%pen ) ! F2003 p(1) = t_xyp( 0, 6, UP ) p(2) = t_xyp( 1, 1, DOWN ) p(3) = t_xyp( 1,-1, DOWN ) p(4) = t_xyp(-1,-4, DOWN ) p(5) = t_xyp( 1, 4, UP ) p(6) = t_xyp( 1, 1, DOWN ) p(7) = t_xyp( 1, 0, DOWN ) p(8) = t_xyp( 1,-1, DOWN ) p(9) = t_xyp(-2,-6, DOWN ) p(10) = t_xyp( 0,-1, DOWN ) p(11) = t_xyp( 1, 0, DOWN ) p(12) = t_xyp( 1, 1, DOWN ) end associate ! theta allocate( greek2(8)%pen(11) ) associate( p => greek2(8)%pen ) ! F2003 p(1) = t_xyp( 4, 8, UP ) p(2) = t_xyp(-2, 0, DOWN ) p(3) = t_xyp(-1,-1, DOWN ) p(4) = t_xyp(-2,-6, DOWN ) p(5) = t_xyp( 1,-1, DOWN ) p(6) = t_xyp( 2, 0, DOWN ) p(7) = t_xyp( 1, 1, DOWN ) p(8) = t_xyp( 2, 6, DOWN ) p(9) = t_xyp(-1, 1, DOWN ) p(10) = t_xyp( 0,-4, UP ) p(11) = t_xyp(-4, 0, DOWN ) end associate ! iota allocate( greek2(9)%pen(5) ) associate( p => greek2(9)%pen ) ! F2003 p(1) = t_xyp( 2, 6, UP ) p(2) = t_xyp( 0,-2, DOWN ) p(3) = t_xyp(-1,-2, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp( 1, 1, DOWN ) end associate ! kappa allocate( greek2(10)%pen(8) ) associate( p => greek2(10)%pen ) ! F2003 p(1) = t_xyp( 2, 5, UP ) p(2) = t_xyp(-2,-4, DOWN ) p(3) = t_xyp( 1, 2, UP ) p(4) = t_xyp( 2, 0, DOWN ) p(5) = t_xyp( 2, 2, DOWN ) p(6) = t_xyp(-2,-2, UP ) p(7) = t_xyp( 0,-1, DOWN ) p(8) = t_xyp( 1,-1, DOWN ) end associate ! lambda allocate( greek2(11)%pen(7) ) associate( p => greek2(11)%pen ) ! F2003 p(1) = t_xyp( 1, 7, UP ) p(2) = t_xyp( 1, 0, DOWN ) p(3) = t_xyp( 1,-2, DOWN ) p(4) = t_xyp( 2,-4, DOWN ) p(5) = t_xyp(-2, 4, UP ) p(6) = t_xyp(-1,-3, DOWN ) p(7) = t_xyp(-1,-1, DOWN ) end associate ! mu allocate( greek2(12)%pen(8) ) associate( p => greek2(12)%pen ) ! F2003 p(1) = t_xyp( 0,-1, UP ) p(2) = t_xyp( 2, 6, DOWN ) p(3) = t_xyp(-1,-3, DOWN ) p(4) = t_xyp( 2,-1, DOWN ) p(5) = t_xyp( 2, 1, DOWN ) p(6) = t_xyp( 1, 3, DOWN ) p(7) = t_xyp(-1,-3, UP ) p(8) = t_xyp( 1,-1, DOWN ) end associate ! nu allocate( greek2(13)%pen(5) ) associate( p => greek2(13)%pen ) ! F2003 p(1) = t_xyp( 2, 5, UP ) p(2) = t_xyp( 0,-1, DOWN ) p(3) = t_xyp(-1,-4, DOWN ) p(4) = t_xyp( 2, 1, DOWN ) p(5) = t_xyp( 3, 3, DOWN ) end associate ! xi allocate( greek2(14)%pen(15) ) associate( p => greek2(14)%pen ) ! F2003 p(1) = t_xyp( 5, 9, UP ) p(2) = t_xyp(-1, 0, DOWN ) p(3) = t_xyp(-2,-1, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp( 2, 0, DOWN ) p(6) = t_xyp(-2, 0, UP ) p(7) = t_xyp(-2,-2, DOWN ) p(8) = t_xyp( 3, 0, DOWN ) p(9) = t_xyp(-3, 0, UP ) p(10) = t_xyp(-1,-2, DOWN ) p(11) = t_xyp( 1,-1, DOWN ) p(12) = t_xyp( 2, 0, DOWN ) p(13) = t_xyp( 1,-1, DOWN ) p(14) = t_xyp(-1,-1, DOWN ) p(15) = t_xyp(-3, 0, DOWN ) end associate ! omicron allocate( greek2(15)%pen(8) ) associate( p => greek2(15)%pen ) ! F2003 p(1) = t_xyp( 1, 2, UP ) p(2) = t_xyp( 1,-1, DOWN ) p(3) = t_xyp( 2, 0, DOWN ) p(4) = t_xyp( 1, 3, DOWN ) p(5) = t_xyp(-1, 1, DOWN ) p(6) = t_xyp(-2, 0, DOWN ) p(7) = t_xyp(-1,-3, DOWN ) p(8) = t_xyp( 1,-1, DOWN ) end associate ! pi allocate( greek2(16)%pen(10) ) associate( p => greek2(16)%pen ) ! F2003 p(1) = t_xyp( 0, 5, UP ) p(2) = t_xyp( 1, 1, DOWN ) p(3) = t_xyp( 4, 0, DOWN ) p(4) = t_xyp( 1, 1, DOWN ) p(5) = t_xyp(-4,-1, UP ) p(6) = t_xyp( 0,-3, DOWN ) p(7) = t_xyp(-1,-2, DOWN ) p(8) = t_xyp( 3, 5, UP ) p(9) = t_xyp( 0,-4, DOWN ) p(10) = t_xyp( 1,-1, DOWN ) end associate ! rho allocate( greek2(17)%pen(10) ) associate( p => greek2(17)%pen ) ! F2003 p(1) = t_xyp( 0, 0, UP ) p(2) = t_xyp( 1, 1, DOWN ) p(3) = t_xyp( 1, 2, DOWN ) p(4) = t_xyp( 1, 2, DOWN ) p(5) = t_xyp( 1, 0, DOWN ) p(6) = t_xyp( 1,-1, DOWN ) p(7) = t_xyp( 0,-2, DOWN ) p(8) = t_xyp(-1,-1, DOWN ) p(9) = t_xyp(-1, 0, DOWN ) p(10) = t_xyp(-1, 1, DOWN ) end associate ! sigma allocate( greek2(18)%pen(11) ) associate( p => greek2(18)%pen ) ! F2003 p(1) = t_xyp( 6, 6, UP ) p(2) = t_xyp(-1,-1, DOWN ) p(3) = t_xyp(-3, 0, DOWN ) p(4) = t_xyp(-1,-1, DOWN ) p(5) = t_xyp( 0,-2, DOWN ) p(6) = t_xyp( 1,-1, DOWN ) p(7) = t_xyp( 2, 0, DOWN ) p(8) = t_xyp( 1, 1, DOWN ) p(9) = t_xyp( 0, 2, DOWN ) p(10) = t_xyp(-1, 1, DOWN ) p(11) = t_xyp(-2, 0, DOWN ) end associate ! tau allocate( greek2(19)%pen(9) ) associate( p => greek2(19)%pen ) ! F2003 p(1) = t_xyp( 0, 5, UP ) p(2) = t_xyp( 2, 1, DOWN ) p(3) = t_xyp( 2, 0, DOWN ) p(4) = t_xyp( 1, 1, DOWN ) p(5) = t_xyp(-2,-1, UP ) p(6) = t_xyp( 0,-1, DOWN ) p(7) = t_xyp(-1,-3, DOWN ) p(8) = t_xyp( 1,-1, DOWN ) p(9) = t_xyp( 1, 1, DOWN ) end associate ! upsilon allocate( greek2(20)%pen(7) ) associate( p => greek2(20)%pen ) ! F2003 p(1) = t_xyp( 2, 5, UP ) p(2) = t_xyp( 0,-3, DOWN ) p(3) = t_xyp( 1,-1, DOWN ) p(4) = t_xyp( 1, 0, DOWN ) p(5) = t_xyp( 1, 1, DOWN ) p(6) = t_xyp( 0, 2, DOWN ) p(7) = t_xyp(-1, 1, DOWN ) end associate ! phi allocate( greek2(21)%pen(11) ) associate( p => greek2(21)%pen ) ! F2003 p(1) = t_xyp( 4, 6, UP ) p(2) = t_xyp(-2, 0, DOWN ) p(3) = t_xyp(-1,-1, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp( 1,-1, DOWN ) p(6) = t_xyp( 2, 0, DOWN ) p(7) = t_xyp( 1, 1, DOWN ) p(8) = t_xyp( 0, 2, DOWN ) p(9) = t_xyp(-1, 1, DOWN ) p(10) = t_xyp( 0, 2, UP ) p(11) = t_xyp(-2,-8, DOWN ) end associate ! varphi allocate( greek2(22)%pen(10) ) associate( p => greek2(22)%pen ) ! F2003 p(1) = t_xyp( 2, 6, UP ) p(2) = t_xyp(-1,-1, DOWN ) p(3) = t_xyp( 0,-1, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp( 3, 0, DOWN ) p(6) = t_xyp( 1, 1, DOWN ) p(7) = t_xyp( 0, 1, DOWN ) p(8) = t_xyp(-1, 1, DOWN ) p(9) = t_xyp(-1, 0, DOWN ) p(10) = t_xyp(-2,-6, DOWN ) end associate ! chi/xi allocate( greek2(23)%pen(8) ) associate( p => greek2(23)%pen ) ! F2003 p(1) = t_xyp( 1, 7, UP ) p(2) = t_xyp( 1, 0, DOWN ) p(3) = t_xyp( 1,-1, DOWN ) p(4) = t_xyp( 1,-4, DOWN ) p(5) = t_xyp( 1,-1, DOWN ) p(6) = t_xyp( 1, 0, DOWN ) p(7) = t_xyp(-1, 6, UP ) p(8) = t_xyp(-3,-6, DOWN ) end associate ! psi allocate( greek2(24)%pen(9) ) associate( p => greek2(24)%pen ) ! F2003 p(1) = t_xyp( 2, 6, UP ) p(2) = t_xyp( 0,-1, DOWN ) p(3) = t_xyp( 0,-1, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp( 2, 0, DOWN ) p(6) = t_xyp( 1, 1, DOWN ) p(7) = t_xyp( 0, 2, DOWN ) p(8) = t_xyp(-1, 2, UP ) p(9) = t_xyp(-2,-8, DOWN ) end associate ! omega allocate( greek2(25)%pen(11) ) associate( p => greek2(25)%pen ) ! F2003 p(1) = t_xyp( 2, 6, UP ) p(2) = t_xyp(-1,-2, DOWN ) p(3) = t_xyp( 1,-2, DOWN ) p(4) = t_xyp( 1, 0, DOWN ) p(5) = t_xyp( 1, 1, DOWN ) p(6) = t_xyp( 0, 2, DOWN ) p(7) = t_xyp( 0,-2, UP ) p(8) = t_xyp( 1,-1, DOWN ) p(9) = t_xyp( 1, 0, DOWN ) p(10) = t_xyp(1, 2, DOWN ) p(11) = t_xyp(-1, 2, DOWN ) end associate ! ALPHA allocate( greek1(1)%pen(5) ) associate( p => greek1(1)%pen ) ! F2003 p(1) = t_xyp( 0, 0, UP ) p(2) = t_xyp( 3, 8, DOWN ) p(3) = t_xyp( 3,-8, DOWN ) p(4) = t_xyp(-1, 3, UP ) p(5) = t_xyp(-4, 0, DOWN ) end associate ! BETA allocate( greek1(2)%pen(12) ) associate( p => greek1(2)%pen ) ! F2003 p(1) = t_xyp( 1, 0, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 3, 0, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp( 0,-2, DOWN ) p(6) = t_xyp(-1,-1, DOWN ) p(7) = t_xyp(-3, 0, UP ) p(8) = t_xyp( 4, 0, DOWN ) p(9) = t_xyp( 1,-1, DOWN ) p(10) = t_xyp( 0,-2, DOWN ) p(11) = t_xyp(-1,-1, DOWN ) p(12) = t_xyp(-4, 0, DOWN ) end associate ! GAMMA allocate( greek1(3)%pen(4) ) associate( p => greek1(3)%pen ) ! F2003 p(1) = t_xyp( 1, 0, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 5, 0, DOWN ) p(4) = t_xyp( 0,-1, DOWN ) end associate ! DELTA allocate( greek1(4)%pen(4) ) associate( p => greek1(4)%pen ) ! F2003 p(1) = t_xyp( 0, 0, UP ) p(2) = t_xyp( 3, 8, DOWN ) p(3) = t_xyp( 3,-8, DOWN ) p(4) = t_xyp(-6, 0, DOWN ) end associate ! EPSILON allocate( greek1(5)%pen(6) ) associate( p => greek1(5)%pen ) ! F2003 p(1) = t_xyp( 6, 0, UP ) p(2) = t_xyp(-5, 0, DOWN ) p(3) = t_xyp( 0, 8, DOWN ) p(4) = t_xyp( 5, 0, DOWN ) p(5) = t_xyp(-5,-4, UP ) p(6) = t_xyp( 4, 0, DOWN ) end associate ! ZETA allocate( greek1(6)%pen(4) ) associate( p => greek1(6)%pen ) ! F2003 p(1) = t_xyp( 6, 0, UP ) p(2) = t_xyp(-5, 0, DOWN ) p(3) = t_xyp( 5, 8, DOWN ) p(4) = t_xyp(-5, 0, DOWN ) end associate ! ETA allocate( greek1(7)%pen(6) ) associate( p => greek1(7)%pen ) ! F2003 p(1) = t_xyp( 1, 0, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 5, 0, UP ) p(4) = t_xyp( 0,-8, DOWN ) p(5) = t_xyp( 0, 4, UP ) p(6) = t_xyp(-5, 0, DOWN ) end associate ! THETA allocate( greek1(8)%pen(15) ) associate( p => greek1(8)%pen ) ! F2003 p(1) = t_xyp( 2, 8, UP ) p(2) = t_xyp(-2,-2, DOWN ) p(3) = t_xyp( 0,-4, DOWN ) p(4) = t_xyp( 2,-2, DOWN ) p(5) = t_xyp( 2, 0, DOWN ) p(6) = t_xyp( 2, 2, DOWN ) p(7) = t_xyp( 0, 4, DOWN ) p(8) = t_xyp(-2, 2, DOWN ) p(9) = t_xyp(-2, 0, DOWN ) p(10) = t_xyp(0,-2, UP ) p(11) = t_xyp(0,-4, DOWN ) p(12) = t_xyp(2, 0, UP ) p(13) = t_xyp(0, 4, DOWN ) p(14) = t_xyp(0,-2, UP ) p(15) = t_xyp(-2,0, DOWN ) end associate ! IOTA allocate( greek1(9)%pen(6) ) associate( p => greek1(9)%pen ) ! F2003 p(1) = t_xyp( 1, 8, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( 0,-8, UP ) p(4) = t_xyp(-4, 0, DOWN ) p(5) = t_xyp( 2, 0, UP ) p(6) = t_xyp( 0, 8, DOWN ) end associate ! KAPPA allocate( greek1(10)%pen(6) ) associate( p => greek1(10)%pen ) ! F2003 p(1) = t_xyp( 1, 8, UP ) p(2) = t_xyp( 0,-8, DOWN ) p(3) = t_xyp( 0, 4, UP ) p(4) = t_xyp( 4, 4, DOWN ) p(5) = t_xyp( 0,-8, UP ) p(6) = t_xyp(-4, 4, DOWN ) end associate ! LAMBDA allocate( greek1(11)%pen(3) ) associate( p => greek1(11)%pen ) ! F2003 p(1) = t_xyp( 0, 0, UP ) p(2) = t_xyp( 3, 8, DOWN ) p(3) = t_xyp( 3,-8, DOWN ) end associate ! MU allocate( greek1(12)%pen(5) ) associate( p => greek1(12)%pen ) ! F2003 p(1) = t_xyp( 0, 0, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 3,-8, DOWN ) p(4) = t_xyp( 3, 8, DOWN ) p(5) = t_xyp( 0,-8, DOWN ) end associate ! NU allocate( greek1(13)%pen(4) ) associate( p => greek1(13)%pen ) ! F2003 p(1) = t_xyp( 1, 0, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 4,-8, DOWN ) p(4) = t_xyp( 0, 8, DOWN ) end associate ! XI allocate( greek1(14)%pen(14) ) associate( p => greek1(14)%pen ) ! F2003 p(1) = t_xyp( 0, 7, UP ) p(2) = t_xyp( 0, 1, DOWN ) p(3) = t_xyp( 6, 0, DOWN ) p(4) = t_xyp( 0,-1, DOWN ) p(5) = t_xyp( 0,-6, UP ) p(6) = t_xyp( 0,-1, DOWN ) p(7) = t_xyp(-6, 0, DOWN ) p(8) = t_xyp( 0, 1, DOWN ) p(9) = t_xyp( 1, 4, UP ) p(10) = t_xyp( 0,-2, DOWN ) p(11) = t_xyp( 0, 1, UP ) p(12) = t_xyp( 4, 0, DOWN ) p(13) = t_xyp( 0, 1, UP ) p(14) = t_xyp( 0,-2, DOWN ) end associate ! OMICRON allocate( greek1(15)%pen(9) ) associate( p => greek1(15)%pen ) ! F2003 p(1) = t_xyp( 2, 8, UP ) p(2) = t_xyp(-2,-2, DOWN ) p(3) = t_xyp( 0,-4, DOWN ) p(4) = t_xyp( 2,-2, DOWN ) p(5) = t_xyp( 2, 0, DOWN ) p(6) = t_xyp( 2, 2, DOWN ) p(7) = t_xyp( 0, 4, DOWN ) p(8) = t_xyp(-2, 2, DOWN ) p(9) = t_xyp(-2, 0, DOWN ) end associate ! PI allocate( greek1(16)%pen(6) ) associate( p => greek1(16)%pen ) ! F2003 p(1) = t_xyp( 0, 8, UP ) p(2) = t_xyp( 6, 0, DOWN ) p(3) = t_xyp(-5, 0, UP ) p(4) = t_xyp( 0,-8, DOWN ) p(5) = t_xyp( 4, 0, UP ) p(6) = t_xyp( 0, 8, DOWN ) end associate ! RHO allocate( greek1(17)%pen(7) ) associate( p => greek1(17)%pen ) ! F2003 p(1) = t_xyp( 1, 0, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 4, 0, DOWN ) p(4) = t_xyp( 1,-1, DOWN ) p(5) = t_xyp( 0,-2, DOWN ) p(6) = t_xyp(-1,-1, DOWN ) p(7) = t_xyp(-4, 0, DOWN ) end associate ! SIGMA allocate( greek1(18)%pen(5) ) associate( p => greek1(18)%pen ) ! F2003 p(1) = t_xyp( 6, 8, UP ) p(2) = t_xyp(-6, 0, DOWN ) p(3) = t_xyp( 4,-4, DOWN ) p(4) = t_xyp(-4,-4, DOWN ) p(5) = t_xyp( 6, 0, DOWN ) end associate ! TAU allocate( greek1(19)%pen(4) ) associate( p => greek1(19)%pen ) ! F2003 p(1) = t_xyp( 0, 8, UP ) p(2) = t_xyp( 6, 0, DOWN ) p(3) = t_xyp(-3, 0, UP ) p(4) = t_xyp( 0,-8, DOWN ) end associate ! UPSILON allocate( greek1(20)%pen(5) ) associate( p => greek1(20)%pen ) ! F2003 p(1) = t_xyp( 0, 8, UP ) p(2) = t_xyp( 3,-3, DOWN ) p(3) = t_xyp( 3, 3, DOWN ) p(4) = t_xyp(-3,-3, UP ) p(5) = t_xyp( 0,-5, DOWN ) end associate ! PHI allocate( greek1(21)%pen(13) ) associate( p => greek1(21)%pen ) ! F2003 p(1) = t_xyp( 3, 7, UP ) p(2) = t_xyp(-2,-1, DOWN ) p(3) = t_xyp(-1,-1, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp( 1,-1, DOWN ) p(6) = t_xyp( 2,-1, DOWN ) p(7) = t_xyp( 2, 1, DOWN ) p(8) = t_xyp( 1, 1, DOWN ) p(9) = t_xyp( 0, 2, DOWN ) p(10) = t_xyp(-1, 1, DOWN ) p(11) = t_xyp(-2, 1, DOWN ) p(12) = t_xyp( 0, 2, UP ) p(13) = t_xyp( 0,-9, DOWN ) end associate ! VARPHI = PHI allocate( greek1(22)%pen(13) ) associate( p => greek1(22)%pen ) ! F2003 p(1) = t_xyp( 3, 7, UP ) p(2) = t_xyp(-2,-1, DOWN ) p(3) = t_xyp(-1,-1, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp( 1,-1, DOWN ) p(6) = t_xyp( 2,-1, DOWN ) p(7) = t_xyp( 2, 1, DOWN ) p(8) = t_xyp( 1, 1, DOWN ) p(9) = t_xyp( 0, 2, DOWN ) p(10) = t_xyp(-1, 1, DOWN ) p(11) = t_xyp(-2, 1, DOWN ) p(12) = t_xyp( 0, 2, UP ) p(13) = t_xyp( 0,-9, DOWN ) end associate ! XI allocate( greek1(23)%pen(4) ) associate( p => greek1(23)%pen ) ! F2003 p(1) = t_xyp( 1, 8, UP ) p(2) = t_xyp( 4,-8, DOWN ) p(3) = t_xyp( 0, 8, UP ) p(4) = t_xyp(-4,-8, DOWN ) end associate ! PSI allocate( greek1(24)%pen(8) ) associate( p => greek1(24)%pen ) ! F2003 p(1) = t_xyp( 0, 8, UP ) p(2) = t_xyp( 0,-3, DOWN ) p(3) = t_xyp( 2,-2, DOWN ) p(4) = t_xyp( 2, 0, DOWN ) p(5) = t_xyp( 2, 2, DOWN ) p(6) = t_xyp( 0, 3, DOWN ) p(7) = t_xyp(-3, 0, UP ) p(8) = t_xyp( 0,-8, DOWN ) end associate ! OMEGA allocate( greek1(25)%pen(14) ) associate( p => greek1(25)%pen ) ! F2003 p(1) = t_xyp( 0, 1, UP ) p(2) = t_xyp( 0,-1, DOWN ) p(3) = t_xyp( 2, 0, DOWN ) p(4) = t_xyp( 0, 2, DOWN ) p(5) = t_xyp(-2, 2, DOWN ) p(6) = t_xyp( 0, 2, DOWN ) p(7) = t_xyp( 2, 2, DOWN ) p(8) = t_xyp( 2, 0, DOWN ) p(9) = t_xyp( 2,-2, DOWN ) p(10) = t_xyp( 0,-2, DOWN ) p(11) = t_xyp(-2,-2, DOWN ) p(12) = t_xyp( 0,-2, DOWN ) p(13) = t_xyp( 2, 0, DOWN ) p(14) = t_xyp( 0, 1, DOWN ) end associate ! A allocate( alpha1(1)%pen(7) ) associate( p => alpha1(1)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 4, DOWN ) p(3) = t_xyp( 2, 4, DOWN ) p(4) = t_xyp( 2,-4, DOWN ) p(5) = t_xyp( 0,-4, DOWN ) p(6) = t_xyp( 0, 3, UP ) p(7) = t_xyp(-4, 0, DOWN ) end associate ! B allocate( alpha1(2)%pen(8) ) associate( p => alpha1(2)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 3, 0, DOWN ) p(4) = t_xyp( 0,-4, DOWN ) p(5) = t_xyp(-3, 0, UP ) p(6) = t_xyp( 4, 0, DOWN ) p(7) = t_xyp( 0,-4, DOWN ) p(8) = t_xyp(-4, 0, DOWN ) end associate ! C allocate( alpha1(3)%pen(6) ) associate( p => alpha1(3)%pen ) ! F2003 p(1) = t_xyp( 5, 3, UP ) p(2) = t_xyp(-2,-2, DOWN ) p(3) = t_xyp(-2, 2, DOWN ) p(4) = t_xyp( 0, 4, DOWN ) p(5) = t_xyp( 2, 2, DOWN ) p(6) = t_xyp( 2,-2, DOWN ) end associate ! D allocate( alpha1(4)%pen(7) ) associate( p => alpha1(4)%pen ) ! F2003 p(1) = t_xyp( 3, 1, UP ) p(2) = t_xyp(-2, 0, DOWN ) p(3) = t_xyp( 0, 8, DOWN ) p(4) = t_xyp( 2, 0, DOWN ) p(5) = t_xyp( 2,-2, DOWN ) p(6) = t_xyp( 0,-4, DOWN ) p(7) = t_xyp(-2,-2, DOWN ) end associate ! E allocate( alpha1(5)%pen(6) ) associate( p => alpha1(5)%pen ) ! F2003 p(1) = t_xyp( 5, 1, UP ) p(2) = t_xyp(-4, 0, DOWN ) p(3) = t_xyp( 0, 8, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp(-4,-4, UP ) p(6) = t_xyp( 4, 0, DOWN ) end associate ! F allocate( alpha1(6)%pen(6) ) associate( p => alpha1(6)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 4, DOWN ) p(3) = t_xyp( 4, 0, DOWN ) p(4) = t_xyp(-4, 0, UP ) p(5) = t_xyp( 0, 4, DOWN ) p(6) = t_xyp( 4, 0, DOWN ) end associate ! G allocate( alpha1(7)%pen(8) ) associate( p => alpha1(7)%pen ) ! F2003 p(1) = t_xyp( 3, 5, UP ) p(2) = t_xyp( 2, 0, DOWN ) p(3) = t_xyp( 0,-2, DOWN ) p(4) = t_xyp(-2,-2, DOWN ) p(5) = t_xyp(-2, 2, DOWN ) p(6) = t_xyp( 0, 4, DOWN ) p(7) = t_xyp( 2, 2, DOWN ) p(8) = t_xyp( 2,-2, DOWN ) end associate ! H allocate( alpha1(8)%pen(6) ) associate( p => alpha1(8)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 0,-4, UP ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp( 0, 4, UP ) p(6) = t_xyp( 0,-8, DOWN ) end associate ! I allocate( alpha1(9)%pen(6) ) associate( p => alpha1(9)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp(-2, 0, UP ) p(4) = t_xyp( 0, 8, DOWN ) p(5) = t_xyp(-2, 0, UP ) p(6) = t_xyp( 4, 0, DOWN ) end associate ! J allocate( alpha1(10)%pen(7) ) associate( p => alpha1(10)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 2, DOWN ) p(3) = t_xyp( 0,-2, UP ) p(4) = t_xyp( 3, 0, DOWN ) p(5) = t_xyp( 0, 8, DOWN ) p(6) = t_xyp( -2, 0, UP ) p(7) = t_xyp( 4, 0, DOWN ) end associate ! K allocate( alpha1(11)%pen(5) ) associate( p => alpha1(11)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 4, 0, UP ) p(4) = t_xyp(-4,-4, DOWN ) p(5) = t_xyp( 4,-4, DOWN ) end associate ! L allocate( alpha1(12)%pen(3) ) associate( p => alpha1(12)%pen ) ! F2003 p(1) = t_xyp( 5, 1, UP ) p(2) = t_xyp(-4, 0, DOWN ) p(3) = t_xyp( 0, 8, DOWN ) end associate ! M allocate( alpha1(13)%pen(5) ) associate( p => alpha1(13)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 2,-8, DOWN ) p(4) = t_xyp( 2, 8, DOWN ) p(5) = t_xyp( 0,-8, DOWN ) end associate ! N allocate( alpha1(14)%pen(4) ) associate( p => alpha1(14)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 4,-8, DOWN ) p(4) = t_xyp( 0, 8, DOWN ) end associate ! O allocate( alpha1(15)%pen(7) ) associate( p => alpha1(15)%pen ) ! F2003 p(1) = t_xyp( 3, 1, UP ) p(2) = t_xyp(-2, 2, DOWN ) p(3) = t_xyp( 0, 4, DOWN ) p(4) = t_xyp( 2, 2, DOWN ) p(5) = t_xyp( 2,-2, DOWN ) p(6) = t_xyp( 0,-4, DOWN ) p(7) = t_xyp(-2,-2, DOWN ) end associate ! P allocate( alpha1(16)%pen(6) ) associate( p => alpha1(16)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 2, 0, DOWN ) p(4) = t_xyp( 2,-2, DOWN ) p(5) = t_xyp(-2,-2, DOWN ) p(6) = t_xyp(-2, 0, DOWN ) end associate ! Q allocate( alpha1(17)%pen(9) ) associate( p => alpha1(17)%pen ) ! F2003 p(1) = t_xyp( 3, 1, UP ) p(2) = t_xyp(-2, 2, DOWN ) p(3) = t_xyp( 0, 4, DOWN ) p(4) = t_xyp( 2, 2, DOWN ) p(5) = t_xyp( 2,-2, DOWN ) p(6) = t_xyp( 0,-4, DOWN ) p(7) = t_xyp(-2,-2, DOWN ) p(8) = t_xyp( 3, 0, UP ) p(9) = t_xyp(-3, 3, DOWN ) end associate ! R allocate( alpha1(18)%pen(8) ) associate( p => alpha1(18)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 2, 0, DOWN ) p(4) = t_xyp( 2,-2, DOWN ) p(5) = t_xyp(-2,-2, DOWN ) p(6) = t_xyp(-2, 0, DOWN ) p(7) = t_xyp( 2, 0, UP ) p(8) = t_xyp( 2,-4, DOWN ) end associate ! S allocate( alpha1(19)%pen(10) ) associate( p => alpha1(19)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 1, UP ) p(3) = t_xyp( 0,-1, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp( 0, 4, DOWN ) p(6) = t_xyp(-4, 0, DOWN ) p(7) = t_xyp( 0, 4, DOWN ) p(8) = t_xyp( 4, 0, DOWN ) p(9) = t_xyp( 0,-1, DOWN ) p(10) = t_xyp( 0, 1, DOWN ) end associate ! T allocate( alpha1(20)%pen(5) ) associate( p => alpha1(20)%pen ) ! F2003 p(1) = t_xyp( 3, 1, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp(-2, 0, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp(-2, 0, DOWN ) end associate ! U allocate( alpha1(21)%pen(6) ) associate( p => alpha1(21)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( 0, 8, DOWN ) p(4) = t_xyp( 0,-8, DOWN ) p(5) = t_xyp(-4, 8, UP ) p(6) = t_xyp( 0,-8, DOWN ) end associate ! V allocate( alpha1(22)%pen(5) ) associate( p => alpha1(22)%pen ) ! F2003 p(1) = t_xyp( 3, 1, UP ) p(2) = t_xyp(-2, 8, DOWN ) p(3) = t_xyp( 2,-8, DOWN ) p(4) = t_xyp( 2, 8, DOWN ) p(5) = t_xyp(-2,-8, DOWN ) end associate ! W allocate( alpha1(23)%pen(7) ) associate( p => alpha1(23)%pen ) ! F2003 p(1) = t_xyp( 2, 1, UP ) p(2) = t_xyp(-1, 8, DOWN ) p(3) = t_xyp( 1,-8, DOWN ) p(4) = t_xyp( 1, 8, DOWN ) p(5) = t_xyp( 1,-8, DOWN ) p(6) = t_xyp( 1, 8, DOWN ) p(7) = t_xyp(-1,-8, DOWN ) end associate ! X allocate( alpha1(24)%pen(6) ) associate( p => alpha1(24)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 4, 8, DOWN ) p(3) = t_xyp(-4,-8, DOWN ) p(4) = t_xyp( 0, 8, UP ) p(5) = t_xyp( 4,-8, DOWN ) p(6) = t_xyp(-4, 8, DOWN ) end associate ! Y allocate( alpha1(25)%pen(6) ) associate( p => alpha1(25)%pen ) ! F2003 p(1) = t_xyp( 3, 1, UP ) p(2) = t_xyp( 0, 4, DOWN ) p(3) = t_xyp(-2, 4, DOWN ) p(4) = t_xyp( 2,-4, DOWN ) p(5) = t_xyp( 2, 4, DOWN ) p(6) = t_xyp(-2,-4, DOWN ) end associate ! Z allocate( alpha1(26)%pen(5) ) associate( p => alpha1(26)%pen ) ! F2003 p(1) = t_xyp( 5, 1, UP ) p(2) = t_xyp(-4, 0, DOWN ) p(3) = t_xyp( 4, 8, DOWN ) p(4) = t_xyp(-4, 0, DOWN ) p(5) = t_xyp( 4, 0, DOWN ) end associate ! a allocate( alpha2(1)%pen(7) ) associate( p => alpha2(1)%pen ) ! F2003 p(1) = t_xyp( 5, 4, UP ) p(2) = t_xyp(-3, 0, DOWN ) p(3) = t_xyp( 0,-3, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp(-1, 0, UP ) p(6) = t_xyp( 0, 5, DOWN ) p(7) = t_xyp(-3, 0, DOWN ) end associate ! b allocate( alpha2(2)%pen(5) ) associate( p => alpha2(2)%pen ) ! F2003 p(1) = t_xyp( 1, 9, UP ) p(2) = t_xyp( 0,-8, DOWN ) p(3) = t_xyp( 4, 0, DOWN ) p(4) = t_xyp( 0, 4, DOWN ) p(5) = t_xyp(-4, 0, DOWN ) end associate ! c allocate( alpha2(3)%pen(6) ) associate( p => alpha2(3)%pen ) ! F2003 p(1) = t_xyp( 5, 2, UP ) p(2) = t_xyp( 0,-1, DOWN ) p(3) = t_xyp(-4, 0, DOWN ) p(4) = t_xyp( 0, 4, DOWN ) p(5) = t_xyp( 4, 0, DOWN ) p(6) = t_xyp( 0,-1, DOWN ) end associate ! d allocate( alpha2(4)%pen(5) ) associate( p => alpha2(4)%pen ) ! F2003 p(1) = t_xyp( 5, 9, UP ) p(2) = t_xyp( 0,-8, DOWN ) p(3) = t_xyp(-4, 0, DOWN ) p(4) = t_xyp( 0, 4, DOWN ) p(5) = t_xyp( 4, 0, DOWN ) end associate ! e allocate( alpha2(5)%pen(6) ) associate( p => alpha2(5)%pen ) ! F2003 p(1) = t_xyp( 5, 1, UP ) p(2) = t_xyp(-4, 0, DOWN ) p(3) = t_xyp( 0, 4, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp( 0,-2, DOWN ) p(6) = t_xyp(-4, 0, DOWN ) end associate ! f allocate( alpha2(6)%pen(6) ) associate( p => alpha2(6)%pen ) ! F2003 p(1) = t_xyp( 5, 7, UP ) p(2) = t_xyp( 0, 2, DOWN ) p(3) = t_xyp(-2, 0, DOWN ) p(4) = t_xyp( 0,-8, DOWN ) p(5) = t_xyp(-2, 4, UP ) p(6) = t_xyp( 4, 0, DOWN ) end associate ! g allocate( alpha2(7)%pen(7) ) associate( p => alpha2(7)%pen ) ! F2003 p(1) = t_xyp( 5, 1, UP ) p(2) = t_xyp(-3, 0, DOWN ) p(3) = t_xyp( 0, 4, DOWN ) p(4) = t_xyp( 3, 0, DOWN ) p(5) = t_xyp( 0,-8, DOWN ) p(6) = t_xyp(-3, 0, DOWN ) p(7) = t_xyp( 0, 2, DOWN ) end associate ! h allocate( alpha2(8)%pen(5) ) associate( p => alpha2(8)%pen ) ! F2003 p(1) = t_xyp( 1, 9, UP ) p(2) = t_xyp( 0,-8, DOWN ) p(3) = t_xyp( 4, 0, UP ) p(4) = t_xyp( 0, 4, DOWN ) p(5) = t_xyp(-4, 0, DOWN ) end associate ! i allocate( alpha2(9)%pen(4) ) associate( p => alpha2(9)%pen ) ! F2003 p(1) = t_xyp( 3, 9, UP ) p(2) = t_xyp( 0,-2, DOWN ) p(3) = t_xyp( 0,-2, UP ) p(4) = t_xyp( 0,-4, DOWN ) end associate ! j allocate( alpha2(10)%pen(6) ) associate( p => alpha2(10)%pen ) ! F2003 p(1) = t_xyp( 3, 9, UP ) p(2) = t_xyp( 0,-2, DOWN ) p(3) = t_xyp( 0,-2, UP ) p(4) = t_xyp( 0,-8, DOWN ) p(5) = t_xyp(-2, 0, DOWN ) p(6) = t_xyp( 0, 2, DOWN ) end associate ! k allocate( alpha2(11)%pen(6) ) associate( p => alpha2(11)%pen ) ! F2003 p(1) = t_xyp( 2, 9, UP ) p(2) = t_xyp( 0,-8, DOWN ) p(3) = t_xyp( 3, 5, UP ) p(4) = t_xyp(-3,-3, DOWN ) p(5) = t_xyp( 1, 1, UP ) p(6) = t_xyp( 2,-3, DOWN ) end associate ! l allocate( alpha2(12)%pen(5) ) associate( p => alpha2(12)%pen ) ! F2003 p(1) = t_xyp( 1, 9, UP ) p(2) = t_xyp( 2, 0, DOWN ) p(3) = t_xyp( 0,-8, DOWN ) p(4) = t_xyp(-2, 0, UP ) p(5) = t_xyp( 4, 0, DOWN ) end associate ! m allocate( alpha2(13)%pen(7) ) associate( p => alpha2(13)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 5, DOWN ) p(3) = t_xyp( 0,-1, UP ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp( 0,-4, DOWN ) p(6) = t_xyp(-2, 0, UP ) p(7) = t_xyp( 0, 4, DOWN ) end associate ! n allocate( alpha2(14)%pen(5) ) associate( p => alpha2(14)%pen ) ! F2003 p(1) = t_xyp( 1, 1, UP ) p(2) = t_xyp( 0, 5, DOWN ) p(3) = t_xyp( 0,-1, UP ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp( 0,-4, DOWN ) end associate ! o allocate( alpha2(15)%pen(5) ) associate( p => alpha2(15)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp( 0,-4, DOWN ) p(4) = t_xyp(-4, 0, DOWN ) p(5) = t_xyp( 0, 4, DOWN ) end associate ! p allocate( alpha2(16)%pen(5) ) associate( p => alpha2(16)%pen ) ! F2003 p(1) = t_xyp( 1,-3, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp( 4, 0, DOWN ) p(4) = t_xyp( 0,-4, DOWN ) p(5) = t_xyp(-4, 0, DOWN ) end associate ! q allocate( alpha2(17)%pen(5) ) associate( p => alpha2(17)%pen ) ! F2003 p(1) = t_xyp( 5,-3, UP ) p(2) = t_xyp( 0, 8, DOWN ) p(3) = t_xyp(-4, 0, DOWN ) p(4) = t_xyp( 0,-4, DOWN ) p(5) = t_xyp( 4, 0, DOWN ) end associate ! r allocate( alpha2(18)%pen(5) ) associate( p => alpha2(18)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 0,-5, DOWN ) p(3) = t_xyp( 0, 3, UP ) p(4) = t_xyp( 2, 2, DOWN ) p(5) = t_xyp( 2,-2, DOWN ) end associate ! s allocate( alpha2(19)%pen(8) ) associate( p => alpha2(19)%pen ) ! F2003 p(1) = t_xyp( 5, 5, UP ) p(2) = t_xyp( 0, 0, DOWN ) p(3) = t_xyp(-4, 0, DOWN ) p(4) = t_xyp( 0,-2, DOWN ) p(5) = t_xyp( 4, 0, DOWN ) p(6) = t_xyp( 0,-2, DOWN ) p(7) = t_xyp(-4, 0, DOWN ) p(8) = t_xyp( 0, 0, DOWN ) end associate ! t allocate( alpha2(20)%pen(6) ) associate( p => alpha2(20)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp(-2, 2, UP ) p(4) = t_xyp( 0,-6, DOWN ) p(5) = t_xyp( 3, 0, DOWN ) p(6) = t_xyp(-5, 0, UP ) end associate ! u allocate( alpha2(21)%pen(7) ) associate( p => alpha2(21)%pen ) ! F2003 p(1) = t_xyp( 1, 4, UP ) p(2) = t_xyp( 1, 1, DOWN ) p(3) = t_xyp( 0,-4, DOWN ) p(4) = t_xyp( 2, 0, DOWN ) p(5) = t_xyp( 1, 1, DOWN ) p(6) = t_xyp( 0, 3, UP ) p(7) = t_xyp( 0,-4, DOWN ) end associate ! v allocate( alpha2(22)%pen(3) ) associate( p => alpha2(22)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 2,-4, DOWN ) p(3) = t_xyp( 2, 4, DOWN ) end associate ! w allocate( alpha2(23)%pen(5) ) associate( p => alpha2(23)%pen ) ! F2003 p(1) = t_xyp( 0, 5, UP ) p(2) = t_xyp( 1,-4, DOWN ) p(3) = t_xyp( 2, 4, DOWN ) p(4) = t_xyp( 2,-4, DOWN ) p(5) = t_xyp( 1, 4, DOWN ) end associate ! x allocate( alpha2(24)%pen(4) ) associate( p => alpha2(24)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 4,-4, DOWN ) p(3) = t_xyp( 0, 4, UP ) p(4) = t_xyp(-4,-4, DOWN ) end associate ! y allocate( alpha2(25)%pen(4) ) associate( p => alpha2(25)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 2,-4, DOWN ) p(3) = t_xyp( 2, 4, UP ) p(4) = t_xyp(-4,-8, DOWN ) end associate ! z allocate( alpha2(26)%pen(5) ) associate( p => alpha2(26)%pen ) ! F2003 p(1) = t_xyp( 1, 5, UP ) p(2) = t_xyp( 4, 0, DOWN ) p(3) = t_xyp(-4,-4, DOWN ) p(4) = t_xyp( 4, 0, DOWN ) p(5) = t_xyp(-1, 2, UP ) end associate end subroutine init_fonts !---------------------------------------------------------------- subroutine draw_font( font ) type (t_font), intent(in) :: font integer :: i, isc1 = 2, isc0 = 1 !===================================================== associate( p => font%pen ) ! F2003 do i = 1, size(p) if ( p(i)%ipen == UP ) then call move_rel( p(i)%ix * isc1 / isc0, p(i)%iy * isc1 / isc0 ) else ! DOWN call draw_rel( p(i)%ix * isc1 / isc0, p(i)%iy * isc1 / isc0 ) end if end do end associate return end subroutine draw_font !---------------------------------------------------------------- subroutine ixy(ix, iy, kx, ky) integer, intent(in ) :: ix, iy integer, intent(out) :: kx, ky kx = wnd%nsize_x / 2 + ix * 1 ky = wnd%nsize_y / 2 - iy * 1 return end subroutine ixy !---------------------------------------------------------------- subroutine move(ix, iy) integer, intent(in) :: ix, iy ixpen = ix iypen = iy return end subroutine move !---------------------------------------------------------------- subroutine move_rel(idx, idy) integer, intent(in) :: idx, idy ixpen = ixpen + idx iypen = iypen + idy return end subroutine move_rel !---------------------------------------------------------------- subroutine draw(ix, iy) integer, intent(in) :: ix, iy integer :: kx, ky call ixy(ixpen, iypen, kx, ky) call html_move(kx, ky) call ixy(ix, iy, kx, ky) call html_line(kx, ky) ixpen = ix iypen = iy call html_show() return end subroutine draw !---------------------------------------------------------------- subroutine draw_rel(idx, idy) integer, intent(in) :: idx, idy integer :: kx0, ky0, kx1, ky1 call ixy(ixpen, iypen, kx0, ky0) call html_move(kx0, ky0) call ixy(ixpen + idx, iypen + idy, kx1, ky1) call html_line(kx1, ky1) ! call html_line(kx0, ky0) ! these lines are required ! call html_move(kx1, ky1) ! because Win32 lineTo API exclues destination point ixpen = ixpen + idx iypen = iypen + idy call html_show() return end subroutine draw_rel !---------------------------------------------------------------- end MODULE plotter !================================================================ program plot use plotter real, parameter :: sc = 100.0 ! scale real :: xmin, ymin, xmax, ymax ! width real :: x0, x1, y0, y1, dx, dy real :: x, y, ax, ay integer :: i, kx, ky x0 = -10.0 x1 = 10.0 y0 = -1.0 y1 = 1.0 dx = (x1 - x0) * sc dy = (y1 - y0) * sc xmin = x0 - dx xmax = x1 + dx ymin = y0 - dy ymax = y1 + dy call init_fonts() call html_on('Font', 640, 480) call html_pen( irgb(255, 0, 0), 1 ) call move( -500, 0 ) call draw_rel(1500, 0) call html_pen( irgb(0, 0, 0), 1 ) ! number do i = 0, 9 print *, 'num ', i call move( 200, 0 ) call move_rel(-1 * 32 * i, 0) call draw_font(num(i)) call move( 200, 0 ) call move_rel(-1 * 32 * i - 16, 0) call draw_font(mark(15 + mod(i, 6))) call move(-100, -60 ) call move_rel(1 * 16 * i, 0) call draw_font(num(i)) end do ! mark do i = 1, 20 print *, 'mark ', i call move( 200, 200 ) call move_rel(-1 * 16 * i + 8, 0) call draw_font(mark(i)) end do ! alphabet capital do i = 1, 26 call move( 200, 140 ) call move_rel(-1 * 15 * i, 0) ! call draw_font(alpha1(i)) call draw_font(greek1(i)) call move( 200, 100 ) call move_rel(-1 * 15 * i, 0) call draw_font(greek2(i)) call move( 200, 60 ) call move_rel(-1 * 15 * i, 0) call draw_font(alpha2(i)) call move(-250, -100 ) call move_rel(1 * 15 * i, 0) call draw_font(alpha1(i)) call move(-250, -130 ) call move_rel(1 * 15 * i, 0) call draw_font(alpha2(i)) end do call html_off() stop end program plot
