# From sph.umich.edu!yuedong Wed Feb 8 14:06:36 0500 1995 # Date: Wed, 8 Feb 1995 14:06:36 -0500 (EST) # From: Yuedong Wang # To: Eric Grosse # Subject: Re: submit # # Here is a set of Ratfor/Fortran routines called grkpack, which we # like to submit to the netlib. It should be put into the directory gcv. # The shar file is also available in # the public ftp file ftp.stat.wisc.edu/pub/wahba/GRKPACK.shar.gz. # The statement of permision is included in the README file. # # Cheers, # Yuedong Wang # yuedong@umich.edu # #%%%%%%%%%%% # title GRKPACK # for smoothing spline ANOVA for data from exponential families # lang ratfor # by Yuedong Wang, University of Michigan [yuedong@umich.edu] # ref Technical Report 940, University of Wisconsin-Madison, Dept. of Statistics. # alg generalization of RKPACK # size 720 kB #%%%%%%%%%%% #!/bin/sh # This is a shell archive (produced by shar 3.52.3) # To extract the files from this archive, save it to a file, remove # everything above the "!/bin/sh" line above, and type "sh file_name". # # made 02/03/1995 13:25 UTC by wang@hera.stat.wisc.edu # Source directory /local.hera/wang # # existing files will NOT be overwritten unless -c is specified # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 1169 -rw-r--r-- grkpack/README # 265799 -rw-r--r-- grkpack/grkpack.ps # 4589 -rw-r--r-- grkpack/rkpack/dmudr.r # 2586 -rw-r--r-- grkpack/rkpack/dcoef.r # 4428 -rw-r--r-- grkpack/rkpack/dcore.r # 3452 -rw-r--r-- grkpack/rkpack/dcrdr.r # 10053 -rw-r--r-- grkpack/rkpack/ddeev.r # 2726 -rw-r--r-- grkpack/rkpack/deval.r # 3987 -rw-r--r-- grkpack/rkpack/dgold.r # 3289 -rw-r--r-- grkpack/rkpack/dmcdc.r # 10816 -rw-r--r-- grkpack/rkpack/dmudr1.r # 6896 -rw-r--r-- grkpack/rkpack/dsidr.r # 2848 -rw-r--r-- grkpack/rkpack/dqrslm.r # 3571 -rw-r--r-- grkpack/rkpack/dsms.r # 625 -rw-r--r-- grkpack/rkpack/README # 2055 -rw-r--r-- grkpack/rkpack/dstup.r # 4186 -rw-r--r-- grkpack/rkpack/dsytr.r # 3127 -rw-r--r-- grkpack/rkpack/dtrev.r # 1413 -rw-r--r-- grkpack/rkpack/dcoef.f # 2504 -rw-r--r-- grkpack/rkpack/dcore.f # 2311 -rw-r--r-- grkpack/rkpack/dcrdr.f # 10264 -rw-r--r-- grkpack/rkpack/ddeev.f # 1363 -rw-r--r-- grkpack/rkpack/deval.f # 2847 -rw-r--r-- grkpack/rkpack/dgold.f # 2411 -rw-r--r-- grkpack/rkpack/dmcdc.f # 1389 -rw-r--r-- grkpack/rkpack/dmudr.f # 7621 -rw-r--r-- grkpack/rkpack/dmudr1.f # 1400 -rw-r--r-- grkpack/rkpack/dqrslm.f # 1096 -rw-r--r-- grkpack/rkpack/dsidr.f # 2578 -rw-r--r-- grkpack/rkpack/dsms.f # 973 -rw-r--r-- grkpack/rkpack/dstup.f # 2070 -rw-r--r-- grkpack/rkpack/dsytr.f # 1996 -rw-r--r-- grkpack/rkpack/dtrev.f # 269 -rw-r--r-- grkpack/rkpack/Makefile # 2882 -rw-r--r-- grkpack/grkpack/dgmdr.f # 2706 -rw-r--r-- grkpack/grkpack/dgsdr.f # 949 -rw-r--r-- grkpack/grkpack/README # 216 -rw-r--r-- grkpack/grkpack/Makefile # 2727 -rw-r--r-- grkpack/grkpack/dbsdr.f # 6097 -rw-r--r-- grkpack/grkpack/dbsdr.r # 2903 -rw-r--r-- grkpack/grkpack/dbmdr.f # 6897 -rw-r--r-- grkpack/grkpack/dbmdr.r # 6244 -rw-r--r-- grkpack/grkpack/dbisdr.r # 6046 -rw-r--r-- grkpack/grkpack/dpsdr.r # 2750 -rw-r--r-- grkpack/grkpack/dbisdr.f # 7067 -rw-r--r-- grkpack/grkpack/dbimdr.r # 2676 -rw-r--r-- grkpack/grkpack/dpsdr.f # 2926 -rw-r--r-- grkpack/grkpack/dbimdr.f # 6847 -rw-r--r-- grkpack/grkpack/dpmdr.r # 2852 -rw-r--r-- grkpack/grkpack/dpmdr.f # 6062 -rw-r--r-- grkpack/grkpack/dgsdr.r # 6866 -rw-r--r-- grkpack/grkpack/dgmdr.r # 2767 -rw-r--r-- grkpack/lib/dpbfa.f # 2145 -rw-r--r-- grkpack/lib/dpbsl.f # 2022 -rw-r--r-- grkpack/lib/dpofa.f # 1848 -rw-r--r-- grkpack/lib/dposl.f # 7032 -rw-r--r-- grkpack/lib/dqrdc.f # 9058 -rw-r--r-- grkpack/lib/dqrsl.f # 3794 -rw-r--r-- grkpack/lib/dtrsl.f # 934 -rw-r--r-- grkpack/lib/dasum.f # 1151 -rw-r--r-- grkpack/lib/daxpy.f # 1128 -rw-r--r-- grkpack/lib/dcopy.f # 1187 -rw-r--r-- grkpack/lib/ddot.f # 886 -rw-r--r-- grkpack/lib/dscal.f # 1236 -rw-r--r-- grkpack/lib/dswap.f # 805 -rw-r--r-- grkpack/lib/idamax.f # 7557 -rw-r--r-- grkpack/lib/dgemv.f # 8149 -rw-r--r-- grkpack/lib/dsymv.f # 7419 -rw-r--r-- grkpack/lib/dsyr2.f # 4020 -rw-r--r-- grkpack/lib/uni.f # 6891 -rw-r--r-- grkpack/lib/rnor.f # 1012 -rw-r--r-- grkpack/lib/dset.f # 1930 -rw-r--r-- grkpack/lib/dprmut.f # 3785 -rw-r--r-- grkpack/lib/dnrm2.f # 1967 -rw-r--r-- grkpack/lib/invnor.f # 547 -rw-r--r-- grkpack/lib/README # 2426 -rw-r--r-- grkpack/lib/lsame.f # 1057 -rw-r--r-- grkpack/lib/xerbla.f # 380 -rw-r--r-- grkpack/lib/Makefile # 776 -rw-r--r-- grkpack/lib/dsort.f # 1211 -rw-r--r-- grkpack/lib/devlpl.f # 3570 -rw-r--r-- grkpack/lib/dumnor.f # 1897 -rw-r--r-- grkpack/lib/dlanor.f # 1859 -rw-r--r-- grkpack/lib/dln1px.f # 23500 -rw-r--r-- grkpack/examples/pima.dat # 13251 -rw-r--r-- grkpack/examples/pima1.r # 860 -rw-r--r-- grkpack/examples/README # 338 -rw-r--r-- grkpack/examples/Makefile # 16110 -rw-r--r-- grkpack/examples/pima2.r # 10210 -rw-r--r-- grkpack/examples/bbci.r # 4030 -rw-r----- grkpack/examples/pima.doc # 3367 -rw-r--r-- grkpack/examples/wesdr.doc # 14146 -rw-r--r-- grkpack/examples/wesdr.r # 18063 -rw-r--r-- grkpack/examples/wesdr.dat # touch -am 1231235999 $$.touch >/dev/null 2>&1 if test ! -f 1231235999 && test -f $$.touch; then shar_touch=touch else shar_touch=: echo 'WARNING: not restoring timestamps' fi rm -f 1231235999 $$.touch # # ============= grkpack/README ============== if test ! -d 'grkpack'; then echo 'x - creating directory grkpack' mkdir 'grkpack' fi if test -f 'grkpack/README' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/README (File already exists)' else echo 'x - extracting grkpack/README (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/README' && X This directory contains four subdirectories: grkpack/, rkpack/, examples/, and lib/. grkpack/ collects Generalized RKPACK routines, rkpack/ collects RKPACK routines, examples/ collects a few application routines illustrating the user interface of GRKPACK, lib/ collects public domain routines from BLAS, BLAS2, LINPACK, and CMLIB which are called upon by routines in grkpack/, rkpack/ and examples/. X The materials are bundled for UNIX users with access to Ratfor preprocessor. Enter grkpack/, rkpack/ and lib/ to make the *.o archives and enter examples/ to check out sample programs. X grkpack.ps gives description of the code and illustration of applications. It also gives references. X DISCLAIMER: THE CODE IS PROVIDED WITH NO CHARGE AND NO WARRANTY AND THE USERS USE THE CODE AT THEIR OWN RISK. FREE DISTRIBUTION OF MATERIALS IN THIS BUNDLE IS GRANTED FOR NONCOMMERCIAL PURPOSES PROVIDED THAT NO CHANGE IS MADE. X Reports of suspected errors, descriptions of interesting applications and other comments should be sent to: X Yuedong Wang Department of Biostatistics University of Michigan Ann Arbor, MI 48109, USA X yuedong@umich.edu X January 16, 1995 X X X X SHAR_EOF $shar_touch -am 0116121095 'grkpack/README' && chmod 0644 'grkpack/README' || echo 'restore of grkpack/README failed' shar_count="`wc -c < 'grkpack/README'`" test 1169 -eq "$shar_count" || echo "grkpack/README: original size 1169, current size $shar_count" fi # ============= grkpack/grkpack.ps ============== if test -f 'grkpack/grkpack.ps' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack.ps (File already exists)' else echo 'x - extracting grkpack/grkpack.ps (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack.ps' && %!PS-Adobe-2.0 %%Creator: dvipsk 5.516a Copyright 1986, 1993 Radical Eye Software %%Title: grkpk.dvi %%Pages: 14 %%PageOrder: Ascend %%BoundingBox: 0 0 612 792 %%EndComments %DVIPSCommandLine: dvips grkpk -o %DVIPSSource: TeX output 1995.01.17:1009 %%BeginProcSet: tex.pro /TeXDict 250 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N /X{S N}B /TR{translate}N /isls false N /vsize 11 72 mul N /hsize 8.5 72 mul N /landplus90{false}def /@rigin{isls{[0 landplus90{1 -1}{-1 1} ifelse 0 0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR matrix currentmatrix dup dup 4 get round 4 exch put dup dup 5 get round 5 exch put setmatrix}N /@landscape{/isls true N}B /@manualfeed{ statusdict /manualfeed true put}B /@copies{/#copies X}B /FMat[1 0 0 -1 0 0]N /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{/nn 8 dict N nn begin /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N string /base X array /BitMaps X /BuildChar{CharBuilder}N /Encoding IE N end dup{/foo setfont}2 array copy cvx N load 0 nn put /ctr 0 N[}B /df{/sf 1 N /fntrx FMat N df-tail}B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0]N df-tail}B /E{ pop nn dup definefont setfont}B /ch-width{ch-data dup length 5 sub get} B /ch-height{ch-data dup length 4 sub get}B /ch-xoff{128 ch-data dup length 3 sub get sub}B /ch-yoff{ch-data dup length 2 sub get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B /ch-image{ch-data dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 N /rw 0 N /rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S dup /base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx 0 ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff setcachedevice ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff .1 add]{ ch-image}imagemask restore}B /D{/cc X dup type /stringtype ne{]}if nn /base get cc ctr put nn /BitMaps get S ctr S sf 1 ne{dup dup length 1 sub dup 2 index S get sf div put}if put /ctr ctr 1 add N}B /I{cc 1 add D }B /bop{userdict /bop-hook known{bop-hook}if /SI save N @rigin 0 0 moveto /V matrix currentmatrix dup 1 get dup mul exch 0 get dup mul add X.99 lt{/QV}{/RV}ifelse load def pop pop}N /eop{SI restore showpage userdict /eop-hook known{eop-hook}if}N /@start{userdict /start-hook known{start-hook}if pop /VResolution X /Resolution X 1000 div /DVImag X /IE 256 array N 0 1 255{IE S 1 string dup 0 3 index put cvn put}for 65781.76 div /vsize X 65781.76 div /hsize X}N /p{show}N /RMat[1 0 0 -1 0 0]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley X /rulex X V}B /V {}B /RV statusdict begin /product where{pop product dup length 7 ge{0 7 getinterval dup(Display)eq exch 0 4 getinterval(NeXT)eq or}{pop false} ifelse}{false}ifelse end{{gsave TR -.1 -.1 TR 1 1 scale rulex ruley false RMat{BDot}imagemask grestore}}{{gsave TR -.1 -.1 TR rulex ruley scale 1 1 false RMat{BDot}imagemask grestore}}ifelse B /QV{gsave transform round exch round exch itransform moveto rulex 0 rlineto 0 ruley neg rlineto rulex neg 0 rlineto fill grestore}B /a{moveto}B /delta 0 N /tail{dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{S p tail} B /c{-4 M}B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{1 M}B /i{2 M}B /j{ 3 M}B /k{4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w}B /q{p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{p 4 w}B /x{0 S rmoveto}B /y{ 3 2 roll p a}B /bos{/SS save N}B /eos{SS restore}B end %%EndProcSet TeXDict begin 40258431 52099146 1000 300 300 (grkpk.dvi) @start /Fa 24 122 df<183E7E7F3F1F070E0E1CFCF860080D77851A>44 D<3078FCFC7830060676851A>46 D<0000C00001E00001E00003E00003C00007C0000780 000F80000F00000F00001F00001E00003E00003C00007C0000780000780000F80000F000 01F00001E00003E00003C00003C00007C0000780000F80000F00001F00001E00001E0000 3E00003C00007C0000780000F80000F00000F0000060000013277DA21A>I<003E0001FF 8003FFC007C1E00F00E01E0F703C3FF0387FF07070F870E07870E078E1C038E1C038E1C0 38E1C038E1C038E1C038E1C038E1C03870E07070E0707070E0387FE03C3FC01E0F000F00 3807C0F803FFF001FFE0003F00151E7E9D1A>64 D<1FF0003FFC007FFE00780F00300700 000380000380007F8007FF801FFF803F8380780380700380E00380E00380E00380700780 780F803FFFFC1FFDFC07F0FC16157D941A>97 D<7E0000FE00007E00000E00000E00000E 00000E00000E00000E00000E3E000EFF800FFFE00FC1F00F80700F00380E00380E001C0E 001C0E001C0E001C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFFC00EFF8006 3E00161E7F9D1A>I<00FF8003FFC00FFFE01F01E03C00C0780000700000700000E00000 E00000E00000E00000E000007000007000007800703C00701F01F00FFFE003FFC000FE00 14157D941A>I<000FC0001FC0000FC00001C00001C00001C00001C00001C00001C001F1 C007FDC00FFFC01E0FC03C07C07803C07001C0E001C0E001C0E001C0E001C0E001C0E001 C0E001C07003C07003C03807C03E0FC01FFFF807FDFC01F1F8161E7E9D1A>I<01F80007 FF000FFF801E07C03C01C07800E07000E0E00070E00070FFFFF0FFFFF0FFFFF0E0000070 00007000007800703C00701F01F00FFFE003FF8000FE0014157D941A>I<0007E0001FF0 003FF800787800F03000E00000E00000E00000E0007FFFF0FFFFF0FFFFF000E00000E000 00E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E000 00E0003FFF807FFFC03FFF80151E7F9D1A>I<01F87C07FFFE0FFFFE1E078C1C03803801 C03801C03801C03801C03801C01C03801E07801FFF001FFE0039F8003800003800001C00 001FFF801FFFE03FFFF878007C70001CE0000EE0000EE0000EE0000E70001C78003C3E00 F81FFFF007FFC001FF0017217F941A>I<7E0000FE00007E00000E00000E00000E00000E 00000E00000E00000E3E000EFF800FFFC00FC1C00F80E00F00E00E00E00E00E00E00E00E 00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E07FC3FCFFE7FE7FC3FC17 1E7F9D1A>I<00C00001E00001E00000C000000000000000000000000000000000000000 7FE0007FE0007FE00000E00000E00000E00000E00000E00000E00000E00000E00000E000 00E00000E00000E00000E00000E00000E0007FFF80FFFFC07FFF80121F7C9E1A>I<7FE0 00FFE0007FE00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0 0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0 0000E00000E0007FFFC0FFFFE07FFFC0131E7D9D1A>108 D<7CE0E000FFFBF8007FFFF8 001F1F1C001E1E1C001E1E1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C 001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C007F1F1F00FFBFBF807F1F1F 00191580941A>I<7E3E00FEFF807FFFC00FC1C00F80E00F00E00E00E00E00E00E00E00E 00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E07FC3FCFFE7FE7FC3FC17 157F941A>I<01F00007FC001FFF003E0F803C07807803C07001C0E000E0E000E0E000E0 E000E0E000E0E000E0F001E07001C07803C03C07803E0F801FFF0007FC0001F00013157D 941A>I<7E3E00FEFF807FFFE00FC1F00F80700F00380E00380E001C0E001C0E001C0E00 1C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFFC00EFF800E3E000E00000E00 000E00000E00000E00000E00000E00000E00007FC000FFE0007FC00016207F941A>I<7F 81F8FF8FFC7F9FFE03FE1E03F80C03E00003E00003C00003800003800003800003800003 80000380000380000380000380000380007FFF00FFFF007FFF0017157F941A>114 D<07FB801FFF807FFF80780780E00380E00380E003807800007FC0001FFC0007FE00003F 800007806001C0E001C0E001C0F003C0FC0780FFFF00EFFE00E3F80012157C941A>I<01 80000380000380000380000380000380000380007FFFE0FFFFE0FFFFE003800003800003 800003800003800003800003800003800003800003800003807003807003807003807001 C1E001FFE000FF80003F00141C7F9B1A>I<7E07E0FE0FE07E07E00E00E00E00E00E00E0 0E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E01E00F03E0 07FFFC03FFFE00FCFC17157F941A>I119 D<7F83FCFFC7FE7F83FC0E00E00E00E00700E00701 C00701C00381C003838003C38001C38001C70000E70000E70000E600006600006E00003C 00003C00003C0000380000380000380000700000700030F00078E00071E0007FC0003F80 001E000017207F941A>121 D E /Fb 1 88 df87 D E /Fc 28 122 df<0007F80FF000007FFE7FFC0001F80FF80E00 03E00FE01F0007C01FC03F000F801F803F000F801F803F000F800F801E000F800F800C00 0F800F8000000F800F8000000F800F8000000F800F800000FFFFFFFFFF00FFFFFFFFFF00 0F800F801F000F800F801F000F800F801F000F800F801F000F800F801F000F800F801F00 0F800F801F000F800F801F000F800F801F000F800F801F000F800F801F000F800F801F00 0F800F801F000F800F801F000F800F801F000F800F801F000F800F801F000F800F801F00 7FF07FF0FFE07FF07FF0FFE02B237FA22F>14 D<387CFEFFFF7F3B03030306060C1C1870 2008117CA210>39 D<387CFEFFFF7F3B03030306060C1C18702008117C8610>44 D<00FE0007FFC00F83E01F01F03E00F83E00F87C007C7C007C7C007CFC007CFC007EFC00 7EFC007EFC007EFC007EFC007EFC007EFC007EFC007EFC007EFC007EFC007EFC007E7C00 7C7C007C7C007C3E00F83E00F81F01F00F83E007FFC000FE0017207E9F1C>48 D<00180000780001F800FFF800FFF80001F80001F80001F80001F80001F80001F80001F8 0001F80001F80001F80001F80001F80001F80001F80001F80001F80001F80001F80001F8 0001F80001F80001F80001F80001F80001F8007FFFE07FFFE013207C9F1C>I<00007000 0000007000000000F800000000F800000000F800000001FC00000001FC00000003FE0000 0003FE00000003FE000000067F000000067F0000000C7F8000000C3F8000000C3F800000 181FC00000181FC00000301FE00000300FE00000700FF000006007F000006007F00000C0 07F80000FFFFF80001FFFFFC00018001FC00018001FC00030001FE00030000FE00070000 FF000600007F000600007F00FFE007FFF8FFE007FFF825227EA12A>65 D75 D82 D<7FFFFFFF807FFFFFFF807E03F80F807803F807807003F803806003F80180E003F801C0 E003F801C0C003F800C0C003F800C0C003F800C0C003F800C00003F800000003F8000000 03F800000003F800000003F800000003F800000003F800000003F800000003F800000003 F800000003F800000003F800000003F800000003F800000003F800000003F800000003F8 00000003F800000003F800000003F8000001FFFFF00001FFFFF00022227EA127>84 D<0FFC003FFF807E07C07E03E07E01E07E01F03C01F00001F00001F0003FF003FDF01FC1 F03F01F07E01F0FC01F0FC01F0FC01F0FC01F07E02F07E0CF81FF87F07E03F18167E951B >97 D<00FF8007FFE00F83F01F03F03E03F07E03F07C01E07C0000FC0000FC0000FC0000 FC0000FC0000FC00007C00007E00007E00003E00181F00300FC06007FFC000FF0015167E 9519>99 D<0001FE000001FE0000003E0000003E0000003E0000003E0000003E0000003E 0000003E0000003E0000003E0000003E0000003E0001FC3E0007FFBE000F81FE001F007E 003E003E007E003E007C003E00FC003E00FC003E00FC003E00FC003E00FC003E00FC003E 00FC003E00FC003E007C003E007C003E003E007E001F00FE000F83BE0007FF3FC001FC3F C01A237EA21F>I<00FE0007FF800F87C01E01E03E01F07C00F07C00F8FC00F8FC00F8FF FFF8FFFFF8FC0000FC0000FC00007C00007C00007E00003E00181F00300FC07003FFC000 FF0015167E951A>I<001FC0007FE000F1F001E3F003E3F007C3F007C1E007C00007C000 07C00007C00007C00007C000FFFE00FFFE0007C00007C00007C00007C00007C00007C000 07C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C000 3FFC003FFC00142380A211>I<01FE0F0007FFBF800F87C7801F03E7801E01E0003E01F0 003E01F0003E01F0003E01F0003E01F0001E01E0001F03E0000F87C0000FFF800009FE00 0018000000180000001C0000001FFFE0000FFFF80007FFFE001FFFFF003C003F0078000F 80F0000780F0000780F0000780F000078078000F003C001E001F007C000FFFF80001FFC0 0019217F951C>II<1C003E007F007F007F003E001C000000000000000000000000 000000FF00FF001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F 001F001F001F00FFE0FFE00B247EA310>I108 DII<00FE0007FFC00F83E01E00F03E00F87C007C7C007C7C007CFC007EFC00 7EFC007EFC007EFC007EFC007EFC007E7C007C7C007C3E00F81F01F00F83E007FFC000FE 0017167E951C>II 114 D<0FF3003FFF00781F00600700E00300E00300F00300FC00007FE0007FF8003FFE00 0FFF0001FF00000F80C00780C00380E00380E00380F00700FC0E00EFFC00C7F00011167E 9516>I<0180000180000180000180000380000380000780000780000F80003F8000FFFF 00FFFF000F80000F80000F80000F80000F80000F80000F80000F80000F80000F80000F80 000F81800F81800F81800F81800F81800F830007C30003FE0000F80011207F9F16>III 121 D E /Fd 1 107 df<0020002000000000000000000000038004C008C008C000C001 8001800180018003000300030003004600CC0078000B1780910D>106 D E /Fe 4 51 df<0408103020606040C0C0C0C0C0C0C0C0C0C04060602030100804061A 7D920C>40 D<80402030101818080C0C0C0C0C0C0C0C0C0C0818181030204080061A7F92 0C>I<187898181818181818181818181818FF08107D8F0F>49 D<1F00618040C08060C0 600060006000C00180030006000C00102020207FC0FFC00B107F8F0F>I E /Ff 7 85 df0 D<4001C0036006300C18180C30066003 C00180018003C006600C301818300C6006C003400110127B901B>2 D<020002000200C218F2783AE00F800F803AE0F278C2180200020002000D0E7E8E12>I< 01FF8007FF800E0000180000300000600000600000600000C00000C00000FFFF80FFFF80 C00000C000006000006000006000003000001800000E000007FF8001FF8011167D9218> 50 D<0003000300060006000C000C00180018003000300060006000C000C00180018003 000300060006000C000C00180018003000300060006000C0004000101E7B9600>54 D<0004000008000E000018001E000038001E000070001E0000F0001F0001F0001F0003F0 001700037000270006700027800C700027801C60004380386000438070E00043C0E0E000 83C1C0E00081E380E00181E700E00100EE00E00300FC00E00200F800E0C6007000E0FC00 2000F8FC000000F0380000000025187F962A>77 D<0000003003FFFFE00FFFFF80100300 003006000060060000600E0000800E0000000C0000000C0000001C0000001C0000001800 000018000000380000003800000030000000300000007000000070000000600000006000 0000C0000000C0000001800000010000001C1A7F9713>84 D E /Fg 22 114 df<0000180000300000600000E00000C0000180000380000700000600000E0000 0C00001C0000380000380000700000700000E00000E00001E00001C00001C00003800003 80000380000780000700000700000F00000E00000E00001E00001E00001E00001C00001C 00003C00003C00003C00003C000038000078000078000078000078000078000078000078 0000780000700000F00000F00000F00000F00000F00000F00000F00000F00000F00000F0 0000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F0 0000F00000F00000F00000F0000070000078000078000078000078000078000078000078 00007800003800003C00003C00003C00003C00001C00001C00001E00001E00001E00000E 00000E00000F000007000007000007800003800003800003800001C00001C00001E00000 E00000E000007000007000003800003800001C00000C00000E0000060000070000038000 01800000C00000E0000060000030000018157C768121>32 DI<00001C00003C0000F80001E00003C0000780000F00000E00001E0000 3C00003C00003C0000780000780000780000780000780000780000780000780000780000 780000780000780000780000780000780000780000780000780000780000780000780000 780000780000780000780000780000780000780000780000780000780000780000780000 780000780000780000780000780000F00000F00000F00001E00001E00003C00003800007 00000E00001C0000780000E00000E000007800001C00000E000007000003800003C00001 E00001E00000F00000F00000F00000780000780000780000780000780000780000780000 780000780000780000780000780000780000780000780000780000780000780000780000 780000780000780000780000780000780000780000780000780000780000780000780000 7800007800007800007800007800007800007800003C00003C00003C00001E00000E0000 0F000007800003C00001E00000F800003C00001C167C7B8121>40 DI<00000C00001800003800003000006000 00E00000C00001C0000380000380000700000700000E00000E00001C00001C0000380000 380000780000700000F00000F00000E00001E00001E00003C00003C00003C00003C00007 80000780000780000F80000F00000F00000F00001F00001F00001E00001E00001E00003E 00003E00003E00003E00003C00003C00003C00007C00007C00007C00007C00007C00007C 00007C00007C0000780000780000F80000F80000F80000F80000F80000F80000F80000F8 0000F80000F80000F80000F80000F80000F80000F80000F80000F80000164B748024>48 DI<0018007800F001E003C007800F001F001E003E 003C007C007C007800F800F800F800F800F800F800F800F800F800F800F800F800F800F8 00F800F800F800F800F800F800F800F800F8000D25707E25>56 DI< F800F800F800F800F800F800F800F800F800F800F800F800F800F800F800F800F800F800 F800F800F800F800F80078007C007C003C003E001E001F000F00078003C001E000F00078 00180D25708025>I<007C007C007C007C007C007C007C007C007C007C007C007C007C00 7C007C007C007C007C007C007C007C007C007C00F800F800F800F001F001E003C007C007 800F001E007C00F000C0000E25798025>I<007C007C007C007C007C007C007C007C007C 007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C00F800F800F8 00F001F001E003E003C0078007000E001C003800F000C000F00038001C000E0007000780 03C003E001E001F000F000F800F800F8007C007C007C007C007C007C007C007C007C007C 007C007C007C007C007C007C007C007C007C007C007C007C007C007C0E4D798025>II64 D<00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C0000 7C00007C00007C00007C00007C00007C0000780000780000F80000F80000F80000F80000 F80000F80000F80000F80000F00000F00000F00001F00001F00001F00001F00001E00001 E00001E00003E00003E00003C00003C00003C00007C0000780000780000780000F00000F 00000F00000F00001E00001E00001C00003C00003C0000380000780000700000700000E0 0000E00001C00001C0000380000380000700000700000E00000C00001C00001800003000 00700000600000C00000164B7F8224>III80 D<0000F800018400030600060E000604000E00000E00 000E00001C00001C00001C00001C00001C00001C00001C00001C00001C00001C00003800 003800003800003800003800003800003800003800003800003800007000007000007000 00700000700000700000700000700000700000700000E00000E00000E00040C000E0C000 C180004300003E0000172E7E7F14>82 D88 DI<00000003 8000000006600000000C700000000CF00000001CF0000000186000000018000000003800 00000038000000003000000000700000000070000000007000000000F000000000E00000 0000E000000000E000000001E000000001E000000001C000000001C000000003C0000000 03C000000003C000000003C0000000078000000007800000000780000000078000000007 800000000F800000000F000000000F000000000F000000001F000000001F000000001F00 0000001F000000001E000000003E000000003E000000003E000000003E000000007C0000 00007C000000007C000000007C000000007C000000007C00000000F800000000F8000000 00F800000000F800000000F000000001F000000001F000000001F000000001F000000001 E000000001E000000001E000000003E000000003C000000003C000000003C000000003C0 00000003C000000007800000000780000000078000000007800000000700000000070000 00000F000000000F000000000E000000000E000000000E000000001E000000001C000000 001C000000001C00000000380000000038000000003800000000300000006070000000F0 60000000F0C0000000E0C000000063000000001E00000000245C7E7F17>I<0000000002 00000000060000000006000000000C000000000C000000000C0000000018000000001800 000000180000000030000000003000000000300000000060000000006000000000600000 0000C000000000C000000000C00000000180000000018000000001800000000300000000 030000000003000000000600000000060000000006000000000C000000000C000000000C 000000001800000000180000000018000000003000000000300000000030000000006000 000000600008000060001C0000C0003C0000C0007C0000C000DC000180008E000180000E 000180000E00030000070003000007000300000700060000038006000003800600000380 0C000003800C000001C00C000001C018000001C018000000E018000000E030000000E030 000000E03000000070600000007060000000706000000038C000000038C000000038C000 00001D800000001D800000001D800000001F000000000F000000000F000000000E000000 00060000000006000000274B7C812A>113 D E /Fh 49 123 df<00000FC0F800003071 8E000060F31E0000C0F71E0001C0660C0001800E000003800E000003800E000003800E00 0003801C000007001C000007001C000007001C000007001C0000FFFFFFC0000E00380000 0E003800000E003800000E003800000E007000001C007000001C007000001C007000001C 007000001C00E000003800E000003800E000003800E000003800E000003801C000007001 C000007001C000007001C000007001C000007003800000E003800000E003800000E00300 0000C007000000C0070000718E060000F19E0C0000F11E180000620C3000003C07C00000 272D82A21E>11 D<00008000010000020000040000080000100000300000600000C00000 C0000180000300000300000600000600000E00000C00001C000018000018000038000030 0000300000700000700000600000600000E00000E00000E00000C00000C00000C00000C0 0000C00000C00000C00000C00000C00000C00000C00000C00000C0000040000060000060 0000200000300000100000080000113278A414>40 D<0008000004000006000002000003 000003000001000001800001800001800001800001800001800001800001800001800001 800001800001800001800003800003800003800003000003000007000007000006000006 00000E00000C00000C00001C0000180000380000300000300000600000600000C0000180 00018000030000060000040000080000100000200000400000800000113280A414>I<0E 1E1E1E1E02020404080810204080070F7D840F>44 DI<70 F8F8F0E005057A840F>I<000F800030C000E06001C0700380700300700700700F00700E 00701E00701E00701C00F03C00F03C00F03C00F07801E07801E07801E07801E0F003C0F0 03C0F003C0F00380E00780E00780E00700E00F00E00E00E01C00E01C00E0380060700030 E0001F000014227AA019>48 D<0001000300030006001E002E03CE001C001C001C001C00 38003800380038007000700070007000E000E000E000E001C001C001C001C00380038003 8003800780FFFC10217AA019>I<0000030000000300000007000000070000000F000000 0F0000001F0000002F0000002F0000004F8000004F800000878000008780000107800002 07800002078000040780000407800008078000180780001007800020078000200780007F FFC0004003C0008003C0018003C0010003C0020003C0020003C0040003C0040003C00C00 03C03C0007E0FF003FFC1E237DA224>65 D<00FFFFE0000F0038000F001C000F001E001E 000E001E000F001E000F001E000F003C000E003C001E003C001E003C003C007800780078 0070007801E00078078000FFFF8000F001E000F000F000F0007801E0007801E0003801E0 003C01E0003C03C0007803C0007803C0007803C000F0078000F0078001E0078003C00780 07000F001E00FFFFF00020227DA122>I<00007F00800003808100000E00630000380027 000070001F0000E0000E0001C0000E000380000E000700000E000F000004000E00000400 1E000004003C000004003C00000800780000000078000000007800000000F000000000F0 00000000F000000000F000000000F000000000E000000000E000002000E000002000E000 004000E000004000F00000800070000080007000010000380002000018000400001C0008 000006003000000381C0000000FE000000212479A223>I<00FFFFF000000F003C00000F 000E00000F000700001E000380001E000380001E0001C0001E0001C0003C0001C0003C00 01E0003C0001E0003C0001E000780001E000780001E000780001E000780001E000F00003 C000F00003C000F00003C000F00003C001E000078001E000078001E000070001E0000F00 03C0000E0003C0001C0003C0003C0003C00038000780007000078000E000078003800007 800700000F801C0000FFFFF0000023227DA125>I<00FFFFFF80000F000780000F000180 000F000180001E000180001E000180001E000100001E000100003C000100003C00010000 3C010100003C01000000780200000078020000007806000000780E000000FFFC000000F0 0C000000F00C000000F00C000001E008000001E008000001E008040001E000080003C000 080003C000080003C000100003C000100007800020000780006000078000C000078001C0 000F0007C000FFFFFF800021227DA121>I<00FFFFFF000F000F000F0003000F0003001E 0003001E0003001E0002001E0002003C0002003C0002003C0102003C0100007802000078 02000078060000780E0000FFFC0000F00C0000F00C0000F00C0001E0080001E0080001E0 080001E0000003C0000003C0000003C0000003C000000780000007800000078000000780 00000F800000FFF8000020227DA120>I<00007F00800003808100000E00630000380027 000070001F0000E0000E0001C0000E000380000E000700000E000F000004000E00000400 1E000004003C000004003C00000800780000000078000000007800000000F000000000F0 00000000F000000000F000000000F0003FFC00E00001E000E00001E000E00001E000E000 03C000E00003C000F00003C000700003C0007000078000380007800018000F80001C0013 800006002300000381C1000000FE000000212479A226>I<00FFF8000F00000F00000F00 001E00001E00001E00001E00003C00003C00003C00003C00007800007800007800007800 00F00000F00000F00000F00001E00001E00001E00001E00003C00003C00003C00003C000 0780000780000780000780000F8000FFF00015227DA113>73 D<0007FFC000003C000000 3C0000003C00000078000000780000007800000078000000F0000000F0000000F0000000 F0000001E0000001E0000001E0000001E0000003C0000003C0000003C0000003C0000007 8000000780000007800000078000000F0000000F0000380F0000780F0000F81E0000F81E 0000F03C0000403800004070000021E000001F8000001A237CA11A>I<00FFFC00000F80 00000F0000000F0000001E0000001E0000001E0000001E0000003C0000003C0000003C00 00003C00000078000000780000007800000078000000F0000000F0000000F0000000F000 0001E0000001E0000001E0002001E0002003C0004003C0004003C0008003C00080078001 80078001000780030007800F000F803E00FFFFFE001B227DA11F>76 D<00FF800007FC000F80000F80000F80001780000F80001780001780002F000013C0002F 000013C0004F000013C0008F000023C0009E000023C0011E000023C0011E000023C0021E 000043C0043C000043C0043C000043C0083C000041E0083C000081E01078000081E02078 000081E02078000081E04078000101E040F0000101E080F0000101E100F0000101E100F0 000200F201E0000200F201E0000200F401E0000200F801E0000400F803C0000400F003C0 000400F003C0000C00E003C0001E00C007C000FF80C07FF8002E227DA12C>I<00FF000F FC000F8001E0000F800180000FC000800013C001000013C001000011E001000011E00100 0021E002000020F002000020F002000020F0020000407804000040780400004078040000 403C040000803C080000803E080000801E080000801E080001001F100001000F10000100 0F10000100079000020007A000020007A000020003E000020003E000040003C000040001 C000040001C0000C0001C0001E00008000FF8000800026227DA124>I<0000FE00000783 80000C00E0003800700070003800E0003801C0001C0380001C0700001C0F00001E1E0000 1E1C00001E3C00001E3C00001E7800001E7800001E7800001EF000003CF000003CF00000 3CF0000078F0000078E0000078E00000F0E00000F0E00001E0E00001C0F00003C0F00007 807000070078000E0038001C001C0038000E00E0000703800001FC00001F2479A225>I< 00FFFFE0000F0038000F001E000F000E001E0007001E0007001E0007001E0007003C000F 003C000F003C000F003C001E0078001E0078003C00780078007800E000F003C000FFFE00 00F0000000F0000001E0000001E0000001E0000001E0000003C0000003C0000003C00000 03C00000078000000780000007800000078000000F800000FFF0000020227DA121>I<00 FFFFC0000F0070000F003C000F001C001E000E001E000E001E000F001E000F003C001E00 3C001E003C001E003C003C0078003800780070007801E00078078000FFFC0000F00E0000 F0070000F0038001E003C001E003C001E003C001E003C003C0078003C0078003C0078003 C0078007800F0007800F0107800F01078007020F800702FFF0038C000000F020237DA124 >82 D<0001F020000E0C40001802C0003001C0006001C000E0018000C0018001C0018001 C0018003C0010003C0010003C0000003C0000003E0000001F8000001FF000000FFE00000 7FF000001FF8000003FC0000007C0000003C0000001E0000001E0000001E0020001C0020 001C0020001C00200018006000380060003000700060007000C000C8018000C607000081 FC00001B247DA21B>I<1FFFFFF81E03C0381803C0183003C01820078018200780184007 801040078010400F0010800F0010800F0010000F0000001E0000001E0000001E0000001E 0000003C0000003C0000003C0000003C00000078000000780000007800000078000000F0 000000F0000000F0000000F0000001E0000001E0000001E0000001E0000003E00000FFFF 00001D2277A123>I86 D<00F8C00185C00705C00E03800E03801C03803C03803807 00780700780700780700F00E00F00E00F00E00F00E10F01C20701C20703C20305C40308C 400F078014157B9419>97 D<03C01F8003800380038007000700070007000E000E000E00 0E001C001CF81D0C1E0E3C0638073807380F700F700F700F700FE01EE01EE01EE03CE038 E038607060E031C01F0010237BA216>I<007E0001C1000301800703800E07801C07803C 0000380000780000780000780000F00000F00000F00000F00000F0010070010070020030 0C001830000FC00011157B9416>I<00003C0003F8000038000038000038000070000070 0000700000700000E00000E00000E00000E00001C000F9C00185C00705C00E03800E0380 1C03803C0380380700780700780700780700F00E00F00E00F00E00F00E10F01C20701C20 703C20305C40308C400F078016237BA219>I<00F803840E021C023C0238027804F018FF E0F000F000E000E000E000E000E002E0026004701830600F800F157A9416>I<00003E00 00470000CF00018F00018600038000038000038000070000070000070000070000070000 0E0000FFF0000E00000E00000E00001C00001C00001C00001C00001C0000380000380000 380000380000380000700000700000700000700000700000E00000E00000E00000E00000 C00001C00001C000718000F18000F300006200003C0000182D82A20F>I<001F180030B8 00E0B801C07001C0700380700780700700E00F00E00F00E00F00E01E01C01E01C01E01C0 1E01C01E03800E03800E0780060B8006170001E700000700000700000E00000E00000E00 701C00F01800F0300060E0003F8000151F7E9416>I<00F0000FE00000E00000E00000E0 0001C00001C00001C00001C000038000038000038000038000070000071F0007218007C0 C00F00E00F00E00E00E00E00E01C01C01C01C01C01C01C01C03803803803803803803807 04700708700E08700E10700610E006206003C016237DA219>I<00C001E001C001C00000 00000000000000000000000000001E002300430043008700870087000E000E001C001C00 1C00380038003840708070807080710032001C000B217BA00F>I<01E00FC001C001C001 C0038003800380038007000700070007000E000E000E000E001C001C001C001C00380038 00380038007000700070007100E200E200E200E200640038000B237CA20C>108 D<1C0F80F8002610C10C0047606606008780780700878078070087007007008700700700 0E00E00E000E00E00E000E00E00E000E00E00E001C01C01C001C01C01C001C01C01C001C 01C03820380380384038038070403803807080380380308070070031003003001E002315 7B9428>I<380F804C30C04E40608E80708F00708E00708E00701C00E01C00E01C00E01C 00E03801C03801C03801C0380384700388700308700708700310E003106001E016157B94 1B>I<007E0001C3000381800701C00E01C01C01E03C01E03801E07801E07801E07801E0 F003C0F003C0F00380F00780700700700E00700C0030180018700007C00013157B9419> I<01C1F002621804741C08780C08700E08700E08701E00E01E00E01E00E01E00E01E01C0 3C01C03C01C03C01C07803807003807003C0E003C1C0072380071E000700000700000E00 000E00000E00000E00001C00001C00001C0000FFC000171F7F9419>I<1C1F0026208047 41C08783C08703C08701808700000E00000E00000E00000E00001C00001C00001C00001C 000038000038000038000038000070000030000012157B9415>114 D<00FC000183000200800401800C03800C03000C00000F00000FF00007FC0003FE00003E 00000F00000700700700F00600F00600E004004008002030001FC00011157D9414>I<00 C001C001C001C001C003800380038003800700FFF8070007000E000E000E000E001C001C 001C001C003800380038003810702070207040708031001E000D1F7C9E10>I<1E006023 00E04380E04381C08381C08701C08701C00703800E03800E03800E03801C07001C07001C 07001C07081C0E10180E101C0E101C1E200C262007C3C015157B941A>I<1C01802603C0 4707C04703C08701C08E00C08E00C00E00801C00801C00801C0080380100380100380100 3802003802003804003808001808000C300007C00012157B9416>I<1E0060E02300E0F0 4380E1F04381C0F08381C0708701C0308701C030070380200E0380200E0380200E038020 1C0700401C0700401C0700401C0700801C0700801C0701001C0F01000C0B020006138400 03E0F8001C157B9420>I<03C1E0046210083470103CF02038F020386020380000700000 700000700000700000E00000E00000E00000E02061C040F1C040F1C080E2C10044620038 3C0014157D9416>I<1E00302300704380704380E08380E08700E08700E00701C00E01C0 0E01C00E01C01C03801C03801C03801C03801C07001C07001C07001C0F000C3E0003CE00 000E00000E00001C00601C00F03800F03000E0600080C0004380003E0000141F7B9418> I<01E02003F06007F8C0041F800801000802000004000008000010000020000040000080 000100000200000400800801001003003F060061FE0040FC0080700013157D9414>I E /Fi 11 62 df<00FC000303000E01C01C00E0380070300030700038700038E0001CE2 011CE3FF1CE3FF1CE3FF1CE2011CE0001C6000187000383000303800701C00E00E01C003 030000FC0016177E961B>2 D<0102040C1818303070606060E0E0E0E0E0E0E0E0E0E060 606070303018180C04020108227D980E>40 D<8040203018180C0C0E0606060707070707 07070707070606060E0C0C18183020408008227E980E>I<003000003000003000003000 003000003000003000003000003000003000003000FFFFFCFFFFFC003000003000003000 00300000300000300000300000300000300000300000300016187E931B>43 D<07C018303018701C600C600CE00EE00EE00EE00EE00EE00EE00EE00EE00E600C600C70 1C30181C7007C00F157F9412>48 D<06000E00FE000E000E000E000E000E000E000E000E 000E000E000E000E000E000E000E000E000E00FFE00B157D9412>I<0F8030E040708030 C038E0384038003800700070006000C00180030006000C08080810183FF07FF0FFF00D15 7E9412>I<0FE030306018701C701C001C00180038006007E000300018000C000E000EE0 0EE00EC00C401830300FE00F157F9412>I<00300030007000F001F00170027004700870 1870107020704070C070FFFE0070007000700070007003FE0F157F9412>I<01F0060808 0C181C301C70006000E000E3E0EC30F018F00CE00EE00EE00E600E600E300C3018183007 C00F157F9412>54 D61 D E /Fj 25 113 df0 D<70F8F8F87005057C8E0E>I<800002C0000660000C3000181800300C00600600C00301 8001830000C600006C00003800003800006C0000C6000183000301800600C00C00601800 3030001860000CC000068000021718789727>I<000FF00000708E000180818002008040 040080200800801010008008100080082000800420008004400080024000800240008002 800080018000800180008001FFFFFFFF8000800180008001800080018000800140008002 400080024000800220008004200080041000800810008008080080100400802002008040 0180818000708E00000FF00020227D9C27>8 D<000FF00000700E000180018002000040 040000200C00003012000048110000882080010420800104404002024020040240100802 800810018004200180024001800180018001800180024001800420018008100140100802 4020040240400202208001042080010411000088120000480C0000300400002002000040 0180018000700E00000FF00020227D9C27>10 D21 D<07E000010FF800013FFC0001381E0003700780036003C006C001E00EC000781C 80003FFC80001FF0800007E0200B7D9127>24 D<07E000011FF800013FFE0001781F0003 60078003C001E006C000F81E80007FFC80001FF8800007E0000000000000000007E00001 1FF800013FFE0001781F000360078003C001E006C000F81E80007FFC80001FF8800007E0 20167D9727>I<00000001800000000001800000000001800000000001800000000000C0 0000000000C000000000006000000000003000000000003000000000001C00000000000E 00000000000700FFFFFFFFFFE0FFFFFFFFFFE0000000000700000000000E00000000001C 0000000000300000000000300000000000600000000000C00000000000C0000000000180 000000000180000000000180000000000180002B1A7D9832>33 D<03F80001F80007FE00 0FFE001E3F801C03003807C03001802003E06000804001F0C000404000F9800040C0007F 00002080003F00002080003E00002080001F00002080000F80002080001F80002080001F C00060400033E00040400061F000402000C0F800803001807C03801807003F8F000FFE00 0FFC0003F00003F8002B157D9432>49 D<001FFF007FFF01E0000380000600000C000018 0000300000300000600000600000600000C00000C00000FFFFFFFFFFFFC00000C0000060 00006000006000003000003000001800000C000006000003800001E000007FFF001FFF18 1E7C9A21>I<00000300000300000600000600000C00000C000018000018000030000030 0000600000600000C00000C00000C0000180000180000300000300000600000600000C00 000C0000180000180000300000300000600000600000C00000C000018000018000030000 0300000300000600000600000C00000C0000180000180000300000300000600000600000 C00000400000183079A300>54 D<00007F000003FFC0000FFFE0001C07E0006001E000C0 01C0018001C003000380060003000E0007001C000C001C00080038000000380000007800 00007000000070000000F0000180F0000380F0000780F0000700F0000F00F0000F00F000 1F00F8001E00F8003E007C007E007E00DC003F839C001FFE3C000FFC380003E038000000 7000000070000000E0000000C000180180003E030000FFFC00003FF800000FE000001B29 7EA21E>71 D<001F800004007FC0001C01FFC000380303C000380C03C000701803C00070 3803C000F07003C000E060038000E0C0038001E000078001C000078001C000078003C000 070003C00007000380000F000380000F000780007FFFFF0000FFFFFF0001FFFFEF00001E 000F00001C000E00001C000E00003C001E000038001E000038001E000078001E00007000 1C000070001C0000F0003C0000E0003C0600E0003C0C01E0003C1801C0003FF00180003F C00300001F0027247FA12A>I<000003E000000FF000003FF8000043F80001C1F8000380 F8000700F0000700E0000E00C0001E0000001E0000003C0000003C0000003C0000007800 00007800000078000000F0000000F0000000F0000001F0000001E0000001E0000001E000 0003C0000003C0000003C00000078000000700000C0700001C0FFC00381FFF80701FFFF0 60387FFFC0600FFF00C001FC001E247FA222>76 D<000018000000100000780000003000 0078000000600000F8000000600000F8000000E00000F8000001E00000FC000003E00000 FC000007C00000BC00000FC000013C00000FC000013C00001FC000013C00003BC000013E 000073C000023E0000E3C000021E0001E38000021E0003C38000041E0003878000041F00 07078000041F000E078000080F001C078000080F0038078000080F8078070000100F80F0 070000100781E00F0000100783C00F00002007C7800F00002007CF000F00004003FE000F 00004003FC000F0000C001F8000F00008001F0000F00618000E0000F007F0000C0000F00 FF000000000FF0FE000000000FE0FE0000000007803C00000000000034257EA23C>I<00 000000001E0000000000FE0000000001FC0000000003FC0000600003F80001E00003C000 01E00006000001F00004000003F00008000003F00008000003F00008000002F800080000 02F800100000027800100000027800100000067C00200000047C00200000043C00200000 043C00200000043E00400000083E00400000081E00400000081F00400000081F00800000 100F00800000100F00800000100F80800000200F810000002007810000002007C1000000 4007C10000004003E20000004003E20000008001F20000018001F20000630000FE00007F 0000FC0000FF00007C0000FE0000780000FC00003000003800000000002F2980A629>I< 00001FC00000FFF00001FFF8000701FC000C007C0018003C0030003C0070003800F00020 00F0000000F0000000F8000000FC0000007E0000003F8000001FE000000FF8000003FC00 0000FE0000003F0000001F8000000FC0060007C00C0003C0380003C0700003C070000380 F0000380F0000700F8000600F8000C007E0018007F80F0003FFFC0000FFF000003F80000 1E247FA21E>83 D<0000000002000000000C003FFFFFF800FFFFFFF003FFFFFFC004001C 00001C003C00003C003C000078007C000078007800007000780000C0007800000000F800 000000F000000000F000000000F000000001F000000001E000000001E000000001E00000 0003E000000003C000000003C000000003C000000007C000000007800000000780000000 07800000000F800000000F000000000F000000000F000000001E000000001E000000001C 000000003C00000000380000000070000000006000000027277FA31B>I<00007FC02000 01FFFFC00007FFFF80001807FF0000380006000070000E0000E0001C0000C00038000100 0030000000006000000000C0000000018000000003000000000600000007FFC000000FFF E000000031C00000006080000000C00000000180000000030000000006000000000C0000 00001800000000300003000060000E0000C0001E000100001C000600003C000C00003800 1FFF8070003FFFFFC0007FFFFF8000800FFE000023227EA124>90 D<0003C0001E0000380000700000E00000E00000E00000E00000E00000E00000E00000E0 0000E00000E00000E00000E00000E00000E00000E00000E00000E00001C0000380000F00 00F800000F000003800001C00000E00000E00000E00000E00000E00000E00000E00000E0 0000E00000E00000E00000E00000E00000E00000E00000E00000E000007000003800001E 000003C012317DA419>102 DI106 D<8010C030C030C030C030C030C030C030C030C030C030C030C030C0 30C030C030C030C030C030C030C030C030C030C030C030C030C030C030C030C030C030C0 30C030C030C030C030C030C030C030C030C030C030C030C030C030C030C030C030C03080 100C327AA419>I<0000000001000000000300000000060000000006000000000C000000 000C00000000180000000018000000003000000000300000000060000000006000000000 C000000000C0000000018000000001800000000300000000030000000006000000000600 0000000C000000000C0000000018000000001800000000300006000030001E000060002F 000060004F0000C000878000C000078001800003C001800003C003000003C003000001E0 06000001E006000000F00C000000F00C000000781800000078180000003C300000003C30 0000001E600000001E600000000FC00000000FC000000007800000000780000000030000 00000300000028327D812A>112 D E /Fk 11 123 df<00030000060000060000060000 07FC001FFE003F0600FFFE01F9F803F00003E00007E00007E0000FC0000FC0000FC00007 C00007FFE003FFF001F03003FFE0073FC00E00001E00003C000038000078000078000078 0000F80000FC0000FF00007FE0007FFC003FFF801FFFE00FFFF003FFF8007FF8000FF800 01F80000F80070F0003FE0000FC0172D7FA219>24 D<03FFFFE007FFFFF00FFFFFF01FFF FFE03FFFFFC0700C0000C01C0000801C0000001C0000003C0000003C0000003C0000007C 00000078000000F8000000F8000000F8000001F8000001F8000001F8000001F0000001E0 00001C167E951A>28 D<0000060000000C0000000C0000000C0000000C00000018000000 1800000018000000180000003000000030000000300000003000000FFF80007FFFE001F0 60F003E060780780C03C0F00C03C1F00C03E3E00C03E3E01803E7C01803E7C01803E7C01 803EF803007CF803007CF80300F8780300F8780601F07C0603E03E0607C01F061F000FFF FE0001FFF000000C0000000C000000180000001800000018000000180000003000000030 000000300000003000001F2D7EA223>30 D<000FE0007FF801F83C03E07C0780FC0F80FC 1F00FC3F00703E00007E00007E00007E0000FC0000FC0000FC00007C00007C00047C000C 3E00381F01F00FFFC001FE0016167F951A>99 D<00003FE000003FE0000007E0000007E0 000007E000000FC000000FC000000FC000000FC000001F8000001F8000001F8000001F80 003F3F0000FFFF0003E0FF0007C07F000F807E001F807E001F007E003F007E003E00FC00 7E00FC007E00FC007E00FC00FC01F800FC01F800FC01F860FC01F8607C03F0C07C03F0C0 7C07F1803E1FF1801FF8FF0007E03E001B237EA21E>I<003FC000FFF003F0780F80381F 00383F00383E00387E00707C01E0FFFFC0FFFE00FC0000F80000F80000F80000F80000F8 00087800187C00703E03E01FFF8003FC0015167E951C>I<00000F8000003FE0000079F0 0000F3F00001F3F00001F3E00003F1C00003F0000003F0000003F0000007E0000007E000 0007E00003FFFFC003FFFFC0000FC000000FC000000FC000000FC000000FC000001F8000 001F8000001F8000001F8000001F8000001F8000003F0000003F0000003F0000003F0000 003F0000003E0000007E0000007E0000007E0000007C0000007C0000007C00003C780000 7CF800007EF00000FCE000007DC000007F8000001F0000001C2D7DA21C>I<00E001F003 F003F003F003F007E007E007E007E0FFFFFFFF0FC00FC01F801F801F801F803F003F003F 003F007E007E007E037E06FC06FC0CFC187C703FE00F8010207E9F15>116 D<07C003801FF007C038F80FC030F80FC061F81F80C1F81F80C1F81F80C3F01F8003F03F 0007E03F0007E03F0007E03F000FC07E000FC07E000FC07E180FC07E180FC0FC300FC0FC 300FC0FC6007C3FC6003FF3FC000FC0F801D167E9522>I<07C003801FF007C038F80FC0 30F80FC061F81F80C1F81F80C1F81F80C3F01F8003F03F0007E03F0007E03F0007E03F00 0FC07E000FC07E000FC07E000FC07E000FC0FC000FC0FC000FC0FC0007C3FC0003FFF800 00FDF8000001F8000001F0001C03F0003E03E0007E07E0007E0FC0007C0F8000783E0000 3FFC00000FE000001A207E951D>121 D<00780601FE0603FF8C07FFF80FFFF00CFC6000 00C0000180000300000600001C0000300000600000C00003800606000E0C1FFC1FFFFC3F FFF838FFF0603FE0C00F8017167E951C>I E /Fl 21 119 df<03C0000C304010184020 1880600C80C00C80C00D00C00E00800E00800C00C01C00C02C0060C4801F0300120E7E8D 17>11 D<000F0000308000C0C00100400100600200C00400C0040080040180083F00083E 00080100080180100180100180100180100180300300300300300600280C0044180043E0 00400000400000800000800000800000800000131D7F9614>I<0780401FC04038E08060 3080C01080801100000900000A00000A00000A00000C00000C00000C0000080000080000 08000010000010000010000010001214808D12>I<0E00030003000180018001C000C000 C000600060006000300030007800980118020C040C080E18063006E003C00310177E9615 >21 D<0402000C06000C06000C0600180C00180C00180C00180C00301800301880301880 3038807859006F8E00600000600000C00000C00000C0000080000011147E8D15>I<7802 18061806180C300C301830183030606060C061806600D800E0000F0E7E8D11>I<004000 80008000F803780C00180018001800180018000FE00FE01800300060006000C000C000C0 00E00070003C001F8003E000700030042003C00D1D7F9610>I<60F0F070101020204040 040A7D830A>59 D<0000300000F00003C0000700001C0000780001E0000780000E000038 0000F00000F000003800000E000007800001E000007800001C000007000003C00000F000 003014167D921B>I<0008001800300030003000600060006000C000C000C00180018001 80030003000600060006000C000C000C00180018001800300030003000600060006000C0 00C0000D217E9812>I<07FE03F800E001C000E0010000E0020000E0080001C0100001C0 200001C0800001C1000003830000038F00000393800003A380000781C0000701C0000700 E0000700E0000E0070000E0070000E0038000E0038001C003C00FF80FF001D177F961E> 75 D<07F0000FE000F0001E0000B8001E0000B8002E0000B8004E000138005C00013800 9C000138011C00011C011C00021C023800021C043800021C043800021C083800041C1070 00040E107000040E207000040E407000080E40E000080E80E000080F00E000080700E000 180601C000FE040FF80023177F9622>77 D<1FFFFE381C0E201C04601C04401C04403804 80380400380000380000700000700000700000700000E00000E00000E00000E00001C000 01C00001C00001C00003C0003FFC0017177F9615>84 D<003E000C000C000C000C001800 1800180018073018F0307060706060C060C060C06080C080C480C4C1C446C838700F177E 9612>100 D<000E0013003700360030006000600060006003FC00C000C000C000C000C0 01800180018001800180030003000300030002006600E600CC007800101D7E9611>102 D<0300038003000000000000000000000000001C002400460046008C000C001800180018 0031003100320032001C0009177F960C>105 D<00180038001000000000000000000000 000001C0022004300430086000600060006000C000C000C000C001800180018001806300 E300C60078000D1D80960E>I<1F0006000600060006000C000C000C000C00181C186618 8E190C32003C003F00318060C060C460C460C4C0C8C0700F177E9612>I<383C0044C600 4702004602008E06000C06000C06000C0600180C00180C40181840181880300980300E00 120E7F8D15>110 D<071018D0307060706060C060C060C06080C080C080C0C1C0478039 80018001800300030003001FC00C147E8D10>113 D<1C0426064606460686040C040C04 0C0418081808181018200C6007800F0E7F8D11>118 D E /Fm 57 123 df<003F000000E180000380E020070060400E0070401C0030403C0038803C003880 780039007800390078003A00F0003A00F0003C00F0003800F00038007000380070007800 3000B800380318401C1C188007E007001B157E941F>11 D<00003E000000C180000300C0 000400C0000800E0001000E0001000E0002000E0004000E0004001C0008001C000800180 00800380010007000101FE0001021C000103EE0002000700020007000200078002000780 0400078004000780040007800400078008000F0008000F0008000E0008001E0014001C00 14003800120070001300E0002081C000207E000020000000200000004000000040000000 4000000040000000800000008000000080000000800000001B2D7FA21C>I<000F000031 800060C000E0C001C0E00180E00380E00700E00700E00F00E00E00E01E00E01E00E01C01 E03C01E03C01E03C01E07FFFC07803C07803C07803C0700780F00780F00700F00F00F00E 00F00E00E01C00601C0060380070300070600030C0001180000F000013237EA217>18 D<03800001C00000E00000F000007000007000007800003800003800003C00001C00001C 00001E00000E00000E00000F00000700000700000780000780000F80001BC00031C00061 C000C1E001C0E00380E00700E00E00701C0070380070780078F00038E00038C0001C1623 7DA21C>21 D<00C0060001C00E0001C00E0003801C0003801C0003801C0003801C000700 38000700380007003800070038000E0070000E0070000E0070000E0070801E00E1001E00 E1001E01E1001E0262003B0C620039F03C00380000003800000070000000700000007000 000070000000E0000000E0000000E0000000E0000000C000000019207F941D>I<070006 7F000E0F000E0E001C0E001C0E00180E00381C00301C00701C00E01C00C0380180380300 380600380C0070180070300070C000738000EC0000F0000017157E9418>I<0008000010 00001000001000000FE000782000E7C001C0000380000780000F00000F00000F00000E00 000E00000F00000F0000077E0003810006FE000C00001800003000002000006000004000 00C00000C00000C00000C00000C00000E00000E000007800003F00001FC0000FF80001FC 00007E00000E00000600000600040400030C0000F000132D7EA215>I<007FFF8001FFFF 8003FFFF800783C0000E01C0001C00E0003800E0003800E0007000E0007000E0007000E0 00E001C000E001C000E001C000E0038000E003000060070000600E000030180000187000 0007C0000019157E941C>27 D<0FFFF81FFFFC3FFFF87020004020008020008060000060 0000600000C00000C00000C00000C00001C0000180000180000380000380000380000700 0003000016157E9415>I<00001000000020000000200000002000000020000000400000 00400000004000000040000000800000008000000080000000800000010000000FE00000 711C0001C10600030203000E0203801C020180180201C0380401C0700401C0700401C070 0401C0E0080380E0080380E00807006008070070100E0030101C00301038001C10E00006 23800001FE00000020000000200000004000000040000000400000004000000080000000 80000000800000008000001A2D7EA21D>30 D<70F8F8F87005057C840E>58 D<70F8FCFC7404040404080810102040060F7C840E>I<0000001800000078000001E000 00078000001E00000078000003E000000F8000003C000000F0000003C000000F0000003C 000000F0000000F00000003C0000000F00000003C0000000F00000003C0000000F800000 03E0000000780000001E0000000780000001E000000078000000181D1C7C9926>I<0000 80000180000180000300000300000300000600000600000600000C00000C00000C000018 0000180000180000300000300000300000600000600000600000C00000C00000C0000180 000180000180000180000300000300000300000600000600000600000C00000C00000C00 00180000180000180000300000300000300000600000600000600000C00000C00000C000 0011317DA418>II<000FC000003030000040180000800C0001 00060001C0070003C0070003C00300018003800000038000000380000003800000038000 1F87800070478001C0278003801780070017800E001F001E001F001C001F003C001F0038 001E0078001E0078001E0078003C00F0003C00F0003800F0007800F00070007000E00070 00E0007001C00038038000180700000C1C000003F0000019257EA31A>64 D<00000080000000018000000001C000000003C000000007C000000007C00000000BC000 00000BC000000013C000000033C000000023C000000043E000000043E000000081E00000 0101E000000101E000000201E000000201E000000401E000000801E000000801E0000010 01F000001FFFF000002000F000004000F000004000F000008000F000008000F000010000 F000020000F000020000F80004000078000C000078001E0000F800FF800FFF8021237EA2 25>I<00FFFFF000000F001E00000F000F00000F000780001E000380001E000380001E00 03C0001E0003C0003C000380003C000780003C000780003C000F000078001E000078003C 000078007800007803E00000FFFFC00000F000F00000F000780000F0003C0001E0003C00 01E0001C0001E0001E0001E0001E0003C0003C0003C0003C0003C0003C0003C000780007 80007800078000F000078001E00007800380000F800F0000FFFFF8000022227DA125>I< 00007F00800003808100000E00630000380027000070001F0000E0000E0001C0000E0003 80000E000700000E000F000004000E000004001E000004003C000004003C000008007800 00000078000000007800000000F000000000F000000000F000000000F000000000F00000 0000E000000000E000002000E000002000E000004000E000004000F00000800070000080 007000010000380002000018000400001C0008000006003000000381C0000000FE000000 21247DA223>I<00FFFFFF80000F000780000F000180000F000180001E000180001E0001 80001E000100001E000100003C000100003C000100003C010100003C0100000078020000 0078020000007806000000780E000000FFFC000000F00C000000F00C000000F00C000001 E008000001E008000001E008000001E000000003C000000003C000000003C000000003C0 00000007800000000780000000078000000007800000000F80000000FFFC00000021227D A120>70 D<00FFF8000F00000F00000F00001E00001E00001E00001E00003C00003C0000 3C00003C0000780000780000780000780000F00000F00000F00000F00001E00001E00001 E00001E00003C00003C00003C00003C0000780000780000780000780000F8000FFF80015 227DA116>73 D<00FFF801FF000F000078000F000060000F0000C0001E000100001E0002 00001E000400001E000800003C002000003C004000003C008000003C0200000078040000 007808000000781C000000787C000000F0BE000000F11E000000F21E000000F80F000001 F00F000001E00F800001E007800001E007800003C003C00003C003C00003C003C00003C0 01E000078001E000078001F000078000F000078000F0000F8001F800FFF80FFF0028227D A129>75 D<00FFFC00000F8000000F0000000F0000001E0000001E0000001E0000001E00 00003C0000003C0000003C0000003C00000078000000780000007800000078000000F000 0000F0000000F0000000F0000001E0000001E0000001E0002001E0002003C0004003C000 4003C0008003C0008007800180078001000780030007800F000F803E00FFFFFE001B227D A121>I<00FF800003FE000F800007C0000F80000BC0000F80000BC00013C00017800013 C00017800013C00027800013C00047800023C0004F000023C0008F000023C0008F000023 C0010F000043C0021E000041E0021E000041E0041E000041E0081E000081E0083C000081 E0103C000081E0103C000081E0203C000101E04078000100F04078000100F08078000100 F10078000200F100F0000200F200F0000200F200F0000200F400F0000400F801E0000400 F801E00004007001E0000C007001E0001E006003E000FFC0403FFE002F227DA12F>I<00 FF8007FE000F8000F0000F8000C0000BC000400013C000800013C000800011E000800011 E000800021F001000020F001000020F001000020780100004078020000407C020000403C 020000403C020000801E040000801E040000801E040000800F040001000F080001000F88 0001000788000100078800020003D000020003D000020003F000020001F000040001E000 040000E000040000E0000C0000E0001E00004000FFC000400027227DA127>I<00FFFFE0 000F0038000F001E000F000E001E0007001E0007001E0007001E0007003C000F003C000F 003C000F003C001E0078001E0078003C00780078007800E000F003C000FFFE0000F00000 00F0000001E0000001E0000001E0000001E0000003C0000003C0000003C0000003C00000 078000000780000007800000078000000F800000FFF8000020227DA11F>80 D<00007F00000381C0000E0060003800380070003800E0001C01C0001E0380000E070000 0E0F00000F0E00000F1E00000F3C00000F3C00000F7800000F7800000F7800000FF00000 1EF000001EF000001EF000001CF000003CE000003CE0000078E0000078E00000F0E00000 E0F00001E0F01E03C0702103807840870038408E001C40B8000E40F00007C1C02000FE80 200000802000018040000180C00001C0800001C3800001FF000000FF000000FE00000078 00202D7DA227>I<00FFFFC000000F007800000F001C00000F000E00001E000F00001E00 0700001E000780001E000780003C000F00003C000F00003C000F00003C001E000078003C 000078007800007800E000007803800000FFFC000000F007000000F003800000F003C000 01E001E00001E001E00001E001E00001E001E00003C003C00003C003C00003C003C00003 C003C00007800780000780078080078007808007800381000F80038100FFF801C6000000 00780021237DA125>I<0003F810000E042000180260002001E0004000E000C000C00080 00C0018000C0018000C00380008003800080038000000380000003C0000001F0000001FE 000000FFE000007FF000001FF8000001FC0000003C0000001C0000000E0000000E000000 0E0020000C0020000C0020000C002000080060001800600010007000200070004000C800 8000C603000081FC00001C247DA21E>I<3FFE01FF8003C0003C0003C000300003C00010 0007800020000780002000078000200007800020000F000040000F000040000F00004000 0F000040001E000080001E000080001E000080001E000080003C000100003C000100003C 000100003C0001000078000200007800020000780002000078000200007000040000F000 040000F000080000700008000070001000007000200000380040000038008000001C0100 0000060600000001F800000021237DA121>85 DII<007FFFFE007E001E0070003C00 E0007800C000F0008001E0018003E0010003C00100078002000F0002001E0000003C0000 007C00000078000000F0000001E0000003C00000078000000F8000000F0000001E000000 3C00200078002000F0004001F0004001E0004003C00080078000800F0001801E0003001E 0007003C000F0078007E00FFFFFE001F227DA121>90 D<00786001C4E00302E00601C00E 01C01C01C03C01C0380380780380780380780380F00700F00700F00700F00708F00E1070 0E10701E1030262018C6200F03C015157E941A>97 D<03C0003F80000380000380000380 000700000700000700000700000E00000E00000E00000E00001C00001C7C001D86001E03 003C03803803803803C03803C07003C07003C07003C07003C0E00780E00780E00780E00F 00E00E00601C00601C0030300018E0000F800012237EA215>I<003F0000E0800380C007 01C00E03C01C03C03C00003C0000780000780000780000F00000F00000F00000F0000070 00407000403001803802001C1C0007E00012157E9415>I<00001E0000FC00001C00001C 00001C0000380000380000380000380000700000700000700000700000E00078E001C4E0 0302E00601C00E01C01C01C03C01C0380380780380780380780380F00700F00700F00700 F00708F00E10700E10701E1030262018C6200F03C017237EA219>I<007E000381000700 800E00801C0080380080780100700600FFF800F00000F00000E00000E00000E00000E000 00E00080E000807003003004001838000FC00011157D9417>I<00001E00000063800000 C7800001C7800001C3000001800000038000000380000003800000038000000700000007 0000000700000007000000FFF800000E0000000E0000000E0000000E0000000E0000000E 0000001C0000001C0000001C0000001C0000001C00000038000000380000003800000038 000000380000007000000070000000700000007000000060000000E0000000E0000000C0 000000C0000071C00000F1800000F1000000620000003C000000192D7EA218>I<000F86 00384E00602E00E03C01C01C03801C07801C0700380F00380F00380F00381E00701E0070 1E00701E00701E00E00E00E00E01E00602E0030DC001F1C00001C00001C0000380000380 000380700700F00600F00C006038003FE000171F809417>I<00F00007E00000E00000E0 0000E00001C00001C00001C00001C000038000038000038000038000070000070F800730 C00740600E80700F00700E00700E00701C00E01C00E01C00E01C00E03801C03801C03803 80380382700384700704700708700308E003106001E017237EA21C>I<00E000E001E000 C00000000000000000000000000000000000001E0023004380438083808700870007000E 000E000E001C001C001C003820384070407080308031001E000B227EA111>I<00007000 00F00000F000006000000000000000000000000000000000000000000000000000000000 0F000031800041C00081C00081C00101C00101C000038000038000038000038000070000 0700000700000700000E00000E00000E00000E00001C00001C00001C00001C0000380000 3800003800707000F06000F0C0006380003E0000142C81A114>I<00F0000FE00000E000 00E00000E00001C00001C00001C00001C000038000038000038000038000070000070078 07018407021C0E0C3C0E103C0E20180E40001C80001F00001FE0001C3800381C00381C00 380E00380E08701C10701C10701C10700C20E006206003C016237EA219>I<01E00FC001 C001C001C0038003800380038007000700070007000E000E000E000E001C001C001C001C 0038003800380038007000700070007080E100E100E100620062003C000B237EA20F>I< 3C07E01F00461830618047201880C087401D00E087801E00E087801C00E087001C00E00E 003801C00E003801C00E003801C00E003801C01C007003801C007003801C007007001C00 7007043800E007083800E00E083800E00E083800E006107001C006203000C003C026157E 942B>I<3C07C04618604720308740388780388700388700380E00700E00700E00700E00 701C00E01C00E01C01C01C01C13801C23803823803843801847001883000F018157E941D >I<03C0F004631C04740E08780E08700708700708700F00E00F00E00F00E00F00E00F01 C01E01C01E01C01E01C03C03803803803803C07003C0E0072180071E000700000700000E 00000E00000E00000E00001C00001C00001C0000FF8000181F819418>112 D<007C1001C2300301700701600E00E01C00E03C00E03801C07801C07801C07801C0F003 80F00380F00380F00380F00700700700700F00301700186E000F8E00000E00000E00001C 00001C00001C00001C0000380000380000380003FF80141F7E9416>I<3C0F004630C047 41C08783C08783C08701808700000E00000E00000E00000E00001C00001C00001C00001C 000038000038000038000038000070000030000012157E9416>I<007E00008100030080 02018006038006030006000007000007F00003FC0001FF00003F00000780000380700380 F00300F00300E002004004003018000FE00011157E9417>I<006000E000E000E000E001 C001C001C001C00380FFFC0380038007000700070007000E000E000E000E001C001C001C 001C08381038103820184018C00F000E1F7F9E12>I<1E00182300384380384380708380 708380708700700700E00E00E00E00E00E00E01C01C01C01C01C01C01C01C21C03841C03 841C07840C09880E118803E0F017157E941C>I<1E00E02301E04381F04380F083807083 80308700300700200E00200E00200E00201C00401C00401C00801C00801C01001C01001C 02000C040006180003E00014157E9418>I<1E00181C2300383C4380383E4380701E8380 700E83807006870070060700E0040E00E0040E00E0040E00E0041C01C0081C01C0081C01 C0081C01C0101C01C0101C01C0201C03C0400C04C0400708618001F03E001F157E9423> I<1E00182300384380384380708380708700708700700700E00E00E00E00E00E00E01C01 C01C01C01C01C01C01C01C03801C03801C07800C0B800E170003E700000700000700000E 00600E00F01C00F01800E0300080600041C0003F0000151F7E9418>121 D<00E01003F02007F860060FC008008008010000020000040000080000100000200000C0 000100000200000400400800801001803F830061FE0040FC0080780014157E9417>I E /Fn 38 122 df<60F0F0701010101020204080040C7C830C>44 D<03C00C301818300C300C700E60066006E007E007E007E007E007E007E007E007E007E0 07E007E007E00760066006700E300C300C18180C3007E0101D7E9B15>48 D<010007003F00C700070007000700070007000700070007000700070007000700070007 00070007000700070007000700070007000700FFF80D1C7C9B15>I<07C01830201C400C 400EF00FF80FF807F8077007000F000E000E001C001C00380070006000C0018003000601 0C01180110023FFE7FFEFFFE101C7E9B15>I<07E01830201C201C781E780E781E381E00 1C001C00180030006007C00030001C001C000E000F000F700FF80FF80FF80FF00E401C20 1C183007C0101D7E9B15>I<000C00000C00001C00003C00003C00005C0000DC00009C00 011C00031C00021C00041C000C1C00081C00101C00301C00201C00401C00C01C00FFFFC0 001C00001C00001C00001C00001C00001C00001C0001FFC0121C7F9B15>I<300C3FF83F F03FC020002000200020002000200023E02C303018301C200E000E000F000F000F600FF0 0FF00FF00F800E401E401C2038187007C0101D7E9B15>I<00F0030C04040C0E181E301E 300C700070006000E3E0E430E818F00CF00EE006E007E007E007E007E007600760077006 300E300C18180C3003E0101D7E9B15>I<4000007FFF807FFF007FFF0040020080040080 040080080000100000100000200000600000400000C00000C00001C00001800001800003 8000038000038000038000078000078000078000078000078000078000030000111D7E9B 15>I<03E00C301008200C200660066006700670067C0C3E183FB01FE007F007F818FC30 7E601E600FC007C003C003C003C00360026004300C1C1007E0101D7E9B15>I<03C00C30 1818300C700C600EE006E006E007E007E007E007E0076007700F300F18170C2707C70006 0006000E300C780C78187018203010C00F80101D7E9B15>I68 DI<001F808000E061800180198007000780 0E0003801C0003801C00018038000180780000807800008070000080F0000000F0000000 F0000000F0000000F0000000F0000000F000FFF0F0000F80700007807800078078000780 380007801C0007801C0007800E00078007000B800180118000E06080001F80001C1E7E9C 21>71 DII75 D78 D80 D82 D<07E0801C1980300580300380600180E00180E00080E00080E00080F00000F800007C00 007FC0003FF8001FFE0007FF0000FF80000F800007C00003C00001C08001C08001C08001 C0C00180C00180E00300D00200CC0C0083F800121E7E9C17>I 89 D<1FC000307000783800781C00301C00001C00001C0001FC000F1C00381C00701C00 601C00E01C40E01C40E01C40603C40304E801F870012127E9115>97 DI<001F8000038000038000038000 038000038000038000038000038000038000038003F3800E0B8018078030038070038060 0380E00380E00380E00380E00380E00380E003806003807003803003801807800E1B8003 E3F0141D7F9C17>100 D<07E00C301818300C700E6006E006FFFEE000E000E000E00060 007002300218040C1803E00F127F9112>I<00F8018C071E061E0E0C0E000E000E000E00 0E000E00FFE00E000E000E000E000E000E000E000E000E000E000E000E000E000E000E00 0E007FE00F1D809C0D>I104 D<18003C003C0018000000000000000000000000000000FC001C001C001C001C001C001C 001C001C001C001C001C001C001C001C001C001C00FF80091D7F9C0C>I108 D110 D<03F0000E1C00180600300300700380600180E001 C0E001C0E001C0E001C0E001C0E001C06001807003803003001806000E1C0003F0001212 7F9115>II114 D<1F9020704030C010C0 10E010F8007F803FE00FF000F880388018C018C018E010D0608FC00D127F9110>I<0400 0400040004000C000C001C003C00FFE01C001C001C001C001C001C001C001C001C001C10 1C101C101C101C100C100E2003C00C1A7F9910>II121 D E /Fo 1 4 df<040004000400C460F5E03F800E003F80F5E0C4600400040004000B0D7E8D11>3 D E /Fp 32 123 df45 D<70F8F8F87005057C840D>I<70F8F8 F8700000000000000000000070F0F8F878080808101010202040051D7C930D>59 D<000100000003800000038000000380000007C0000007C0000007C0000009E0000009E0 000009E0000010F0000010F0000010F00000207800002078000020780000403C0000403C 0000C03E0000801E0000801E0001FFFF0001000F0001000F000200078002000780020007 80040003C0040003C00C0003C01E0003E0FF801FFE1F207F9F22>65 D<000FE01000381C3000E0027003C00170078000F00F0000701E0000701E0000303C0000 303C0000107C00001078000010F8000000F8000000F8000000F8000000F8000000F80000 00F8000000F8000000F8000000780000007C0000103C0000103C0000101E0000201E0000 200F0000200780004003C0008000E0030000380C00000FF0001C217E9F21>67 D75 D78 D<001FE0000070380001C00E0003800700070003800F0003 C01E0001E03C0000F03C0000F07C0000F87C0000F878000078F800007CF800007CF80000 7CF800007CF800007CF800007CF800007CF800007CF800007C780000787C0000F87C0000 F83C0000F03E0001F01E0001E00F0003C0070003800380070001E01E0000703800001FE0 001E217E9F23>II82 D86 D<1FE000303000781800781C00300E00000E00000E00 000E0000FE00078E001E0E00380E00780E00F00E10F00E10F00E10F01E10781E10386720 0F83C014147E9317>97 D<1C0000FC00001C00001C00001C00001C00001C00001C00001C 00001C00001C00001C00001C7C001D87001E01801E00C01C00E01C00701C00701C00781C 00781C00781C00781C00781C00781C00701C00F01C00E01E00C01A0180198700107C0015 207E9F19>I<01FC000706001C0F00380F00380600780000700000F00000F00000F00000 F00000F00000F000007000007800003800803800801C010007060001F80011147F9314> I<0001C0000FC00001C00001C00001C00001C00001C00001C00001C00001C00001C00001 C001F1C0070DC00C03C01801C03801C07801C07001C0F001C0F001C0F001C0F001C0F001 C0F001C07001C07001C03801C01803C00C03C0070DC001F1F815207F9F19>I<03F0000E 1C001C0E00380700380700700700700380F00380F00380FFFF80F00000F00000F0000070 00007000003800803800801C010007060001F80011147F9314>I<0000E003E3300E3C30 1C1C30380E00780F00780F00780F00780F00780F00380E001C1C001E380033E000200000 2000003000003000003FFE001FFF801FFFC03001E0600070C00030C00030C00030C00030 6000603000C01C038003FC00141F7F9417>103 D<1C0000FC00001C00001C00001C0000 1C00001C00001C00001C00001C00001C00001C00001C7C001C86001D03001E03801E0380 1C03801C03801C03801C03801C03801C03801C03801C03801C03801C03801C03801C0380 1C03801C0380FF8FF014207E9F19>I<38007C007C007C00380000000000000000000000 00001C00FC001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C00 1C001C00FF80091F7F9E0C>I<1C0000FC00001C00001C00001C00001C00001C00001C00 001C00001C00001C00001C00001C1FE01C07801C06001C04001C08001C10001C20001C60 001CE0001DF0001E70001C38001C3C001C1C001C0E001C0F001C07001C07801C07C0FF9F F014207E9F18>107 D<1C00FC001C001C001C001C001C001C001C001C001C001C001C00 1C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C00 FF8009207F9F0C>I<1C3E03E000FCC30C30001D039038001E01E01C001E01E01C001C01 C01C001C01C01C001C01C01C001C01C01C001C01C01C001C01C01C001C01C01C001C01C0 1C001C01C01C001C01C01C001C01C01C001C01C01C001C01C01C001C01C01C00FF8FF8FF 8021147E9326>I<1C7C00FC86001D03001E03801E03801C03801C03801C03801C03801C 03801C03801C03801C03801C03801C03801C03801C03801C03801C0380FF8FF014147E93 19>I<01F800070E001C03803801C03801C07000E07000E0F000F0F000F0F000F0F000F0 F000F0F000F07000E07000E03801C03801C01C0380070E0001F80014147F9317>I<1C7C 00FD87001E01801E01C01C00E01C00F01C00701C00781C00781C00781C00781C00781C00 781C00701C00F01C00E01E01C01E03801D87001C7C001C00001C00001C00001C00001C00 001C00001C00001C0000FF8000151D7E9319>I<1CF0FD181E3C1E3C1E181C001C001C00 1C001C001C001C001C001C001C001C001C001C001C00FFC00E147E9312>114 D<0FC830386018C008C008C008E0007C003FE01FF007F8003C800E8006C006C006C004E0 0CD81887E00F147F9312>I<020002000200060006000E000E003E00FFF80E000E000E00 0E000E000E000E000E000E000E000E000E040E040E040E040E040708030801F00E1C7F9B 12>I<1C0380FC1F801C03801C03801C03801C03801C03801C03801C03801C03801C0380 1C03801C03801C03801C03801C03801C07800C0780061B8003E3F014147E9319>III<7FFF700E600E401C40384078407000E001E001C00380078007010E01 1E011C0338027006700EFFFE10147F9314>122 D E /Fq 44 122 df<00003FE00000E0100001803800038078000380780007003000070000000700000007 0000000E0000000E0000000E000000FFFFE0000E00E0001C01C0001C01C0001C01C0001C 01C0001C0380003803800038038000380380003807000038070000780700007007100070 0E2000700E2000700E2000600E2000E0064000E0038000E0000000C0000000C0000001C0 00003180000079800000F3000000620000003C0000001D29829F1A>12 D<000100020004000800100020006000C0018001800300070006000E000C001C00180038 00380030007000700060006000E000E000C000C000C000C000C000C000C000C000C000C0 00C000C000C0004000600060002000100010000800102E79A113>40 D<0010000008000004000006000002000003000003000003000001000001800001800001 800001800001800001800001800003800003800003800003000003000003000007000007 00000600000600000E00000C00000C00001C0000180000380000300000700000600000E0 0000C0000180000100000300000600000C0000180000300000600000800000112E80A113 >I<1C3C3C3C3C040408081020204080060E7D840E>44 D<7FF0FFE07FE00C037D8A10>I< 70F8F8F0E005057B840E>I<000200020006000E003C00DC031C001C0038003800380038 007000700070007000E000E000E000E001C001C001C001C003800380038003800780FFF8 0F1E7B9D17>49 D<0000600000E00000E00000E00001C00001C00001C000038000038000 0300000700000700000600000E00000C0000180000180000300000300000630000C70000 8700010700030700060E00040E00080E003F8E00607C00801FC0001C00001C0000380000 380000380000380000700000700000600013277E9D17>52 D<001F0000718000C0C00180 C00380E00700E00F00E00F01E01E01E01E01E01E01E01E01C01C03C01C03C01C03C01C07 C01C0F800C0F8006378003C700000F00000E00000E00001C00601C00F03800F07000E060 0080C0004380003E0000131F7B9D17>57 D<070F1F1F0E0000000000000000000070F8F8 F0E008147B930E>I<00000200000006000000060000000E0000001E0000001E0000003F 0000002F0000004F000000CF0000008F0000010F0000010F0000020F0000020F0000040F 0000080F0000080F0000100F800010078000200780003FFF800040078000800780008007 8001000780010007800200078006000780040007801E0007C0FF807FF81D207E9F22>65 D<01FFFFC0001E00F0001E0078001E0038001E003C003C003C003C003C003C003C003C00 3C0078007800780078007800F0007801E000F0078000FFFE0000F00F8000F003C001E001 C001E001E001E001E001E001E003C001E003C001E003C001E003C001C0078003C0078007 8007800F0007801E000F007C00FFFFE0001E1F7D9E20>I<0000FE0200078186001C004C 0038003C0060003C00C0001C01C0001803800018070000180F0000181E0000101E000010 3C0000003C00000078000000780000007800000078000000F0000000F0000000F0000000 F0000000F00000807000008070000080700001003800010038000200180004000C001800 060020000381C00000FE00001F217A9F21>I<0000FC040007030C001C00980030007800 E0007801C000380380003003800030070000300E0000301E0000201E0000203C0000003C 00000078000000780000007800000078000000F0000000F000FFF0F0000780F0000780F0 000F0070000F0070000F0070000F0070001E0038001E0018003E001C002E000E00CC0003 83040000FC00001E217A9F23>71 D<00FFF01FE0001F000F80001E000E00001E00080000 1E001000003C002000003C004000003C010000003C020000007804000000780800000078 100000007830000000F0F0000000F1F8000000F278000000F478000001E83C000001F03C 000001E03C000001E01E000003C01E000003C01E000003C00F000003C00F000007800F00 000780078000078007800007800780000F8007C000FFF03FF800231F7D9E23>75 D<00FF003FE0001F000F00001F0004000017800400001780040000278008000023C00800 0023C008000023C008000041E010000041E010000041F010000040F010000080F0200000 807820000080782000008078200001003C400001003C400001003C400001001E40000200 1E800002001E800002000F800002000F800004000F0000040007000004000700000C0007 00001C00020000FF80020000231F7D9E22>78 D<0001FC0000070700001C01C0003000E0 00E0006001C000700380007007800038070000380E0000381E0000381C0000383C000038 3C00003878000078780000787800007878000078F00000F0F00000F0F00000E0F00001E0 F00001C0F00003C0700003807000070078000F0038001E0038003C001C0070000E00E000 0783800001FC00001D217A9F23>I<01FFFF80001E00E0001E0070001E0038001E003C00 3C003C003C003C003C003C003C003C0078007800780078007800F0007800E000F003C000 F00F0000FFFC0000F0000001E0000001E0000001E0000001E0000003C0000003C0000003 C0000003C00000078000000780000007800000078000000F800000FFF000001E1F7D9E1F >I<00FFFF00001E03C0001E00E0001E0070001E0078003C0078003C0078003C0078003C 0078007800F0007800F0007801E0007801C000F0070000F01E0000FFF00000F01C0001E0 0E0001E00F0001E0070001E0078003C00F0003C00F0003C00F0003C00F0007801E000780 1E0807801E0807801E100F800E10FFF00E20000003C01D207D9E21>82 D<0007E040001C18C0003005800060038000C0038001C001800180010003800100038001 00038001000380000003C0000003C0000003F8000001FF800001FFE000007FF000001FF0 000001F80000007800000078000000380000003800200038002000380020003000600070 00600060006000E0007000C000E8038000C606000081F800001A217D9F1A>I86 DI<00F1800389C00707800E03801C03803C03803807007807007807007807 00F00E00F00E00F00E00F00E20F01C40F01C40703C40705C40308C800F070013147C9317 >97 D<07803F8007000700070007000E000E000E000E001C001C001CF01D0C3A0E3C0E38 0F380F700F700F700F700FE01EE01EE01EE01CE03CE038607060E031C01F0010207B9F15 >I<007E0001C1000300800E07801E07801C07003C0200780000780000780000F00000F0 0000F00000F00000F0000070010070020030040018380007C00011147C9315>I<000078 0003F80000700000700000700000700000E00000E00000E00000E00001C00001C000F1C0 0389C00707800E03801C03803C0380380700780700780700780700F00E00F00E00F00E00 F00E20F01C40F01C40703C40705C40308C800F070015207C9F17>I<007C01C207010E01 1C013C013802780C7BF07C00F000F000F000F0007000700170023804183807C010147C93 15>I<00007800019C00033C00033C000718000700000700000E00000E00000E00000E00 000E0000FFE0001C00001C00001C00001C00003800003800003800003800003800007000 00700000700000700000700000E00000E00000E00000E00000E00001C00001C00001C000 0180003180007B0000F300006600003C00001629829F0E>I<001E3000713800E0F001C0 700380700780700700E00F00E00F00E00F00E01E01C01E01C01E01C01E01C01E03801E03 800E07800E0B8006170001E700000700000700000E00000E00300E00781C00F038006070 003FC000151D7F9315>I<01E0000FE00001C00001C00001C00001C00003800003800003 8000038000070000070000071E000763000E81800F01C00E01C00E01C01C03801C03801C 03801C0380380700380700380700380E10700E20700E20701C20700C40E00C8060070014 207D9F17>I<00C001E001E001C000000000000000000000000000000E00130023004380 4700470087000E000E000E001C001C001C003840388038807080310032001C000B1F7C9E 0E>I<03C01FC0038003800380038007000700070007000E000E000E000E001C001C001C 001C0038003800380038007000700070007100E200E200E200E200640038000A207C9F0C >108 D<1C0F80F0002630C318004740640C004780680E004700700E004700700E008E00 E01C000E00E01C000E00E01C000E00E01C001C01C038001C01C038001C01C038001C01C0 708038038071003803807100380380E10038038062007007006400300300380021147C93 25>I<1C0F802630C04740604780604700704700708E00E00E00E00E00E00E00E01C01C0 1C01C01C01C01C03843803883803883807083803107003303001C016147C931A>I<007C 0001C3000301800E01C01E01C01C01E03C01E07801E07801E07801E0F003C0F003C0F003 C0F00780F00700700F00700E0030180018700007C00013147C9317>I<01C1E002621804 741C04781C04701E04701E08E01E00E01E00E01E00E01E01C03C01C03C01C03C01C03803 80780380700380E003C1C0072380071E000700000700000E00000E00000E00000E00001C 00001C0000FF8000171D809317>I<1C1E002661002783804787804707804703008E0000 0E00000E00000E00001C00001C00001C00001C0000380000380000380000380000700000 30000011147C9313>114 D<00FC030206010C030C070C060C000F800FF007F803FC003E 000E700EF00CF00CE008401020601F8010147D9313>I<018001C0038003800380038007 000700FFF007000E000E000E000E001C001C001C001C0038003800380038207040704070 80708031001E000C1C7C9B0F>I<0E00C01300E02301C04381C04701C04701C08703800E 03800E03800E03801C07001C07001C07001C07101C0E20180E20180E201C1E400C264007 C38014147C9318>I<0E03801307802307C04383C04701C04700C08700800E00800E0080 0E00801C01001C01001C01001C02001C02001C04001C04001C08000E300003C00012147C 9315>I<0E00C1C01300E3C02301C3E04381C1E04701C0E04701C060870380400E038040 0E0380400E0380401C0700801C0700801C0700801C0701001C0701001C0601001C0F0200 0C0F04000E13080003E1F0001B147C931E>I<0383800CC4401068E01071E02071E02070 C040E00000E00000E00000E00001C00001C00001C00001C040638080F38080F38100E581 0084C60078780013147D9315>I<0E00C01300E02301C04381C04701C04701C08703800E 03800E03800E03801C07001C07001C07001C07001C0E00180E00180E001C1E000C3C0007 DC00001C00001C00003800F03800F07000E06000C0C0004380003E0000131D7C9316>I E /Fr 7 117 df<0000E000000000E000000001F000000001F000000001F000000003F8 00000003F800000006FC00000006FC0000000EFE0000000C7E0000000C7E000000183F00 0000183F000000303F800000301F800000701FC00000600FC00000600FC00000C007E000 00FFFFE00001FFFFF000018003F000038003F800030001F800030001F800060000FC0006 0000FC000E0000FE00FFE00FFFE0FFE00FFFE0231F7E9E28>65 D<07FC001FFF803F07C0 3F03E03F01F03F01F00C01F00001F0003FF007FDF01F81F03E01F07C01F0F801F0F801F0 F801F0FC02F07E0CF03FF87E0FE03E17147F9319>97 DI<01FE0007FF801F0FC03E0FC03E0FC07C0FC0 7C0300FC0000FC0000FC0000FC0000FC0000FC00007C00007E00003E00603F00C01F81C0 07FF0001FC0013147E9317>I114 D<0FE63FFE701E600EE006E006F800FFC07FF83FFC1FFE03FE001F C007C007E007F006F81EFFFCC7F010147E9315>I<0300030003000300070007000F000F 003F00FFFCFFFC1F001F001F001F001F001F001F001F001F001F001F061F061F061F061F 060F8C07F803F00F1D7F9C14>I E /Fs 30 122 df<07000F801F801F801F800E800080 0080010001000200020004000800100030004000800009127C8512>44 D<387CFCFCF8700606798512>46 D<0001F80000070E00001C070000380380007003C000 F001C000E001C001E001C003C003C003C003C007C003C0078003C00F8003C00F8003C00F 0007C01F0007C01F0007C01F0007C03E000F803E000F803E000F803E000F807C001F007C 001F007C001F007C001E0078003E00F8003E00F8003C00F8007C00F8007C00F0007800F0 00F000F000F0007000E0007001C0007003C00038078000380E00001E1C000007E000001A 2979A71F>48 D<0000080000180000300000700000F00001F00007E0001FE000F9E000C1 E00003C00003C00003C00003C0000780000780000780000780000F00000F00000F00000F 00001E00001E00001E00001E00003C00003C00003C00003C000078000078000078000078 0000F00000F00000F00001F0007FFFC0FFFFC0152879A71F>I<00000180000003C00000 078000000780000007800000078000000F0000000F0000000F0000001E0000001E000000 1C0000003C0000003C000000380000007800000070000000F0000000E0000001E0000001 C0000003C000000380000007000000070000000E0000000C1C00001C3C0000383C000070 3C000060780000C0780001807800038078000700F0000E00F0001FE0F0007FFCF000E01F E1004003FF800001FE000001E0000003C0000003C0000003C0000003C000000780000007 80000007800000078000000F0000000600001A347DA71F>52 D<0000FC000003FF000007 0380000C01C0001801E0003000E0007000E000E000E000E000E000E000E001E001C001E0 01C001F0038001F8030001FC060000FE0C0000FF3800007FE000003FC000001FE0000037 F80000C3FC000181FC000700FE000E007E001C003F0038001F0038000F0070000F007000 0F00E0000E00E0000E00E0000E00E0001C00E000180070003000700060003801C0001E07 80000FFE000003F800001B297AA71F>56 D<0001F8000007FE00001E0F00003C03800070 038000F003C001E003C003C003C003C003C007C003C0078003C00F8003C00F8003C00F80 07C01F0007C01F0007C01F0007C01F000FC01F000F800F001F800F001F800F002F800700 5F0003009F0001831F00007C1E0000003E0000003C0000007C0000007800000078000000 F0000000E0007801C000F803C000F8078000F00F0000C01C0000707800003FF000001F80 00001A2979A71F>I<0000001C000000001C000000003C000000007C000000007C000000 00FC00000000FC00000001FC00000001FC000000037C000000037C000000067C0000000E 7C0000000C7C000000187C000000187E000000303E000000303E000000603E000000E03E 000000C03E000001803E000001803E000003003E000003003E000006003E000006003E00 000FFFFE00001FFFFE000018003E000030003E000030003F000060001F000060001F0000 C0001F0001C0001F000180001F000380001F000780001F000F80003F00FFF003FFF8FFF0 03FFF0252A7CA92C>65 D<003FFFFFC0007FFFFFF00003F001F80003E0007C0003E0003E 0003E0003E0003E0003F0007C0003F0007C0003F0007C0003F0007C0003F000F80003E00 0F80007E000F80007C000F8000F8001F0001F8001F0003E0001F0007C0001F001F00003F FFFC00003E001F00003E000780003E0007C0007C0003E0007C0003F0007C0003F0007C00 03F000F80003F000F80003F000F80003F000F80003F001F00007E001F00007E001F0000F C001F0000FC003E0001F8003E0003F0003E0007E0007E001F800FFFFFFE000FFFFFF8000 28297CA82A>I<003FFFFF8000007FFFFFF0000003F001F8000003E0007C000003E0003E 000003E0001F000003E0000F000007C0000F800007C0000F800007C0000F800007C00007 80000F800007C0000F800007C0000F800007C0000F80000FC0001F00000FC0001F00000F C0001F00000FC0001F00000FC0003E00000F80003E00001F80003E00001F80003E00001F 80007C00001F00007C00003F00007C00003E00007C00003E0000F800007C0000F800007C 0000F80000F80000F80000F80001F00001F00001F00003E00001F00003C00001F0000780 0003E0000F000003E0003E000003E0007C000007E003F00000FFFFFFC00000FFFFFE0000 002A297CA82D>68 D<003FF000001FFE007FF000003FFC0003F000003F8000037800007F 0000037800007F000003780000DF0000037800019F000006780001BE0000067800033E00 00067800033E0000067800063E00000C7800067C00000C78000C7C00000C7800187C0000 0C7800187C000018780030F80000183C0030F80000183C0060F80000183C0060F8000030 3C00C1F00000303C0181F00000303C0181F00000303C0301F00000603C0303E00000603C 0603E00000603C0C03E00000603C0C03E00000C03C1807C00000C01E1807C00000C01E30 07C00000C01E3007C00001801E600F800001801EC00F800001801EC00F800001801F800F 800003001F801F000003001F001F000007001F001F00000F801E003F0000FFF81C07FFF8 00FFF81C07FFF80037297BA836>77 D<00003F010001FFC30003C0E70007007F000E003E 001C001E0038001E0078001E0070001C00F0001C00F0001C00F0001C01F0001801F00018 01F0000001F8000000FC000000FF000000FFF000007FFE00003FFF00001FFF800003FFC0 00007FC000000FE0000003E0000003E0000003E0000001E0180001E0180001E0180001E0 380003C0380003C03800038038000780780007007C000E007C001C0077003800E3C0F000 C1FFE000807F0000202B7BA922>83 D<3FFFC03FFE7FFF807FFC03F00007C003E0000380 03E000030003E000030003E000030007C000060007C000060007C000060007C00006000F 80000C000F80000C000F80000C000F80000C001F000018001F000018001F000018001F00 0018003E000030003E000030003E000030003E000030007C000060007C000060007C0000 60007C00006000F80000C000F80000C000F80000C000F800018000F800018000F8000300 00F800030000F80006000078000C000078001800003C003000001C00E000000F03C00000 07FF00000001FC000000272A74A82C>85 D<003E000000E1180001C0BC000380FC000700 78000F0078001E0078001E0078003E00F0007C00F0007C00F0007C00F000F801E000F801 E000F801E000F801E000F003C000F003C180F003C180F003C180F0078300700F8300700B 86003833860018618C000F80F000191A79991F>97 D<01E0003FE0003FE00003E00003C0 0003C00003C00003C0000780000780000780000780000F00000F00000F00000F00001E3E 001E63801F81C01F01C03E01E03C00E03C01F03C01F07801F07801F07801F07801F0F003 E0F003E0F003E0F003C0E007C0E007C0E00780E00F00E00F00E01E00701C0030380018E0 000F8000142A79A91B>I<001F8000706001C0300380700780F00F01F01E01F01E00E03E 00003C00007C00007C0000F80000F80000F80000F80000F00000F00000F00000F00020F0 00607000C03801803807001C1C0007F000141A79991B>I<001F8000704001C020038030 0700300F00301E00303E00603C00607C01C07C0F007FF800F80000F80000F80000F80000 F80000F00000F00000F000207000607800C03801801807000C1C0007F000141A79991B> 101 D<0000078000001C40000038E0000079E0000073E00000F3E00000F1C00000F00000 01E0000001E0000001E0000001E0000001E0000003C0000003C0000003C000007FFF0000 7FFF000007800000078000000780000007800000078000000F0000000F0000000F000000 0F0000000F0000001E0000001E0000001E0000001E0000001E0000003C0000003C000000 3C0000003C0000003C00000078000000780000007800000078000000F0000000F0000000 F0000000F0000000E0000031E0000079C00000F9C00000F9800000F3800000630000003C 0000001B3681A912>I<0003E000000E1180001C0BC000380FC00070078000F0078001E0 078001E0078003E00F0007C00F0007C00F0007C00F000F801E000F801E000F801E000F80 1E000F003C000F003C000F003C000F003C000F0078000700F8000700F800038378000186 F00000F8F0000000F0000000F0000001E0000001E0000001E0000001C0007003C000F807 8000F8070000F00E0000E03C00003FE000001A267D991B>I<003C000007FC000007FC00 00007C00000078000000780000007800000078000000F0000000F0000000F0000000F000 0001E0000001E0000001E0000001E0000003C3E00003CC380003D01C0003E01C0007E01E 0007C01E0007801E0007801E000F003C000F003C000F003C000F003C001E0078001E0078 001E0078001E00F0003C00F0003C00F0603C01E0603C01E0407801E0C07801C0807801C1 807801C300F000C600600078001B2A7BA91F>I<001C003E003E003C0038000000000000 00000000000000000000000003C00CE0186030F030F060F060F061E0C1E001E003C003C0 0780078007800F000F000F0C1E0C1E081E181C181C301C200C4007800F287BA712>I<07 807E00F80008C1C3830E0018E301C4070030F601C8070030FC01F8078060F801F0078060 F001E0078060F001E00780C1E003C00F0001E003C00F0001E003C00F0001E003C00F0003 C007801E0003C007801E0003C007801E0003C007803C0007800F003C0007800F003C1807 800F00781807800F0078100F001E0078300F001E0070200F001E0070600F001E0070C01E 003C0031800C0018001E002D1A7B9931>109 D<07807C0008C1870018E2038030F40380 30FC03C060F803C060F003C060F003C0C1E0078001E0078001E0078001E0078003C00F00 03C00F0003C00F0003C01E0007801E0007801E0C07803C0C07803C080F003C180F003810 0F0038300F0038601E0018C00C000F001E1A7B9922>I<000FC000787000E03803C01C07 801C0F001E1F001E1E001F3E001F3C001F7C001F7C001FF8003EF8003EF8003EF8003CF0 007CF00078F000F8F000F07001E07801C03803801807000E1C0003F000181A79991F>I< 00780F80008C18E0018E6070030FC070030F8078060F0038060F007C060F007C0C1E007C 001E007C001E007C001E007C003C00F8003C00F8003C00F8003C00F0007801F0007801F0 007801E0007803C000F803C000F8078000F8070000FC0E0001E6380001E3E00001E00000 01E0000003C0000003C0000003C0000003C000000780000007800000078000000F800000 7FF80000FFF800001E267F991F>I<0F01FC19C70631CC0731F80F61F01F61F01F61E00E 61E000C3C00003C00003C00003C0000780000780000780000780000F00000F00000F0000 0F00001E00001E00001E00001E00003C0000180000181A7B9919>114 D<001F8000706000C03001C0300180700380F00380F003806003C00003F00003FE0003FF 8001FFC000FFE0000FE00003E00001E03800E07C00E07C00C0F801C07001806003802007 00181C0007F000141A7C9918>I<00300078007800F000F000F000F001E001E001E001E0 FFFFFFFF03C003C007800780078007800F000F000F000F001E001E001E001E003C003C06 3C063C0C780C78183810382018400F8010257AA414>I<03C00C0CE01E18603F30F03F30 F01F60F00F60F00F61E007C1E00601E00603C00603C00603C00C07800C07800C0780180F 00180F00180F00300F00300F00600F00400700C003818001C30000FC00181A7B991B> 118 D<07C001800CE003C0186003C030F003C030F0078060F0078060F0078061E00780C1 E00F0001E00F0003C00F0003C00F0003C01E0007801E0007801E0007801E000F003C000F 003C000F003C000F003C000F0078000F0078000700F8000701F8000382F00000FCF00000 00F0000000F0000001E0000801E0003C03C0003E0380007C0780007C070000300E000030 1C0000187000000FC000001A267B991D>121 D E /Ft 1 4 df<0300030003000300C30C E31C73381FE0078007801FE07338E31CC30C03000300030003000E127D9215>3 D E /Fu 30 121 df<0F801FC03FE07FF0FFF8FFF8FFF8FFF8FFF87FF03FE01FC00F8000 00000000000000000000000000000000000000000000000F801FC03FE07FF0FFF8FFF8FF F8FFF8FFF87FF03FE01FC00F800D2679A51B>58 D<00000001F80000000000000001F800 00000000000003FC0000000000000003FC0000000000000007FE0000000000000007FE00 00000000000007FE000000000000000FFF000000000000000FFF000000000000001FFF80 0000000000001FFF800000000000001FFF800000000000003FFFC00000000000003FFFC0 0000000000007FFFE00000000000007DFFE00000000000007DFFE0000000000000F9FFF0 000000000000F8FFF0000000000001F8FFF8000000000001F07FF8000000000003F07FFC 000000000003E03FFC000000000003E03FFC000000000007E03FFE000000000007C01FFE 00000000000FC01FFF00000000000F800FFF00000000000F800FFF00000000001F800FFF 80000000001F0007FF80000000003F0007FFC0000000003E0003FFC0000000007E0003FF E0000000007C0003FFE0000000007C0001FFE000000000FC0001FFF000000000F80000FF F000000001F80000FFF800000001FFFFFFFFF800000001FFFFFFFFF800000003FFFFFFFF FC00000003FFFFFFFFFC00000007E000003FFE00000007C000001FFE00000007C000001F FE0000000FC000001FFF0000000F8000000FFF0000001F8000000FFF8000001F00000007 FF8000003F00000007FFC000003E00000007FFC000003E00000003FFC000007E00000003 FFE00000FE00000001FFE000FFFFFC0001FFFFFFF0FFFFFC0001FFFFFFF0FFFFFC0001FF FFFFF0FFFFFC0001FFFFFFF0443B7DBA4B>65 D<0000001FFF000030000001FFFFE000F0 00000FFFFFFC01F000007FFFFFFE03F00001FFFE007F87F00003FFE0000FCFF0000FFF00 0003FFF0001FFC000001FFF0003FF80000007FF0007FF00000003FF000FFC00000003FF0 01FFC00000001FF003FF800000000FF007FF000000000FF00FFF0000000007F00FFE0000 000007F01FFE0000000003F01FFE0000000003F03FFC0000000003F03FFC0000000001F0 3FFC0000000001F07FFC0000000001F07FF80000000001F07FF80000000000007FF80000 00000000FFF8000000000000FFF8000000000000FFF8000000000000FFF8000000000000 FFF8000000000000FFF8000000000000FFF8000000000000FFF8000000000000FFF80000 00000000FFF8000000000000FFF80000000000007FF80000000000007FF8000000000000 7FF80000000000007FFC0000000000F03FFC0000000000F03FFC0000000000F03FFC0000 000000F01FFE0000000000F01FFE0000000001E00FFE0000000001E00FFF0000000001E0 07FF0000000003C003FF8000000003C001FFC0000000078000FFE00000000F00007FF000 00001F00003FF80000003E00001FFC0000007C00000FFF000001F8000003FFE00007F000 0001FFFE003FC00000007FFFFFFF000000000FFFFFFC0000000001FFFFF000000000001F FF0000003C3D7BBB47>67 D69 DI<0000001FFF00003000000001FFFFE000F00000000FFFFFFC 01F00000007FFFFFFE03F0000001FFFE007F87F0000003FFE0000FCFF000000FFF000003 FFF000001FFC000001FFF000003FF80000007FF000007FF00000003FF00000FFC0000000 3FF00001FFC00000001FF00003FF800000000FF00007FF000000000FF0000FFF00000000 07F0000FFE0000000007F0001FFE0000000003F0001FFE0000000003F0003FFC00000000 03F0003FFC0000000001F0003FFC0000000001F0007FFC0000000001F0007FF800000000 01F0007FF8000000000000007FF800000000000000FFF800000000000000FFF800000000 000000FFF800000000000000FFF800000000000000FFF800000000000000FFF800000000 000000FFF800000000000000FFF800000000000000FFF800000000000000FFF800000000 000000FFF800000FFFFFFFE07FF800000FFFFFFFE07FF800000FFFFFFFE07FFC00000FFF FFFFE07FFC00000000FFF0003FFC00000000FFF0003FFC00000000FFF0003FFC00000000 FFF0001FFE00000000FFF0001FFE00000000FFF0000FFE00000000FFF0000FFF00000000 FFF00007FF00000000FFF00003FF80000000FFF00001FFC0000000FFF00000FFE0000000 FFF000007FF0000000FFF000003FF8000001FFF000001FFE000001FFF000000FFF800003 FFF0000003FFE0000FFFF0000001FFFE007FCFF00000007FFFFFFF03F00000000FFFFFFE 00F000000001FFFFF80030000000001FFF80000000433D7BBB4E>I75 D77 DI<00 00007FFC000000000007FFFFC0000000003FFFFFF800000000FFE00FFE00000003FF0001 FF8000000FFC00007FE000001FF800003FF000003FF000001FF800007FE000000FFC0000 FFC0000007FE0001FF80000003FF0003FF80000003FF8007FF00000001FFC007FF000000 01FFC00FFE00000000FFE01FFE00000000FFF01FFC000000007FF01FFC000000007FF03F FC000000007FF83FFC000000007FF87FFC000000007FFC7FF8000000003FFC7FF8000000 003FFC7FF8000000003FFC7FF8000000003FFCFFF8000000003FFEFFF8000000003FFEFF F8000000003FFEFFF8000000003FFEFFF8000000003FFEFFF8000000003FFEFFF8000000 003FFEFFF8000000003FFEFFF8000000003FFEFFF8000000003FFEFFF8000000003FFEFF F8000000003FFE7FF8000000003FFC7FFC000000007FFC7FFC000000007FFC7FFC000000 007FFC3FFC000000007FF83FFC000000007FF83FFE00000000FFF81FFE00000000FFF01F FE00000000FFF00FFF00000001FFE00FFF00000001FFE007FF80000003FFC003FF800000 03FF8003FFC0000007FF8001FFE000000FFF0000FFF000001FFE00007FF800003FFC0000 1FFE0000FFF000000FFF0001FFE0000003FFE00FFF80000001FFFFFFFF000000003FFFFF F80000000007FFFFC000000000007FFC0000003F3D7BBB4A>I I82 D<0003FF800180001FFFF00380007FFFFC078001FFFFFF0F8003FE00 FF9F8007F0000FFF800FE00003FF801FC00001FF803F8000007F803F8000007F807F0000 003F807F0000001F807F0000001F80FF0000000F80FF0000000F80FF0000000F80FF8000 000780FF8000000780FFC000000780FFE000000780FFF8000000007FFE000000007FFFF0 0000007FFFFF0000003FFFFFF800003FFFFFFF00001FFFFFFFC0000FFFFFFFF00007FFFF FFF80003FFFFFFFC0001FFFFFFFE00007FFFFFFF00003FFFFFFF800007FFFFFF8000007F FFFFC0000007FFFFC00000003FFFE000000003FFE000000000FFF0000000007FF0000000 003FF0700000001FF0F00000001FF0F00000001FF0F00000000FF0F00000000FF0F80000 000FF0F80000000FE0F80000000FE0FC0000000FE0FC0000001FC0FE0000001FC0FF0000 001F80FFC000003F80FFF000007F00FFFC0001FE00FCFFC007FC00F87FFFFFF000F01FFF FFE000E003FFFF8000C0003FFC00002C3D7BBB37>I86 D<001FFF80000001FFFFF0000003FFFF FC000007F003FF00000FF800FF80001FFC007FC0001FFC003FE0001FFC003FF0001FFC00 1FF0000FF8001FF8000FF8001FF80007F0001FF80001C0001FF8000000001FF800000000 1FF8000000001FF8000000FFFFF800000FFFFFF800007FFC1FF80001FFC01FF80007FE00 1FF8000FFC001FF8001FF0001FF8003FF0001FF8007FE0001FF8007FE0001FF800FFC000 1FF800FFC0001FF800FFC0001FF800FFC0001FF800FFC0003FF8007FE0003FF8007FE000 6FF8003FF001CFFC001FFC0787FFF007FFFF07FFF001FFFC03FFF0003FF0007FF02C267D A530>97 D<000000003FC00000003FFFC00000003FFFC00000003FFFC00000003FFFC000 000001FFC000000000FFC000000000FFC000000000FFC000000000FFC000000000FFC000 000000FFC000000000FFC000000000FFC000000000FFC000000000FFC000000000FFC000 000000FFC000000000FFC000000000FFC000000000FFC000000000FFC00000FFC0FFC000 0FFFF8FFC0003FFFFEFFC000FFE03FFFC001FF000FFFC003FE0003FFC007FC0001FFC00F F80000FFC01FF00000FFC01FF00000FFC03FF00000FFC03FE00000FFC07FE00000FFC07F E00000FFC07FE00000FFC0FFE00000FFC0FFE00000FFC0FFE00000FFC0FFE00000FFC0FF E00000FFC0FFE00000FFC0FFE00000FFC0FFE00000FFC0FFE00000FFC07FE00000FFC07F E00000FFC07FE00000FFC03FF00000FFC03FF00000FFC01FF00000FFC00FF80001FFC007 F80003FFC003FC0007FFC001FF000FFFE000FFC07EFFFF003FFFFCFFFF000FFFF0FFFF00 01FF80FFFF303C7DBB37>100 D<0001FF8000000FFFF800003FFFFE0000FF80FF0001FE 003F8007FC001FC00FF8000FE00FF8000FF01FF00007F03FF00007F83FF00007F87FE000 07F87FE00003FC7FE00003FC7FE00003FCFFE00003FCFFFFFFFFFCFFFFFFFFFCFFFFFFFF FCFFE0000000FFE0000000FFE0000000FFE00000007FE00000007FE00000007FE0000000 3FE00000003FF000003C1FF000003C1FF000003C0FF800007807FC0000F803FE0001F001 FF0007E000FFC03FC0003FFFFF000007FFFC000000FFE00026267DA52D>I<00001FF800 0000FFFE000007FFFF00000FF83F80003FE07FC0007FC0FFE000FF80FFE000FF80FFE001 FF80FFE001FF00FFE003FF007FC003FF003F8003FF001F0003FF00000003FF00000003FF 00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF000000FFFFFF 8000FFFFFF8000FFFFFF8000FFFFFF800003FF00000003FF00000003FF00000003FF0000 0003FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF000000 03FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003 FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF 00000003FF00000003FF00000003FF00000003FF000000FFFFFE0000FFFFFE0000FFFFFE 0000FFFFFE0000233C7DBB1E>I<000000001F800007FE007FC0007FFFE1FFE001FFFFFB E7F003FE07FF07F007F801FE07F00FF000FF07F01FF000FF87E03FE0007FC3C03FE0007F C0007FE0007FE0007FE0007FE0007FE0007FE0007FE0007FE0007FE0007FE0007FE0007F E0007FE0007FE0003FE0007FC0003FE0007FC0001FF000FF80000FF000FF000007F801FE 000003FE07FC000007FFFFF800000E7FFFE000000E07FE0000001E00000000001E000000 00001E00000000001E00000000001F00000000001FC0000000001FFFFFFC00001FFFFFFF 80000FFFFFFFF00007FFFFFFF80007FFFFFFFC0003FFFFFFFE0003FFFFFFFF000FFFFFFF FF801FC00007FF803F000000FF807F0000003FC0FE0000001FC0FE0000001FC0FE000000 1FC0FE0000001FC0FE0000001FC07F0000003F807F0000003F803F8000007F001FC00000 FE000FF00003FC0007FE001FF80001FFFFFFE000003FFFFF00000003FFF000002C397DA6 31>I<00FF00000000FFFF00000000FFFF00000000FFFF00000000FFFF0000000007FF00 00000003FF0000000003FF0000000003FF0000000003FF0000000003FF0000000003FF00 00000003FF0000000003FF0000000003FF0000000003FF0000000003FF0000000003FF00 00000003FF0000000003FF0000000003FF0000000003FF0000000003FF007FC00003FF01 FFF80003FF07FFFC0003FF0F03FE0003FF1C01FF0003FF3001FF8003FF6000FF8003FFE0 00FFC003FFC000FFC003FF8000FFC003FF8000FFC003FF8000FFC003FF0000FFC003FF00 00FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF00 00FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF00 00FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF00 00FFC003FF0000FFC003FF0000FFC0FFFFFC3FFFFFFFFFFC3FFFFFFFFFFC3FFFFFFFFFFC 3FFFFF303C7CBB37>I<01F00007FC000FFE000FFE001FFF001FFF001FFF001FFF001FFF 000FFE000FFE0007FC0001F0000000000000000000000000000000000000000000000000 0000000000000000FF007FFF007FFF007FFF007FFF0007FF0003FF0003FF0003FF0003FF 0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF 0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF 00FFFFF8FFFFF8FFFFF8FFFFF8153D7DBC1B>I<00FF00FFFF00FFFF00FFFF00FFFF0007 FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003 FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003 FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003 FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003FF0003 FF0003FF0003FF00FFFFFCFFFFFCFFFFFCFFFFFC163C7DBB1B>108 D<00FE003FE00007FC0000FFFE01FFFC003FFF8000FFFE07FFFE00FFFFC000FFFE0F81FF 01F03FE000FFFE1C00FF83801FF00007FE3800FFC7001FF80003FE60007FCC000FF80003 FEE0007FFC000FFC0003FEC0007FF8000FFC0003FF80007FF0000FFC0003FF80007FF000 0FFC0003FF80007FF0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00 007FE0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC 0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00007F E0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003 FF00007FE0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00007FE000 0FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00007FE0000FFC0003FF00 007FE0000FFC0003FF00007FE0000FFC00FFFFFC1FFFFF83FFFFF0FFFFFC1FFFFF83FFFF F0FFFFFC1FFFFF83FFFFF0FFFFFC1FFFFF83FFFFF04C267CA553>I<00FE007FC000FFFE 01FFF800FFFE07FFFC00FFFE0F03FE00FFFE1C01FF0007FE3001FF8003FE6000FF8003FE E000FFC003FEC000FFC003FF8000FFC003FF8000FFC003FF8000FFC003FF0000FFC003FF 0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF 0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF 0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF0000FFC003FF 0000FFC003FF0000FFC003FF0000FFC0FFFFFC3FFFFFFFFFFC3FFFFFFFFFFC3FFFFFFFFF FC3FFFFF30267CA537>I<0000FFC00000000FFFFC0000003FFFFF000000FFC0FFC00001 FE001FE00007FC000FF80007F80007F8000FF00003FC001FF00003FE003FF00003FF003F E00001FF007FE00001FF807FE00001FF807FE00001FF807FE00001FF80FFE00001FFC0FF E00001FFC0FFE00001FFC0FFE00001FFC0FFE00001FFC0FFE00001FFC0FFE00001FFC0FF E00001FFC0FFE00001FFC07FE00001FF807FE00001FF807FE00001FF803FF00003FF003F F00003FF001FF00003FE000FF80007FC000FF80007FC0007FC000FF80003FE001FF00000 FFC0FFC000003FFFFF0000000FFFFC00000001FFE000002A267DA531>I<00FF01FF8000 FFFF0FFFF000FFFF3FFFFC00FFFFFE03FF00FFFFF000FF8003FFC0007FC003FF80003FE0 03FF00003FF003FF00001FF803FF00001FFC03FF00000FFC03FF00000FFE03FF00000FFE 03FF000007FE03FF000007FF03FF000007FF03FF000007FF03FF000007FF03FF000007FF 03FF000007FF03FF000007FF03FF000007FF03FF000007FF03FF000007FE03FF000007FE 03FF00000FFE03FF00000FFC03FF00000FFC03FF00001FF803FF00001FF803FF00003FF0 03FF80003FE003FFC0007FC003FFF001FF8003FFFC07FF0003FF3FFFFC0003FF0FFFF000 03FF03FF000003FF0000000003FF0000000003FF0000000003FF0000000003FF00000000 03FF0000000003FF0000000003FF0000000003FF0000000003FF0000000003FF00000000 03FF0000000003FF00000000FFFFFC000000FFFFFC000000FFFFFC000000FFFFFC000000 30377DA537>I<00FE01FC00FFFE07FF00FFFE0FFF80FFFE1E1FC0FFFE383FE007FE707F F003FE607FF003FEC07FF003FEC07FF003FFC03FE003FF803FE003FF801FC003FF800700 03FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003 FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF 00000003FF00000003FF00000003FF00000003FF00000003FF00000003FF000000FFFFFE 0000FFFFFE0000FFFFFE0000FFFFFE000024267EA529>114 D<003FF83801FFFEF807FF FFF80FC00FF81F0003F83E0000F87C0000F87C000078FC000078FC000078FE000078FF80 0000FFF00000FFFF80007FFFFC007FFFFF003FFFFFC01FFFFFE00FFFFFF007FFFFF801FF FFFC003FFFFE0001FFFE00000FFF000001FF7000007FF000007FF000003FF800003FF800 003EFC00003EFE00003EFF00007CFF8000F8FFF007F0FDFFFFE0F0FFFF80E01FFC002026 7DA527>I<000F0000000F0000000F0000000F0000000F0000001F0000001F0000001F00 00001F0000003F0000003F0000007F0000007F000000FF000001FF000003FF000007FF00 001FFFFFF0FFFFFFF0FFFFFFF0FFFFFFF003FF000003FF000003FF000003FF000003FF00 0003FF000003FF000003FF000003FF000003FF000003FF000003FF000003FF000003FF00 0003FF000003FF000003FF000003FF000003FF000003FF003C03FF003C03FF003C03FF00 3C03FF003C03FF003C03FF003C03FF003C01FF007801FF807800FF80F0007FC1E0003FFF C0000FFF800001FE001E377EB626>I120 D E /Fv 9 118 df87 D89 D<03FF80000FFFF0001F01F8003F807E003F807E003F803F001F003F800E003F8000003F 8000003F8000003F80000FFF8000FFFF8007FC3F800FE03F803F803F803F003F807F003F 80FE003F80FE003F80FE003F80FE003F807E007F807F00DF803F839FFC0FFF0FFC01FC03 FC1E1B7E9A21>97 D<00003FF80000003FF80000003FF800000003F800000003F8000000 03F800000003F800000003F800000003F800000003F800000003F800000003F800000003 F800000003F800000003F800001FE3F80000FFFBF80003F83FF80007E00FF8000FC007F8 001F8003F8003F8003F8007F0003F8007F0003F8007F0003F800FF0003F800FF0003F800 FF0003F800FF0003F800FF0003F800FF0003F800FF0003F8007F0003F8007F0003F8007F 0003F8003F8003F8001F8003F8000F8007F80007C00FF80003F03FFF8000FFF3FF80003F C3FF80212A7EA926>100 D<003FE00001FFF80003F07E0007C01F000F801F801F800F80 3F800FC07F000FC07F0007C07F0007E0FF0007E0FF0007E0FFFFFFE0FFFFFFE0FF000000 FF000000FF0000007F0000007F0000007F0000003F8000E01F8000E00FC001C007E00380 03F81F0000FFFE00001FF0001B1B7E9A20>I<00FF81F003FFE7F80FC1FE7C1F80FC7C1F 007C383F007E107F007F007F007F007F007F007F007F007F007F007F007F003F007E001F 007C001F80FC000FC1F8001FFFE00018FF800038000000380000003C0000003E0000003F FFF8001FFFFF001FFFFF800FFFFFC007FFFFE01FFFFFF03C0007F07C0001F8F80000F8F8 0000F8F80000F8F80000F87C0001F03C0001E01F0007C00FC01F8003FFFE00007FF0001E 287E9A22>103 D110 D<003FE00001FFFC0003F07E000FC01F801F800FC03F800FE03F0007E0 7F0007F07F0007F07F0007F0FF0007F8FF0007F8FF0007F8FF0007F8FF0007F8FF0007F8 FF0007F8FF0007F87F0007F07F0007F03F800FE03F800FE01F800FC00FC01F8007F07F00 01FFFC00003FE0001D1B7E9A22>I117 D E /Fw 46 122 df<00001FFC00000001FFFF000000 07FFFF8000001FF807C000007FC003E00000FF0007F00000FE000FF00001FE000FF00003 FC000FF00003FC000FF00003FC000FF00003FC0007E00003FC0001800003FC0000000003 FC0000000003FC0000000003FC0000000003FC00FFF800FFFFFFFFF800FFFFFFFFF800FF FFFFFFF80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003 FC0007F80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003 FC0007F80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003 FC0007F80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003FC0007F80003 FC0007F80003FC0007F80003FC0007F8007FFFE0FFFFC07FFFE0FFFFC07FFFE0FFFFC02A 327FB12E>12 D<0001E0000003E000000FE000007FE0001FFFE000FFFFE000FFBFE000E0 3FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE00000 3FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE00000 3FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE00000 3FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE000003FE0007F FFFFF07FFFFFF07FFFFFF01C2E7AAD29>49 D<003FF00001FFFE0007FFFF800FC07FE01E 001FF03C000FF87F0007FC7F8007FEFFC007FEFFC003FEFFC003FFFFC003FF7F8003FF7F 8003FF3F0003FF000003FF000003FE000003FE000007FC000007FC00000FF800000FF000 001FE000001FC000003F8000007F000000FE000001F8000001F0000003E0000007800700 0F0007001E0007003C000F0078000E00F0000E01C0001E03FFFFFE07FFFFFE0FFFFFFE1F FFFFFE3FFFFFFE7FFFFFFCFFFFFFFCFFFFFFFCFFFFFFFC202E7CAD29>I<000FFC000000 7FFF800001F01FE00003C00FF000070007F8000FE007FC000FF007FC001FF007FE001FF8 07FE001FF807FE001FF807FE001FF807FE000FF007FC0007E007FC0001800FFC0000000F F80000000FF00000001FE00000003FC0000000FF8000003FFE0000003FFC0000003FFF80 0000001FF000000007F800000003FC00000003FE00000003FF00000001FF80000001FF80 0E0001FFC03F8001FFC07FC001FFC07FC001FFC0FFE001FFC0FFE001FFC0FFE001FF80FF E001FF80FFC003FF007F8003FF003F0003FE001F0007FC000FE01FF80007FFFFE00001FF FF8000001FFC0000222E7DAD29>I<0000007800000000F800000001F800000003F80000 0007F800000007F80000000FF80000001FF80000003FF80000007FF800000077F8000000 F7F8000001E7F8000003C7F800000787F800000707F800000F07F800001E07F800003C07 F800007807F800007007F80000F007F80001E007F80003C007F800078007F8000F0007F8 000F0007F8001E0007F8003C0007F800780007F800F00007F800FFFFFFFFF0FFFFFFFFF0 FFFFFFFFF000000FF80000000FF80000000FF80000000FF80000000FF80000000FF80000 000FF80000000FF80000000FF800000FFFFFF0000FFFFFF0000FFFFFF0242E7EAD29>I< 0C0000381FC003F81FFFFFF81FFFFFF01FFFFFE01FFFFFC01FFFFF801FFFFE001FFFFC00 1FFFF0001FFF00001E0000001E0000001E0000001E0000001E0000001E0000001E000000 1E1FF8001E7FFF001FFFFFC01FE01FE01F800FF01E0007F80C0007FC000003FC000003FE 000003FE000003FF000003FF1E0003FF3F0003FF7F8003FFFF8003FFFFC003FFFFC003FE FF8003FEFF8003FE7F0007FC7C0007F83C000FF01E001FE00FC07FC007FFFF8001FFFE00 003FE000202E7CAD29>I<00007F80000007FFF000001FC07800007F001C0000FC001E00 01F8007E0003F800FF0007F001FF000FF001FF000FE001FF001FE001FF003FE000FE003F E0007C003FC00000007FC00000007FC00000007FC0000000FFC3FF8000FFC7FFE000FFCF BFF000FFDC03F800FFF801FC00FFF001FE00FFF000FF00FFE000FF80FFE000FF80FFE000 FF80FFC000FFC0FFC000FFC0FFC000FFC07FC000FFC07FC000FFC07FC000FFC07FC000FF C03FC000FFC03FC000FF803FC000FF801FE000FF801FE000FF000FE001FE0007F001FC00 03F803F80001FC0FF00000FFFFE000003FFF80000007FC0000222E7DAD29>I<1F003F80 7FC0FFE0FFE0FFE0FFE0FFE07FC03F801F00000000000000000000000000000000000000 00001F003F807FC0FFE0FFE0FFE0FFE0FFE07FC03F801F000B207A9F17>58 D<0000007C0000000000007C000000000000FE000000000000FE000000000000FE000000 000001FF000000000001FF000000000003FF800000000003FF800000000007FFC0000000 0007FFC00000000007FFC0000000000FFFE0000000000F7FE0000000001F7FF000000000 1E3FF0000000001E3FF0000000003E3FF8000000003C1FF8000000007C1FFC0000000078 0FFC00000000780FFC00000000F80FFE00000000F007FE00000001F007FF00000001E003 FF00000001E003FF00000003C003FF80000003C001FF80000007C001FFC00000078000FF C00000078000FFC000000FFFFFFFE000000FFFFFFFE000001FFFFFFFF000001E00003FF0 00001E00003FF000003C00001FF800003C00001FF800007C00001FFC00007800000FFC00 00F800000FFE0000F0000007FE0000F0000007FE0001F0000007FF0003F8000003FF00FF FFC001FFFFFEFFFFC001FFFFFEFFFFC001FFFFFE37317DB03E>65 DI<000003FF8001800000 3FFFF003800001FFFFFC0F800007FF007F1F80001FF8000FBF80003FE00003FF8000FF80 0000FF8001FF0000007F8003FE0000003F8007FC0000003F8007FC0000001F800FF80000 001F801FF80000000F801FF00000000F803FF000000007803FF000000007807FF0000000 07807FE000000007807FE000000000007FE00000000000FFE00000000000FFE000000000 00FFE00000000000FFE00000000000FFE00000000000FFE00000000000FFE00000000000 FFE00000000000FFE000000000007FE000000000007FE000000000007FE000000000007F F000000003803FF000000003803FF000000003801FF000000003801FF800000007800FF8 000000070007FC000000070007FC0000000E0003FE0000001E0001FF0000003C0000FF80 00007800003FE00000F000001FF80003E0000007FF003F80000001FFFFFE000000003FFF F80000000003FF80000031317BB03C>I69 DI<000003FF80018000003FFFF0038000 01FFFFFC0F800007FF007F1F80001FF8000FBF80003FE00003FF8000FF800000FF8001FF 0000007F8003FE0000003F8007FC0000003F8007FC0000001F800FF80000001F801FF800 00000F801FF00000000F803FF000000007803FF000000007807FF000000007807FE00000 0007807FE000000000007FE00000000000FFE00000000000FFE00000000000FFE0000000 0000FFE00000000000FFE00000000000FFE00000000000FFE00000000000FFE000000000 00FFE00007FFFFFE7FE00007FFFFFE7FE00007FFFFFE7FE0000001FF807FF0000001FF80 3FF0000001FF803FF0000001FF801FF0000001FF801FF8000001FF800FF8000001FF8007 FC000001FF8007FC000001FF8003FE000001FF8001FF000001FF8000FF800001FF80003F E00003FF80001FF80007FF800007FF803F3F800001FFFFFE1F8000003FFFF80780000003 FFC0018037317BB041>I73 D75 D77 DI<00000FFE0000000000FFFFE000000007FFFFFC0000001FFC07FF0000003FE000 FF800000FF80003FE00001FF00001FF00003FE00000FF80007FC000007FC0007FC000007 FC000FF8000003FE001FF8000003FF001FF0000001FF003FF0000001FF803FF0000001FF 803FF0000001FF807FE0000000FFC07FE0000000FFC07FE0000000FFC0FFE0000000FFE0 FFE0000000FFE0FFE0000000FFE0FFE0000000FFE0FFE0000000FFE0FFE0000000FFE0FF E0000000FFE0FFE0000000FFE0FFE0000000FFE0FFE0000000FFE0FFE0000000FFE07FE0 000000FFC07FE0000000FFC07FF0000001FFC07FF0000001FFC03FF0000001FF803FF000 0001FF801FF8000003FF001FF8000003FF000FFC000007FE000FFC000007FE0007FE0000 0FFC0003FF00001FF80001FF80003FF00000FFC0007FE000003FE000FF8000001FFC07FF 00000007FFFFFC00000000FFFFE0000000000FFE00000033317BB03E>II82 D<001FF0018000FFFF038003FFFFC78007F00FFF800FC001FF80 1F00007F803F00001F803E00000F807E00000F807E00000780FE00000780FE00000780FE 00000380FF00000380FF00000380FF80000000FFE00000007FFC0000007FFFE000007FFF FE00003FFFFFC0001FFFFFF0000FFFFFF80007FFFFFC0003FFFFFE0001FFFFFF00007FFF FF80001FFFFF800000FFFFC0000007FFC0000000FFE00000007FE00000003FE00000001F E06000001FE0E000000FE0E000000FE0E000000FE0E000000FC0F000000FC0F000000FC0 F800001F80FC00001F80FF00003F00FFC0007E00FFFC01FC00F1FFFFF800E03FFFE000C0 07FF000023317BB02E>I<7FFFFFFFFFFF807FFFFFFFFFFF807FFFFFFFFFFF807FC00FFC 00FF807E000FFC001F807C000FFC000F8078000FFC00078078000FFC00078070000FFC00 0380F0000FFC0003C0F0000FFC0003C0F0000FFC0003C0E0000FFC0001C0E0000FFC0001 C0E0000FFC0001C0E0000FFC0001C0E0000FFC0001C000000FFC00000000000FFC000000 00000FFC00000000000FFC00000000000FFC00000000000FFC00000000000FFC00000000 000FFC00000000000FFC00000000000FFC00000000000FFC00000000000FFC0000000000 0FFC00000000000FFC00000000000FFC00000000000FFC00000000000FFC00000000000F FC00000000000FFC00000000000FFC00000000000FFC00000000000FFC00000000000FFC 00000000000FFC00000000000FFC00000000000FFC00000000000FFC00000000000FFC00 0000007FFFFFFF8000007FFFFFFF8000007FFFFFFF800032307DAF39>I86 D<007FF8000003FFFF000007FFFFC0000FE01FE0001FF007F0001FF003F8001FF003FC00 1FF001FE000FE001FE0007C001FE00010001FE00000001FE00000001FE000001FFFE0000 3FFFFE0001FFF1FE0007FE01FE000FF001FE001FC001FE003F8001FE007F8001FE00FF00 01FE00FF0001FE00FF0001FE00FF0001FE00FF0003FE007F8003FE007FC00EFE003FF03C FF000FFFF87FF807FFF03FF800FF800FF825207E9F28>97 D<0007FF00007FFFE000FFFF F003FC03F807F007FC0FE007FC1FE007FC3FC007FC3FC003F87FC001F07F8000407F8000 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000007F8000 007FC000007FC000003FC0000E3FE0000E1FE0001C0FF0001C07F8007803FF01F000FFFF E0007FFF800007FC001F207D9F25>99 D<00000007E0000003FFE0000003FFE0000003FF E00000003FE00000001FE00000001FE00000001FE00000001FE00000001FE00000001FE0 0000001FE00000001FE00000001FE00000001FE00000001FE00000001FE00000001FE000 0FF81FE0007FFF1FE001FFFFDFE003FE03FFE007F800FFE00FE0003FE01FE0001FE03FC0 001FE03FC0001FE07F80001FE07F80001FE07F80001FE0FF80001FE0FF80001FE0FF8000 1FE0FF80001FE0FF80001FE0FF80001FE0FF80001FE0FF80001FE07F80001FE07F80001F E07F80001FE03FC0001FE03FC0001FE01FC0003FE00FE0007FE007F001FFE003FC07DFF0 01FFFF9FFF007FFE1FFF000FF01FFF28327DB12E>I<0007FC0000003FFF800000FFFFE0 0003FC07F00007F801F8000FE000FC001FE0007E003FC0007E003FC0003F007FC0003F00 7F80003F007F80003F80FF80003F80FF80003F80FFFFFFFF80FFFFFFFF80FFFFFFFF80FF 80000000FF80000000FF800000007F800000007F800000003FC00000003FC00003801FC0 0003801FE00007800FF0000F0007F8001E0003FE00FC0000FFFFF800003FFFE0000003FF 000021207E9F26>I<0000FF000007FFC0001FFFE0003FC7F0007F0FF800FE0FF801FE0F F801FC0FF803FC07F003FC03E003FC01C003FC000003FC000003FC000003FC000003FC00 0003FC000003FC0000FFFFFC00FFFFFC00FFFFFC0003FC000003FC000003FC000003FC00 0003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC00 0003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC00 0003FC000003FC000003FC000003FC00007FFFF0007FFFF0007FFFF0001D327EB119>I< 001FF803E000FFFF1FF001FFFFBFF807F81FF9F80FE007F1F80FE007F0F01FC003F8601F C003F8003FC003FC003FC003FC003FC003FC003FC003FC003FC003FC001FC003F8001FC0 03F8000FE007F0000FE007F00007F81FE00007FFFF800006FFFF00000E1FF800000E0000 00001E000000001E000000001F000000001F800000001FFFFFC0000FFFFFF8000FFFFFFE 0007FFFFFF0003FFFFFF8007FFFFFFC01FFFFFFFE03F00007FE07E00000FF0FC000007F0 FC000003F0FC000003F0FC000003F0FC000003F07E000007E03F00000FC01FC0003F800F F801FF0007FFFFFE0000FFFFF000001FFF8000252F7E9F29>I<01F800000000FFF80000 0000FFF800000000FFF8000000000FF80000000007F80000000007F80000000007F80000 000007F80000000007F80000000007F80000000007F80000000007F80000000007F80000 000007F80000000007F80000000007F80000000007F80000000007F807F8000007F83FFF 000007F87FFF800007F8F03FC00007F9C01FE00007FB000FE00007FE000FF00007FE000F F00007FC000FF00007FC000FF00007F8000FF00007F8000FF00007F8000FF00007F8000F F00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000F F00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000F F00007F8000FF00007F8000FF00007F8000FF000FFFFC1FFFF80FFFFC1FFFF80FFFFC1FF FF8029327DB12E>I<01C00007F0000FF8000FF8001FFC001FFC001FFC000FF8000FF800 07F00001C00000000000000000000000000000000000000000000000000001F800FFF800 FFF800FFF80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F800 07F80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F800 07F80007F80007F800FFFF80FFFF80FFFF8011337DB217>I<01F8000000FFF8000000FF F8000000FFF80000000FF800000007F800000007F800000007F800000007F800000007F8 00000007F800000007F800000007F800000007F800000007F800000007F800000007F800 000007F800000007F8007FFC07F8007FFC07F8007FFC07F8001FC007F8001F0007F8003E 0007F800780007F801F00007F803E00007F807800007F81F000007F83E000007F87C0000 07F9FE000007FBFF000007FFFF800007FF7FC00007FE3FE00007F81FE00007F01FF00007 F00FF80007F007FC0007F003FE0007F001FF0007F000FF0007F000FF8007F0007FC007F0 003FE007F0003FF0FFFF80FFFFFFFF80FFFFFFFF80FFFF28327EB12C>107 D<01F800FFF800FFF800FFF8000FF80007F80007F80007F80007F80007F80007F80007F8 0007F80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F8 0007F80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F8 0007F80007F80007F80007F80007F80007F80007F80007F80007F80007F80007F800FFFF C0FFFFC0FFFFC012327DB117>I<03F007F8000FF000FFF03FFF007FFE00FFF07FFF80FF FF00FFF0F03FC1E07F800FF1C01FE3803FC007F3000FE6001FC007F6000FFC001FE007FE 000FFC001FE007FC000FF8001FE007FC000FF8001FE007F8000FF0001FE007F8000FF000 1FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8 000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF000 1FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8 000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE0FFFFC1FFFF83 FFFFFFFFC1FFFF83FFFFFFFFC1FFFF83FFFF40207D9F45>I<03F007F80000FFF03FFF00 00FFF07FFF8000FFF0F03FC0000FF1C01FE00007F3000FE00007F6000FF00007FE000FF0 0007FC000FF00007FC000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF0 0007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF0 0007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF0 0007F8000FF00007F8000FF00007F8000FF000FFFFC1FFFF80FFFFC1FFFF80FFFFC1FFFF 8029207D9F2E>I<0007FE0000003FFFC00000FFFFF00003FC03FC0007F000FE000FE000 7F001FC0003F803FC0003FC03FC0003FC07F80001FE07F80001FE07F80001FE0FF80001F F0FF80001FF0FF80001FF0FF80001FF0FF80001FF0FF80001FF0FF80001FF0FF80001FF0 7F80001FE07F80001FE07F80001FE03FC0003FC03FC0003FC01FE0007F800FE0007F0007 F801FE0003FE07FC0001FFFFF800003FFFC0000007FE000024207E9F29>I<01F80FF000 FFF87FFE00FFF9FFFF80FFFFE07FC00FFF001FE007FE000FF007F80007F807F80007FC07 F80003FC07F80003FE07F80003FE07F80001FE07F80001FF07F80001FF07F80001FF07F8 0001FF07F80001FF07F80001FF07F80001FF07F80001FF07F80001FE07F80003FE07F800 03FE07F80003FC07F80007FC07FC0007F807FE000FF007FF001FE007FBE07FC007F9FFFF 0007F87FFE0007F81FE00007F800000007F800000007F800000007F800000007F8000000 07F800000007F800000007F800000007F800000007F800000007F8000000FFFFC00000FF FFC00000FFFFC00000282E7E9F2E>I<03F03F00FFF07FC0FFF1FFE0FFF1C7F00FF38FF8 07F70FF807F60FF807FE0FF807FC07F007FC03E007FC008007F8000007F8000007F80000 07F8000007F8000007F8000007F8000007F8000007F8000007F8000007F8000007F80000 07F8000007F8000007F8000007F8000007F8000007F80000FFFFE000FFFFE000FFFFE000 1D207E9F22>114 D<00FF870007FFEF001FFFFF003F007F003C001F0078000F00F80007 00F8000700F8000700FC000700FF000000FFF800007FFFC0003FFFF0003FFFFC000FFFFE 0007FFFF0001FFFF80001FFF800000FFC000001FC060000FC0E00007C0E00007C0F00007 C0F8000780F8000F80FE000F00FF803E00FFFFFC00F3FFF800C07FC0001A207D9F21>I< 001C0000001C0000001C0000001C0000003C0000003C0000003C0000007C0000007C0000 00FC000001FC000003FC000007FC00001FFC0000FFFFFF00FFFFFF00FFFFFF0003FC0000 03FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC0000 03FC000003FC000003FC000003FC000003FC000003FC000003FC01C003FC01C003FC01C0 03FC01C003FC01C003FC01C003FC01C001FC038001FE038000FF0700007FFE00003FFC00 0007F0001A2E7FAD20>I<01F80003F000FFF801FFF000FFF801FFF000FFF801FFF0000F F8001FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007 F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007 F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007 F8000FF00007F8000FF00007F8001FF00007F8001FF00003F8003FF00003F8006FF00001 FE03CFF80000FFFF8FFF80007FFF0FFF80000FFC0FFF8029207D9F2E>IIIII E /Fx 15 85 df<78FCFCFCFC7806067A8512>46 D<007F800001FFF0000701F8 000C007E0018001F0010000F0020000F80400007C0400007C0400003E0B00003E0F80003 E0FC0003E0FC0003E0FC0003E0780003E0000003E0000007C0000007C00000078000000F 8000000F0000001F0000001E0000003C0000007800000070000000E0000001C000000380 0000070000000E0000000C000000180000003000000060000000C0002001800020030000 20060000400C00004008000040100000C03FFFFFC07FFFFF80FFFFFF80FFFFFF801B2F7D AE21>50 D<00000C0000000C0000001C0000001C0000003C0000007C0000007C000000BC 0000013C0000013C0000023C0000063C0000043C0000083C0000183C0000103C0000203C 0000603C0000403C0000803C0001803C0001003C0002003C0002003C0004003C0008003C 0008003C0010003C0020003C0020003C0040003C00C0003C00FFFFFFF8FFFFFFF800003C 0000003C0000003C0000003C0000003C0000003C0000003C0000003C0000003C0000003C 0000007E00000FFFF0000FFFF01D2F7EAE21>52 D<003F800000FFE00003E0F000078038 000F001C001E000E001C000F003C0007007C0007807800078078000780F80007C0F80003 C0F80003C0F80003C0F80003C0F80003E0F80003E0F80003E0F80003E0780003E0780007 E0780007E03C0007E03C0007E01C000BE00E0013E0070013E0038023E001C0C3E0003F03 C0000003C0000003C0000007C000000780000007800000078000000F0000000F0038000E 007C001C007C003C0078003800700070003000E0001C03C0000FFF000001FC00001B307D AE21>57 D<00000300000000000300000000000300000000000780000000000780000000 000FC0000000000FC0000000000FC00000000017E00000000013E00000000013E0000000 0023F00000000021F00000000021F00000000040F80000000040F80000000040F8000000 00807C00000000807C00000001007E00000001003E00000001003E00000002003F000000 02001F00000002001F00000004000F80000004000F80000004000F800000080007C00000 080007C00000180007E000001FFFFFE000001FFFFFE00000200003F00000200001F00000 200001F00000400000F80000400000F80000400000F800008000007C00008000007C0001 8000007E00010000003E00010000003E00030000003F00030000001F00070000001F001F 8000003F80FFE00001FFFCFFE00001FFFC2E327EB132>65 D<00003FE0010001FFF80300 07F01E03001F800307003E000087007800004F00F000002F01E000001F03C000000F0780 00000F0F800000070F000000071F000000031E000000033E000000033C000000017C0000 00017C000000017C000000017800000000F800000000F800000000F800000000F8000000 00F800000000F800000000F800000000F800000000F800000000F800000000F800000000 78000000007C000000007C000000017C000000013C000000013E000000011E000000011F 000000020F000000020F80000006078000000403C000000801E000000800F00000100078 000020003E0000C0001F8003800007F00F000001FFFC0000003FE00028337CB130>67 D 69 D72 DI76 D78 D<00003FC000000001C03800000007000E0000001C00 03800000380001C00000F00000F00001E00000780003C000003C00038000001C00078000 001E000F0000000F000F0000000F001E00000007801E00000007803C00000003C03C0000 0003C07C00000003E07C00000003E07800000001E07800000001E0F800000001F0F80000 0001F0F800000001F0F800000001F0F800000001F0F800000001F0F800000001F0F80000 0001F0F800000001F0F800000001F0F800000001F07C00000003E07C00000003E07C0000 0003E07C00000003E03C00000003C03E00000007C01E00000007801E00000007800F0000 000F000F0000000F00078000001E0003C000003C0003C000003C0001E00000780000F000 00F00000380001C000001C000380000007000E00000001E078000000003FC000002C337C B134>II82 D<7FFFFFFFFFE07FFFFFFFFFE0 7E000F8007E078000F8001E070000F8000E060000F80006040000F80002040000F800020 C0000F800030C0000F80003080000F80001080000F80001080000F80001080000F800010 80000F80001080000F80001000000F80000000000F80000000000F80000000000F800000 00000F80000000000F80000000000F80000000000F80000000000F80000000000F800000 00000F80000000000F80000000000F80000000000F80000000000F80000000000F800000 00000F80000000000F80000000000F80000000000F80000000000F80000000000F800000 00000F80000000000F80000000000F80000000000F80000000000F80000000000F800000 00000F80000000000F80000000001FC00000000FFFFF8000000FFFFF80002C317EB030> 84 D E /Fy 89 127 df<000FE00000783C0000E00E0003C00780078003C00F0001E00E 0000E01E0000F03E0000F83C0000787C00007C7C00007C7800003C7800003CF840043EF8 40043EF87FFC3EF87FFC3EF87FFC3EF840043EF840043EF800003EF800003E7800003C7C 00007C7C00007C3C0000783C0000781E0000F00E0000E00F0001E0078003C003C0078000 E00E0000783C00000FE0001F247DA226>2 D<0001000000038000000380000003800000 07C0000007C0000007C0000007C0000009E0000009E0000009E0000010F0000010F00000 10F00000207800002078000020780000403C0000403C0000403C0000801E0000801E0000 801E0001000F0001000F0001000F00020007800200078002000780040003C0040003C004 0003C00C0003E01E0003E0FF801FFE1F237FA222>I6 D<001FC1F00070371800C03E3C0180 7C3C0380783C070038000700380007003800070038000700380007003800070038000700 380007003800FFFFFFC00700380007003800070038000700380007003800070038000700 380007003800070038000700380007003800070038000700380007003800070038000700 3800070038000700380007003C007FE1FFC01E2380A21C>11 D<001FC0000070200000C0 100001803800038078000700780007003000070000000700000007000000070000000700 00000700000007000000FFFFF80007007800070038000700380007003800070038000700 380007003800070038000700380007003800070038000700380007003800070038000700 3800070038000700380007003800070038007FE1FF80192380A21B>I<001FD800007038 0000C0780001807800038078000700380007003800070038000700380007003800070038 00070038000700380007003800FFFFF80007003800070038000700380007003800070038 000700380007003800070038000700380007003800070038000700380007003800070038 0007003800070038000700380007003800070038007FF3FF80192380A21B>I<000FC07F 00007031C08000E00B004001801E00E003803E01E007003C01E007001C00C007001C0000 07001C000007001C000007001C000007001C000007001C000007001C0000FFFFFFFFE007 001C01E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E00700 1C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C 00E007001C00E007001C00E007001C00E007001C00E07FF1FFCFFE272380A229>I<70F8 F8F8F8F8F8F8707070707070707070707070202020202020000000000070F8F8F8700524 7CA30E>33 D<7038F87CFC7EFC7E743A0402040204020402080408041008100820104020 0F0F7EA218>I<0780000C001840000C0018200018003010007000701C00B0006013FF60 00E008006000E00800C000E008018000E008018000E008030000E008060000E008060000 E0080C0000601018000070101800003010300000182030000018406000000780C03C0000 00C04200000180C1000003018100000303808000060300800006030040000C0700400018 070040001807004000300700400060070040006007004000C00700400180030040018003 008003000380800300018100060000C1000C000042000400003C0022287DA429>37 D<70F8FCFC7404040404080810102040060F7CA20E>39 D<002000400080010003000600 04000C000C00180018003000300030007000600060006000E000E000E000E000E000E000 E000E000E000E000E000E000E000E0006000600060007000300030003000180018000C00 0C0004000600030001000080004000200B327CA413>I<800040002000100018000C0004 00060006000300030001800180018001C000C000C000C000E000E000E000E000E000E000 E000E000E000E000E000E000E000E000C000C000C001C001800180018003000300060006 0004000C00180010002000400080000B327DA413>I<0001800000018000000180000001 800000018000000180000001800000018000000180000001800000018000000180000001 8000000180000001800000018000FFFFFFFEFFFFFFFE0001800000018000000180000001 800000018000000180000001800000018000000180000001800000018000000180000001 80000001800000018000000180001F227D9C26>43 D<70F8FCFC74040404040808101020 40060F7C840E>II<70F8F8F87005057C840E>I<000080000180 000180000300000300000300000600000600000600000C00000C00000C00001800001800 00180000300000300000300000600000600000600000C00000C00000C000018000018000 0180000180000300000300000300000600000600000600000C00000C00000C0000180000 180000180000300000300000300000600000600000600000C00000C00000C0000011317D A418>I<01F000071C000C06001803003803803803807001C07001C07001C07001C0F001 E0F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001 E0F001E07001C07001C07001C07803C03803803803801C07000C0600071C0001F0001322 7EA018>I<008003800F80F3800380038003800380038003800380038003800380038003 8003800380038003800380038003800380038003800380038003800380038007C0FFFE0F 217CA018>I<03F0000C1C001007002007804003C04003C08003E0F003E0F801E0F801E0 F801E02003E00003E00003C00003C0000780000700000E00001C00001800003000006000 00C0000180000100000200200400200800201800603000403FFFC07FFFC0FFFFC013217E A018>I<03F8000C1E00100F002007804007C07807C07803C07807C03807C00007800007 80000700000F00000C0000380003F000001C00000F000007800007800003C00003C00003 E02003E07003E0F803E0F803E0F003C04003C0400780200780100F000C1C0003F0001322 7EA018>I<000300000300000700000700000F0000170000170000270000670000470000 8700018700010700020700060700040700080700080700100700200700200700400700C0 0700FFFFF8000700000700000700000700000700000700000700000F80007FF015217FA0 18>I<1000801E07001FFF001FFE001FF80017E000100000100000100000100000100000 10000011F800120C001C07001803801003800001C00001C00001E00001E00001E00001E0 7001E0F001E0F001E0E001C08001C04003C04003802007001006000C1C0003F00013227E A018>I<007E0001C1000300800601C00C03C01C03C01801803800003800007800007000 00700000F0F800F30C00F40600F40300F80380F801C0F001C0F001E0F001E0F001E0F001 E0F001E07001E07001E07001E03801C03801C01803801C03000C0600070C0001F0001322 7EA018>I<4000006000007FFFE07FFFC07FFFC0400080C0010080010080020080020000 040000080000080000100000200000200000600000400000C00000C00001C00001C00001 800003800003800003800003800007800007800007800007800007800007800007800003 000013237DA118>I<01F800060E000803001001802001806000C06000C06000C07000C0 7000C07801803E01003F02001FC4000FF80003F80001FC00067E00083F00100F803007C0 6003C06000E0C000E0C00060C00060C00060C000606000406000C03000801803000E0E00 03F00013227EA018>I<01F000060C000C0600180700380380700380700380F001C0F001 C0F001C0F001E0F001E0F001E0F001E0F001E07001E07003E03803E01805E00C05E00619 E003E1E00001C00001C00001C0000380000380300380780700780600700C002018001030 000FC00013227EA018>I<70F8F8F870000000000000000000000070F8F8F87005157C94 0E>I<70F8F8F870000000000000000000000070F8F8F87808080808101010204040051F 7C940E>I61 D<0001800000018000000180 000003C0000003C0000003C0000005E0000005E0000009F0000008F0000008F000001078 00001078000010780000203C0000203C0000203C0000401E0000401E0000C01F0000800F 0000800F0001FFFF800100078001000780020003C0020003C0020003C0040001E0040001 E0040001E0080000F01C0000F03E0001F8FF800FFF20237EA225>65 DI< 0007E0100038183000E0063001C00170038000F0070000F00E0000701E0000701C000030 3C0000303C0000307C0000107800001078000010F8000000F8000000F8000000F8000000 F8000000F8000000F8000000F800000078000000780000107C0000103C0000103C000010 1C0000201E0000200E000040070000400380008001C0010000E0020000381C000007E000 1C247DA223>IIII<0007F008003C0C1800E0021801C001B8038000F8070000780F0000381E000038 1E0000183C0000183C0000187C0000087800000878000008F8000000F8000000F8000000 F8000000F8000000F8000000F8000000F8001FFF780000F8780000787C0000783C000078 3C0000781E0000781E0000780F00007807000078038000B801C000B800E00318003C0C08 0007F00020247DA226>III<03FFE0001F00000F00000F00000F00000F00000F00000F 00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F 00000F00000F00000F00000F00000F00000F00700F00F80F00F80F00F80E00F01E00401C 0020380018700007C00013237EA119>IIIII<000FE00000783C0000E00E0003C00780078003C00F0001E00E 0000E01E0000F03C0000783C0000787C00007C7C00007C7800003C7800003CF800003EF8 00003EF800003EF800003EF800003EF800003EF800003EF800003EF800003E7800003C7C 00007C7C00007C3C0000783E0000F81E0000F00F0001E00F0001E0078003C003C0078000 E00E0000783C00000FE0001F247DA226>II82 D<03F0200C0C601802603001E07000E060 0060E00060E00060E00020E00020E00020F00000F000007800007F00003FF0001FFE000F FF0003FF80003FC00007E00001E00000F00000F0000070800070800070800070800070C0 0060C00060E000C0F000C0C80180C6070081FC0014247DA21B>I<7FFFFFF87807807860 078018400780084007800840078008C007800C8007800480078004800780048007800400 078000000780000007800000078000000780000007800000078000000780000007800000 078000000780000007800000078000000780000007800000078000000780000007800000 0780000007800000078000000FC00001FFFE001E227EA123>IIII<7FF803FF 000FE001F80007C000E00003E000C00001E000800001F001800000F80100000078020000 007C040000003E040000001E080000001F100000000FB000000007A000000007C0000000 03E000000001E000000001F000000003F80000000278000000047C0000000C3E00000008 1E000000101F000000200F80000020078000004007C000008003E000008001E000010001 F000030000F800070000F8001F8000FC00FFC003FFC022227FA125>II<7FFFFE7E003E78003C70 00786000784000F0C000F0C001E08003C08003C0800780000780000F00001F00001E0000 3C00003C0000780000780000F00001F00001E00103C00103C0010780010780030F00031E 00021E00023C00063C000E78001EF8007EFFFFFE18227DA11E>II<0804100820102010402040208040804080408040B85CFC7EFC 7E7C3E381C0F0F7AA218>II<04000E00 1F001B00318060C0C06080200B087AA218>I<08102020404080808080B8FCFC7C38060F 7DA20E>96 D<1FE000303800780C00780E0030070000070000070000070000FF0007C700 1E07003C0700780700700700F00708F00708F00708F00F087817083C23900FC1E015157E 9418>I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00 000E00000E00000E00000E1F000E61C00E80600F00300E00380E003C0E001C0E001E0E00 1E0E001E0E001E0E001E0E001E0E001E0E001C0E003C0E00380F00700C80600C41C0083F 0017237FA21B>I<01FE000703000C07801C0780380300780000700000F00000F00000F0 0000F00000F00000F00000F000007000007800403800401C00800C010007060001F80012 157E9416>I<0000E0000FE00001E00000E00000E00000E00000E00000E00000E00000E0 0000E00000E00000E00000E001F8E00704E00C02E01C01E03800E07800E07000E0F000E0 F000E0F000E0F000E0F000E0F000E0F000E07000E07800E03800E01801E00C02E0070CF0 01F0FE17237EA21B>I<01FC000707000C03801C01C03801C07801E07000E0F000E0FFFF E0F00000F00000F00000F00000F000007000007800203800201C00400E008007030000FC 0013157F9416>I<003E0000E30001C78003878003078007000007000007000007000007 0000070000070000070000070000FFF80007000007000007000007000007000007000007 000007000007000007000007000007000007000007000007000007000007000007000007 80007FF000112380A20F>I<00007003F1980E1E181C0E18380700380700780780780780 7807807807803807003807001C0E001E1C0033F0002000002000003000003800003FFE00 1FFFC00FFFE03000F0600030C00018C00018C00018C000186000306000303800E00E0380 03FE0015217F9518>I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00 000E00000E00000E00000E00000E00000E1F800E60C00E80E00F00700F00700E00700E00 700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00 700E0070FFE7FF18237FA21B>I<1C003E003E003E001C00000000000000000000000000 000000000E007E001E000E000E000E000E000E000E000E000E000E000E000E000E000E00 0E000E000E000E00FFC00A227FA10E>I<00E001F001F001F000E0000000000000000000 00000000000000007007F000F00070007000700070007000700070007000700070007000 70007000700070007000700070007000700070007000706070F0E0F0C061803F000C2C83 A10F>I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00 000E00000E00000E00000E03FC0E01F00E01C00E01800E02000E04000E08000E10000E38 000EF8000F1C000E1E000E0E000E07000E07800E03C00E01C00E01E00E00F00E00F8FFE3 FE17237FA21A>I<0E00FE001E000E000E000E000E000E000E000E000E000E000E000E00 0E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E00 0E000E00FFE00B237FA20E>I<0E1FC07F00FE60E183801E807201C00F003C00E00F003C 00E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800 E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E0 0E003800E0FFE3FF8FFE27157F942A>I<0E1F80FE60C01E80E00F00700F00700E00700E 00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E 00700E0070FFE7FF18157F941B>I<01FC000707000C01801800C03800E0700070700070 F00078F00078F00078F00078F00078F00078F000787000707800F03800E01C01C00E0380 07070001FC0015157F9418>I<0E1F00FE61C00E80600F00700E00380E003C0E003C0E00 1E0E001E0E001E0E001E0E001E0E001E0E001E0E003C0E003C0E00380F00700E80E00E41 C00E3F000E00000E00000E00000E00000E00000E00000E00000E00000E0000FFE000171F 7F941B>I<01F8200704600E02601C01603801E07800E07800E0F000E0F000E0F000E0F0 00E0F000E0F000E0F000E07800E07800E03801E01C01E00C02E0070CE001F0E00000E000 00E00000E00000E00000E00000E00000E00000E00000E0000FFE171F7E941A>I<0E3CFE 461E8F0F0F0F060F000E000E000E000E000E000E000E000E000E000E000E000E000E000F 00FFF010157F9413>I<0F8830786018C018C008C008E008F0007F003FE00FF001F8003C 801C800C800CC00CC008E018D0308FC00E157E9413>I<02000200020002000600060006 000E001E003E00FFFC0E000E000E000E000E000E000E000E000E000E000E000E040E040E 040E040E040E040708030801F00E1F7F9E13>I<0E0070FE07F01E00F00E00700E00700E 00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00F00E 00F006017003827800FC7F18157F941B>IIIII<3FFFC03803803007802007 00600E00401C00403C0040380000700000E00001E00001C0000380400700400F00400E00 C01C0080380080780180700780FFFF8012157F9416>II<0E023F04 238841F880E00F057CA018>126 D E /Fz 31 122 df<78FCFCFEFE7A02020202040404 080810204007127B8511>44 D<00100000700000F00007F000FFF000F8F00000F00000F0 0000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F0 0000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F0 0000F00000F00000F00000F00000F00001F8007FFFE07FFFE013287BA71E>49 D<1800181F00F01FFFE01FFFC01FFF801FFE0011F8001000001000001000001000001000 00100000100000100000107E001383801400C01800E010007000007800007C00003C0000 3C00003E00003E00003E70003EF8003EF8003EF8003EF8003C80003C40007C4000782000 783000F01801E00E07C007FF0001FC0017297DA71E>53 D<20000000380000003FFFFF80 3FFFFF803FFFFF007FFFFF00600002004000040040000400400008008000100080002000 000020000000400000008000000080000001000000020000000200000006000000040000 000C0000001C000000180000003800000038000000380000007800000070000000700000 00F0000000F0000000F0000000F0000001F0000001F0000001F0000001F0000001F00000 01F0000001F0000000E00000192A7DA81E>55 D<007F000001FFC00007C1E0000F007000 1E0038003C003C003C001C0078001E0078001E00F8000F00F8000F00F8000F00F8000F00 F8000F80F8000F80F8000F80F8000F8078000F8078001F803C001F803C001F801C002F80 0E004F800700CF8003810F80007E0F8000000F0000000F0000000F0000001E0000001E00 00001E0000003C001C003C003E0078003E0070003C00E0001801C0001C0780000FFF0000 03F8000019297EA71E>57 D<00001800000000180000000018000000003C000000003C00 0000007E000000007E000000007E00000000BF000000009F000000009F000000010F8000 00010F800000010F8000000207C000000207C000000207C000000403E000000403E00000 0C03F000000801F000000801F000001001F800001000F800001000F8000020007C00003F FFFC00003FFFFC000040003E000040003E000040003E000080001F000080001F00018000 1F800100000F800100000F800200000FC002000007C007000007C01F80000FE0FFF000FF FFFFF000FFFF282A7EA92D>65 D<0000FF00100007FFE030001FC07830003E000C7000F8 0006F001F00003F003E00001F007C00000F00F800000700F800000701F000000303F0000 00303E000000303E000000107E000000107E000000107C00000000FC00000000FC000000 00FC00000000FC00000000FC00000000FC00000000FC00000000FC00000000FC00000000 7C000000007E000000007E000000103E000000103E000000103F000000101F000000200F 800000200F8000006007C000004003E000008001F000018000F8000300003E000E00001F C038000007FFE0000000FF8000242B7DA92B>67 DIII73 D<01FFFF01FFFF0003F00001F00001F00001F00001F00001F00001F00001F00001F00001 F00001F00001F00001F00001F00001F00001F00001F00001F00001F00001F00001F00001 F00001F00001F00001F00001F00001F00001F00001F03001F07801F0FC01F0FC01F0FC01 E0F803E04003C02007801007000C1E0003F000182A7DA81F>I77 DI<0001FF 0000000F01E000003C0078000078003C0000E0000E0001E0000F0003C000078007800003 C00F800003E01F000001F01F000001F03E000000F83E000000F87E000000FC7E000000FC 7C0000007C7C0000007CFC0000007EFC0000007EFC0000007EFC0000007EFC0000007EFC 0000007EFC0000007EFC0000007EFC0000007E7C0000007C7E000000FC7E000000FC7E00 0000FC3E000000F83F000001F81F000001F01F000001F00F800003E007800003C007C000 07C003E0000F8000F0001E000078003C00003C007800000F01E0000001FF0000272B7DA9 2E>II82 D<00FE010003FF83000F81E3001E0037003C001F0038000F007800070070 000700F0000300F0000300F0000300F0000100F8000100F8000100FC0000007E0000007F 0000003FF000001FFE00000FFFE00007FFF80003FFFC00007FFE000007FF0000007F0000 001F8000000F80000007C0000007C0800003C0800003C0800003C0800003C0C00003C0C0 000380C0000380E0000780F0000700F8000E00EE001C00C3C07800C1FFF000803FC0001A 2B7DA921>I<7FFFFFFFF87FFFFFFFF87C007C00F870007C003860007C001840007C0008 40007C0008C0007C000CC0007C000C80007C000480007C000480007C000480007C000480 007C000400007C000000007C000000007C000000007C000000007C000000007C00000000 7C000000007C000000007C000000007C000000007C000000007C000000007C000000007C 000000007C000000007C000000007C000000007C000000007C000000007C000000007C00 0000007C000000007C000000007C00000000FE0000007FFFFC00007FFFFC0026297EA82B >I87 D89 D<01FC00000E0780001001C000 3C00E0003E00F0003E0078001C00780008007800000078000000780000007800007FF800 03E078000F8078001F0078003E0078007C00780078007820F8007820F8007820F8007820 F800F8207C00F8203C013C401F063FC007F80F001B1A7E991E>97 D<0F000000FF000000FF0000001F0000000F0000000F0000000F0000000F0000000F0000 000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F07E0000F1838 000F600E000F8007000F8007800F0003C00F0003C00F0001E00F0001E00F0001F00F0001 F00F0001F00F0001F00F0001F00F0001F00F0001F00F0001E00F0001E00F0003E00F0003 C00F0003800F8007800E800F000E401C000C303800080FC0001C2A7EA921>I<00000F00 0000FF000000FF0000001F0000000F0000000F0000000F0000000F0000000F0000000F00 00000F0000000F0000000F0000000F0000000F0000000F00003F0F0001C0CF0003802F00 0F001F001E001F001C000F003C000F007C000F0078000F0078000F00F8000F00F8000F00 F8000F00F8000F00F8000F00F8000F00F8000F0078000F0078000F003C000F003C000F00 1E001F000E002F0007004F8001C18FF0007E0FF01C2A7EA921>100 D<007E0003C3800700E00E00F01C00703C00783C003878003C78003CF8003CF8003CFFFF FCF80000F80000F80000F80000F800007800007C00003C00043C00041E00080E00100700 2001C0C0007F00161A7E991B>I<0000078000FC18400787A1C00E01C1C01E01E0803C00 F0003C00F0007C00F8007C00F8007C00F8007C00F8007C00F8003C00F0003C00F0001E01 E0000E01C0001F87800010FC0000100000003000000030000000380000001C0000001FFF C0000FFFF80007FFFC001C003E0030000F007000070060000380E0000380E0000380E000 0380E0000380700007007000070038000E000C0018000780F00000FF80001A287E9A1E> 103 D<0F07F000FF183800FF201C001F400E000F400F000F800F000F800F000F000F000F 000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F 000F000F000F000F000F000F000F000F000F000F000F000F000F00FFF0FFF0FFF0FFF01C 1A7E9921>110 D<007F000001C1C000070070000E0038001C001C003C001E003C001E00 78000F0078000F00F8000F80F8000F80F8000F80F8000F80F8000F80F8000F80F8000F80 F8000F8078000F0078000F003C001E003C001E001E003C000E0038000700700001C1C000 007F0000191A7E991E>I<0F0F80FF11C0FF23E01F43E00F83E00F81C00F80000F00000F 00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F 00000F00000F00000F8000FFF800FFF800131A7E9917>114 D<0F000F00FF00FF00FF00 FF001F001F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F00 0F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F00 1F000F001F0007002F0003804F8001C08FF0007F0FF01C1A7E9921>117 D121 D E end %%EndProlog %%BeginSetup %%Feature: *Resolution 300dpi TeXDict begin X %%EndSetup %%Page: 1 1 1 0 bop 0 170 a Fz(DEP)-5 b(AR)g(TMENT)18 b(OF)j(ST)-5 b(A)g(TISTICS)0 230 y Fy(Univ)o(ersit)o(y)14 b(of)i(Wisconsin)0 291 y(1210)i(W)l(est)e(Da)o(yton)h(St.)0 351 y(Madison,)f(WI)g(53706) 491 901 y Fx(TECHNICAL)22 b(REPOR)-6 b(T)21 b(NO.)g(942)800 1025 y Fz(Jan)n(uary)f(1995)116 1521 y Fw(GRKP)-7 b(A)n(CK:)27 b(Fitting)g(Smo)r(othing)h(Spline)f(ANO)n(V)-9 b(A)390 1596 y(Mo)r(dels)28 b(for)g(Exp)r(onen)n(tial)f(F)-7 b(amilies)943 2092 y Fz(b)n(y)747 2192 y Fv(Y)h(uedong)24 b(W)-6 b(ang)p eop %%Page: 1 2 1 1 bop 142 372 a Fu(GRKP)-8 b(A)m(CK:)33 b(Fitting)j(Smo)s(othing)f (Spline)76 475 y(ANO)m(V)-11 b(A)33 b(Mo)s(dels)h(for)g(Exp)s(onen)m (tial)i(F)-8 b(amilies)777 623 y Fz(Y)j(uedong)20 b(W)-5 b(ang)1172 601 y Ft(\003)288 698 y Fs(Dep)m(artment)21 b(of)g(Biostatistics,)j(University)f(of)f(Michigan,)500 773 y(A)n(nn)f(A)n(rb)m(or,)i(Michigan)e(48109,)f(U.S.A.)752 889 y Fz(Jan)n(uary)g(17,)f(1995)875 1126 y Fr(Abstract)190 1211 y Fq(Wahb)n(a)12 b(et)g(al)g(\(1994c\))f(intr)n(o)n(duc)n(e)n(d)g (Smo)n(othing)g(Spline)g(ANalysis)f(of)i(V)-5 b(A)o(rianc)n(e)11 b(\(SS)f(ANO)o(V)-5 b(A\))122 1267 y(metho)n(d)15 b(for)h(data)f(fr)n (om)g(exp)n(onential)f(families.)20 b(Base)n(d)14 b(on)h(RKP)m(A)o(CK,) e(which)j(\014ts)e(SS)g(ANO)o(V)-5 b(A)122 1324 y(mo)n(dels)16 b(to)i(Gaussian)e(data,)i(we)f(intr)n(o)n(duc)n(e)g(GRKP)m(A)o(CK:)e(a) i(c)n(ol)r(le)n(ction)f(of)h(subr)n(outines)g(for)g(bi-)122 1380 y(nary,)i(binomial,)g(Poisson)f(and)h(Gamma)g(data.)29 b(We)19 b(also)g(show)g(how)g(to)g(c)n(alculate)g(Bayesian)122 1436 y(c)n(on\014denc)n(e)14 b(intervals)i(for)g(SS)g(ANO)o(V)-5 b(A)15 b(estimates.)190 1493 y(Key)21 b(Wor)n(ds:)32 b Fp(generalized)22 b(cross)f(v)m(alidation;)k(Newton-Raphson)c (iteration;)i(RKP)l(A)o(CK;)122 1549 y(smo)q(othing)15 b(parameter;)f(smo)q(othing)h(spline)i(ANO)o(V)-5 b(A;)16 b(un)o(biased)g(risk)g(estimate.)0 1716 y Fw(1)83 b(In)n(tro)r(duction) 0 1825 y Fy(Generalized)14 b(linear)h(mo)q(dels)g(\(GLM's\))h(for)g (analysis)g(of)g(data)g(from)f(exp)q(onen)o(tial)g(families)e(ha)o(v)o (e)i(b)q(een)0 1885 y(extensiv)o(ely)d(studied)i(and)h(widely)f(used)h (since)e(1970's)j(\(Nelder)e(and)h(W)l(edderburn,)f(1972;)i(McCullagh)0 1946 y(and)24 b(Nelder,)g(1989\).)45 b(As)24 b(the)f(p)q(opularit)o(y)h (of)g(these)f(metho)q(ds)g(has)i(increased,)f(so)h(has)f(the)f(need)0 2006 y(for)15 b(more)f(sophisticated)i(mo)q(del)e(building)g(and)i (diagnostic)g(c)o(hec)o(king)d(tec)o(hniques.)19 b(In)c(the)g(con)o (text)g(of)0 2066 y(nonparametric)c(estimate)f(of)i(the)g(GLM)g (regression)h(surface,)f(O'Sulliv)m(an)f(et)g(al)h(\(1986\))i(and)e(Gu) h(\(1990\))0 2126 y(used)j(p)q(enalized)e(lik)o(eliho)q(o)q(d)h(metho)q (d)g(with)g(smo)q(othing)h(splines)f(and)h(thin)f(plate)g(splines.)21 b(Hastie)14 b(and)0 2186 y(Tibshirani)20 b(\(1990\))i(used)e(additiv)o (e)f(mo)q(dels.)33 b(W)l(ah)o(ba)21 b(et)e(al)i(\(1994c\))g(in)o(tro)q (duced)f(the)g(SS)h(ANO)o(V)-5 b(A)0 2247 y(mo)q(dels)15 b(using)h(the)f(p)q(enalized)g(lik)o(eliho)q(o)q(d)g(and)i(Smo)q (othing)e(Spline)g(ANalysis)g(of)h(V)l(ariance)f(metho)q(ds.)0 2307 y(See)i(also)h(W)l(ah)o(ba)g(et)f(al)h(\(1994a,)h(1994b\),)g(W)l (ang)f(\(1994\))h(and)f(W)l(ang)h(et)e(al)g(\(1995\))i(for)f(details)f (of)h(SS)0 2367 y(ANO)o(V)-5 b(A)18 b(mo)q(dels.)32 b(In)20 b(this)g(pap)q(er,)h(w)o(e)f(describ)q(e)f(a)i(pac)o(k)m(age)f(for)h (estimations)e(of)h(the)g(SS)h(ANO)o(V)-5 b(A)0 2427 y(mo)q(dels)10 b(with)h(binary)l(,)h(binomial,)e(P)o(oisson)i(and)f (Gamma)f(data.)20 b(W)l(e)11 b(call)g(this)g(pac)o(k)m(age)g(as)h(GRKP) l(A)o(CK,)0 2487 y(whic)o(h)k(stands)h(for)f(generalized)f(RKP)l(A)o (CK.)p 0 2531 780 2 v 56 2562 a Fo(\003)75 2577 y Fn(Supp)q(orted)20 b(b)o(y)f(the)h(National)e(Institute)i(of)f(Health)g(under)h(Gran)o(ts) f(R01)g(EY09946,)g(P60)g(DK20572)f(and)h(P30)0 2627 y(HD18258)963 2803 y Fy(1)p eop %%Page: 2 3 2 2 bop 73 170 a Fy(First,)16 b(w)o(e)g(describ)q(e)g(the)h (computational)e(part)i(of)g(the)g(SS)g(ANO)o(V)-5 b(A)14 b(mo)q(del.)21 b(Supp)q(ose)c(data)h(ha)o(v)o(e)0 230 y(the)13 b(form)f(\()p Fm(y)236 237 y Fl(i)250 230 y Fy(;)c Fk(t)293 237 y Fl(i)307 230 y Fy(\))p Fm(;)21 b(i)14 b Fy(=)f(1)p Fm(;)8 b Fy(2)p Fm(;)g Fj(\001)g(\001)g(\001)h Fm(;)f(n;)13 b Fy(where)g Fm(y)842 237 y Fl(i)869 230 y Fy(are)h(indep)q(enden)o(t)e(observ)m(ations)j(and)f Fk(t)1609 237 y Fl(i)1637 230 y Fy(=)g(\()p Fm(t)1726 237 y Fi(1)p Fl(i)1758 230 y Fm(;)8 b Fj(\001)g(\001)g(\001)g Fm(;)g(t)1886 237 y Fl(di)1917 230 y Fy(\).)0 291 y(The)16 b(distribution)g(function)g(of)h Fm(y)637 298 y Fl(i)667 291 y Fy(is)f(from)f(an)i(exp)q(onen)o(tial)e(family)f(with)i(densit)o (y)g(function)401 401 y Fm(g)r Fy(\()p Fm(y)469 408 y Fl(i)483 401 y Fy(;)8 b Fm(f)529 408 y Fl(i)543 401 y Fm(;)g(\036)p Fy(\))13 b(=)h(exp\(\()p Fm(y)815 408 y Fl(i)828 401 y Fm(h)p Fy(\()p Fm(f)899 408 y Fl(i)914 401 y Fy(\))d Fj(\000)f Fm(b)p Fy(\()p Fm(f)1057 408 y Fl(i)1071 401 y Fy(\)\))p Fm(=a)p Fy(\()p Fm(\036)p Fy(\))h(+)g Fm(c)p Fy(\()p Fm(y)1350 408 y Fl(i)1364 401 y Fm(;)d(\036)p Fy(\)\))p Fm(;)421 b Fy(\(1\))0 511 y(where)18 b Fm(f)167 518 y Fl(i)198 511 y Fy(=)f Fm(f)5 b Fy(\()p Fk(t)322 518 y Fl(i)337 511 y Fy(\))18 b(is)g(the)g (parameter)f(of)h(in)o(terest)f(and)i Fm(h)p Fy(\()p Fm(f)1148 518 y Fl(i)1162 511 y Fy(\))g(is)f(a)g(monotone)g (transformation)g(of)h Fm(f)1936 518 y Fl(i)0 571 y Fy(kno)o(wn)h(as)g (the)g Fh(c)n(anonic)n(al)h(p)n(ar)n(ameter)p Fy(.)30 b Fm(\036)20 b Fy(is)f(an)i(unkno)o(wn)f(scale)f(parameter.)30 b(Let)20 b Fk(t)f Fy(=)h(\()p Fm(t)1776 578 y Fi(1)1795 571 y Fm(;)8 b(:::;)g(t)1899 578 y Fl(d)1917 571 y Fy(\),)0 631 y(and)17 b(let)f Fm(t)184 638 y Fl(j)217 631 y Fj(2)f(T)304 613 y Fi(\()p Fl(j)r Fi(\))350 631 y Fy(,)i(where)f Fj(T)562 613 y Fi(\()p Fl(j)r Fi(\))624 631 y Fy(is)h(a)g(measurable)e(space.)23 b(Let)17 b Fj(T)27 b Fy(=)15 b Fj(T)1356 613 y Fi(\(1\))1414 631 y Fj(\012)c(\001)d(\001)g(\001)k(\012)f(T)1624 613 y Fi(\()p Fl(d)p Fi(\))1671 631 y Fy(,)17 b(then)f Fk(t)f Fj(2)g(T)d Fy(.)0 691 y(Denote)k(the)g(log)h(lik)o(eliho)q(o)q(d)e(giv) o(en)g Fm(y)703 698 y Fl(i)734 691 y Fy(and)h Fk(t)849 698 y Fl(i)879 691 y Fy(as)336 801 y Fm(l)351 808 y Fl(i)365 801 y Fy(\()p Fm(f)408 808 y Fl(i)422 801 y Fy(\))e(=)g(log)9 b Fm(g)r Fy(\()p Fm(y)646 808 y Fl(i)660 801 y Fy(;)f Fm(f)706 808 y Fl(i)720 801 y Fm(;)g(\036)p Fy(\))13 b(=)h(\()p Fm(y)898 808 y Fl(i)912 801 y Fm(h)p Fy(\()p Fm(f)983 808 y Fl(i)997 801 y Fy(\))d Fj(\000)g Fm(b)p Fy(\()p Fm(f)1141 808 y Fl(i)1155 801 y Fy(\)\))p Fm(=a)p Fy(\()p Fm(\036)p Fy(\))g(+)g Fm(c)p Fy(\()p Fm(y)1434 808 y Fl(i)1447 801 y Fm(;)d(\036)p Fy(\))p Fm(:)357 b Fy(\(2\))0 911 y(The)16 b(purp)q(ose)h(is)f(to)h(in)o(v)o(estigate)e (the)h(global)h(relationship)e(b)q(et)o(w)o(een)h Fm(f)21 b Fy(and)c Fk(t)p Fy(.)73 971 y(Let)i Fm(d\026)217 978 y Fl(j)255 971 y Fy(b)q(e)h(a)f(probabilit)o(y)f(measure)g(on)i Fj(T)923 953 y Fi(\()p Fl(j)r Fi(\))988 971 y Fy(and)g(let)e Fj(H)1201 953 y Fi(\()p Fl(j)r Fi(\))1267 971 y Fy(b)q(e)h(a)g(repro)q (ducing)h(k)o(ernel)d(Hilb)q(ert)0 1032 y(space)i(\(RKHS\))g(\(Aronsza) s(jn,)h(1950\))h(of)f(functions)f(on)h Fj(T)1117 1013 y Fi(\()p Fl(j)r Fi(\))1182 1032 y Fy(with)1296 996 y Fg(R)1316 1044 y Ff(T)1344 1034 y Fe(\()p Fd(j)q Fe(\))1395 1032 y Fm(f)1419 1039 y Fl(j)1437 1032 y Fy(\()p Fm(t)1474 1039 y Fl(j)1492 1032 y Fy(\))p Fm(d\026)1565 1039 y Fl(j)1603 1032 y Fy(=)f(0)h(for)f Fm(f)1805 1039 y Fl(j)1824 1032 y Fy(\()p Fm(t)1861 1039 y Fl(j)1879 1032 y Fy(\))g Fj(2)0 1092 y(H)42 1074 y Fi(\()p Fl(j)r Fi(\))88 1092 y Fy(.)28 b(Let)19 b Fj(f)p Fy(1)269 1074 y Fi(\()p Fl(j)r Fi(\))315 1092 y Fj(g)g Fy(b)q(e)f(the)h(one)g(dimensional)d(space)j (of)g(constan)o(t)g(functions)g(on)g Fj(T)1588 1074 y Fi(\()p Fl(j)r Fi(\))1634 1092 y Fy(.)28 b(Consider)19 b(the)0 1152 y(RKHS)477 1287 y Fj(G)44 b Fy(=)652 1233 y Fl(d)634 1246 y Fg(Y)630 1337 y Fl(j)r Fi(=1)692 1287 y Fy(\(1)735 1267 y Fi(\()p Fl(j)r Fi(\))792 1287 y Fj(\010)11 b(H)884 1267 y Fi(\()p Fl(j)r Fi(\))930 1287 y Fy(\))551 1410 y(=)41 b Fj(f)p Fy(1)p Fj(g)12 b(\010)765 1368 y Fg(X)787 1459 y Fl(j)834 1410 y Fj(H)876 1389 y Fi(\()p Fl(j)r Fi(\))933 1410 y Fj(\010)984 1368 y Fg(X)983 1460 y Fl(j)r()g Fy(0)g(is)g(used)g(in)g(our)122 1075 y(programs\))i(or)g(the)g(n)o(um)o (b)q(er)f(of)h(iterations)g(exceeds)f(some)g(presp)q(eci\014ed)g(n)o (um)o(b)q(er)f Fm(L)p Fy(;)i(otherwise)122 1135 y(go)h(to)g(step)f(1.) 73 1237 y(The)i(starting)h(v)m(alue)f Fk(f)521 1248 y Fi(0)559 1237 y Fy(ma)o(y)f(b)q(e)h(a)h(constan)o(t)g(function,)f(a)h (GLM)f(\014t)h(or)f(some)g(other)g(estimates.)0 1297 y(W)l(e)h(usually)g(let)g Fm(p)g Fy(=)g(10)479 1279 y Ff(\000)p Fi(6)527 1297 y Fy(.)30 b(The)20 b(algorithm)e(usually)h(tak) o(es)g(5)g(to)h(15)g(iterations)f(to)h(con)o(v)o(erge.)29 b(W)l(e)0 1357 y(b)q(eliev)o(e)12 b Fm(L)i Fy(=)g(30)g(is)g(big)g (enough)g(for)h(most)e(applications.)20 b(Since)13 b(c)o(hanging)h Fm(\025)h Fy(and)f(\002)g(at)g(eac)o(h)f(iteration)0 1417 y(means)h(mo)q(difying)f(the)i(problem)e(successiv)o(ely)l(,)f (con)o(v)o(ergence)h(is)i(not)g(guaran)o(teed.)21 b(Nev)o(ertheless,)12 b(the)0 1477 y(algorithm)j(con)o(v)o(erges)h(most)f(of)i(the)f(time.)0 1644 y Fw(3)83 b(Appro)n(ximate)26 b(Ba)n(y)n(esian)f(Con\014dence)h (In)n(terv)-5 b(als)26 b(for)h(SS)124 1735 y(ANO)n(V)-9 b(A)27 b(Estimates)0 1845 y Fy(In)15 b(an)h(observ)m(ation)g(study)l(,) f(often)h(design)f(is)h(not)f(balanced.)21 b(It)15 b(is)h(desirable)e (to)i(construct)g(con\014dence)0 1905 y(in)o(terv)m(als)d(for)i(the)f (SS)g(ANO)o(V)-5 b(A)12 b(estimate)g(and)j(decide)e(a)i(region)f(in)g (whic)o(h)f(the)h(estimates)f(are)h(deemed)0 1965 y(to)g(b)q(e)f (reliable.)19 b(Con\014dence)14 b(in)o(terv)m(als)e(for)i(comp)q(onen)o (ts)e(lik)o(e)g(main)g(e\013ects)h(and)h(in)o(teractions)f(are)g(also)0 2025 y(useful)20 b(for)g(mo)q(del)f(selection.)31 b(W)l(ah)o(ba)21 b(et)e(al)h(\(1994c\))i(deriv)o(ed)c(appro)o(ximate)h(Ba)o(y)o(esian)g (con\014dence)0 2085 y(in)o(terv)m(als)c(for)i(SS)f(ANO)o(V)-5 b(A)14 b(estimates)h(and)h(sho)o(w)o(ed)h(ho)o(w)f(to)h(use)f(them)f (in)h(practice.)73 2145 y(Let)h(the)f(prior)g(for)g Fm(f)5 b Fy(\()p Fk(t)p Fy(\))17 b(b)q(e)526 2293 y Fm(F)558 2300 y Fl(\030)576 2293 y Fy(\()p Fk(t)p Fy(\))c(=)714 2239 y Fl(M)703 2251 y Fg(X)700 2342 y Fl(\027)r Fi(=1)773 2293 y Fm(\034)794 2300 y Fl(\027)816 2293 y Fm(\036)845 2300 y Fl(\027)866 2293 y Fy(\()p Fk(t)p Fy(\))e(+)g Fm(b)1011 2259 y Fe(1)p 1011 2265 16 2 v 1011 2285 a(2)1066 2236 y Fl(q)1045 2251 y Fg(X)1041 2343 y Fl(\014)r Fi(=1)1116 2242 y Fg(q)p 1158 2242 47 2 v 51 x Fm(\022)1181 2300 y Fl(\014)1204 2293 y Fm(Z)1237 2300 y Fl(\014)1261 2293 y Fy(\()p Fk(t)p Fy(\))p Fm(;)529 b Fy(\(31\))0 2449 y(where)20 b Fk(\034)28 b Fy(=)20 b(\()p Fm(\034)297 2456 y Fi(1)317 2449 y Fm(;)8 b Fj(\001)g(\001)g(\001)h Fm(;)f(\034)449 2456 y Fl(M)488 2449 y Fy(\))507 2431 y Fl(T)556 2449 y Fj(\030)20 b Fm(N)5 b Fy(\(0)p Fm(;)j(\030)r(I)t Fy(\),)22 b Fm(Z)861 2456 y Fl(\014)905 2449 y Fy(are)f(indep)q(enden)o (t,)f(zero)g(mean)f(Gaussian)j(sto)q(c)o(hastic)0 2509 y(pro)q(cesses,)e(indep)q(enden)o(t)e(of)h Fk(\034)7 b Fy(,)19 b(with)f(E)q Fm(Z)811 2516 y Fl(\014)835 2509 y Fy(\()p Fk(t)o Fy(\))p Fm(Z)926 2516 y Fl(\014)950 2509 y Fy(\()p Fk(z)r Fy(\))g(=)h Fm(R)1130 2516 y Fl(\014)1153 2509 y Fy(\()p Fk(t)p Fm(;)8 b Fk(z)r Fy(\).)29 b(With)18 b(the)h(log)g(lik)o(eliho)q(o)q(d)f(in)h(\(2\))0 2569 y(and)g Fm(\030)g Fj(!)e(1)p Fy(,)g(W)l(ah)o(ba)i(et)e(al)h(\(1994c\))h (deriv)o(ed)e(the)h(appro)o(ximate)e(p)q(osterior)j(mean)d(and)j(co)o (v)m(ariance.)0 2629 y(W)l(e)d(list)g(them)e(in)i(the)g(follo)o(wing)g (theorem.)963 2803 y(5)p eop %%Page: 6 7 6 6 bop 0 170 a Fc(Theorem)17 b(1)24 b Fh(L)n(et)15 b Fk(c)f Fh(and)i Fk(d)f Fh(b)n(e)h(a)f(solution)h(to)f(\(10\).)21 b(L)n(et)15 b Fm(\025)p Fh(,)h Fy(\002)f Fh(b)n(e)h(smo)n(othing)f(p)n (ar)n(ameters)f(at)h(c)n(onver-)0 230 y(genc)n(e)f(and)f Fm(W)7 b Fh(,)14 b Fm(Q)338 237 y Fi(\002)380 230 y Fh(b)n(e)f(matrix)f (b)n(ase)n(d)g(on)i(c)n(onver)n(ge)n(d)f(values.)22 b(L)n(et)12 b Fm(n\025)i Fy(=)j(^)-27 b Fm(\033)1385 212 y Fi(2)1404 230 y Fm(=b)13 b Fh(and)g Fm(M)19 b Fy(=)14 b Fm(Q)1709 237 y Fi(\002)1739 230 y Fy(+)q Fm(n\025W)1888 212 y Ff(\000)p Fi(1)1935 230 y Fh(.)0 298 y(F)l(or)j Fm(g)114 305 y Fi(0)p Fl(;\027)163 298 y Fy(\()p Fk(t)p Fy(\))d(=)g Fm(\034)309 305 y Fl(\027)330 298 y Fm(\036)359 305 y Fl(\027)381 298 y Fy(\()p Fk(t)o Fy(\))p Fh(,)k Fm(g)495 305 y Fl(\014)519 298 y Fy(\()p Fk(t)o Fy(\))c(=)g Fm(b)669 266 y Fe(1)p 669 272 16 2 v 669 293 a(2)691 250 y Fg(q)p 732 250 47 2 v 732 298 a Fm(\022)755 305 y Fl(\014)779 298 y Fm(Z)812 305 y Fl(\014)836 298 y Fy(\()p Fk(t)o Fy(\))p Fh(,)k Fm(\027)f Fy(=)d(1)p Fm(;)8 b Fj(\001)g(\001)g(\001)g Fm(;)g(M)d Fh(,)18 b Fm(\014)e Fy(=)e(1)p Fm(;)8 b Fj(\001)g(\001)g (\001)g Fm(;)g(q)r Fh(,)17 b(we)h(have)552 410 y(E)p Fy(\()p Fm(g)627 417 y Fi(0)p Fl(;\027)676 410 y Fy(\()p Fk(t)p Fy(\))p Fj(j)p Fk(y)r Fy(\))41 b Fj(\031)h Fm(d)946 417 y Fl(\027)968 410 y Fm(\036)997 417 y Fl(\027)1018 410 y Fy(\()p Fk(t)p Fy(\))p Fm(;)577 513 y Fh(E)p Fy(\()p Fm(g)652 520 y Fl(\014)676 513 y Fy(\()p Fk(t)p Fy(\))p Fj(j)p Fk(y)r Fy(\))f Fj(\031)940 459 y Fl(n)921 471 y Fg(X)922 562 y Fl(i)p Fi(=1)989 513 y Fm(c)1010 520 y Fl(i)1024 513 y Fm(\022)1047 520 y Fl(\014)1070 513 y Fm(R)1107 520 y Fl(\014)1131 513 y Fy(\()p Fk(t)p Fm(;)8 b Fk(t)1213 520 y Fl(i)1227 513 y Fy(\))p Fm(;)310 615 y Fy(1)p 310 637 25 2 v 312 683 a Fm(b)339 649 y Fh(Cov)p Fy(\()p Fm(g)463 656 y Fi(0)p Fl(;\027)513 649 y Fy(\()p Fk(z)q Fy(\))p Fm(;)g(g)625 656 y Fi(0)p Fl(;\026)676 649 y Fy(\()p Fk(t)p Fy(\))p Fj(j)p Fk(y)r Fy(\))41 b Fj(\031)h Fm(\036)950 656 y Fl(\027)971 649 y Fy(\()p Fk(z)r Fy(\))p Fm(\036)1068 656 y Fl(\026)1091 649 y Fy(\()p Fk(t)p Fy(\))p Fk(e)1177 628 y Fl(T)1177 661 y(\027)1205 649 y Fy(\()p Fm(S)1257 628 y Fl(T)1284 649 y Fm(M)1336 628 y Ff(\000)p Fi(1)1384 649 y Fm(S)s Fy(\))1436 628 y Ff(\000)p Fi(1)1483 649 y Fk(e)1510 656 y Fl(\026)1534 649 y Fm(;)337 732 y Fy(1)p 337 754 V 339 800 a Fm(b)366 765 y Fh(Cov)p Fy(\()p Fm(g)490 772 y Fl(\014)514 765 y Fy(\()p Fk(z)r Fy(\))p Fm(;)8 b(g)627 772 y Fi(0)p Fl(;\027)676 765 y Fy(\()p Fk(t)p Fy(\))p Fj(j)p Fk(y)r Fy(\))41 b Fj(\031)h(\000)p Fm(d)985 772 y Fl(\027;\014)1036 765 y Fy(\()p Fk(z)q Fy(\))p Fm(\036)1132 772 y Fl(\027)1154 765 y Fy(\()p Fk(t)p Fy(\))p Fm(;)362 855 y Fy(1)p 362 877 V 364 923 a Fm(b)392 889 y Fh(Cov)p Fy(\()p Fm(g)516 896 y Fl(\014)540 889 y Fy(\()p Fk(z)r Fy(\))p Fm(;)8 b(g)653 896 y Fl(\014)676 889 y Fy(\()p Fk(t)p Fy(\))p Fj(j)p Fk(y)r Fy(\))41 b Fj(\031)h Fm(\022)944 896 y Fl(\014)967 889 y Fm(R)1004 896 y Fl(\014)1028 889 y Fy(\()p Fk(z)q Fm(;)8 b Fk(t)p Fy(\))j Fj(\000)1218 835 y Fl(n)1199 847 y Fg(X)1200 938 y Fl(i)p Fi(=1)1267 889 y Fm(c)1288 896 y Fl(i;\014)1333 889 y Fy(\()p Fk(z)r Fy(\))p Fm(\022)1424 896 y Fl(\014)1447 889 y Fm(R)1484 896 y Fl(\014)1508 889 y Fy(\()p Fk(t)p Fm(;)d Fk(t)1590 896 y Fl(i)1604 889 y Fy(\))p Fm(;)364 998 y Fy(1)p 364 1020 V 366 1066 a Fm(b)393 1031 y Fh(Cov)p Fy(\()p Fm(g)517 1038 y Fl(\015)540 1031 y Fy(\()p Fk(z)r Fy(\))p Fm(;)g(g)653 1038 y Fl(\014)676 1031 y Fy(\()p Fk(t)p Fy(\))p Fj(j)p Fk(y)r Fy(\))41 b Fj(\031)h(\000)987 977 y Fl(n)968 990 y Fg(X)969 1081 y Fl(i)p Fi(=1)1036 1031 y Fm(c)1057 1038 y Fl(i;\015)1101 1031 y Fy(\()p Fk(z)r Fy(\))p Fm(\022)1192 1038 y Fl(\014)1215 1031 y Fm(R)1252 1038 y Fl(\014)1276 1031 y Fy(\()p Fk(t)o Fm(;)8 b Fk(t)1358 1038 y Fl(i)1372 1031 y Fy(\))p Fm(;)0 1175 y Fh(wher)n(e)18 b Fk(e)165 1182 y Fl(\027)204 1175 y Fh(is)g(the)f Fm(\027)s Fh(th)h(unit)g(ve)n (ctor,)g(and)g Fy(\()p Fm(d)823 1182 y Fi(1)p Fl(;\014)874 1175 y Fy(\()p Fk(z)r Fy(\))p Fm(;)8 b Fj(\001)g(\001)g(\001)g Fm(;)g(d)1077 1182 y Fl(M)r(;\014)1146 1175 y Fy(\()p Fk(z)r Fy(\)\))14 b(=)f Fm(d)1323 1182 y Fl(\014)1347 1175 y Fy(\()p Fk(z)r Fy(\))1415 1157 y Fl(T)1460 1175 y Fh(and)0 1235 y Fy(\()p Fm(c)40 1242 y Fi(1)p Fl(;\014)91 1235 y Fy(\()p Fk(z)r Fy(\))p Fm(;)8 b Fj(\001)g(\001)g(\001)g Fm(;)g(c)290 1242 y Fl(n;\014)345 1235 y Fy(\()p Fk(z)q Fy(\)\))14 b(=)g Fm(c)518 1242 y Fl(\014)541 1235 y Fy(\()p Fk(z)r Fy(\))609 1217 y Fl(T)654 1235 y Fh(ar)n(e)j(given)i(by)285 1411 y Fm(d)310 1418 y Fl(\014)334 1411 y Fy(\()p Fk(z)q Fy(\))42 b(=)f(\()p Fm(S)574 1391 y Fl(T)602 1411 y Fm(M)654 1391 y Ff(\000)p Fi(1)701 1411 y Fm(S)s Fy(\))753 1391 y Ff(\000)p Fi(1)800 1411 y Fm(S)833 1391 y Fl(T)861 1411 y Fm(M)913 1391 y Ff(\000)p Fi(1)969 1301 y Fg(0)969 1374 y(B)969 1399 y(B)969 1425 y(@)1028 1340 y Fm(\022)1051 1347 y Fl(\014)1074 1340 y Fm(R)1111 1347 y Fl(\014)1135 1340 y Fy(\()p Fk(z)q Fm(;)8 b Fk(t)1226 1347 y Fi(1)1245 1340 y Fy(\))1139 1388 y Fh(.)1139 1405 y(.)1139 1421 y(.)1026 1481 y Fm(\022)1049 1488 y Fl(\014)1072 1481 y Fm(R)1109 1488 y Fl(\014)1133 1481 y Fy(\()p Fk(z)q Fm(;)g Fk(t)1224 1488 y Fl(n)1247 1481 y Fy(\))1287 1301 y Fg(1)1287 1374 y(C)1287 1399 y(C)1287 1425 y(A)1332 1411 y Fm(;)517 b Fy(\(32\))289 1629 y Fm(c)310 1636 y Fl(\014)334 1629 y Fy(\()p Fk(z)q Fy(\))42 b(=)f([)p Fm(M)588 1609 y Ff(\000)p Fi(1)646 1629 y Fj(\000)11 b Fm(M)748 1609 y Ff(\000)p Fi(1)796 1629 y Fm(S)s Fy(\()p Fm(S)881 1609 y Fl(T)908 1629 y Fm(M)960 1609 y Ff(\000)p Fi(1)1008 1629 y Fm(S)s Fy(\))1060 1609 y Ff(\000)p Fi(1)1107 1629 y Fm(S)1140 1609 y Fl(T)1167 1629 y Fm(M)1219 1609 y Ff(\000)p Fi(1)1267 1629 y Fy(])1289 1519 y Fg(0)1289 1592 y(B)1289 1617 y(B)1289 1643 y(@)1347 1558 y Fm(\022)1370 1565 y Fl(\014)1394 1558 y Fm(R)1431 1565 y Fl(\014)1455 1558 y Fy(\()p Fk(z)q Fm(;)d Fk(t)1546 1565 y Fi(1)1565 1558 y Fy(\))1458 1606 y Fh(.)1458 1623 y(.)1458 1639 y(.)1346 1699 y Fm(\022)1369 1706 y Fl(\014)1392 1699 y Fm(R)1429 1706 y Fl(\014)1453 1699 y Fy(\()p Fk(z)q Fm(;)g Fk(t)1544 1706 y Fl(n)1567 1699 y Fy(\))1607 1519 y Fg(1)1607 1592 y(C)1607 1617 y(C)1607 1643 y(A)1652 1629 y Fm(:)197 b Fy(\(33\))0 1846 y Fw(4)83 b(A)28 b(Sp)r(ecial)e (Case:)36 b(T)-7 b(ensor)27 b(Pro)r(duct)h(of)g Fb(W)1478 1856 y Fy(2)0 1955 y(T)l(o)c(illustrate)e(ho)o(w)i(to)f(use)g(SS)h(ANO) o(V)-5 b(A)21 b(metho)q(d)h(and)i(ho)o(w)f(to)h(construct)f(Ba)o(y)o (esian)g(con\014dence)0 2015 y(in)o(terv)m(als,)13 b(consider)g(the)g (sp)q(ecial)g(case)g Fj(T)771 1997 y Fi(\()p Fl(j)r Fi(\))830 2015 y Fy(=)h([0)p Fm(;)8 b Fy(1],)13 b Fm(j)k Fy(=)d(1)p Fm(;)8 b Fj(\001)g(\001)g(\001)h Fm(;)f(d)13 b Fy(and)h Fm(d)g Fj(\025)g Fy(2)g(\(w)o(e)e(usually)h(transform)0 2076 y(all)23 b(con)o(tin)o(uous)h(v)m(ariables)f(in)o(to)g([0)p Fm(;)8 b Fy(1])24 b(for)g(\014tting)f(and)i(then)e(transform)g(them)f (bac)o(k\).)43 b(T)l(ak)o(e)23 b(the)0 2136 y(comp)q(onen)o(t)15 b(space)i(on)f([0,1])g(as)h(the)f(RKHS)414 2264 y Fm(W)460 2271 y Fi(2)494 2264 y Fy(=)d Fj(f)p Fm(f)20 b Fy(:)13 b Fm(f)22 b Fy(and)16 b Fm(f)810 2243 y Fi(\(1\))874 2264 y Fy(abs.)h(con)o(t.)o Fm(;)1117 2205 y Fg(Z)1159 2219 y Fi(1)1140 2300 y(0)1178 2264 y Fy(\()p Fm(f)1226 2243 y Fi(\(2\))1274 2264 y Fy(\))1293 2243 y Fi(2)1326 2264 y Fm(<)d Fj(1g)410 b Fy(\(34\))0 2383 y(with)16 b(norm)531 2499 y Fm(f)560 2479 y Fi(2)594 2499 y Fy(=)e(\()665 2441 y Fg(Z)707 2454 y Fi(1)688 2535 y(0)735 2499 y Fm(f)5 b Fy(\))783 2479 y Fi(2)814 2499 y Fy(+)11 b(\()882 2441 y Fg(Z)923 2454 y Fi(1)905 2535 y(0)951 2499 y Fm(f)980 2479 y Fi(\(1\))1028 2499 y Fy(\))1047 2479 y Fi(2)1078 2499 y Fy(+)1127 2441 y Fg(Z)1168 2454 y Fi(1)1150 2535 y(0)1188 2499 y Fy(\()p Fm(f)1236 2479 y Fi(\(2\))1283 2499 y Fy(\))1302 2479 y Fi(2)1322 2499 y Fm(:)527 b Fy(\(35\))73 2618 y(W)l(e)19 b(decomp)q(ose)g Fm(W)455 2625 y Fi(2)495 2618 y Fy(=)g Fj(N)i(\010)13 b(L)g(\010)g(S)t Fy(,)20 b(where)f Fj(N)27 b Fy(is)20 b(the)f(space)h(of)f(constan)o (ts,)i(with)f(the)f(square)0 2679 y(norm)12 b(\()143 2643 y Fg(R)171 2656 y Fi(1)163 2691 y(0)199 2679 y Fm(f)5 b Fy(\))247 2661 y Fi(2)267 2679 y Fy(;)14 b Fj(L)g Fy(is)f(the)g (space)g(of)h(linear)f(functions)g(whic)o(h)g(in)o(tegrate)f(to)i (zero,)f(with)g(the)g(square)h(norm)963 2803 y(6)p eop %%Page: 7 8 7 7 bop 0 172 a Fy(\()19 137 y Fg(R)47 150 y Fi(1)39 185 y(0)75 172 y Fm(f)104 154 y Fi(\(1\))151 172 y Fy(\))170 154 y Fi(2)190 172 y Fy(;)17 b(and)h Fj(S)k Fy(is)17 b(the)g(space)g(of)h(functions)f(with)h(square)f(in)o(tegrable)f(2nd)i (deriv)m(ativ)o(e)e(and)i(satisfy)0 197 y Fg(R)28 210 y Fi(1)20 245 y(0)56 233 y Fm(f)85 215 y Fi(\()p Fl(v)q Fi(\))147 233 y Fy(=)c(0,)i Fm(v)f Fy(=)f(0)p Fm(;)8 b Fy(1,)16 b(with)g(the)g(square)h(norm)920 197 y Fg(R)948 210 y Fi(1)940 245 y(0)967 233 y Fy(\()p Fm(f)1015 215 y Fi(\(2\))1063 233 y Fy(\))1082 215 y Fi(2)1102 233 y Fy(.)k(The)16 b(RK)g(for)h(subspace)f Fj(S)21 b Fy(is)596 328 y Fm(R)p Fy(\()p Fm(t;)8 b(z)r Fy(\))14 b(=)g Fm(k)827 335 y Fi(2)847 328 y Fy(\()p Fm(t)p Fy(\))p Fm(k)928 335 y Fi(2)947 328 y Fy(\()p Fm(z)r Fy(\))d Fj(\000)g Fm(k)1096 335 y Fi(4)1116 328 y Fy(\()p Fm(t)g Fj(\000)f Fm(z)r Fy(\))p Fm(;)592 b Fy(\(36\))0 423 y(where)22 b Fm(k)172 430 y Fl(\027)194 423 y Fy(\()p Fj(\001)p Fy(\))i(=)g Fm(B)369 430 y Fl(\027)391 423 y Fy(\()p Fj(\001)p Fy(\))p Fm(=v)r Fy(!)d(and)i Fm(B)666 430 y Fl(\027)688 423 y Fy(\()p Fj(\001)p Fy(\))f(is)g(the)g Fm(\027)s Fy(th)h(Bernoulli)d(p)q(olynomial.)39 b(Let)22 b Fj(G)j Fy(b)q(e)e(the)f(tensor)0 483 y(pro)q(duct)17 b(of)f(comp)q(onen)o(t)g(spaces)189 578 y Fj(G)44 b Fy(=)e Fj(\012)382 558 y Fl(d)382 591 y(j)r Fi(=1)445 578 y Fy(\()p Fj(N)512 558 y Fl(j)541 578 y Fj(\010)11 b(L)625 558 y Fl(j)655 578 y Fj(\010)g(S)739 558 y Fl(j)757 578 y Fy(\))263 657 y(=)42 b Fj(f)p Fy(1)p Fj(g)11 b(\010)g(f)p Fy(\()p Fj(\010)561 637 y Fl(d)561 670 y(j)r Fi(=1)624 657 y Fj(L)658 637 y Fl(j)676 657 y Fy(\))g Fj(\010)g Fy(\()p Fj(\010)814 637 y Fl(d)814 670 y(j)r Fi(=1)877 657 y Fj(S)911 637 y Fl(j)929 657 y Fy(\))p Fj(g)354 736 y(\010)g(f)p Fy(\()p Fj(\010)487 743 y Fl(j)r( 'grkpack/rkpack/dmudr.r' && #::::::::::: # dmudr #::::::::::: X subroutine dmudr (vmu,_ X s, lds, nobs, nnull, q, ldqr, ldqc, nq, y,_ # inputs X tol, init, prec, maxite,_ # tune para X theta, nlaht, score, varht, c, d,_ # outputs X wk, info) X # Acronym: Double precision MUltiple smoothing parameter DRiver. X # Purpose: This routine implements the iterative algorithm for minimizing # GCV/GML scores with multiple smoothing parameters described in # Gu and Wahba (1991, SISSC). X # WARNING: Please be sure that you understand what this routine does before # you call it. Pilot runs with small problems are recommended. This # routine performs VERY INTENSIVE numerical calculations for big nobs. X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxite,_ X info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol, prec,_ X theta(*), nlaht, score, varht, c(*), d(*),_ X wk(*) X character*1 vmu X # On entry: # vmu 'v': GCV criterion. # 'm': GML criterion. # 'u': unbiased risk estimate. # s the matrix S, of size (lds,nnull). # nobs the number of observations. # nnull the dimension of the null space. # q the matrices Q_{i}'s, of dimension (ldqr,ldqc,nq). # nq the number of Q_{i}'s. # y the response vector of size (nobs) # tol the tolerance for truncation in the tridiagonalization; usually set to 0.d0. # init 0 : no initial values provided for the theta. # 1 : initial values provided for the theta. # theta initial values of theta if init = 1. # prec precision requested for the minimum score value, where precision # is the weaker of the absolute and relative precisions. # maxite maximum number of iterations allowed; usually 20 is enough. # varht known variance if vmu=='u'. X # On exit: # theta the vector of parameter log10(theta) used in the final model, # of dimension (nq). -25 indicates effective minus infinity. # nlaht the estimated log10(n*lambda)|theta in the final model. # score the minimum GCV/GML/URE score found at (theta, nlaht). # varht the variance estimate. # c,d the coefficient estimates. # info 0 : normal termination. # -1 : dimension error. # -2 : F_{2}^{T} Q_{*}^{theta} F_{2} !>= 0. # -3 : tuning parameters are out of scope. # -4 : fails to converge within maxite steps. # -5 : fails to find a reasonable descent direction. # >0 : the matrix S is rank deficient: rank(S)+1. # s,q,y destroyed. # others intact. X # Work arrays: # wk of size (nobs*nobs*(nq+2)) X # Routines called directly: # Rkpack -- dmudr1 X # Routines called indirectly: # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal, dswap, idamax # Blas2 -- dgemv, dsymv, dsyr2 # Fortran -- dabs, dexp, dfloat, dlog, dlog10, dmax1, dsqrt # Linpack -- dpbfa, dpbsl, dpofa, dposl, dqrdc, dqrsl, dtrsl # Rkpack -- dcoef, dcore, ddeev, deval, dgold, dmcdc, dqrslm, # dstup, dsytr, dtrev # Other -- dprmut, dset X # Written: Chong Gu, Statistics, Purdue, latest version 3/9/91. X integer n, n0 integer iqraux, itraux, itwk, iqwk, iywk, ithewk, ihes, igra, ihwk1, ihwk2,_ X igwk1, igwk2, ikwk, iwork1, iwork2, ijpvt, ipvtwk X X n = nobs n0 = nnull X iqraux = 1 itraux = iqraux + n0 itwk = itraux + (n-n0-2) iqwk = itwk + 2 * (n-n0) iywk = iqwk + n * n ithewk = iywk + n ihes = ithewk + nq igra = ihes + nq * nq ihwk1 = igra + nq ihwk2 = ihwk1 + nq * nq igwk1 = ihwk2 + nq * nq igwk2 = igwk1 + nq ikwk = igwk2 + nq iwork1 = ikwk + (n-n0) * (n-n0) * nq iwork2 = iwork1 + n ijpvt = iwork2 + n ipvtwk = ijpvt + n0 X call dmudr1 (vmu,_ X s, lds, nobs, nnull, q, ldqr, ldqc, nq, y,_ # inputs X tol, init, prec, maxite,_ # tune para X theta, nlaht, score, varht, c, d,_ # outputs X wk(iqraux), wk(ijpvt), wk(itwk), wk(itraux), wk(iqwk),_ X wk(iywk), wk(ithewk), wk(ihes), wk(igra), wk(ihwk1),_ X wk(ihwk2), wk(igwk1), wk(igwk2), wk(ipvtwk), wk(ikwk),_ X wk(iwork1), wk(iwork2),_ X info) X return end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dmudr.r' && chmod 0644 'grkpack/rkpack/dmudr.r' || echo 'restore of grkpack/rkpack/dmudr.r failed' shar_count="`wc -c < 'grkpack/rkpack/dmudr.r'`" test 4589 -eq "$shar_count" || echo "grkpack/rkpack/dmudr.r: original size 4589, current size $shar_count" fi # ============= grkpack/rkpack/dcoef.r ============== if test -f 'grkpack/rkpack/dcoef.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dcoef.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dcoef.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dcoef.r' && X #::::::::::: # dcoef #::::::::::: X subroutine dcoef (s, lds, nobs, nnull, qraux, jpvt, z, q, ldq, nlaht,_ X c, d, info, twk) X # Purpose: To compute the estimated coefficients of the model. X integer lds, nobs, nnull, jpvt(*), ldq, info double precision s(lds,*), qraux(*), z(*), q(ldq,*), nlaht, c(*), d(*),_ X twk(2,*) X # On entry: # s,qraux,jpvt # QR-decomposition of S = F R. # lds leading dimension of s. # nobs number of observations. # nnull dimension of null space. # z diag(I, U^{T}) F^{T} y. # q U^{T} F_{2}^{T} Q F_{2} U in BOTTOM-RIGHT corner's # LOWER triangle and SUPER DIAGONAL; # F_{2}^{T} Q F_{1} in BOTTOM-LEFT corner. # ldq leading dimension of q. # nlaht estimated log10(n*lambda). X # On exit: # c parameters c. # d parameters d. # info 0: normal termination. # >0: S is not of full rank: rank(S)+1 . # -1: dimension error. # -2: F_{2}^{T} Q F_{2} is not non-negative definite. X # Work array: # twk of size at least (2,nobs-nnull). X # Routines called directly: # Blas -- daxpy, dcopy, ddot # Linpack -- dpbfa, dpbsl, dqrsl, dtrsl # Other -- dprmut, dset X # Written: Chong Gu, Statistics, UW-Madison, 5/4/88 at Yale. X double precision dum, ddot integer n, n0 X info = 0 X # check dimension if ( nnull < 1 | nnull >= nobs | nobs > lds | nobs > ldq ) { X info = -1 X return } X # set working parameters n0 = nnull n = nobs - nnull X # compute U ( T + n*lambdahat I )^{-1} z call dset (n, 10.d0 ** nlaht, twk(2,1), 2) call daxpy (n, 1.d0, q(n0+1,n0+1), ldq+1, twk(2,1), 2) call dcopy (n-1, q(n0+1,n0+2), ldq+1, twk(1,2), 2) call dpbfa (twk, 2, n, 1, info) if ( info != 0 ) { X info = -2 X return } call dpbsl (twk, 2, n, 1, z(n0+1)) call dcopy (n-2, q(n0+2,n0+1), ldq+1, twk, 1) call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, twk, z(n0+2), z(n0+2), dum,_ X dum, dum, dum, 10000, info) X # compute c call dset (n0, 0.d0, c, 1) call dcopy (n, z(n0+1), 1, c(n0+1), 1) call dqrsl (s, lds, nobs, nnull, qraux, c, c, dum, dum, dum, dum, 10000,_ X info) X # compute d for (j=1;j<=n0;j=j+1) { X d(j) = z(j) - ddot (n, z(n0+1), 1, q(n0+1,j), 1) } call dtrsl (s, lds, n0, d, 01, info) call dprmut (d, n0, jpvt, 1) X return end X #............................................................................... X SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dcoef.r' && chmod 0644 'grkpack/rkpack/dcoef.r' || echo 'restore of grkpack/rkpack/dcoef.r failed' shar_count="`wc -c < 'grkpack/rkpack/dcoef.r'`" test 2586 -eq "$shar_count" || echo "grkpack/rkpack/dcoef.r: original size 2586, current size $shar_count" fi # ============= grkpack/rkpack/dcore.r ============== if test -f 'grkpack/rkpack/dcore.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dcore.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dcore.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dcore.r' && X #::::::::::: # dcore #::::::::::: X subroutine dcore (vmu, q, ldq, nobs, nnull, tol, z, job, limnla, nlaht,_ X score, varht, info, twk, work) X # Purpose: To evaluate the GCV/GML score function at various trial values # of n*lambda using the tridiagonalization GCV/GML algorithm. Perform # either golden section search or regular grid search for minimizing # n*lambda. X character*1 vmu integer ldq, nobs, nnull, job, info double precision q(ldq,*), tol, z(*), limnla(2), nlaht, score(*), varht,_ X twk(2,*), work(*) X # On entry: # vmu 'v': GCV criterion. # 'm': GML criterion. # 'u': unbiased risk estimate. # q F^{T} Q F, only refer the LOWER triangle of the BOTTOM- # RIGHT corner, i.e., F_{2}^{T} Q F_{2}. # ldq leading dimension of Q. # nobs number of observations. # nnull dimension of null space. # tol tolerance of truncation. # z F^{T} y. # job 0: searching interval for nlaht chosen automatically. # -1: searching interval for nlaht provided by limnla. # >0: search regular grid points on [limnla(1),limnla(2)]: # #(grids) = job + 1. # limnla searching interval in log10 scale, see job. # varht known variance if vmu=='u'. X # On exit: # q tridiagonal form in diagonal and superdiagonal of the # corner, Householder factors in strict lower triangle of # the corner. # z diag(I, U^{T}) F^{T} y. # limnla see limnla of entry. # nlaht the estimated log10(n*lambda). # score job <= 0 : the GCV/GML/URE score at nlaht. # job > 0 : the GCV/GML/URE score at the regular grid points. # varht variance estimate. # info 0 : normal termination. # -1 : dimension error. # -2 : F_{2}^{T}QF_{2} is not non-negative definite. # -3 : vmu is none of 'v', 'm', or 'u'. X # Work arrays: # twk of size at least (2,nobs-nnull). # work of size at least (nobs-nnull). X # Routines called directly: # Fortran -- dfloat, dlog10 # Blas -- dasum, dcopy # Linpack -- dqrsl # Rkpack -- deval, dgold, dsytr X # Written: Chong Gu, Statistics, Purdue, latest version 3/24/92. X double precision dum, low, upp, dasum, mchpr integer n0, n, j X info = 0 X # check vmu if ( vmu != 'v' & vmu != 'm' & vmu != 'u' ) { X info = -3 X return } X # check dimension if ( nnull < 1 | nobs <= nnull | nobs > ldq ) { X info = -1 X return } X # set working parameters n0 = nnull n = nobs - nnull X # tridiagonalization U^{T} ( F_{2}^{T} Q F_{2} ) U = T call dsytr (q(n0+1,n0+1), ldq, n, tol, info, work) X if ( info != 0 ) return X # U^{T} z_{2} call dcopy (n-2, q(n0+2,n0+1), ldq+1, work, 1) call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, work, z(n0+2), dum, z(n0+2),_ X dum, dum, dum, 01000, info) X # set searching range if ( job == 0 ) { X mchpr = 1.d0 X while ( 1.d0 + mchpr > 1.d0 ) mchpr = mchpr / 2.d0 X mchpr = mchpr * 2.d0 X limnla(2) = dmax1 (dasum (n, q(n0+1,n0+1), ldq+1) * 1.d2, mchpr) X limnla(1) = limnla(2) * mchpr X limnla(2) = dlog10 (limnla(2)) X limnla(1) = dlog10 (limnla(1)) } X low = limnla(1) upp = limnla(2) if ( job <= 0 ) { X # compute score and estimate nlaht thru golden-section search X call dgold (vmu, q(n0+1,n0+1), ldq, n, z(n0+1), low, upp, nlaht,_ X score(1), varht, info, twk, work) X if ( vmu == 'v' ) score(1) = score(1) * dfloat (nobs) / dfloat (n) X if ( vmu == 'm' ) score(1) = score(1) * dfloat (n) / dfloat (nobs) X if ( vmu == 'u' ) score(1) = score(1) * dfloat (n) / dfloat (nobs) + 2.d0 * varht } else { X # regular grid evaluation X call deval (vmu, q(n0+1,n0+1), ldq, n, z(n0+1), job, low, upp, nlaht,_ X score, varht, info, twk, work) X dum = dfloat (nobs) / dfloat (n) X for (j=1;j<=job+1;j=j+1) { X if ( vmu == 'v' ) score(j) = score(j) * dum X if ( vmu == 'm' ) score(j) = score(j) / dum X if ( vmu == 'u' ) score(j) = score(j) / dum + 2.d0 * varht X } } X return end X #............................................................................... X SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dcore.r' && chmod 0644 'grkpack/rkpack/dcore.r' || echo 'restore of grkpack/rkpack/dcore.r failed' shar_count="`wc -c < 'grkpack/rkpack/dcore.r'`" test 4428 -eq "$shar_count" || echo "grkpack/rkpack/dcore.r: original size 4428, current size $shar_count" fi # ============= grkpack/rkpack/dcrdr.r ============== if test -f 'grkpack/rkpack/dcrdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dcrdr.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dcrdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dcrdr.r' && X #::::::::::: # dcrdr #::::::::::: X subroutine dcrdr (s, lds, nobs, nnull, qraux, jpvt, q, ldq, nlaht,_ X r, ldr, nr, cr, ldcr, dr, lddr, wk, info) X # Purpose: To compute auxiliary quantities cr and dr for posterior covariance X # Usage: Use s, qraux, jpvt, q, and nlaht returned by dsidr. X integer lds, nobs, nnull, jpvt(*), ldq, ldr, nr, ldcr, lddr, info double precision s(lds,*), qraux(*), q(ldq,*), nlaht, r(ldr,*), cr(ldcr,*),_ X dr(lddr,*), wk(2,*) X # On entry: # s,qraux,jpvt # QR-decomposition of S = F R. # nobs number of observations. # nnull dimension of null space. # q U^{T} F_{2}^{T} Q F_{2} U in BOTTOM-RIGHT corner's # LOWER triangle and SUPER DIAGONAL; # F_{2}^{T} Q F_{1} in BOTTOM-LEFT corner; # ldq leading dimension of q. # nlaht estimated log10(n*lambda). # r R(t,s^{T}), distroyed on exit. # nr length of s. X # On exit: # cr (M^{-1}-M^{-1}S(S^{T}M^{-1}S)^{-1}S^{T}M^{-1})R(t,s^{T}) # dr (S^{T}M^{-1}S)^{-1}S^{T}M^{-1}R(t,s^{T}) # info 0: normal termination. # >0: S is not of full rank: rank(S)+1 . # -1: dimension error. # -2: F_{2}^{T} Q F_{2} is not non-negative definite. # r destroyed. # others intact. X # Work array: # wk of size at least (2,nobs-nnull). X # Routines called directly: # Blas -- daxpy, dcopy, ddot # Linpack -- dpbfa, dpbsl, dqrsl, dtrsl # Other -- dprmut, dset X # Written: Chong Gu, Statistics, Purdue, 1/31/91. X double precision dum, ddot integer i, j, n, n0 X info = 0 X # check dimension if ( nnull < 1 | nnull >= nobs | nobs > lds | nobs > ldq | ldr < nobs |_ X nr < 1 | ldcr < nobs | lddr < nnull ) { X info = -1 X return } X # set working parameters n0 = nnull n = nobs - nnull X # compute diag(I, U^{T}) F^{T} R(t,s^{T}) call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) for (j=1;j<=nr;j=j+1) { X call dqrsl (s, lds, nobs, nnull, qraux, r(1,j), dum, r(1,j), dum,_ X dum, dum, 01000, info) X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, r(n0+2,j), dum, X r(n0+2,j), dum, dum, dum, 01000, info) } X # compute U ( T + n*lambdahat I )^{-1} diag(I, U^{T}) F^{T} R(t,s^{T}) call dset (n, 10.d0 ** nlaht, wk(2,1), 2) call daxpy (n, 1.d0, q(n0+1,n0+1), ldq+1, wk(2,1), 2) call dcopy (n-1, q(n0+1,n0+2), ldq+1, wk(1,2), 2) call dpbfa (wk, 2, n, 1, info) if ( info != 0 ) { X info = -2 X return } for (j=1;j<=nr;j=j+1) call dpbsl (wk, 2, n, 1, r(n0+1,j)) call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) for (j=1;j<=nr;j=j+1) X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, r(n0+2,j), r(n0+2,j),_ X dum, dum, dum, dum, 10000, info) X # compute cr for (j=1;j<=nr;j=j+1) { X call dset (n0, 0.d0, cr(1,j), 1) X call dcopy (n, r(n0+1,j), 1, cr(n0+1,j), 1) X call dqrsl (s, lds, nobs, nnull, qraux, cr(1,j), cr(1,j),_ X dum, dum, dum, dum, 10000, info) } X # compute dr for (j=1;j<=nr;j=j+1) { X for (i=1;i<=n0;i=i+1) X dr(i,j) = r(i,j) - ddot (n, r(n0+1,j), 1, q(n0+1,i), 1) X call dtrsl (s, lds, n0, dr(1,j), 01, info) X call dprmut (dr(1,j), n0, jpvt, 1) } X return end X #.............................................................................. SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dcrdr.r' && chmod 0644 'grkpack/rkpack/dcrdr.r' || echo 'restore of grkpack/rkpack/dcrdr.r failed' shar_count="`wc -c < 'grkpack/rkpack/dcrdr.r'`" test 3452 -eq "$shar_count" || echo "grkpack/rkpack/dcrdr.r: original size 3452, current size $shar_count" fi # ============= grkpack/rkpack/ddeev.r ============== if test -f 'grkpack/rkpack/ddeev.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/ddeev.r (File already exists)' else echo 'x - extracting grkpack/rkpack/ddeev.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/ddeev.r' && X #::::::::::: # ddeev #::::::::::: X subroutine ddeev (vmu, nobs,_ X q, ldqr, ldqc, n, nq, u, ldu, uaux, t, x,_ # inputs X theta, nlaht, score, varht,_ X hes, ldh, gra,_ # outputs X hwk1, hwk2, gwk1, gwk2,_ # work arrays X kwk, ldk, work1, work2, work3,_ X info) X # Acronym: Double precision DErivative EValuation. X # Purpose: This routine calculates the gradient and the Hessian of # V(theta|lambda) or M(theta|lambda). X character*1 vmu integer nobs, ldqr, ldqc, n, nq, ldu, ldh, ldk, info double precision q(ldqr,ldqc,*), u(ldu,*), uaux(*), t(2,*), x(*),_ X theta(*), nlaht, score, varht,_ X hes(ldh,*), gra(*), hwk1(nq,*), hwk2(nq,*), gwk1(*), gwk2(*),_ X kwk(ldk,ldk,*), work1(*), work2(*), work3(*) X # On entry: # vmu 'v': GCV criterion. # 'm': GML criterion. # 'u': unbiased risk estimate. # nobs the number of observations. # q F_{2}^{T} Q_{i} F_{2}, of size (n,n,nq). # n the size of q. # nq the number of Q_{i}'s. # u,uaux Householder vectors of U, of size (n-1,n-2), # where U^{T}DU is tridiagonal. # t U^{T} (D-n\lambda I) U in packed form, of size (2,n). # x U^{T}z = U^{T}F_{2}^{T}y, of size (n). # theta the current log(theta) for the D matrix, of dimension (nq). # nlaht the estimated log10(n*lambda) in the current model. # score the minimum GCV/GML score found at (theta, nlaht). # varht the variance estimate at (theta, nlaht). X # On exit: # hes Hessian at point (theta, nlaht), of size (nq,nq). # gra gradient at point (theta, nlaht), of size (nq). # info 0 : normal termination. # -1 : dimension error. # -2 : D !>= 0. # -3 : tuning parameters are out of scope. X # Work arrays: # hwk1,2 of sizes at least (nq,nq). # gwk1,2 of sizes at least (nq). # kwk of size at least (n,n,nq). # work1-3 of sizes at least (n). X # Routines called directly: # Fortran -- dfloat # Blas -- daxpy, dcopy, ddot, dscal # Blas2 -- dgemv # Linpack -- dpbfa, dpbsl, dqrsl # Rkpack -- dqrslm # Other -- dset X # Written: Chong Gu, Statistics, Purdue, latest version 12/29/91. X double precision trc, det, dum, ddot integer i, j, m X info = 0 call dset (nq, 0.d0, gra, 1) call dset (nq*nq, 0.d0, hes, 1) X # check tuning parameters if ( vmu != 'v' & vmu != 'm' & vmu != 'u' ) { X info = -3 X return } X # check dimension if ( nobs < n | ldqr < n | ldqc < n | nq <= 0 | ldu < n-1 | ldh < nq | ldk < n ) { X info = -1 X return } X # compute K_{i} = U^{T}(\theta_{i}Q_{i})U for (i=2;i<=nq;i=i+1) { # from i=2 to nq X if ( theta(i) <= -25.d0 ) next X for (j=1;j<=n;j=j+1) { X call dcopy (n-j+1, q(j,j,i), 1, kwk(j,j,i), 1) X call dscal (n-j+1, 10.d0 ** theta(i), kwk(j,j,i), 1) X } X call dqrslm (u, ldu, n-1, n-2, uaux, kwk(2,2,i), n, 0, info, work1) X call dqrsl (u, ldu, n-1, n-2, uaux, kwk(2,1,i), dum, kwk(2,1,i),_ X dum, dum, dum, 01000, info) } # compute K_{1} through the identity: U^{T}(\sum K_{i})U = T call dcopy (n, t(2,1), 2, kwk(1,1,1), n+1) call dcopy (n-1, t(1,2), 2, kwk(2,1,1), n+1) for (j=1;j 'grkpack/rkpack/deval.r' && X #::::::::::: # deval #::::::::::: X subroutine deval (vmu, q, ldq, n, z, nint, low, upp, nlaht, score, varht,_ X info, twk, work) X # Purpose: To evaluate GCV/GML function based on tridiagonal form and to # search minimum on an interval by equally spaced (in log10 scale) grid # search. X character*1 vmu integer ldq, n, nint, info double precision q(ldq,*), z(*), low, upp, nlaht, score(*), varht,_ X twk(2,*), work(*) X # On entry: # vmu 'v': GCV criterion. # 'm': GML criterion. # 'u': unbiased risk estimate. # q tidiagonal matrix in diagonal and super diagonal. # ldq leading dimension of Q. # n size of the matrix. # z U^{T} F_{2}^{T} y. # nint number of intervals (number of grids minus 1). # low lower limit of log10(n*lambda). # upp upper limit of log10(n*lambda). # varht known variance if vmu=='u'. X # On exit: # nlaht the estimated log10(n*lambda). # score the GCV/GML/URE score vector on grid points. # varht the variance estimate at the estimated n*lambda. # info 0: normal termination. # -1: dimension error. # -2: tridiagonal form is not non-negative definite. # -3: vmu or nint is out of scope. X # Work arrays: # twk array of length at least (2,n). # work array of length at least (n). X # Routines called directly: # Fortran -- dfloat # Blas -- daxpy, dcopy # Rkpack -- dtrev # Other -- dset X # Written: Chong Gu, Statistics, Purdue, 12/29/91 latest version. X double precision tmp, minscr, mlo, varhtwk integer j X info = 0 X # interchange boundaries if necessary if ( upp < low ) { X mlo = low X low = upp X upp = mlo } X # check job requests if ( (vmu != 'v' & vmu != 'm' & vmu != 'u') | nint < 1 ) { X info = -3 X return } X # check dimension if ( 1 > n | n > ldq ) { X info = -1 X return } X # evaluation for (j=1;j<=nint+1;j=j+1) { X tmp = low + dfloat (j-1) * ( upp - low ) / dfloat (nint) X call dset (n, 10.d0 ** (tmp), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**tmp X call dtrev (vmu, twk, 2, n, z, score(j), varht, info, work) X if ( info != 0 ) { X info = -2 X return X } X if ( score(j) <= minscr | j == 1 ) { X minscr = score(j) X nlaht = tmp X varhtwk = varht X } } varht = varhtwk X return end X #............................................................................... X SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/deval.r' && chmod 0644 'grkpack/rkpack/deval.r' || echo 'restore of grkpack/rkpack/deval.r failed' shar_count="`wc -c < 'grkpack/rkpack/deval.r'`" test 2726 -eq "$shar_count" || echo "grkpack/rkpack/deval.r: original size 2726, current size $shar_count" fi # ============= grkpack/rkpack/dgold.r ============== if test -f 'grkpack/rkpack/dgold.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dgold.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dgold.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dgold.r' && X #::::::::::: # dgold #::::::::::: X subroutine dgold (vmu, q, ldq, n, z, low, upp, nlaht, score, varht,_ X info, twk, work) X # Purpose: To evaluate GCV/GML function based on tridiagonal form and to # search minimum on an interval by golden section search. X character*1 vmu integer ldq, n, info double precision q(ldq,*), z(*), low, upp, nlaht, score, varht, twk(2,*),_ X work(*) X # On entry: # vmu 'v': GCV criterion. # 'm': GML criterion. # 'u': unbiased risk estimate. # q tidiagonal matrix in diagonal and super diagonal. # ldq leading dimension of Q. # n size of the matrix. # z U^{T} F_{2}^{T} y. # low lower limit of log10(n*lambda). # upp upper limit of log10(n*lambda). # varht known variance if vmu=='u'. X # On exit: # nlaht the estimated log(n*lambda). # score the GCV/GML/URE score at the estimated lambda. # varht the variance estimate at the estimated lambda. # info 0: normal termination. # -1: dimension error. # -2: tridiagonal form is not non-negative definite. # -3: vmu is none of 'v', 'm', or 'u'. X # Work arrays: # twk of size at least (2,n). # work of size at least (n). X # Routines called directly: # Fortran -- dsqrt # Blas -- daxpy, dcopy # Rkpack -- dtrev # Other -- dset X # Written: Chong Gu, Statistics, Purdue, latest version 12/29/91. X double precision ratio, mlo, mup, tmpl, tmpu X ratio = ( dsqrt (5.d0) - 1.d0 ) / 2.d0 X info = 0 X if ( upp < low ) { X mlo = low X low = upp X upp = mlo } X # check vmu if ( vmu != 'v' & vmu != 'm' & vmu != 'u' ) { X info = -3 X return } X # check dimension if ( n < 1 | n > ldq ) { X info = -1 X return } X # initialize golden section search for scrht mlo = upp - ratio * (upp - low) call dset (n, 10.d0 ** (mlo), twk(2,1), 2) call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) twk(1,1) = 10.d0**mlo call dtrev (vmu, twk, 2, n, z, tmpl, varht, info, work) if ( info != 0 ) { X info = -2 X return } mup = low + ratio * (upp - low) call dset (n, 10.d0 ** (mup), twk(2,1), 2) call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) twk(1,1) = 10.d0**mup call dtrev (vmu, twk, 2, n, z, tmpu, varht, info, work) if ( info != 0 ) { X info = -2 X return } X # golden section search for estimate of lambda repeat { X if ( mup - mlo < 1.d-7 ) break X if ( tmpl < tmpu ) { X upp = mup X mup = mlo X tmpu = tmpl X mlo = upp - ratio * (upp - low) X call dset (n, 10.d0 ** (mlo), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**mlo X call dtrev (vmu, twk, 2, n, z, tmpl, varht, info, work) X if ( info != 0 ) { X info = -2 X return X } X } X else { X low = mlo X mlo = mup X tmpl = tmpu X mup = low + ratio * (upp - low) X call dset (n, 10.d0 ** (mup), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**mup X call dtrev (vmu, twk, 2, n, z, tmpu, varht, info, work) X if ( info != 0 ) { X info = -2 X return X } X } } X # compute the return value nlaht = ( mup + mlo ) / 2.d0 call dset (n, 10.d0 ** (nlaht), twk(2,1), 2) call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) twk(1,1) = 10.d0**nlaht call dtrev (vmu, twk, 2, n, z, score, varht, info, work) if ( info != 0 ) { X info = -2 X return } X return end X #............................................................................... X SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dgold.r' && chmod 0644 'grkpack/rkpack/dgold.r' || echo 'restore of grkpack/rkpack/dgold.r failed' shar_count="`wc -c < 'grkpack/rkpack/dgold.r'`" test 3987 -eq "$shar_count" || echo "grkpack/rkpack/dgold.r: original size 3987, current size $shar_count" fi # ============= grkpack/rkpack/dmcdc.r ============== if test -f 'grkpack/rkpack/dmcdc.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dmcdc.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dmcdc.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dmcdc.r' && X #::::::::::: # dmcdc #::::::::::: X subroutine dmcdc (a, lda, p, e, jpvt, info) X # Acronym: Double precision Modified Cholesky DeComposition. X # Purpose: This routine implements the modified Cholesky decomposition as # described by Gill, Murray, and Wright (p.111, Practical Optimization, # Academic Press, 1981). The parameter delta is set to the maximum of # 1.d-7 * (average diag) and 1.d-10. Pivoting is enforced. The result # is compatible with the Linpack routine `dposl'. X integer lda, p, jpvt(*), info double precision a(lda,*), e(*) X # On entry: # a a symmetric matrix in the UPPER triangle. # lda the leading dimension of a. # p the size of a. X # On exit: # a the Cholesky factor R of P^{T}AP + E = R^{T} R, where P # is a permutation matrix. # e the amount of diagonal modification, of size (p). # jpvt the permutation P, jpvt(j) contains the index of diagonal # element moved to j-th position, of size (p). # info 0: normal termination. # -1: dimension error. X # Routines called directly: # Blas -- dasum, ddot, dscal, dswap, idamax # Fortran -- dabs, dmax1, dfloat, dsqrt X # Written: Chong Gu, Statistics, UW-Madison, latest version 9/16/88. X double precision beta, delta, theta, tmp, dasum, ddot integer i, j, jmax, jtmp, idamax X info = 0 X # check dimension if ( lda < p | p < 1 ) { X info = -1 X return } X # compute constants tmp = 1.d0 while ( 1.d0 + tmp > 1.d0 ) tmp = tmp / 2.d0 jmax = idamax (p, a, lda+1) beta = dmax1 (2.d0 * tmp, dabs (a(jmax,jmax))) tmp = dsqrt (dfloat (p*p-1)) if ( tmp < 1.d0 ) tmp = 1.d0 for (j=2;j<=p;j=j+1) { X jmax = idamax (j-1, a(1,j), 1) X beta = dmax1 (beta, dabs (a(jmax,j)) / tmp) } delta = dasum (p, a, lda+1) / dfloat (p) * 1.d-7 delta = dmax1 (delta, 1.d-10) for (j=1;j<=p;j=j+1) jpvt(j) = j X # compute P^{T}AP + E = LDL^{T} for (j=1;j<=p;j=j+1) { X # pivoting X jmax = idamax (p-j+1, a(j,j), lda+1) + j - 1 X if ( jmax != j ) { X call dswap (j-1, a(1,j), 1, a(1,jmax), 1) X call dswap (jmax-j-1, a(j,j+1), lda, a(j+1,jmax), 1) X call dswap (p-jmax, a(j,jmax+1), lda, a(jmax,jmax+1), lda) X tmp = a(j,j) X a(j,j) = a(jmax,jmax) X a(jmax,jmax) = tmp X jtmp = jpvt(j) X jpvt(j) = jpvt(jmax) X jpvt(jmax) = jtmp X } X # compute j-th column of L^{T} X for (i=1;i 'grkpack/rkpack/dmudr1.r' && #::::::::::: # dmudr1 #::::::::::: X subroutine dmudr1 (vmu,_ X s, lds, nobs, nnull, q, ldqr, ldqc, nq, y,_ # inputs X tol, init, prec, maxite,_ # tune para X theta, nlaht, score, varht, c, d,_ # outputs X qraux, jpvt, twk, traux, qwk, ywk, thewk,_ # work arrays X hes, gra, hwk1, hwk2, gwk1, gwk2, pvtwk,_ X kwk, work1, work2,_ X info) X # Acronym: Double precision MUltiple smoothing parameter DRiver. X # Purpose: This routine implements the iterative algorithm for minimizing # GCV/GML scores with multiple smoothing parameters described in # Gu and Wahba(1988, Minimizing GCV/GML scores with multiple smoothing # parameters via the Newton method). X # WARNING: Please be sure that you understand what this routine does before # you call it. Pilot runs with small problems are recommended. This # routine performs VERY INTENSIVE numerical calculations for big nobs. X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxite,_ X jpvt(*), pvtwk(*), info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol, prec,_ X theta(*), nlaht, score, varht, c(*), d(*),_ X qraux(*), traux(*), twk(2,*), qwk(ldqr,*), ywk(*),_ X thewk(*), hes(nq,*), gra(*), hwk1(nq,*), hwk2(nq,*),_ X gwk1(*), gwk2(*), kwk(nobs-nnull,nobs-nnull,*),_ X work1(*), work2(*) X character*1 vmu X # On entry: # vmu 'v': GCV criterion. # 'm': GML criterion. # 'u': unbiased risk estimate. # s the matrix S, of size (lds,nnull). # nobs the number of observations. # nnull the dimension of the null space. # q the matrices Q_{i}'s, of dimension (ldqr,ldqc,nq). # nq the number of Q_{i}'s. # y the response vector of size (nobs) # tol the tolerance for truncation in the tridiagonalization. # init 0 : No initial values provided for the theta. # 1 : Initial values provided for the theta. # theta initial values of theta if init = 1. # prec precision requested for the minimum score value. # maxite maximum number of iterations allowed. # varht known variance if vmu=='u'. X # On exit: # theta the vector of parameter log10(theta) used in the final model, # of dimension (nq). -25 indicates effective minus infinity. # nlaht the estimated log10(n*lambda)|theta in the final model. # score the minimum GCV/GML/URE score found at (theta, nlaht). # varht the variance estimate. # c,d the coefficients estimates. # info 0 : normal termination. # -1 : dimension error. # -2 : F_{2}^{T} Q_{*}^{theta} F_{2} !>= 0. # -3 : tuning parameters are out of scope. # -4 : fails to converge within maxite steps. # -5 : fails to find a reasonable descent direction. # >0 : the matrix S is rank deficient: rank(S)+1. X # Work arrays: # qraux of size at least (nnull). # jpvt of size at least (nnull). # twk of size at least (2,nobs-nnull). # traux of size at least (nobs-nnull-2). # qwk of size at least (nobs,nobs). # ywk of size at least (nobs). # thewk of size at least (nq). # hes of size at least (nq,nq). # gra of size at least (nq). # hwk1-2 of sizes at least (nq,nq). # gwk1-2 of sizes at least (nq). # pvtwk of size at least (nq). # kwk of size at least (nobs-nnull,nobs-nnull,nq). # work1-2 of sizes at least (nobs). X # Routines called directly: # Blas -- dasum, daxpy, dcopy, ddot, dscal, idamax # Blas2 -- dsymv # Fortran -- dfloat, dlog, dlog10 # Linpack -- dpofa, dposl, sqrsl # Rkpack -- dcoef, dcore, ddeev, dmcdc, dstup # Other -- dprmut, dset X # Routines called indirectly: # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal, dswap, idamax # Blas2 -- dgemv, dsymv, dsyr2 # Fortran -- dabs, dexp, dfloat, dlog, dlog10, dsqrt # Linpack -- dpbfa, dpbsl, dqrdc, dqrsl, dtrsl # Rkpack -- deval, dgold, dqrslm, dsytr, dtrev # Other -- dprmut, dset X # Written: Chong Gu, Statistics, Purdue, latest version 1/6/92. X double precision alph, scrold, scrwk, nlawk, limnla(2),_ X tmp, dasum, ddot integer n, n0, i, j, iwk, maxitwk, idamax, job X info = 0 X # set working parameters n0 = nnull n = nobs - nnull maxitwk = maxite X # check tuning parameters if ( (vmu != 'v' & vmu != 'm' & vmu != 'u') | (init != 0 & init != 1) |_ X (maxitwk <=0) | (prec <= 0.d0) ) { X info = -3 X return } X # check dimension if ( lds < nobs | nobs <= n0 | n0 < 1 | ldqr < nobs | ldqc < nobs |_ X nq <= 0 ) { X info = -1 X return } X # initialize call dstup (s, lds, nobs, n0, qraux, jpvt, y, q, ldqr, ldqc, nq, info,_ X work1) if ( info != 0 ) return if ( init == 1 ) call dcopy (nq, theta, 1, thewk, 1) else { # use the "plug-in" weights as the starting theta X for (i=1;i<=nq;i=i+1) { X thewk(i) = dasum (n, q(n0+1,n0+1,i), ldqr+1) X if ( thewk(i) > 0.d0 ) thewk(i) = 1.d0 / thewk(i) X } X # fit an initial model X for (j=1;j<=nobs;j=j+1) call dset (nobs-j+1, 0.d0, qwk(j,j), 1) X for (i=1;i<=nq;i=i+1) { X for (j=1;j<=nobs;j=j+1) X call daxpy (nobs-j+1, thewk(i), q(j,j,i), 1, qwk(j,j), 1) X } X call dcopy (nobs, y, 1, ywk, 1) X call dcore (vmu, qwk, ldqr, nobs, n0, tol, ywk, 0, limnla, nlawk,_ X scrwk, varht, info, twk, work1) X if (info != 0 ) return X call dcoef (s, lds, nobs, n0, qraux, jpvt, ywk, qwk, ldqr, nlawk,_ X c, d, info, twk) X # assign weights due to norm \theta^{2}c^{T}(Q_{i})c X call dqrsl (s, lds, nobs, n0, qraux, c, tmp, c, tmp, tmp, tmp,_ X 01000, info) X for (i=1;i<=nq;i=i+1) { X call dsymv('l', n, thewk(i), q(n0+1,n0+1,i), ldqr, c(n0+1), 1,_ X 0.d0, work1, 1) X thewk(i) = ddot (n, c(n0+1), 1, work1, 1) * thewk(i) X if ( thewk(i) > 0.d0 ) thewk(i) = dlog10 (thewk(i)) X else thewk(i) = -25.d0 X } } scrold = 1.d10 X # main process X job = 0 repeat { X # nq == 1 X if ( nq == 1 ) { X theta(1) = 0.d0 X break X } X # form Qwk = \sum_{i=1}^{nq} \thewk_{i} Q_{i} X for (j=1;j<=nobs;j=j+1) call dset (nobs-j+1, 0.d0, qwk(j,j), 1) X for (i=1;i<=nq;i=i+1) { X if ( thewk(i) <= -25.d0 ) next X for (j=1;j<=nobs;j=j+1) X call daxpy (nobs-j+1, 10.d0 ** thewk(i), q(j,j,i), 1,_ X qwk(j,j), 1) X } X # main calculation X call dcopy (nobs, y, 1, ywk, 1) X call dcore (vmu, qwk, ldqr, nobs, n0, tol, ywk, job, limnla, nlawk,_ X scrwk, varht, info, twk, work1) X if (info != 0 ) return X X # half the increment if no gain X if ( scrold < scrwk ) { X # algorithm halts X tmp = dabs (gwk1(idamax (nq, gwk1, 1))) X if ( alph * tmp > - prec ) { X info = -5 X return X } X alph = alph / 2.d0 X for (i=1;i<=nq;i=i+1) thewk(i) = theta(i) + alph * gwk1(i) X next X } X # count for one iteration X maxitwk = maxitwk - 1 X X # compute the gradient and the Hessian X call dcopy (n-2, qwk(n0+2,n0+1), ldqr+1, traux, 1) X call dcopy (n, qwk(n0+1,n0+1), ldqr+1, twk(2,1), 2) X call dcopy (n-1, qwk(n0+1,n0+2), ldqr+1, twk(1,2), 2) X call ddeev (vmu, nobs,_ X q(n0+1,n0+1,1), ldqr, ldqc, n, nq, qwk(n0+2,n0+1),_ X ldqr, traux, twk, ywk(n0+1),_ X thewk, nlawk, scrwk, varht,_ # inputs X hes, nq, gra,_ # outputs X hwk1, hwk2, gwk1, gwk2,_ X kwk, n, work1, work2, c,_ X info) X X # get the active subset X iwk = 0 X for (i=1;i<=nq;i=i+1) { X if ( thewk(i) <= -25.d0 ) next X iwk = iwk + 1 X call dcopy (nq, hes(1,i), 1, hes(1,iwk), 1) X } X iwk = 0 X for (i=1;i<=nq;i=i+1) { X if ( thewk(i) <= -25.d0 ) next X iwk = iwk + 1 X call dcopy (nq, hes(i,1), nq, hes(iwk,1), nq) X gwk1(iwk) = gra(i) X work2(iwk) = gra(i) X } X X # compute the Newton direction X for (i=1;i=1;i=i-1) { X if ( thewk(i) <= -25.0 ) gwk1(i) = 0.d0 X else { X gwk1(i) = gwk1(iwk) X iwk = iwk - 1 X } X } X call dscal (nq, 1.d0/dlog(1.d1), gwk1, 1) X tmp = dabs (gwk1(idamax (nq, gwk1, 1))) X if ( tmp > 1.d0 ) call dscal (nq, 1.d0/tmp, gwk1, 1) X X # set thewk such that nlawk = 0.d0 X for (i=1;i<=nq;i=i+1) { X if ( thewk(i) <= -25.d0 ) next X thewk(i) = thewk(i) - nlawk X } X call dcopy (nq, thewk, 1, theta, 1) X X # check convergence X tmp = gra(idamax (nq, gra, 1)) ** 2 X if ( tmp < prec ** 2_ # zero gradient X | scrold - scrwk < prec * (scrwk + 1.d0)_ # small change X & tmp < prec * (scrwk + 1.d0) ** 2 ) { # small gradient X break X } X X # fail to converge X if ( maxitwk < 1 ) { X info = -4 X return X } X X # update records X scrold = scrwk X X # increment thewk X for (i=1;i<=nq;i=i+1) thewk(i) = thewk(i) + alph * gwk1(i) X X job = -1 X limnla(1) = -1.d0 X limnla(2) = 1.d0 } # the end of the main loop X # compute the model to be returned for (j=1;j<=nobs;j=j+1) call dset (nobs-j+1, 0.d0, qwk(j,j), 1) for (i=1;i<=nq;i=i+1) { X if ( theta(i) <= -25.d0 ) next X for (j=1;j<=nobs;j=j+1) X call daxpy (nobs-j+1, 10.d0 ** theta(i), q(j,j,i), 1,_ X qwk(j,j), 1) } X call dcopy (nobs, y, 1, ywk, 1) call dcore (vmu, qwk, ldqr, nobs, n0, tol, ywk, job, limnla, nlaht,_ X score, varht, info, twk, work1) if (info != 0 ) return call dcoef (s, lds, nobs, n0, qraux, jpvt, ywk, qwk, ldqr, nlaht,_ X c, d, info, twk) X return end X #.................................................................................... SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dmudr1.r' && chmod 0644 'grkpack/rkpack/dmudr1.r' || echo 'restore of grkpack/rkpack/dmudr1.r failed' shar_count="`wc -c < 'grkpack/rkpack/dmudr1.r'`" test 10816 -eq "$shar_count" || echo "grkpack/rkpack/dmudr1.r: original size 10816, current size $shar_count" fi # ============= grkpack/rkpack/dsidr.r ============== if test -f 'grkpack/rkpack/dsidr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dsidr.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dsidr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dsidr.r' && X #:::::::::::: # dsidr #:::::::::::: X subroutine dsidr (vmu,_ X s, lds, nobs, nnull, y, q, ldq,_ # data X tol, job, limnla,_ # job requests X nlaht, score, varht, c, d,_ # output X qraux, jpvt, wk,_ # work arrays X info) # error message X # Acronym: Double precision SIngle smoothing parameter DRiver. X # Purpose: # # This routine is the double precision single smoothing parameter # driver of the RKPACK -- a minipackage for solving the equations # # ( n lambda I + Sigma ) c + S d = y # S' c = 0 , # # where Sigma is n-by-n and S is n-by-M, and lambda is the so-called # smoothing parameter chosen to minimize the GCV criterion # # (1/n) || ( I - A(lambda) ) y || ** 2 # V(lambda) = -------------------------------------- , # [ (1/n) tr ( I - A(lambda) ) ] ** 2 # # where A(lambda), satisfying # # A(lambda) y = Sigma c + S d , # # is the so-called influence matrix, OR to minimize the GML criterion # # (1/n) y' ( I - A(lambda) ) y # M(lambda) = ------------------------------------ , # det [ (I - A(lambda))+ ]^{1/(n-M)} # # where det[(...)+] is the product of nonzero eigenvalues of (...). # # The general theory behind this is described in Kimeldorf and Wahba # (1971), which seeks the minimizer of certain variational problem in # reproducing kernel hilbert space. The generalized cross validation # (GCV) method for choosing the smoothing parameter lambda is propos- # ed by Craven and Wahba (1979). The GML criterion is described and # compared with the GCV by Wahba (1985). An example of this general # scheme is the thin plate smoothing spline model, as described by # Wahba and Wendelberger (1980), and Bates et al. (1987). # # RKPACK is the implementation of the GCV/GML algorithm based on the # Householder tridiagonalization, as proposed by Gu et al. (1988). # It does not assume any structure of Sigma and S, except that S is # of full rank, Sigma is symmetric, and # # S' c = 0 ===> c' Sigma c >= 0 (*) # # The Sigma matrix is the reproducing kernel (or semi-kernel) evalu- # ated at the data points, and the matrix S is a set of null space # basis evaluated at the data points. # # Dsidr will do either golden-section search or regular grid search # for the minimizing lambda of V/M(lambda). In the goden-section # search case, it does assume bowl-shaped V/M(lambda) curve. If this # is not true, the user may specify shorter searching intervals on # which the curve may be bowl-shaped. The precision of n*lambda is # 1.d-7 in the log10 scale. In the regular grid search case, it # provides a "GCV/GML curve" on the searching interval. (For the # later case user should provide `score' as a vector, though in the # golden section search case only minimum GCV/GML value is recorded.) # # RKPACK is a cubic order package. In fitting univariate smoothing # spline models, a linear order algorithm developed independently # by Hutchinson and deHoog (1985) and by O'Sullivan (1985) is recommended. # Code by Woltring (1986) and O'Sullivan is available from NETLIB. X X character*1 vmu integer lds, nobs, nnull, ldq, job, jpvt(*), info double precision s(lds,*), y(*), q(ldq,*), tol, limnla(2), nlaht, score(*),_ X varht, c(*), d(*), qraux(*), wk(*) X X # On entry: # vmu 'v': GCV criterion. # 'm': GML criterion. # 'u': unbiased risk estimate. # s the matrix S of size (nobs,nnull). # lds the leading dimension of s. # nobs the number of observations. # nnull the dimension of the null space. # y the observations. # q the matrix Q, only the lower triangle referred. # tol tolerance for truncation in `dsytr'. If 0.d0, set to # square of machine precision. # job <=0 : golden-section search # 0 -- searching interval specified automatically. # -1 -- search on (limnla(1), limnla(2)). # >0 : regular grid search on [limnla(1), limnla(2)] # #(grids) = job + 1. # limnla the searching interval (in log10 scale), see job. # varht known variance if vmu=='u'. X # On exit: # nlaht the GCV/GML/URE estimate of log10(nobs*lambda). # limnla searching range for nlaht. # score job <= 0 : GCV/GML/URE value at nlaht. # job > 0 : GCV/GML/URE vector on the regular grid points. # varht the variance estimate. # c the parameters c. # d the parameters d. # s,qraux,jpvt # QR decomposition of S=FR, as from Linpack `dqrdc'. # q first nnull columns: F^{T} Q F_{1}. # BOTTOM-RIGHT corner: tridiagonalization of # F_{2}^{T} Q F_{2}. # info 0: normal termination. # -1: dimension error. # -2: F_{2}^{T} Q F_{2} !>= 0. # -3: vmu is out of scope. # >0: the matrix S is rank deficient: rank(S)+1. # others intact. X # Work arrays: # wk of size at least (3*nobs). X # Routines called directly: # Rkpack -- dcoef, dcore, dstup X # Routines called indirectly: # Fortran -- dexp, dfloat, dlog, dlog10, dsqrt # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal # Blas2 -- dsymv, dsyr2 # Linpack -- dpbfa, dpbsl, dqrdc, dqrsl, dtrsl # Rkpack -- deval, dgold, dqrslm, dsytr, dtrev # Other -- dprmut, dset X # Written: Chong Gu, Statistics, Purdue, latest version 12/29/91. X X info = 0 X # check dimension if ( nnull < 1 | nnull >= nobs | nobs > lds | nobs > ldq ) { X info = -1 X return } X # check vmu if ( vmu != 'v' & vmu != 'm' & vmu != 'u' ) { X info = -3 X return } X # main process X call dstup (s, lds, nobs, nnull, qraux, jpvt, y, q, ldq, nobs, 1, info,_ X wk) if ( info != 0 ) return X call dcore (vmu, q, ldq, nobs, nnull, tol, y, job, limnla, nlaht, score,_ X varht, info, wk, wk(2*nobs+1)) if ( info != 0 ) return X call dcoef (s, lds, nobs, nnull, qraux, jpvt, y, q, ldq, nlaht, c, d,_ X info, wk) X return end X #............................................................................... SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dsidr.r' && chmod 0644 'grkpack/rkpack/dsidr.r' || echo 'restore of grkpack/rkpack/dsidr.r failed' shar_count="`wc -c < 'grkpack/rkpack/dsidr.r'`" test 6896 -eq "$shar_count" || echo "grkpack/rkpack/dsidr.r: original size 6896, current size $shar_count" fi # ============= grkpack/rkpack/dqrslm.r ============== if test -f 'grkpack/rkpack/dqrslm.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dqrslm.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dqrslm.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dqrslm.r' && X #:::::::::::: # dqrslm #:::::::::::: X subroutine dqrslm (x, ldx, n, k, qraux, a, lda, job, info, work) X # Acronym: `dqrsl' Matrix version X # Purpose: This routine generates the matrix Q^{T}AQ or QAQ^{T}, where # Q is the products of Householder matrix stored in factored form in # the LOWER triangle of `x' and `qraux', and A is assumed to be # symmetric. This routine is designed to be compatible with LINPACK's # `dqrdc' subroutine. X # References: 1. Dongarra et al. (1979) LINPACK Users' Guide. (chap. 9) # 2. Golud and Van Loan (1983) Matrix Computation. (pp.276-7) X integer ldx, n, k, lda, job, info double precision x(ldx,*), qraux(*), a(lda,*), work(*) X # On entry: # x output from `dqrdc', of size (ldx,k). # ldx leading dimension of x. # n size of matrix A and Q. # k number of factors in Q. # qraux output from `dqrdc'. # a matrix A (of size (lda,n)), only LOWER triangle refered. # lda leading dimension of a. # job 0: Q^{T} A Q. # 1: Q A Q^{T}. X # On Exit: # a matrix Q^{T}AQ or QAQ^{T} in LOWER triangle. # info 0: normal termination. # 1: `job' is out of scope. # -1: dimension error. # others unchanged. X # Work array: # work of size at least (n). X # Routines called: # Blas -- ddot, daxpy # Blas2 -- dsymv, dsyr2 X # Written: Chong Gu, Statistics, UW-Madison, latest version 8/29/88. X double precision tmp, alph, ddot integer i, j, step X info = 0 X # check input if ( lda < n | n < k | k < 1 ) { X info = -1 X return } if ( job != 0 & job != 1 ) { X info = 1 X return } X # set operation sequence if ( job == 0 ) { X j = 1 X step = 1 } else { X j = k X step = -1 } X # main process while ( j >= 1 & j <= k ) { X if ( qraux(j) == 0.0d0 ) { X j = j + step X next X } X X tmp = x(j,j) X x(j,j) = qraux(j) X X # update the columns 1 thru j-1 X for (i=1;i 'grkpack/rkpack/dsms.r' && X #::::::::::: # dsms #::::::::::: X subroutine dsms (s, lds, nobs, nnull, jpvt, q, ldq, nlaht,_ X sms, ldsms, wk, info) X # Purpose: To compute the auxiliary quantity sms for posterior covariance X # Usage: Use s, qraux, jpvt, q, and nlaht returned by dsidr. X integer lds, nobs, nnull, jpvt(*), ldq, ldsms, info double precision s(lds,*), q(ldq,*), nlaht, sms(ldsms,*), wk(2,*) X # On entry: # s,jpvt QR-decomposition of S = F R. # nobs number of observations. # nnull dimension of null space. # q U^{T} F_{2}^{T} Q F_{2} U in BOTTOM-RIGHT corner's # LOWER triangle and SUPER DIAGONAL; # F_{2}^{T} Q F_{1} in BOTTOM-LEFT corner; # F_{1}^{T} Q F_{1} in UPPER-LEFT corner's LOWER triangle. # ldq leading dimension of q. # nlaht estimated log10(n*lambda). X # On exit: # sms (S^{T}M^{-1}S)^{-1}. # info 0: normal termination. # >0: S is not of full rank: rank(S)+1 . # -1: dimension error. # -2: F_{2}^{T} Q F_{2} is not non-negative definite. # inputs intact but UPPER-RIGHT corner of q was used as work array. X # Work array: # wk of size at least (2,nobs-nnull). X # Routines called directly: # Blas -- daxpy, dcopy, ddot # Linpack -- dpbfa, dpbsl, dqrsl, dtrsl # Other -- dprmut, dset X # Written: Chong Gu, Statistics, Purdue, latest version 4/17/92. X double precision dum, ddot integer i, j, n, n0 X info = 0 X # check dimension if ( nnull < 1 | nnull >= nobs | nobs > lds | nobs > ldq | ldsms < nnull ) { X info = -1 X return } X # set working parameters n0 = nnull n = nobs - nnull X # compute sms X # U^{T} (F_{2}^{T} Q F_{1}) call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) for (j=1;j<=n0;j=j+1) { X call dcopy (n, q(n0+1,j), 1, q(j,n0+1), ldq) X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, q(n0+2,j), dum, X q(n0+2,j), dum, dum, dum, 01000, info) } # U^{T} (F_{2}^{T}QF_{2} + n lambda I)^{-1} (F_{2}^{T}QF_{1}) call dset (n, 10.d0 ** nlaht, wk(2,1), 2) call daxpy (n, 1.d0, q(n0+1,n0+1), ldq+1, wk(2,1), 2) call dcopy (n-1, q(n0+1,n0+2), ldq+1, wk(1,2), 2) call dpbfa (wk, 2, n, 1, info) if ( info != 0 ) { X info = -2 X return } for (j=1;j<=n0;j=j+1) call dpbsl (wk, 2, n, 1, q(n0+1,j)) # (F_{2}^{T}QF_{2} + n lambda I)^{-1} (F_{2}^{T}QF_{1}) call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) for (j=1;j<=n0;j=j+1) { X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, q(n0+2,j), q(n0+2,j),_ X dum, dum, dum, dum, 10000, info) } # (F_{1}^{T}QF_{1} + n lambda I) - # (F_{1}^{T}QF_{2}^{T}) (F_{2}^{T}QF_{2} + n lambda I)^{-1} (F_{2}^{T}QF_{1}) for (i=1;i<=n0;i=i+1) { X for (j=1;j 'grkpack/rkpack/README' && X This directory collects RKPACK routines in RATFOR and FORTRAN written by Dr. Chong Gu. RKPACK is available at statlib@lib.stat.cmu. The RATFOR routines are self-documented and the FORTRAN routines were translated from the corresponding RATFOR routines using `ratfor' under standard UNIX system. The user interface is via two drivers DSIDR, DMUDR, and two utility routines DCRDR and DSMS. The routines are based on a set of public domain routines from BLAS, BLAS2, and LINPACK collected in ../lib/. Run `make' under standard UNIX system to compile and archive the *.o files in rkpack.a. X Yuedong Wang January 16, 1995 X SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/README' && chmod 0644 'grkpack/rkpack/README' || echo 'restore of grkpack/rkpack/README failed' shar_count="`wc -c < 'grkpack/rkpack/README'`" test 625 -eq "$shar_count" || echo "grkpack/rkpack/README: original size 625, current size $shar_count" fi # ============= grkpack/rkpack/dstup.r ============== if test -f 'grkpack/rkpack/dstup.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dstup.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dstup.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dstup.r' && X #::::::::::: # dstup #::::::::::: X subroutine dstup (s, lds, nobs, nnull, qraux, jpvt, y, q, ldqr, ldqc, nq,_ X info, work) X # Purpose: To perform QR decomposition of S=FR and to form F^{T}y, F^{T}QF's. X integer lds, nobs, nnull, jpvt(*), ldqr, ldqc, nq, info double precision s(lds,*), y(*), qraux(*), q(ldqr,ldqc,*), work(*) X # On entry: # s the S matrix spanning null space, of size (lds,nnull). # lds leading dimension of s. # nobs number of observations. # nnull dimension of null space. # y observations, of size (nobs). # q the reproducing kernels, of size (ldqr,ldqc,nq). # ldqr leading dimension for rows of q. # ldqc leading dimension for columns of q. # nq number of Q's. X # On exit: # s,qraux,jpvt # QR decomposition of S=FR. # y F^{T} y. # q F^{T}QF's. # info 0: normal termination. # -1: dimension error. # >0: rank(S)+1. X # Work array: # work of size at least (nobs). X # Routines called directly: # Linpack -- dqrdc, dqrsl # Rkpack -- dqrslm X # Written: Chong Gu, Statistics, Purdue, latest version 3/7/91. X double precision dum integer j X info = 0 X # check dimension if ( nobs < 1 | nobs > lds | nobs > ldqr | nobs > ldqc ) { X info = -1 X return } X # QR decomposition of S=FR X # The indented line below is added on Mar 7, 1991, X # with credit to Dick Franke X for (j=1;j<=nnull;j=j+1) jpvt(j) = 0 call dqrdc (s, lds, nobs, nnull, qraux, jpvt, work, 1) X # F^{T} y; test rank of R call dqrsl (s, lds, nobs, nnull, qraux, y, dum, y, work, dum, dum, 01100,_ X info) if ( info != 0 ) return X # F^{T} Q_{*} F for (j=1;j<=nq;j=j+1) { X call dqrslm (s, lds, nobs, nnull, qraux, q(1,1,j), ldqr, 0, info,_ X work) } X return end X #............................................................................... X SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dstup.r' && chmod 0644 'grkpack/rkpack/dstup.r' || echo 'restore of grkpack/rkpack/dstup.r failed' shar_count="`wc -c < 'grkpack/rkpack/dstup.r'`" test 2055 -eq "$shar_count" || echo "grkpack/rkpack/dstup.r: original size 2055, current size $shar_count" fi # ============= grkpack/rkpack/dsytr.r ============== if test -f 'grkpack/rkpack/dsytr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dsytr.r (File already exists)' else echo 'x - extracting grkpack/rkpack/dsytr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dsytr.r' && X #::::::::::: # dsytr #::::::::::: X subroutine dsytr (x, ldx, n, tol, info, work) X # Acronym: Double-precision SYmmetric matrix TRidiagonalization. X # Purpose: This routine performs the Householder tridiagonalization # algorithm on symmetric matrix `x', with truncation strategy as # described in Gu, Bates, Chen, and Wahba (1988). X # References: 1. Golud and Van Loan (1983) Matrix Computation. (pp.276-7) # 2. Gu, Bates, Chen, and Wahba(1988), TR#823, Stat, UW-M. # 3. Dongarra et al.(1979) LINPACK User's Guide. (Chap. 9) X # Relation with LINPACK: This routine computes the tridiagonalization # U^{T}XU=T, where X is symmetric, T is tridiagonal, and U is an # orthogonal matrix as the product of Housholder matrices. To compute # U^{T}y or Uy for vector y, we can use routine `dqrsl' of LINPACK. # The calling procedure is: # # 1. Create vector `qraux' by # call dcopy(n-2, x(2,1), ldx+1, qraux, 1) # 2. Call `dqrsl' as # call dqrsl (x(2,1), ldx, n-1, n-2, qraux, y(2), ... ) X integer ldx, n, info double precision x(ldx,*), tol, work(*) X # On entry: # x symmetric matrix, only LOWER triangle refered. # ldx leading dimension of x. # n size of matrix `x'. # tol truncation tolarence; if zero, set to square machine # precision. X # On Exit: # x diagonal: diagonal elements of tridiag. transf. # upper triangle: off-diagonal of tridiag. transf. # lower triangle: overwritten by Householder factors. # info 0 : normal termination. # -1 : dimension error. X # Work array: # work of size at least (n). X # Routines called directly: # Fortran -- dfloat, dsqrt # Blas -- daxpy, ddot, dscal # Blas2 -- dsymv, dsyr2 X # Written: Chong Gu, Statistics, UW-Madison, latest version 8/29/88. X double precision nrmtot, nrmxj, alph, toltot, tolcum, toluni, dn, ddot integer j X info = 0 X # check dimension if ( ldx < n | n <= 2 ) { X info = -1 X return } X # total Frobenius norm nrmtot = ddot (n, x, ldx+1, x, ldx+1) for ( j=1 ; j 1.d0 ) toltot = toltot / 2.d0 toltot = 4.d0 * toltot ** 2 X # set truncation criterion if ( toltot < tol ) toltot = tol toltot = toltot * nrmtot dn = dfloat (n) toluni = toltot * 6.d0 / dn / ( dn - 1.d0 ) / ( 2.d0 * dn - 1.d0 ) X # initialization tolcum = 0.d0 X # main process X for ( j=1 ; j 'grkpack/rkpack/dtrev.r' && X #::::::::::: # dtrev #::::::::::: X subroutine dtrev (vmu, t, ldt, n, z, score, varht, info, work) X # Acronym: Double-precision TRidiagonal EValuation. X # Purpose: To compute the GCV/GML function and the related variance # estimate from the tridiagonal matrix `t' and data vector `z'. X # References: 1. Gu, Bates, Chen, and Wahba(1988), TR#823, Stat, UW-M. # 2. Dongarra et al. (1979) LINPACK User's Guide. (Chap. 4) X character*1 vmu integer n, info double precision t(ldt,*), z(*), score, varht, work(*) X # On entry: # vmu 'v': GCV. # 'm': GML. # 'u': unbiased risk estimate. # t the positive definite tridiagonal matrix T, # stored in packed form: # t(1,2:n): off-diagonal # t(2,1:n): diagonal. # ldt leading dimension of t. # n the dimension of the matrix. # z the appropriately transformed data vector. # varht known variance if vmu=='u'. X # On exit: # score the GCV/GML/URE score. # varht \hat\sigma^{2}. # info -3: vmu is none of 'v', 'm', or 'u'. # > -3: as from LINPACK's `dpbfa'. X # Work array: # work of size at least (n). X # Routines called directly: # Fortran -- dexp, dfloat, dlog # Blas -- dasum, dcopy, ddot, dscal # Linpack -- dpbfa, dpbsl X # Written: Chong Gu, Statistics, UW-Madison, latest version 12/29/91. X double precision nume, deno, tmp, alph, la, dasum, ddot integer j X info = 0 X # check vmu if ( vmu != 'v' & vmu != 'm' & vmu != 'u' ) { X info = -3 X return } X la = t(1,1) X # standardize the matrix for numerical stability alph = dfloat (n) / dasum (n, t(2,1), ldt) call dscal (n, alph, t(2,1), ldt) call dscal (n-1, alph, t(1,2), ldt) X # decomposition call dpbfa (t, ldt, n, 1, info) if ( info != 0 ) return X call dcopy (n, z, 1, work, 1) call dpbsl (t, ldt, n, 1, work) X # GCV computation if ( vmu == 'v' ) { X tmp = 1.d0 / t(2,n) / t(2,n) X deno = tmp X for (j=n-1;j>0;j=j-1) { X tmp = ( 1.d0 + t(1,j+1) * t(1,j+1) * tmp ) / t(2,j) / t(2,j) X deno = deno + tmp X } X nume = ddot (n, work, 1, work, 1) / dfloat (n) X deno = deno / dfloat (n) X varht = alph * la * nume / deno X score = nume / deno / deno } X # GML computation if ( vmu == 'm' ) { X deno = dlog (t(2,n)) X for (j=n-1;j>0;j=j-1) deno = deno + dlog (t(2,j)) X nume = ddot (n, z, 1, work, 1) / dfloat (n) X varht = alph * la * nume X score = nume * dexp (2.d0 * deno / dfloat (n)) } X # unbiased risk computation if ( vmu == 'u' ) { X nume = ddot (n, work, 1, work, 1) / dfloat (n) X tmp = 1.d0 / t(2,n) / t(2,n) X deno = tmp X for (j=n-1;j>0;j=j-1) { X tmp = ( 1.d0 + t(1,j+1) * t(1,j+1) * tmp ) / t(2,j) / t(2,j) X deno = deno + tmp X } X deno = deno / dfloat (n) X score = alph * alph * la * la * nume - 2.d0 * varht * alph * la * deno } X return end X #............................................................................... SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dtrev.r' && chmod 0644 'grkpack/rkpack/dtrev.r' || echo 'restore of grkpack/rkpack/dtrev.r failed' shar_count="`wc -c < 'grkpack/rkpack/dtrev.r'`" test 3127 -eq "$shar_count" || echo "grkpack/rkpack/dtrev.r: original size 3127, current size $shar_count" fi # ============= grkpack/rkpack/dcoef.f ============== if test -f 'grkpack/rkpack/dcoef.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dcoef.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dcoef.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dcoef.f' && X subroutine dcoef (s, lds, nobs, nnull, qraux, jpvt, z, q, ldq, X &nlaht, c, d, info, twk) X integer lds, nobs, nnull, jpvt(*), ldq, info X double precision s(lds,*), qraux(*), z(*), q(ldq,*), nlaht, c(*), X &d(*), twk(2,*) X double precision dum, ddot X integer n, n0 X info = 0 X if(.not.( nnull .lt. 1 .or. nnull .ge. nobs .or. nobs .gt. lds X &.or. nobs .gt. ldq ))goto 23000 X info = -1 X return 23000 continue X n0 = nnull X n = nobs - nnull X call dset (n, 10.d0 ** nlaht, twk(2,1), 2) X call daxpy (n, 1.d0, q(n0+1,n0+1), ldq+1, twk(2,1), 2) X call dcopy (n-1, q(n0+1,n0+2), ldq+1, twk(1,2), 2) X call dpbfa (twk, 2, n, 1, info) X if(.not.( info .ne. 0 ))goto 23002 X info = -2 X return 23002 continue X call dpbsl (twk, 2, n, 1, z(n0+1)) X call dcopy (n-2, q(n0+2,n0+1), ldq+1, twk, 1) X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, twk, z(n0+2), z(n0+2), X &dum, dum, dum, dum, 10000, info) X call dset (n0, 0.d0, c, 1) X call dcopy (n, z(n0+1), 1, c(n0+1), 1) X call dqrsl (s, lds, nobs, nnull, qraux, c, c, dum, dum, dum, dum, X &10000, info) X j=1 23004 if(.not.(j.le.n0))goto 23006 X d(j) = z(j) - ddot (n, z(n0+1), 1, q(n0+1,j), 1) X j=j+1 X goto 23004 23006 continue X call dtrsl (s, lds, n0, d, 01, info) X call dprmut (d, n0, jpvt, 1) X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dcoef.f' && chmod 0644 'grkpack/rkpack/dcoef.f' || echo 'restore of grkpack/rkpack/dcoef.f failed' shar_count="`wc -c < 'grkpack/rkpack/dcoef.f'`" test 1413 -eq "$shar_count" || echo "grkpack/rkpack/dcoef.f: original size 1413, current size $shar_count" fi # ============= grkpack/rkpack/dcore.f ============== if test -f 'grkpack/rkpack/dcore.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dcore.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dcore.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dcore.f' && X subroutine dcore (vmu, q, ldq, nobs, nnull, tol, z, job, limnla, X &nlaht, score, varht, info, twk, work) X character*1 vmu X integer ldq, nobs, nnull, job, info X double precision q(ldq,*), tol, z(*), limnla(2), nlaht, score(*), X &varht, twk(2,*), work(*) X double precision dum, low, upp, dasum, mchpr X integer n0, n, j X info = 0 X if(.not.( vmu .ne. 'v' .and. vmu .ne. 'm' .and. vmu .ne. 'u' )) X &goto 23000 X info = -3 X return 23000 continue X if(.not.( nnull .lt. 1 .or. nobs .le. nnull .or. nobs .gt. ldq )) X &goto 23002 X info = -1 X return 23002 continue X n0 = nnull X n = nobs - nnull X call dsytr (q(n0+1,n0+1), ldq, n, tol, info, work) X if(.not.( info .ne. 0 ))goto 23004 X return 23004 continue X call dcopy (n-2, q(n0+2,n0+1), ldq+1, work, 1) X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, work, z(n0+2), dum, z(n0+ X &2), dum, dum, dum, 01000, info) X if(.not.( job .eq. 0 ))goto 23006 X mchpr = 1.d0 23008 if(.not.( 1.d0 + mchpr .gt. 1.d0 ))goto 23009 X mchpr = mchpr / 2.d0 X goto 23008 23009 continue X mchpr = mchpr * 2.d0 X limnla(2) = dmax1 (dasum (n, q(n0+1,n0+1), ldq+1) * 1.d2, mchpr) X limnla(1) = limnla(2) * mchpr X limnla(2) = dlog10 (limnla(2)) X limnla(1) = dlog10 (limnla(1)) 23006 continue X low = limnla(1) X upp = limnla(2) X if(.not.( job .le. 0 ))goto 23010 X call dgold (vmu, q(n0+1,n0+1), ldq, n, z(n0+1), low, upp, nlaht, X &score(1), varht, info, twk, work) X if(.not.( vmu .eq. 'v' ))goto 23012 X score(1) = score(1) * dfloat (nobs) / dfloat (n) 23012 continue X if(.not.( vmu .eq. 'm' ))goto 23014 X score(1) = score(1) * dfloat (n) / dfloat (nobs) 23014 continue X if(.not.( vmu .eq. 'u' ))goto 23016 X score(1) = score(1) * dfloat (n) / dfloat (nobs) + 2.d0 * varht 23016 continue X goto 23011 23010 continue X call deval (vmu, q(n0+1,n0+1), ldq, n, z(n0+1), job, low, upp, X &nlaht, score, varht, info, twk, work) X dum = dfloat (nobs) / dfloat (n) X j=1 23018 if(.not.(j.le.job+1))goto 23020 X if(.not.( vmu .eq. 'v' ))goto 23021 X score(j) = score(j) * dum 23021 continue X if(.not.( vmu .eq. 'm' ))goto 23023 X score(j) = score(j) / dum 23023 continue X if(.not.( vmu .eq. 'u' ))goto 23025 X score(j) = score(j) / dum + 2.d0 * varht 23025 continue X j=j+1 X goto 23018 23020 continue 23011 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dcore.f' && chmod 0644 'grkpack/rkpack/dcore.f' || echo 'restore of grkpack/rkpack/dcore.f failed' shar_count="`wc -c < 'grkpack/rkpack/dcore.f'`" test 2504 -eq "$shar_count" || echo "grkpack/rkpack/dcore.f: original size 2504, current size $shar_count" fi # ============= grkpack/rkpack/dcrdr.f ============== if test -f 'grkpack/rkpack/dcrdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dcrdr.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dcrdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dcrdr.f' && X subroutine dcrdr (s, lds, nobs, nnull, qraux, jpvt, q, ldq, nlaht, X & r, ldr, nr, cr, ldcr, dr, lddr, wk, info) X integer lds, nobs, nnull, jpvt(*), ldq, ldr, nr, ldcr, lddr, info X double precision s(lds,*), qraux(*), q(ldq,*), nlaht, r(ldr,*), X &cr(ldcr,*), dr(lddr,*), wk(2,*) X double precision dum, ddot X integer i, j, n, n0 X info = 0 X if(.not.( nnull .lt. 1 .or. nnull .ge. nobs .or. nobs .gt. lds X &.or. nobs .gt. ldq .or. ldr .lt. nobs .or. nr .lt. 1 .or. ldcr X &.lt. nobs .or. lddr .lt. nnull ))goto 23000 X info = -1 X return 23000 continue X n0 = nnull X n = nobs - nnull X call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) X j=1 23002 if(.not.(j.le.nr))goto 23004 X call dqrsl (s, lds, nobs, nnull, qraux, r(1,j), dum, r(1,j), dum, X &dum, dum, 01000, info) X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, r(n0+2,j), dum, r(n0+ X &2,j), dum, dum, dum, 01000, info) X j=j+1 X goto 23002 23004 continue X call dset (n, 10.d0 ** nlaht, wk(2,1), 2) X call daxpy (n, 1.d0, q(n0+1,n0+1), ldq+1, wk(2,1), 2) X call dcopy (n-1, q(n0+1,n0+2), ldq+1, wk(1,2), 2) X call dpbfa (wk, 2, n, 1, info) X if(.not.( info .ne. 0 ))goto 23005 X info = -2 X return 23005 continue X j=1 23007 if(.not.(j.le.nr))goto 23009 X call dpbsl (wk, 2, n, 1, r(n0+1,j)) X j=j+1 X goto 23007 23009 continue X call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) X j=1 23010 if(.not.(j.le.nr))goto 23012 X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, r(n0+2,j), r(n0+2,j), X & dum, dum, dum, dum, 10000, info) X j=j+1 X goto 23010 23012 continue X j=1 23013 if(.not.(j.le.nr))goto 23015 X call dset (n0, 0.d0, cr(1,j), 1) X call dcopy (n, r(n0+1,j), 1, cr(n0+1,j), 1) X call dqrsl (s, lds, nobs, nnull, qraux, cr(1,j), cr(1,j), dum, X &dum, dum, dum, 10000, info) X j=j+1 X goto 23013 23015 continue X j=1 23016 if(.not.(j.le.nr))goto 23018 X i=1 23019 if(.not.(i.le.n0))goto 23021 X dr(i,j) = r(i,j) - ddot (n, r(n0+1,j), 1, q(n0+1,i), 1) X i=i+1 X goto 23019 23021 continue X call dtrsl (s, lds, n0, dr(1,j), 01, info) X call dprmut (dr(1,j), n0, jpvt, 1) X j=j+1 X goto 23016 23018 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dcrdr.f' && chmod 0644 'grkpack/rkpack/dcrdr.f' || echo 'restore of grkpack/rkpack/dcrdr.f failed' shar_count="`wc -c < 'grkpack/rkpack/dcrdr.f'`" test 2311 -eq "$shar_count" || echo "grkpack/rkpack/dcrdr.f: original size 2311, current size $shar_count" fi # ============= grkpack/rkpack/ddeev.f ============== if test -f 'grkpack/rkpack/ddeev.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/ddeev.f (File already exists)' else echo 'x - extracting grkpack/rkpack/ddeev.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/ddeev.f' && X subroutine ddeev (vmu, nobs, q, ldqr, ldqc, n, nq, u, ldu, uaux, X &t, x, theta, nlaht, score, varht, hes, ldh, gra, hwk1, hwk2, gwk1, X & gwk2, kwk, ldk, work1, work2, work3, info) X character*1 vmu X integer nobs, ldqr, ldqc, n, nq, ldu, ldh, ldk, info X double precision q(ldqr,ldqc,*), u(ldu,*), uaux(*), t(2,*), x(*), X &theta(*), nlaht, score, varht, hes(ldh,*), gra(*), hwk1(nq,*), X &hwk2(nq,*), gwk1(*), gwk2(*), kwk(ldk,ldk,*), work1(*), work2(*), X &work3(*) X double precision trc, det, dum, ddot X integer i, j, m X info = 0 X call dset (nq, 0.d0, gra, 1) X call dset (nq*nq, 0.d0, hes, 1) X if(.not.( vmu .ne. 'v' .and. vmu .ne. 'm' .and. vmu .ne. 'u' )) X &goto 23000 X info = -3 X return 23000 continue X if(.not.( nobs .lt. n .or. ldqr .lt. n .or. ldqc .lt. n .or. nq X &.le. 0 .or. ldu .lt. n-1 .or. ldh .lt. nq .or. ldk .lt. n ))goto 2 X &3002 X info = -1 X return 23002 continue X i=2 23004 if(.not.(i.le.nq))goto 23006 X if(.not.( theta(i) .le. -25.d0 ))goto 23007 X goto 23005 23007 continue X j=1 23009 if(.not.(j.le.n))goto 23011 X call dcopy (n-j+1, q(j,j,i), 1, kwk(j,j,i), 1) X call dscal (n-j+1, 10.d0 ** theta(i), kwk(j,j,i), 1) X j=j+1 X goto 23009 23011 continue X call dqrslm (u, ldu, n-1, n-2, uaux, kwk(2,2,i), n, 0, info, X &work1) X call dqrsl (u, ldu, n-1, n-2, uaux, kwk(2,1,i), dum, kwk(2,1,i), X &dum, dum, dum, 01000, info) 23005 i=i+1 X goto 23004 23006 continue X call dcopy (n, t(2,1), 2, kwk(1,1,1), n+1) X call dcopy (n-1, t(1,2), 2, kwk(2,1,1), n+1) X j=1 23012 if(.not.(j.lt.n-1))goto 23014 X call dset (n-j-1, 0.d0, kwk(j+2,j,1), 1) X j=j+1 X goto 23012 23014 continue X i=2 23015 if(.not.(i.le.nq))goto 23017 X if(.not.( theta(i) .le. -25.d0 ))goto 23018 X goto 23016 23018 continue X j=1 23020 if(.not.(j.le.n))goto 23022 X call daxpy (n-j+1, -1.d0, kwk(j,j,i), 1, kwk(j,j,1), 1) X j=j+1 X goto 23020 23022 continue 23016 i=i+1 X goto 23015 23017 continue X i=1 23023 if(.not.(i.le.nq))goto 23025 X if(.not.( theta(i) .le. -25.d0 ))goto 23026 X goto 23024 23026 continue X j=1 23028 if(.not.(j.lt.n))goto 23030 X call dcopy (n-j, kwk(j+1,j,i), 1, kwk(j,j+1,i), n) X j=j+1 X goto 23028 23030 continue 23024 i=i+1 X goto 23023 23025 continue X call dset (n, 10.d0 ** nlaht, work1, 1) X call daxpy (n, 1.d0, work1, 1, t(2,1), 2) X call dpbfa (t, 2, n, 1, info) X if(.not.( info .ne. 0 ))goto 23031 X info = -2 X return 23031 continue X i=1 23033 if(.not.(i.le.nq))goto 23035 X if(.not.( theta(i) .le. -25.d0 ))goto 23036 X goto 23034 23036 continue X j=1 23038 if(.not.(j.le.n))goto 23040 X call dpbsl (t, 2, n, 1, kwk(1,j,i)) X j=j+1 X goto 23038 23040 continue 23034 i=i+1 X goto 23033 23035 continue X call dcopy (n, x, 1, work1, 1) X call dpbsl (t, 2, n, 1, work1) X if(.not.( vmu .ne. 'm' ))goto 23041 X call dcopy (n, work1, 1, work2, 1) X call dscal (n, 2.d0, work2, 1) X goto 23042 23041 continue X call dcopy (n, x, 1, work2, 1) 23042 continue X i=1 23043 if(.not.(i.le.nq))goto 23045 X if(.not.( theta(i) .le. -25.d0 ))goto 23046 X goto 23044 23046 continue X call dgemv ('t', n, n, 1.d0, kwk(1,1,i), n, work2, 1, 0.d0, work3, X & 1) X gwk1(i) = - ddot (n, work1, 1, work3, 1) 23044 i=i+1 X goto 23043 23045 continue X i=1 23048 if(.not.(i.le.nq))goto 23050 X gwk2(i) = 0.d0 X if(.not.( theta(i) .le. -25.d0 ))goto 23051 X goto 23049 23051 continue X j=1 23053 if(.not.(j.le.n))goto 23055 X if(.not.( vmu .ne. 'm' ))goto 23056 X call dcopy (n, kwk(1,j,i), 1, work1, 1) X call dpbsl (t, 2, n, 1, work1) X gwk2(i) = gwk2(i) - work1(j) X goto 23057 23056 continue X gwk2(i) = gwk2(i) - kwk(j,j,i) 23057 continue X j=j+1 X goto 23053 23055 continue 23049 i=i+1 X goto 23048 23050 continue X if(.not.( vmu .ne. 'm' ))goto 23058 X call dcopy (n, x, 1, work1, 1) X call dpbsl (t, 2, n, 1, work1) X i=1 23060 if(.not.(i.le.nq))goto 23062 X if(.not.( theta(i) .le. -25.d0 ))goto 23063 X goto 23061 23063 continue X call dgemv ('n', n, n, 1.d0, kwk(1,1,i), n, work1, 1, 0.d0, work2, X & 1) X j=1 23065 if(.not.(j.le.i))goto 23067 X if(.not.( theta(j) .le. -25.d0 ))goto 23068 X goto 23066 23068 continue X call dgemv ('n', n, n, 1.d0, kwk(1,1,j), n, work1, 1, 0.d0, work3, X & 1) X hwk1(i,j) = 2.d0 * ddot (n, work2, 1, work3, 1) X call dgemv ('t', n, n, 1.d0, kwk(1,1,j), n, work1, 1, 0.d0, work3, X & 1) X hwk1(i,j) = hwk1(i,j) + 2.d0 * ddot (n, work2, 1, work3, 1) 23066 j=j+1 X goto 23065 23067 continue X call dgemv ('t', n, n, 1.d0, kwk(1,1,i), n, work1, 1, 0.d0, work2, X & 1) X j=1 23070 if(.not.(j.le.i))goto 23072 X if(.not.( theta(j) .le. -25.d0 ))goto 23073 X goto 23071 23073 continue X call dgemv ('n', n, n, 1.d0, kwk(1,1,j), n, work1, 1, 0.d0, work3, X & 1) X hwk1(i,j) = hwk1(i,j) + 2.d0 * ddot (n, work2, 1, work3, 1) 23071 j=j+1 X goto 23070 23072 continue 23061 i=i+1 X goto 23060 23062 continue X goto 23059 23058 continue X call dcopy (n, x, 1, work1, 1) X call dpbsl (t, 2, n, 1, work1) X i=1 23075 if(.not.(i.le.nq))goto 23077 X if(.not.( theta(i) .le. -25.d0 ))goto 23078 X goto 23076 23078 continue X call dgemv ('n', n, n, 1.d0, kwk(1,1,i), n, work1, 1, 0.d0, work2, X & 1) X j=1 23080 if(.not.(j.le.i))goto 23082 X if(.not.( theta(j) .le. -25.d0 ))goto 23083 X goto 23081 23083 continue X call dgemv ('t', n, n, 1.d0, kwk(1,1,j), n, x, 1, 0.d0, work3, 1) X hwk1(i,j) = 2.d0 * ddot (n, work2, 1, work3, 1) 23081 j=j+1 X goto 23080 23082 continue 23076 i=i+1 X goto 23075 23077 continue 23059 continue X i=1 23085 if(.not.(i.le.nq))goto 23087 X if(.not.( theta(i) .le. -25.d0 ))goto 23088 X goto 23086 23088 continue X hwk1(i,i) = hwk1(i,i) + gwk1(i) 23086 i=i+1 X goto 23085 23087 continue X i=1 23090 if(.not.(i.le.nq))goto 23092 X if(.not.( theta(i) .le. -25.d0 ))goto 23093 X goto 23091 23093 continue X m=1 23095 if(.not.(m.le.i))goto 23097 X hwk2(i,m) = 0.d0 X if(.not.( theta(m) .le. -25.d0 ))goto 23098 X goto 23096 23098 continue X j=1 23100 if(.not.(j.le.n))goto 23102 X if(.not.( vmu .ne. 'm' ))goto 23103 X call dcopy (n, kwk(1,j,m), 1, work1, 1) X call dpbsl (t, 2, n, 1, work1) X hwk2(i,m) = hwk2(i,m) + 2.d0 * ddot (n, kwk(j,1,i), n, work1, 1) X goto 23104 23103 continue X hwk2(i,m) = hwk2(i,m) + ddot (n, kwk(j,1,i), n, kwk(1,j,m), 1) 23104 continue X j=j+1 X goto 23100 23102 continue 23096 m=m+1 X goto 23095 23097 continue 23091 i=i+1 X goto 23090 23092 continue X i=1 23105 if(.not.(i.le.nq))goto 23107 X if(.not.( theta(i) .le. -25.d0 ))goto 23108 X goto 23106 23108 continue X hwk2(i,i) = hwk2(i,i) + gwk2(i) 23106 i=i+1 X goto 23105 23107 continue X if(.not.( vmu .eq. 'v' ))goto 23110 X trc = dfloat (nobs) * 10.d0 ** (-nlaht) * varht / score X i=1 23112 if(.not.(i.le.nq))goto 23114 X if(.not.( theta(i) .le. -25.d0 ))goto 23115 X goto 23113 23115 continue X gra(i) = gwk1(i) / trc / trc - 2.d0 * score * gwk2(i) / trc / X &dfloat(nobs) 23113 i=i+1 X goto 23112 23114 continue X call dscal (nq, dfloat (nobs), gra, 1) 23110 continue X if(.not.( vmu .eq. 'u' ))goto 23117 X dum = 10.d0 ** nlaht X i=1 23119 if(.not.(i.le.nq))goto 23121 X if(.not.( theta(i) .le. -25.d0 ))goto 23122 X goto 23120 23122 continue X gra(i) = dum * dum * gwk1(i) - 2.d0 * varht * dum * gwk2(i) 23120 i=i+1 X goto 23119 23121 continue X call dscal (nq, 1.d0/dfloat (n), gra, 1) 23117 continue X if(.not.( vmu .eq. 'm' ))goto 23124 X det = 10.d0 ** (-nlaht) * varht / score X i=1 23126 if(.not.(i.le.nq))goto 23128 X if(.not.( theta(i) .le. -25.d0 ))goto 23129 X goto 23127 23129 continue X gra(i) = gwk1(i) / det - dfloat (nobs) / dfloat (n) * score * X &gwk2(i) 23127 i=i+1 X goto 23126 23128 continue X call dscal (nq, 1.d0 / dfloat (nobs), gra, 1) 23124 continue X if(.not.( vmu .eq. 'v' ))goto 23131 X i=1 23133 if(.not.(i.le.nq))goto 23135 X if(.not.( theta(i) .le. -25.d0 ))goto 23136 X goto 23134 23136 continue X j=1 23138 if(.not.(j.le.i))goto 23140 X if(.not.( theta(j) .le. -25.d0 ))goto 23141 X goto 23139 23141 continue X hes(i,j) = hwk1(i,j) / trc / trc - 2.d0 * gwk1(i) * gwk2(j) / trc X &** 3 - 2.d0 * gwk1(j) * gwk2(i) / trc ** 3 - 2.d0 * score * hwk2( X &i,j) / trc / dfloat (nobs) + 6.d0 * score * gwk2(i) * gwk2(j) / X &trc / trc / dfloat (nobs) 23139 j=j+1 X goto 23138 23140 continue X call dscal (i, dfloat (nobs), hes(i,1), ldh) 23134 i=i+1 X goto 23133 23135 continue 23131 continue X if(.not.( vmu .eq. 'u' ))goto 23143 X i=1 23145 if(.not.(i.le.nq))goto 23147 X if(.not.( theta(i) .le. -25.d0 ))goto 23148 X goto 23146 23148 continue X j=1 23150 if(.not.(j.le.i))goto 23152 X if(.not.( theta(j) .le. -25.d0 ))goto 23153 X goto 23151 23153 continue X hes(i,j) = dum * dum * hwk1(i,j) - 2.d0 * varht * dum * hwk2(i,j) 23151 j=j+1 X goto 23150 23152 continue X call dscal (i, 1.d0/dfloat (n), hes(i,1), ldh) 23146 i=i+1 X goto 23145 23147 continue 23143 continue X if(.not.( vmu .eq. 'm' ))goto 23155 X i=1 23157 if(.not.(i.le.nq))goto 23159 X if(.not.( theta(i) .le. -25.d0 ))goto 23160 X goto 23158 23160 continue X j=1 23162 if(.not.(j.le.i))goto 23164 X if(.not.( theta(j) .le. -25.d0 ))goto 23165 X goto 23163 23165 continue X hes(i,j) = hwk1(i,j) / det - gwk1(i) * gwk2(j) / det / dfloat (n) X &- gwk1(j) * gwk2(i) / det / dfloat (n) - dfloat (nobs) / dfloat ( X &n) * score * hwk2(i,j) + dfloat (nobs) / dfloat (n) ** 2 * score * X & gwk2(i) * gwk2(j) 23163 j=j+1 X goto 23162 23164 continue X call dscal (i, 1.d0 / dfloat (nobs), hes(i,1), ldh) 23158 i=i+1 X goto 23157 23159 continue 23155 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/ddeev.f' && chmod 0644 'grkpack/rkpack/ddeev.f' || echo 'restore of grkpack/rkpack/ddeev.f failed' shar_count="`wc -c < 'grkpack/rkpack/ddeev.f'`" test 10264 -eq "$shar_count" || echo "grkpack/rkpack/ddeev.f: original size 10264, current size $shar_count" fi # ============= grkpack/rkpack/deval.f ============== if test -f 'grkpack/rkpack/deval.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/deval.f (File already exists)' else echo 'x - extracting grkpack/rkpack/deval.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/deval.f' && X subroutine deval (vmu, q, ldq, n, z, nint, low, upp, nlaht, score, X & varht, info, twk, work) X character*1 vmu X integer ldq, n, nint, info X double precision q(ldq,*), z(*), low, upp, nlaht, score(*), varht, X & twk(2,*), work(*) X double precision tmp, minscr, mlo, varhtwk X integer j X info = 0 X if(.not.( upp .lt. low ))goto 23000 X mlo = low X low = upp X upp = mlo 23000 continue X if(.not.( (vmu .ne. 'v' .and. vmu .ne. 'm' .and. vmu .ne. 'u') X &.or. nint .lt. 1 ))goto 23002 X info = -3 X return 23002 continue X if(.not.( 1 .gt. n .or. n .gt. ldq ))goto 23004 X info = -1 X return 23004 continue X j=1 23006 if(.not.(j.le.nint+1))goto 23008 X tmp = low + dfloat (j-1) * ( upp - low ) / dfloat (nint) X call dset (n, 10.d0 ** (tmp), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**tmp X call dtrev (vmu, twk, 2, n, z, score(j), varht, info, work) X if(.not.( info .ne. 0 ))goto 23009 X info = -2 X return 23009 continue X if(.not.( score(j) .le. minscr .or. j .eq. 1 ))goto 23011 X minscr = score(j) X nlaht = tmp X varhtwk = varht 23011 continue X j=j+1 X goto 23006 23008 continue X varht = varhtwk X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/deval.f' && chmod 0644 'grkpack/rkpack/deval.f' || echo 'restore of grkpack/rkpack/deval.f failed' shar_count="`wc -c < 'grkpack/rkpack/deval.f'`" test 1363 -eq "$shar_count" || echo "grkpack/rkpack/deval.f: original size 1363, current size $shar_count" fi # ============= grkpack/rkpack/dgold.f ============== if test -f 'grkpack/rkpack/dgold.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dgold.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dgold.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dgold.f' && X subroutine dgold (vmu, q, ldq, n, z, low, upp, nlaht, score, X &varht, info, twk, work) X character*1 vmu X integer ldq, n, info X double precision q(ldq,*), z(*), low, upp, nlaht, score, varht, X &twk(2,*), work(*) X double precision ratio, mlo, mup, tmpl, tmpu X ratio = ( dsqrt (5.d0) - 1.d0 ) / 2.d0 X info = 0 X if(.not.( upp .lt. low ))goto 23000 X mlo = low X low = upp X upp = mlo 23000 continue X if(.not.( vmu .ne. 'v' .and. vmu .ne. 'm' .and. vmu .ne. 'u' )) X &goto 23002 X info = -3 X return 23002 continue X if(.not.( n .lt. 1 .or. n .gt. ldq ))goto 23004 X info = -1 X return 23004 continue X mlo = upp - ratio * (upp - low) X call dset (n, 10.d0 ** (mlo), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**mlo X call dtrev (vmu, twk, 2, n, z, tmpl, varht, info, work) X if(.not.( info .ne. 0 ))goto 23006 X info = -2 X return 23006 continue X mup = low + ratio * (upp - low) X call dset (n, 10.d0 ** (mup), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**mup X call dtrev (vmu, twk, 2, n, z, tmpu, varht, info, work) X if(.not.( info .ne. 0 ))goto 23008 X info = -2 X return 23008 continue 23010 continue X if(.not.( mup - mlo .lt. 1.d-7 ))goto 23013 X goto 23012 23013 continue X if(.not.( tmpl .lt. tmpu ))goto 23015 X upp = mup X mup = mlo X tmpu = tmpl X mlo = upp - ratio * (upp - low) X call dset (n, 10.d0 ** (mlo), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**mlo X call dtrev (vmu, twk, 2, n, z, tmpl, varht, info, work) X if(.not.( info .ne. 0 ))goto 23017 X info = -2 X return 23017 continue X goto 23016 23015 continue X low = mlo X mlo = mup X tmpl = tmpu X mup = low + ratio * (upp - low) X call dset (n, 10.d0 ** (mup), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**mup X call dtrev (vmu, twk, 2, n, z, tmpu, varht, info, work) X if(.not.( info .ne. 0 ))goto 23019 X info = -2 X return 23019 continue 23016 continue 23011 goto 23010 23012 continue X nlaht = ( mup + mlo ) / 2.d0 X call dset (n, 10.d0 ** (nlaht), twk(2,1), 2) X call daxpy (n, 1.d0, q, ldq+1, twk(2,1), 2) X call dcopy (n-1, q(1,2), ldq+1, twk(1,2), 2) X twk(1,1) = 10.d0**nlaht X call dtrev (vmu, twk, 2, n, z, score, varht, info, work) X if(.not.( info .ne. 0 ))goto 23021 X info = -2 X return 23021 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dgold.f' && chmod 0644 'grkpack/rkpack/dgold.f' || echo 'restore of grkpack/rkpack/dgold.f failed' shar_count="`wc -c < 'grkpack/rkpack/dgold.f'`" test 2847 -eq "$shar_count" || echo "grkpack/rkpack/dgold.f: original size 2847, current size $shar_count" fi # ============= grkpack/rkpack/dmcdc.f ============== if test -f 'grkpack/rkpack/dmcdc.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dmcdc.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dmcdc.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dmcdc.f' && X subroutine dmcdc (a, lda, p, e, jpvt, info) X integer lda, p, jpvt(*), info X double precision a(lda,*), e(*) X double precision beta, delta, theta, tmp, dasum, ddot X integer i, j, jmax, jtmp, idamax X info = 0 X if(.not.( lda .lt. p .or. p .lt. 1 ))goto 23000 X info = -1 X return 23000 continue X tmp = 1.d0 23002 if(.not.( 1.d0 + tmp .gt. 1.d0 ))goto 23003 X tmp = tmp / 2.d0 X goto 23002 23003 continue X jmax = idamax (p, a, lda+1) X beta = dmax1 (2.d0 * tmp, dabs (a(jmax,jmax))) X tmp = dsqrt (dfloat (p*p-1)) X if(.not.( tmp .lt. 1.d0 ))goto 23004 X tmp = 1.d0 23004 continue X j=2 23006 if(.not.(j.le.p))goto 23008 X jmax = idamax (j-1, a(1,j), 1) X beta = dmax1 (beta, dabs (a(jmax,j)) / tmp) X j=j+1 X goto 23006 23008 continue X delta = dasum (p, a, lda+1) / dfloat (p) * 1.d-7 X delta = dmax1 (delta, 1.d-10) X j=1 23009 if(.not.(j.le.p))goto 23011 X jpvt(j) = j X j=j+1 X goto 23009 23011 continue X j=1 23012 if(.not.(j.le.p))goto 23014 X jmax = idamax (p-j+1, a(j,j), lda+1) + j - 1 X if(.not.( jmax .ne. j ))goto 23015 X call dswap (j-1, a(1,j), 1, a(1,jmax), 1) X call dswap (jmax-j-1, a(j,j+1), lda, a(j+1,jmax), 1) X call dswap (p-jmax, a(j,jmax+1), lda, a(jmax,jmax+1), lda) X tmp = a(j,j) X a(j,j) = a(jmax,jmax) X a(jmax,jmax) = tmp X jtmp = jpvt(j) X jpvt(j) = jpvt(jmax) X jpvt(jmax) = jtmp 23015 continue X i=1 23017 if(.not.(i.lt.j))goto 23019 X a(i,j) = a(i,j) / a(i,i) X i=i+1 X goto 23017 23019 continue X i=j+1 23020 if(.not.(i.le.p))goto 23022 X a(j,i) = a(j,i) - ddot (j-1, a(1,j), 1, a(1,i), 1) X i=i+1 X goto 23020 23022 continue X if(.not.( j .eq. p ))goto 23023 X theta = 0.d0 X goto 23024 23023 continue X jmax = idamax (p-j, a(j,j+1), lda) + j X theta = dabs (a(j,jmax)) 23024 continue X tmp = dmax1 (delta, dabs (a(j,j)), theta ** 2 / beta) X e(j) = tmp - a(j,j) X a(j,j) = tmp X i=j+1 23025 if(.not.(i.le.p))goto 23027 X a(i,i) = a(i,i) - a(j,i) ** 2 / a(j,j) X i=i+1 X goto 23025 23027 continue X j=j+1 X goto 23012 23014 continue X j=1 23028 if(.not.(j.le.p))goto 23030 X a(j,j) = dsqrt (a(j,j)) X call dscal (p-j, a(j,j), a(j,j+1), lda) X j=j+1 X goto 23028 23030 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dmcdc.f' && chmod 0644 'grkpack/rkpack/dmcdc.f' || echo 'restore of grkpack/rkpack/dmcdc.f failed' shar_count="`wc -c < 'grkpack/rkpack/dmcdc.f'`" test 2411 -eq "$shar_count" || echo "grkpack/rkpack/dmcdc.f: original size 2411, current size $shar_count" fi # ============= grkpack/rkpack/dmudr.f ============== if test -f 'grkpack/rkpack/dmudr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dmudr.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dmudr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dmudr.f' && X subroutine dmudr (vmu, s, lds, nobs, nnull, q, ldqr, ldqc, nq, y, X &tol, init, prec, maxite, theta, nlaht, score, varht, c, d, wk, X &info) X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxite, info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol, prec, theta( X &*), nlaht, score, varht, c(*), d(*), wk(*) X character*1 vmu X integer n, n0 X integer iqraux, itraux, itwk, iqwk, iywk, ithewk, ihes, igra, X &ihwk1, ihwk2, igwk1, igwk2, ikwk, iwork1, iwork2, ijpvt, ipvtwk X n = nobs X n0 = nnull X iqraux = 1 X itraux = iqraux + n0 X itwk = itraux + (n-n0-2) X iqwk = itwk + 2 * (n-n0) X iywk = iqwk + n * n X ithewk = iywk + n X ihes = ithewk + nq X igra = ihes + nq * nq X ihwk1 = igra + nq X ihwk2 = ihwk1 + nq * nq X igwk1 = ihwk2 + nq * nq X igwk2 = igwk1 + nq X ikwk = igwk2 + nq X iwork1 = ikwk + (n-n0) * (n-n0) * nq X iwork2 = iwork1 + n X ijpvt = iwork2 + n X ipvtwk = ijpvt + n0 X call dmudr1 (vmu, s, lds, nobs, nnull, q, ldqr, ldqc, nq, y, tol, X &init, prec, maxite, theta, nlaht, score, varht, c, d, wk(iqraux), X &wk(ijpvt), wk(itwk), wk(itraux), wk(iqwk), wk(iywk), wk(ithewk), X &wk(ihes), wk(igra), wk(ihwk1), wk(ihwk2), wk(igwk1), wk(igwk2), X &wk(ipvtwk), wk(ikwk), wk(iwork1), wk(iwork2), info) X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dmudr.f' && chmod 0644 'grkpack/rkpack/dmudr.f' || echo 'restore of grkpack/rkpack/dmudr.f failed' shar_count="`wc -c < 'grkpack/rkpack/dmudr.f'`" test 1389 -eq "$shar_count" || echo "grkpack/rkpack/dmudr.f: original size 1389, current size $shar_count" fi # ============= grkpack/rkpack/dmudr1.f ============== if test -f 'grkpack/rkpack/dmudr1.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dmudr1.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dmudr1.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dmudr1.f' && X subroutine dmudr1 (vmu, s, lds, nobs, nnull, q, ldqr, ldqc, nq, y, X & tol, init, prec, maxite, theta, nlaht, score, varht, c, d, qraux, X & jpvt, twk, traux, qwk, ywk, thewk, hes, gra, hwk1, hwk2, gwk1, X &gwk2, pvtwk, kwk, work1, work2, info) X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxite, jpvt(*), X &pvtwk(*), info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol, prec, theta( X &*), nlaht, score, varht, c(*), d(*), qraux(*), traux(*), twk(2,*), X & qwk(ldqr,*), ywk(*), thewk(*), hes(nq,*), gra(*), hwk1(nq,*), X &hwk2(nq,*), gwk1(*), gwk2(*), kwk(nobs-nnull,nobs-nnull,*), work1( X &*), work2(*) X character*1 vmu X double precision alph, scrold, scrwk, nlawk, limnla(2), tmp, X &dasum, ddot X integer n, n0, i, j, iwk, maxitwk, idamax, job X info = 0 X n0 = nnull X n = nobs - nnull X maxitwk = maxite X if(.not.( (vmu .ne. 'v' .and. vmu .ne. 'm' .and. vmu .ne. 'u') X &.or. (init .ne. 0 .and. init .ne. 1) .or. (maxitwk .le.0) .or. ( X &prec .le. 0.d0) ))goto 23000 X info = -3 X return 23000 continue X if(.not.( lds .lt. nobs .or. nobs .le. n0 .or. n0 .lt. 1 .or. X &ldqr .lt. nobs .or. ldqc .lt. nobs .or. nq .le. 0 ))goto 23002 X info = -1 X return 23002 continue X call dstup (s, lds, nobs, n0, qraux, jpvt, y, q, ldqr, ldqc, nq, X &info, work1) X if(.not.( info .ne. 0 ))goto 23004 X return 23004 continue X if(.not.( init .eq. 1 ))goto 23006 X call dcopy (nq, theta, 1, thewk, 1) X goto 23007 23006 continue X i=1 23008 if(.not.(i.le.nq))goto 23010 X thewk(i) = dasum (n, q(n0+1,n0+1,i), ldqr+1) X if(.not.( thewk(i) .gt. 0.d0 ))goto 23011 X thewk(i) = 1.d0 / thewk(i) 23011 continue X i=i+1 X goto 23008 23010 continue X j=1 23013 if(.not.(j.le.nobs))goto 23015 X call dset (nobs-j+1, 0.d0, qwk(j,j), 1) X j=j+1 X goto 23013 23015 continue X i=1 23016 if(.not.(i.le.nq))goto 23018 X j=1 23019 if(.not.(j.le.nobs))goto 23021 X call daxpy (nobs-j+1, thewk(i), q(j,j,i), 1, qwk(j,j), 1) X j=j+1 X goto 23019 23021 continue X i=i+1 X goto 23016 23018 continue X call dcopy (nobs, y, 1, ywk, 1) X call dcore (vmu, qwk, ldqr, nobs, n0, tol, ywk, 0, limnla, nlawk, X &scrwk, varht, info, twk, work1) X if(.not.(info .ne. 0 ))goto 23022 X return 23022 continue X call dcoef (s, lds, nobs, n0, qraux, jpvt, ywk, qwk, ldqr, nlawk, X &c, d, info, twk) X call dqrsl (s, lds, nobs, n0, qraux, c, tmp, c, tmp, tmp, tmp, X &01000, info) X i=1 23024 if(.not.(i.le.nq))goto 23026 X call dsymv('l', n, thewk(i), q(n0+1,n0+1,i), ldqr, c(n0+1), 1, 0. X &d0, work1, 1) X thewk(i) = ddot (n, c(n0+1), 1, work1, 1) * thewk(i) X if(.not.( thewk(i) .gt. 0.d0 ))goto 23027 X thewk(i) = dlog10 (thewk(i)) X goto 23028 23027 continue X thewk(i) = -25.d0 23028 continue X i=i+1 X goto 23024 23026 continue 23007 continue X scrold = 1.d10 X job = 0 23029 continue X if(.not.( nq .eq. 1 ))goto 23032 X theta(1) = 0.d0 X goto 23031 23032 continue X j=1 23034 if(.not.(j.le.nobs))goto 23036 X call dset (nobs-j+1, 0.d0, qwk(j,j), 1) X j=j+1 X goto 23034 23036 continue X i=1 23037 if(.not.(i.le.nq))goto 23039 X if(.not.( thewk(i) .le. -25.d0 ))goto 23040 X goto 23038 23040 continue X j=1 23042 if(.not.(j.le.nobs))goto 23044 X call daxpy (nobs-j+1, 10.d0 ** thewk(i), q(j,j,i), 1, qwk(j,j), 1) X j=j+1 X goto 23042 23044 continue 23038 i=i+1 X goto 23037 23039 continue X call dcopy (nobs, y, 1, ywk, 1) X call dcore (vmu, qwk, ldqr, nobs, n0, tol, ywk, job, limnla, X &nlawk, scrwk, varht, info, twk, work1) X if(.not.(info .ne. 0 ))goto 23045 X return 23045 continue X if(.not.( scrold .lt. scrwk ))goto 23047 X tmp = dabs (gwk1(idamax (nq, gwk1, 1))) X if(.not.( alph * tmp .gt. - prec ))goto 23049 X info = -5 X return 23049 continue X alph = alph / 2.d0 X i=1 23051 if(.not.(i.le.nq))goto 23053 X thewk(i) = theta(i) + alph * gwk1(i) X i=i+1 X goto 23051 23053 continue X goto 23030 23047 continue X maxitwk = maxitwk - 1 X call dcopy (n-2, qwk(n0+2,n0+1), ldqr+1, traux, 1) X call dcopy (n, qwk(n0+1,n0+1), ldqr+1, twk(2,1), 2) X call dcopy (n-1, qwk(n0+1,n0+2), ldqr+1, twk(1,2), 2) X call ddeev (vmu, nobs, q(n0+1,n0+1,1), ldqr, ldqc, n, nq, qwk(n0+ X &2,n0+1), ldqr, traux, twk, ywk(n0+1), thewk, nlawk, scrwk, varht, X &hes, nq, gra, hwk1, hwk2, gwk1, gwk2, kwk, n, work1, work2, c, X &info) X iwk = 0 X i=1 23054 if(.not.(i.le.nq))goto 23056 X if(.not.( thewk(i) .le. -25.d0 ))goto 23057 X goto 23055 23057 continue X iwk = iwk + 1 X call dcopy (nq, hes(1,i), 1, hes(1,iwk), 1) 23055 i=i+1 X goto 23054 23056 continue X iwk = 0 X i=1 23059 if(.not.(i.le.nq))goto 23061 X if(.not.( thewk(i) .le. -25.d0 ))goto 23062 X goto 23060 23062 continue X iwk = iwk + 1 X call dcopy (nq, hes(i,1), nq, hes(iwk,1), nq) X gwk1(iwk) = gra(i) X work2(iwk) = gra(i) 23060 i=i+1 X goto 23059 23061 continue X i=1 23064 if(.not.(i.lt.iwk))goto 23066 X call dcopy (iwk-i, hes(i+1,i), 1, hes(i,i+1), nq) X i=i+1 X goto 23064 23066 continue X call dmcdc (hes, nq, iwk, gwk2, pvtwk, info) X call dprmut (gwk1, iwk, pvtwk, 0) X call dposl (hes, nq, iwk, gwk1) X call dprmut (gwk1, iwk, pvtwk, 1) X alph = -1.d0 X j = iwk X i=nq 23067 if(.not.(i.ge.1))goto 23069 X if(.not.( thewk(i) .le. -25.0 ))goto 23070 X gwk1(i) = 0.d0 X goto 23071 23070 continue X gwk1(i) = gwk1(iwk) X iwk = iwk - 1 23071 continue X i=i-1 X goto 23067 23069 continue X call dscal (nq, 1.d0/dlog(1.d1), gwk1, 1) X tmp = dabs (gwk1(idamax (nq, gwk1, 1))) X if(.not.( tmp .gt. 1.d0 ))goto 23072 X call dscal (nq, 1.d0/tmp, gwk1, 1) 23072 continue X i=1 23074 if(.not.(i.le.nq))goto 23076 X if(.not.( thewk(i) .le. -25.d0 ))goto 23077 X goto 23075 23077 continue X thewk(i) = thewk(i) - nlawk 23075 i=i+1 X goto 23074 23076 continue X call dcopy (nq, thewk, 1, theta, 1) X tmp = gra(idamax (nq, gra, 1)) ** 2 X if(.not.( tmp .lt. prec ** 2 .or. scrold - scrwk .lt. prec * ( X &scrwk + 1.d0) .and. tmp .lt. prec * (scrwk + 1.d0) ** 2 ))goto 230 X &79 X goto 23031 23079 continue X if(.not.( maxitwk .lt. 1 ))goto 23081 X info = -4 X return 23081 continue X scrold = scrwk X i=1 23083 if(.not.(i.le.nq))goto 23085 X thewk(i) = thewk(i) + alph * gwk1(i) X i=i+1 X goto 23083 23085 continue X job = -1 X limnla(1) = -1.d0 X limnla(2) = 1.d0 23030 goto 23029 23031 continue X j=1 23086 if(.not.(j.le.nobs))goto 23088 X call dset (nobs-j+1, 0.d0, qwk(j,j), 1) X j=j+1 X goto 23086 23088 continue X i=1 23089 if(.not.(i.le.nq))goto 23091 X if(.not.( theta(i) .le. -25.d0 ))goto 23092 X goto 23090 23092 continue X j=1 23094 if(.not.(j.le.nobs))goto 23096 X call daxpy (nobs-j+1, 10.d0 ** theta(i), q(j,j,i), 1, qwk(j,j), 1) X j=j+1 X goto 23094 23096 continue 23090 i=i+1 X goto 23089 23091 continue X call dcopy (nobs, y, 1, ywk, 1) X call dcore (vmu, qwk, ldqr, nobs, n0, tol, ywk, job, limnla, X &nlaht, score, varht, info, twk, work1) X if(.not.(info .ne. 0 ))goto 23097 X return 23097 continue X call dcoef (s, lds, nobs, n0, qraux, jpvt, ywk, qwk, ldqr, nlaht, X &c, d, info, twk) X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dmudr1.f' && chmod 0644 'grkpack/rkpack/dmudr1.f' || echo 'restore of grkpack/rkpack/dmudr1.f failed' shar_count="`wc -c < 'grkpack/rkpack/dmudr1.f'`" test 7621 -eq "$shar_count" || echo "grkpack/rkpack/dmudr1.f: original size 7621, current size $shar_count" fi # ============= grkpack/rkpack/dqrslm.f ============== if test -f 'grkpack/rkpack/dqrslm.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dqrslm.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dqrslm.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dqrslm.f' && X subroutine dqrslm (x, ldx, n, k, qraux, a, lda, job, info, work) X integer ldx, n, k, lda, job, info X double precision x(ldx,*), qraux(*), a(lda,*), work(*) X double precision tmp, alph, ddot X integer i, j, step X info = 0 X if(.not.( lda .lt. n .or. n .lt. k .or. k .lt. 1 ))goto 23000 X info = -1 X return 23000 continue X if(.not.( job .ne. 0 .and. job .ne. 1 ))goto 23002 X info = 1 X return 23002 continue X if(.not.( job .eq. 0 ))goto 23004 X j = 1 X step = 1 X goto 23005 23004 continue X j = k X step = -1 23005 continue 23006 if(.not.( j .ge. 1 .and. j .le. k ))goto 23007 X if(.not.( qraux(j) .eq. 0.0d0 ))goto 23008 X j = j + step X goto 23006 23008 continue X tmp = x(j,j) X x(j,j) = qraux(j) X i=1 23010 if(.not.(i.lt.j))goto 23012 X alph = - ddot (n-j+1, x(j,j), 1, a(j,i), 1) / x(j,j) X call daxpy (n-j+1, alph, x(j,j), 1, a(j,i), 1) X i=i+1 X goto 23010 23012 continue X alph = 1.d0 / x(j,j) X call dsymv ('l', n-j+1, alph, a(j,j), lda, x(j,j), 1, 0.d0, work( X &j), 1) X alph = - ddot (n-j+1, work(j), 1, x(j,j), 1) / 2.d0 / x(j,j) X call daxpy (n-j+1, alph, x(j,j), 1, work(j), 1) X call dsyr2 ('l', n-j+1, -1.d0, x(j,j), 1, work(j), 1, a(j,j), lda) X x(j,j) = tmp X j = j + step X goto 23006 23007 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dqrslm.f' && chmod 0644 'grkpack/rkpack/dqrslm.f' || echo 'restore of grkpack/rkpack/dqrslm.f failed' shar_count="`wc -c < 'grkpack/rkpack/dqrslm.f'`" test 1400 -eq "$shar_count" || echo "grkpack/rkpack/dqrslm.f: original size 1400, current size $shar_count" fi # ============= grkpack/rkpack/dsidr.f ============== if test -f 'grkpack/rkpack/dsidr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dsidr.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dsidr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dsidr.f' && X subroutine dsidr (vmu, s, lds, nobs, nnull, y, q, ldq, tol, job, X &limnla, nlaht, score, varht, c, d, qraux, jpvt, wk, info) X character*1 vmu X integer lds, nobs, nnull, ldq, job, jpvt(*), info X double precision s(lds,*), y(*), q(ldq,*), tol, limnla(2), nlaht, X &score(*), varht, c(*), d(*), qraux(*), wk(*) X info = 0 X if(.not.( nnull .lt. 1 .or. nnull .ge. nobs .or. nobs .gt. lds X &.or. nobs .gt. ldq ))goto 23000 X info = -1 X return 23000 continue X if(.not.( vmu .ne. 'v' .and. vmu .ne. 'm' .and. vmu .ne. 'u' )) X &goto 23002 X info = -3 X return 23002 continue X call dstup (s, lds, nobs, nnull, qraux, jpvt, y, q, ldq, nobs, 1, X &info, wk) X if(.not.( info .ne. 0 ))goto 23004 X return 23004 continue X call dcore (vmu, q, ldq, nobs, nnull, tol, y, job, limnla, nlaht, X &score, varht, info, wk, wk(2*nobs+1)) X if(.not.( info .ne. 0 ))goto 23006 X return 23006 continue X call dcoef (s, lds, nobs, nnull, qraux, jpvt, y, q, ldq, nlaht, c, X & d, info, wk) X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dsidr.f' && chmod 0644 'grkpack/rkpack/dsidr.f' || echo 'restore of grkpack/rkpack/dsidr.f failed' shar_count="`wc -c < 'grkpack/rkpack/dsidr.f'`" test 1096 -eq "$shar_count" || echo "grkpack/rkpack/dsidr.f: original size 1096, current size $shar_count" fi # ============= grkpack/rkpack/dsms.f ============== if test -f 'grkpack/rkpack/dsms.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dsms.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dsms.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dsms.f' && X subroutine dsms (s, lds, nobs, nnull, jpvt, q, ldq, nlaht, sms, X &ldsms, wk, info) X integer lds, nobs, nnull, jpvt(*), ldq, ldsms, info X double precision s(lds,*), q(ldq,*), nlaht, sms(ldsms,*), wk(2,*) X double precision dum, ddot X integer i, j, n, n0 X info = 0 X if(.not.( nnull .lt. 1 .or. nnull .ge. nobs .or. nobs .gt. lds X &.or. nobs .gt. ldq .or. ldsms .lt. nnull ))goto 23000 X info = -1 X return 23000 continue X n0 = nnull X n = nobs - nnull X call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) X j=1 23002 if(.not.(j.le.n0))goto 23004 X call dcopy (n, q(n0+1,j), 1, q(j,n0+1), ldq) X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, q(n0+2,j), dum, q(n0+ X &2,j), dum, dum, dum, 01000, info) X j=j+1 X goto 23002 23004 continue X call dset (n, 10.d0 ** nlaht, wk(2,1), 2) X call daxpy (n, 1.d0, q(n0+1,n0+1), ldq+1, wk(2,1), 2) X call dcopy (n-1, q(n0+1,n0+2), ldq+1, wk(1,2), 2) X call dpbfa (wk, 2, n, 1, info) X if(.not.( info .ne. 0 ))goto 23005 X info = -2 X return 23005 continue X j=1 23007 if(.not.(j.le.n0))goto 23009 X call dpbsl (wk, 2, n, 1, q(n0+1,j)) X j=j+1 X goto 23007 23009 continue X call dcopy (n-2, q(n0+2,n0+1), ldq+1, wk, 1) X j=1 23010 if(.not.(j.le.n0))goto 23012 X call dqrsl (q(n0+2,n0+1), ldq, n-1, n-2, wk, q(n0+2,j), q(n0+2,j), X & dum, dum, dum, dum, 10000, info) X j=j+1 X goto 23010 23012 continue X i=1 23013 if(.not.(i.le.n0))goto 23015 X j=1 23016 if(.not.(j.lt.i))goto 23018 X sms(i,j) = sms(j,i) X j=j+1 X goto 23016 23018 continue X j=i 23019 if(.not.(j.le.n0))goto 23021 X sms(i,j) = q(j,i) - ddot (n, q(n0+1,j), 1, q(i,n0+1), ldq) X j=j+1 X goto 23019 23021 continue X sms(i,i) = sms(i,i) + 10.d0**nlaht X i=i+1 X goto 23013 23015 continue X j=1 23022 if(.not.(j.le.n0))goto 23024 X call dtrsl (s, lds, n0, sms(1,j), 01, info) X j=j+1 X goto 23022 23024 continue X i=1 23025 if(.not.(i.le.n0))goto 23027 X call dcopy (n0, sms(i,1), ldsms, wk, 1) X call dtrsl (s, lds, n0, wk, 01, info) X call dprmut (wk, n0, jpvt, 1) X call dcopy (n0, wk, 1, sms(i,1), ldsms) X i=i+1 X goto 23025 23027 continue X j=1 23028 if(.not.(j.le.n0))goto 23030 X call dprmut (sms(1,j), n0, jpvt, 1) X j=j+1 X goto 23028 23030 continue X j=1 23031 if(.not.(j.le.n0))goto 23033 X call dcopy (n, q(j,n0+1), ldq, q(n0+1,j), 1) X j=j+1 X goto 23031 23033 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dsms.f' && chmod 0644 'grkpack/rkpack/dsms.f' || echo 'restore of grkpack/rkpack/dsms.f failed' shar_count="`wc -c < 'grkpack/rkpack/dsms.f'`" test 2578 -eq "$shar_count" || echo "grkpack/rkpack/dsms.f: original size 2578, current size $shar_count" fi # ============= grkpack/rkpack/dstup.f ============== if test -f 'grkpack/rkpack/dstup.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dstup.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dstup.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dstup.f' && X subroutine dstup (s, lds, nobs, nnull, qraux, jpvt, y, q, ldqr, X &ldqc, nq, info, work) X integer lds, nobs, nnull, jpvt(*), ldqr, ldqc, nq, info X double precision s(lds,*), y(*), qraux(*), q(ldqr,ldqc,*), work(*) X double precision dum X integer j X info = 0 X if(.not.( nobs .lt. 1 .or. nobs .gt. lds .or. nobs .gt. ldqr .or. X &nobs .gt. ldqc ))goto 23000 X info = -1 X return 23000 continue X j=1 23002 if(.not.(j.le.nnull))goto 23004 X jpvt(j) = 0 X j=j+1 X goto 23002 23004 continue X call dqrdc (s, lds, nobs, nnull, qraux, jpvt, work, 1) X call dqrsl (s, lds, nobs, nnull, qraux, y, dum, y, work, dum, dum, X & 01100, info) X if(.not.( info .ne. 0 ))goto 23005 X return 23005 continue X j=1 23007 if(.not.(j.le.nq))goto 23009 X call dqrslm (s, lds, nobs, nnull, qraux, q(1,1,j), ldqr, 0, info, X &work) X j=j+1 X goto 23007 23009 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dstup.f' && chmod 0644 'grkpack/rkpack/dstup.f' || echo 'restore of grkpack/rkpack/dstup.f failed' shar_count="`wc -c < 'grkpack/rkpack/dstup.f'`" test 973 -eq "$shar_count" || echo "grkpack/rkpack/dstup.f: original size 973, current size $shar_count" fi # ============= grkpack/rkpack/dsytr.f ============== if test -f 'grkpack/rkpack/dsytr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dsytr.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dsytr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dsytr.f' && X subroutine dsytr (x, ldx, n, tol, info, work) X integer ldx, n, info X double precision x(ldx,*), tol, work(*) X double precision nrmtot, nrmxj, alph, toltot, tolcum, toluni, dn, X &ddot X integer j X info = 0 X if(.not.( ldx .lt. n .or. n .le. 2 ))goto 23000 X info = -1 X return 23000 continue X nrmtot = ddot (n, x, ldx+1, x, ldx+1) X j=1 23002 if(.not.(j.lt.n))goto 23004 X nrmtot = nrmtot + 2.d0 * ddot (n-j, x(j+1,j), 1, x(j+1,j), 1) X j=j+1 X goto 23002 23004 continue X toltot = 1.d0 23005 if(.not.( 1.d0 + toltot .gt. 1.d0 ))goto 23006 X toltot = toltot / 2.d0 X goto 23005 23006 continue X toltot = 4.d0 * toltot ** 2 X if(.not.( toltot .lt. tol ))goto 23007 X toltot = tol 23007 continue X toltot = toltot * nrmtot X dn = dfloat (n) X toluni = toltot * 6.d0 / dn / ( dn - 1.d0 ) / ( 2.d0 * dn - 1.d0 ) X tolcum = 0.d0 X j=1 23009 if(.not.(j.lt.n-1))goto 23011 X nrmtot = nrmtot - x(j,j) * x(j,j) X nrmxj = ddot (n-j, x(j+1,j), 1, x(j+1,j), 1) X dn = dfloat (n-j) X tolcum = tolcum + toluni * dn * dn X if(.not.( 2.d0 * nrmxj .le. tolcum ))goto 23012 X x(j,j+1) = 0.d0 X call dscal (n-j, 0.d0, x(j+1,j), 1) X tolcum = tolcum - 2.d0 * nrmxj X toltot = toltot - 2.d0 * nrmxj X goto 23010 23012 continue X if(.not.( x(j+1,j) .lt. 0.d0 ))goto 23014 X x(j,j+1) = dsqrt (nrmxj) X goto 23015 23014 continue X x(j,j+1) = - dsqrt (nrmxj) 23015 continue X nrmtot = nrmtot - 2.d0 * nrmxj X call dscal (n-j, -1.d0/x(j,j+1), x(j+1,j), 1) X x(j+1,j) = 1.d0 + x(j+1,j) X alph = 1.d0 / x(j+1,j) X call dsymv ('l', n-j, alph, x(j+1,j+1), ldx, x(j+1,j), 1, 0.d0, X &work(j+1), 1) X alph = - ddot (n-j, work(j+1), 1, x(j+1,j), 1) / 2.d0 / x(j+1,j) X call daxpy (n-j, alph, x(j+1,j), 1, work(j+1), 1) X call dsyr2 ('l', n-j, -1.d0, x(j+1,j), 1, work(j+1), 1, x(j+1,j+1) X &, ldx) 23010 j=j+1 X goto 23009 23011 continue X x(n-1,n) = x(n,n-1) X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dsytr.f' && chmod 0644 'grkpack/rkpack/dsytr.f' || echo 'restore of grkpack/rkpack/dsytr.f failed' shar_count="`wc -c < 'grkpack/rkpack/dsytr.f'`" test 2070 -eq "$shar_count" || echo "grkpack/rkpack/dsytr.f: original size 2070, current size $shar_count" fi # ============= grkpack/rkpack/dtrev.f ============== if test -f 'grkpack/rkpack/dtrev.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/dtrev.f (File already exists)' else echo 'x - extracting grkpack/rkpack/dtrev.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/dtrev.f' && X subroutine dtrev (vmu, t, ldt, n, z, score, varht, info, work) X character*1 vmu X integer n, info X double precision t(ldt,*), z(*), score, varht, work(*) X double precision nume, deno, tmp, alph, la, dasum, ddot X integer j X info = 0 X if(.not.( vmu .ne. 'v' .and. vmu .ne. 'm' .and. vmu .ne. 'u' )) X &goto 23000 X info = -3 X return 23000 continue X la = t(1,1) X alph = dfloat (n) / dasum (n, t(2,1), ldt) X call dscal (n, alph, t(2,1), ldt) X call dscal (n-1, alph, t(1,2), ldt) X call dpbfa (t, ldt, n, 1, info) X if(.not.( info .ne. 0 ))goto 23002 X return 23002 continue X call dcopy (n, z, 1, work, 1) X call dpbsl (t, ldt, n, 1, work) X if(.not.( vmu .eq. 'v' ))goto 23004 X tmp = 1.d0 / t(2,n) / t(2,n) X deno = tmp X j=n-1 23006 if(.not.(j.gt.0))goto 23008 X tmp = ( 1.d0 + t(1,j+1) * t(1,j+1) * tmp ) / t(2,j) / t(2,j) X deno = deno + tmp X j=j-1 X goto 23006 23008 continue X nume = ddot (n, work, 1, work, 1) / dfloat (n) X deno = deno / dfloat (n) X varht = alph * la * nume / deno X score = nume / deno / deno 23004 continue X if(.not.( vmu .eq. 'm' ))goto 23009 X deno = dlog (t(2,n)) X j=n-1 23011 if(.not.(j.gt.0))goto 23013 X deno = deno + dlog (t(2,j)) X j=j-1 X goto 23011 23013 continue X nume = ddot (n, z, 1, work, 1) / dfloat (n) X varht = alph * la * nume X score = nume * dexp (2.d0 * deno / dfloat (n)) 23009 continue X if(.not.( vmu .eq. 'u' ))goto 23014 X nume = ddot (n, work, 1, work, 1) / dfloat (n) X tmp = 1.d0 / t(2,n) / t(2,n) X deno = tmp X j=n-1 23016 if(.not.(j.gt.0))goto 23018 X tmp = ( 1.d0 + t(1,j+1) * t(1,j+1) * tmp ) / t(2,j) / t(2,j) X deno = deno + tmp X j=j-1 X goto 23016 23018 continue X deno = deno / dfloat (n) X score = alph * alph * la * la * nume - 2.d0 * varht * alph * la * X &deno 23014 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/dtrev.f' && chmod 0644 'grkpack/rkpack/dtrev.f' || echo 'restore of grkpack/rkpack/dtrev.f failed' shar_count="`wc -c < 'grkpack/rkpack/dtrev.f'`" test 1996 -eq "$shar_count" || echo "grkpack/rkpack/dtrev.f: original size 1996, current size $shar_count" fi # ============= grkpack/rkpack/Makefile ============== if test -f 'grkpack/rkpack/Makefile' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/rkpack/Makefile (File already exists)' else echo 'x - extracting grkpack/rkpack/Makefile (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/rkpack/Makefile' && OBJECTS = dcoef.o dcore.o dcrdr.o ddeev.o deval.o dgold.o dmcdc.o dmudr.o dmudr1.o dqrslm.o dsidr.o dsms.o dstup.o dsytr.o dtrev.o X FLAGS = -O X X.SUFFIXES: .f .o X X.f.o: X f77 -c $(FLAGS) $*.f X rkpack.a :: $(OBJECTS) X ar rv rkpack.a $(OBJECTS) X rm *.o X ranlib rkpack.a SHAR_EOF $shar_touch -am 0116120295 'grkpack/rkpack/Makefile' && chmod 0644 'grkpack/rkpack/Makefile' || echo 'restore of grkpack/rkpack/Makefile failed' shar_count="`wc -c < 'grkpack/rkpack/Makefile'`" test 269 -eq "$shar_count" || echo "grkpack/rkpack/Makefile: original size 269, current size $shar_count" fi # ============= grkpack/grkpack/dgmdr.f ============== if test ! -d 'grkpack/grkpack'; then echo 'x - creating directory grkpack/grkpack' mkdir 'grkpack/grkpack' fi if test -f 'grkpack/grkpack/dgmdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dgmdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dgmdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dgmdr.f' && X subroutine dgmdr (vmu, s, lds, nobs, nnull, q, ldqr, ldqc, nq, y, X &tol1, tol2, init, prec1, maxiter1, prec2, maxiter2, theta, nlaht, X &score, varht, c, d, eta, wk, swk, qwk, ywk, u, w, info) X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1, X &maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol1, tol2, X &prec1, prec2, theta(*), nlaht, score, varht, c(*), d(*), wk(*), X &eta(*), swk(lds,*), qwk(ldqr,ldqc,*), ywk(*), u(*), w(*) X character*2 vmu X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter2 = maxiter2 - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .lt. -700.d0))goto 23010 X tmp = 1.d0 X goto 23011 23010 continue X tmp = dexp (-eta(j)) 23011 continue X u(j) = 1.d0 - y(j) * tmp X w(j) = y(j) * tmp X if(.not.(w(j) .le. mtol))goto 23012 X info = -7 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -7))goto 23017 X goto 23006 23017 continue X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X i=1 23019 if(.not.(i.le.nq))goto 23021 X j=1 23022 if(.not.(j.le.ldqr))goto 23024 X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X j=j+1 X goto 23022 23024 continue X i=i+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23025 X varht = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23027 23029 continue X varht = varht / dble (nobs) 23025 continue X call dcopy (nobs, ywk, 1, u, 1) X call dmudr (vmu, swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk, X &tol2, init, prec1, maxiter1, theta, nlaht, score, varht, c, d, wk, X & info) X init = 1 X mse = 0.d0 X j=1 23030 if(.not.(j.le.nobs))goto 23032 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X j=j+1 X goto 23030 23032 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23033 X goto 23006 23033 continue X if(.not.( mse .lt. prec2 ))goto 23035 X goto 23006 23035 continue X if(.not.( maxiter2 .lt. 1 ))goto 23037 X info = -6 X goto 23006 23037 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dgmdr.f' && chmod 0644 'grkpack/grkpack/dgmdr.f' || echo 'restore of grkpack/grkpack/dgmdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dgmdr.f'`" test 2882 -eq "$shar_count" || echo "grkpack/grkpack/dgmdr.f: original size 2882, current size $shar_count" fi # ============= grkpack/grkpack/dgsdr.f ============== if test -f 'grkpack/grkpack/dgsdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dgsdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dgsdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dgsdr.f' && X subroutine dgsdr (vmu, s, lds, nobs, nnull, y, q, ldq, tol1, tol2, X & job, limnla, prec, maxiter, nlaht, score, varht, c, d, eta, X &qraux, jpvt, wk, swk, qwk, ywk, u, w, info) X character*2 vmu X integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter X double precision s(lds,*), y(*), q(ldq,*), tol1, tol2, limnla(2), X &nlaht, score(*), varht, c(*), d(*), qraux(*), wk(*), prec, eta(*), X & swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter = maxiter - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .lt. -700.d0))goto 23010 X tmp = 1.d0 X goto 23011 23010 continue X tmp = dexp (-eta(j)) 23011 continue X u(j) = 1.d0 - y(j) * tmp X w(j) = y(j) * tmp X if(.not.(w(j) .le. mtol))goto 23012 X info = -5 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -5))goto 23017 X goto 23006 23017 continue X call dcopy (ldq*nobs, q, 1, qwk, 1) X j=1 23019 if(.not.(j.le.nobs))goto 23021 X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X j=j+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23022 X varht = 0.d0 X j=1 23024 if(.not.(j.le.nobs))goto 23026 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23024 23026 continue X varht = varht / dble (nobs) 23022 continue X call dcopy (nobs, ywk, 1, u, 1) X call dsidr (vmu, swk, lds, nobs, nnull, ywk, qwk, ldq, tol2, job, X &limnla, nlaht, score, varht, c, d, qraux, jpvt, wk, info) X mse = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X j=j+1 X goto 23027 23029 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23030 X goto 23006 23030 continue X if(.not.( mse .lt. prec ))goto 23032 X goto 23006 23032 continue X if(.not.( maxiter .lt. 1 ))goto 23034 X info = -4 X goto 23006 23034 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dgsdr.f' && chmod 0644 'grkpack/grkpack/dgsdr.f' || echo 'restore of grkpack/grkpack/dgsdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dgsdr.f'`" test 2706 -eq "$shar_count" || echo "grkpack/grkpack/dgsdr.f: original size 2706, current size $shar_count" fi # ============= grkpack/grkpack/README ============== if test -f 'grkpack/grkpack/README' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/README (File already exists)' else echo 'x - extracting grkpack/grkpack/README (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/README' && X This directory collects GRKPACK routines in RATFOR and FORTRAN. The RATFOR routines are self-documented and the FORTRAN routines were translated from the corresponding RATFOR routines using `ratfor' under standard UNIX system. The user interface is via drivers DBSDR and DBMDR for binary data, DBISDR and DBIMDR for binomial data, DPSDR and DPMDR for Poisson data, DGSDR and DGMDR for Gamma data. Here **S** means a single smoothing parameter driver and **M** means a multiple smoothing parameter driver. Users can modify these routines for other distributions in exponential families. Some illustration programs are in ../examples/. Our routines are based on RKPACK developed by Chong Gu for Gaussian data and it is in ../rkpack/. A set of public domain routines from BLAS, BLAS2, and LINPACK is collected in ../lib/. Run `make' under standard UNIX system to compile and archive the *.o files in grkpack.a. X Yuedong Wang January 16, 1995 SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/README' && chmod 0644 'grkpack/grkpack/README' || echo 'restore of grkpack/grkpack/README failed' shar_count="`wc -c < 'grkpack/grkpack/README'`" test 949 -eq "$shar_count" || echo "grkpack/grkpack/README: original size 949, current size $shar_count" fi # ============= grkpack/grkpack/Makefile ============== if test -f 'grkpack/grkpack/Makefile' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/Makefile (File already exists)' else echo 'x - extracting grkpack/grkpack/Makefile (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/Makefile' && OBJECTS = dbsdr.o dbmdr.o dbisdr.o dbimdr.o dpsdr.o dpmdr.o dgsdr.o dgmdr.o X FLAGS = -O X X.SUFFIXES: .f .o X X.f.o: X f77 -c $(FLAGS) $*.f X grkpack.a :: $(OBJECTS) X ar rv grkpack.a $(OBJECTS) X rm *.o X ranlib grkpack.a SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/Makefile' && chmod 0644 'grkpack/grkpack/Makefile' || echo 'restore of grkpack/grkpack/Makefile failed' shar_count="`wc -c < 'grkpack/grkpack/Makefile'`" test 216 -eq "$shar_count" || echo "grkpack/grkpack/Makefile: original size 216, current size $shar_count" fi # ============= grkpack/grkpack/dbsdr.f ============== if test -f 'grkpack/grkpack/dbsdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbsdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dbsdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbsdr.f' && X subroutine dbsdr (vmu, s, lds, nobs, nnull, y, q, ldq, tol1, tol2, X & job, limnla, prec, maxiter, nlaht, score, varht, c, d, eta, X &qraux, jpvt, wk, swk, qwk, ywk, u, w, info) X character*2 vmu X integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter X double precision s(lds,*), y(*), q(ldq,*), tol1, tol2, limnla(2), X &nlaht, score(*), varht, c(*), d(*), qraux(*), wk(*), prec, eta(*), X & swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter = maxiter - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .gt. 700.d0))goto 23010 X tmp = 1.d0 X goto 23011 23010 continue X tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) 23011 continue X u(j) = tmp - y(j) X w(j) = tmp * (1 - tmp) X if(.not.(w(j) .le. mtol))goto 23012 X info = -5 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -5))goto 23017 X goto 23006 23017 continue X call dcopy (ldq*nobs, q, 1, qwk, 1) X j=1 23019 if(.not.(j.le.nobs))goto 23021 X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X j=j+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23022 X varht = 0.d0 X j=1 23024 if(.not.(j.le.nobs))goto 23026 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23024 23026 continue X varht = varht / dble (nobs) 23022 continue X call dcopy (nobs, ywk, 1, u, 1) X call dsidr (vmu, swk, lds, nobs, nnull, ywk, qwk, ldq, tol2, job, X &limnla, nlaht, score, varht, c, d, qraux, jpvt, wk, info) X mse = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X j=j+1 X goto 23027 23029 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23030 X goto 23006 23030 continue X if(.not.( mse .lt. prec ))goto 23032 X goto 23006 23032 continue X if(.not.( maxiter .lt. 1 ))goto 23034 X info = -4 X goto 23006 23034 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbsdr.f' && chmod 0644 'grkpack/grkpack/dbsdr.f' || echo 'restore of grkpack/grkpack/dbsdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dbsdr.f'`" test 2727 -eq "$shar_count" || echo "grkpack/grkpack/dbsdr.f: original size 2727, current size $shar_count" fi # ============= grkpack/grkpack/dbsdr.r ============== if test -f 'grkpack/grkpack/dbsdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbsdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dbsdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbsdr.r' && X #:::::::::::: # dbsdr #:::::::::::: X subroutine dbsdr (vmu,_ X s, lds, nobs, nnull, y, q, ldq,_ # data X tol1, tol2, job, limnla, prec, maxiter,_ # job requests X nlaht, score, varht, c, d, eta,_ # output X qraux, jpvt, wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Binary data Single smoothing parameter DRiver. X X character*2 vmu integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter double precision s(lds,*), y(*), q(ldq,*), tol1, tol2, limnla(2), nlaht, score(*),_ X varht, c(*), d(*), qraux(*), wk(*), prec, eta(*),_ X swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S of size (nobs,nnull). # lds the leading dimension of s. # nobs the number of observations. # nnull the dimension of the null space. # y the observations. # q the matrix Q, only the lower triangle referred. # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 tolerance for truncation in `dsytr'. If 0.d0, set to # square of machine precision. # job <=0 : golden-section search # 0 -- searching interval specified automatically. # -1 -- search on (limnla(1), limnla(2)). # >0 : regular grid search on [limnla(1), limnla(2)] # #(grids) = job + 1. # limnla the searching interval (in log10 scale), see job. # varht known variance and only has effect when vmu=='u'. varht=1.0 # if no dispersion. # prec precision for stopping the iteration. # maxiter maximum number of iterations allowed for the iteration. X # On exit: # nlaht the GCV/GML/URE estimate of log10(nobs*lambda). # limnla searching range for nlaht. # score job <= 0 : GCV/GML/URE value at nlaht. # job > 0 : GCV/GML/URE vector on the regular grid points. # varht the variance estimate. # c the parameters c. # d the parameters d. # eta the estimated logit of probabilities at design points. # swk,qraux,jpvt # QR decomposition of SWK=FR, as from Linpack `dqrdc'. # qwk first nnull columns: F^{T} Q F_{1}. # BOTTOM-RIGHT corner: tridiagonalization of # F_{2}^{T} Q F_{2}. # info 0: normal termination. # -1: dimension error. # -2: F_{2}^{T} Q F_{2} !>= 0. # -3: vmu is out of scope. # -4: fail to converge at the maxiter steps. # -5: There are some w's equals to zero. # >0: the matrix S is rank deficient: rank(S)+1. # others intact. X # Work arrays: # wk of size at least (3*nobs). # swk same size of s. # qwk same size of q. # ywk same size of y. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dsidr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Fortran -- dexp, dfloat, dlog, dlog10, dsqrt # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal # Blas2 -- dsymv, dsyr2 # Linpack -- dpbfa, dpbsl, dqrdc, dqrsl, dtrsl # Rkpack -- deval, dgold, dqrslm, dsytr, dtrev # Other -- dprmut, dset X # Written: YUEDONG WANG, Department of Statistics, University of Wisconsin - Madison. # Latest version 7/1/93. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat{ X maxiter = maxiter - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) > 700.d0) tmp = 1.d0 X else tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) X u(j) = tmp - y(j) X w(j) = tmp * (1 - tmp) X if (w(j) <= mtol) { X info = -5 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -5) break X call dcopy (ldq*nobs, q, 1, qwk, 1) X for (j=1;j<=nobs;j=j+1) { X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dsidr (vmu,_ X swk, lds, nobs, nnull, ywk, qwk, ldq,_ # data X tol2, job, limnla,_ # job requests X nlaht, score, varht, c, d,_ # output X qraux, jpvt, wk,_ # work arrays X info) # error message X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec ) break X if ( maxiter < 1 ) { X info = -4 X break X } } X return end X #................................................................................ SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbsdr.r' && chmod 0644 'grkpack/grkpack/dbsdr.r' || echo 'restore of grkpack/grkpack/dbsdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dbsdr.r'`" test 6097 -eq "$shar_count" || echo "grkpack/grkpack/dbsdr.r: original size 6097, current size $shar_count" fi # ============= grkpack/grkpack/dbmdr.f ============== if test -f 'grkpack/grkpack/dbmdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbmdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dbmdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbmdr.f' && X subroutine dbmdr (vmu, s, lds, nobs, nnull, q, ldqr, ldqc, nq, y, X &tol1, tol2, init, prec1, maxiter1, prec2, maxiter2, theta, nlaht, X &score, varht, c, d, eta, wk, swk, qwk, ywk, u, w, info) X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1, X &maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol1, tol2, X &prec1, prec2, theta(*), nlaht, score, varht, c(*), d(*), wk(*), X &eta(*), swk(lds,*), qwk(ldqr,ldqc,*), ywk(*), u(*), w(*) X character*2 vmu X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter2 = maxiter2 - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .gt. 700.d0))goto 23010 X tmp = 1.d0 X goto 23011 23010 continue X tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) 23011 continue X u(j) = tmp - y(j) X w(j) = tmp * (1 - tmp) X if(.not.(w(j) .le. mtol))goto 23012 X info = -7 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -7))goto 23017 X goto 23006 23017 continue X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X i=1 23019 if(.not.(i.le.nq))goto 23021 X j=1 23022 if(.not.(j.le.ldqr))goto 23024 X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X j=j+1 X goto 23022 23024 continue X i=i+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23025 X varht = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23027 23029 continue X varht = varht / dble (nobs) 23025 continue X call dcopy (nobs, ywk, 1, u, 1) X call dmudr (vmu, swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk, X &tol2, init, prec1, maxiter1, theta, nlaht, score, varht, c, d, wk, X & info) X init = 1 X mse = 0.d0 X j=1 23030 if(.not.(j.le.nobs))goto 23032 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X j=j+1 X goto 23030 23032 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23033 X goto 23006 23033 continue X if(.not.( mse .lt. prec2 ))goto 23035 X goto 23006 23035 continue X if(.not.( maxiter2 .lt. 1 ))goto 23037 X info = -6 X goto 23006 23037 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbmdr.f' && chmod 0644 'grkpack/grkpack/dbmdr.f' || echo 'restore of grkpack/grkpack/dbmdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dbmdr.f'`" test 2903 -eq "$shar_count" || echo "grkpack/grkpack/dbmdr.f: original size 2903, current size $shar_count" fi # ============= grkpack/grkpack/dbmdr.r ============== if test -f 'grkpack/grkpack/dbmdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbmdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dbmdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbmdr.r' && #::::::::::: # dbmdr #::::::::::: X subroutine dbmdr (vmu,_ X s, lds, nobs, nnull, q, ldqr, ldqc, nq, y,_ # inputs X tol1, tol2, init, prec1, maxiter1, prec2, maxiter2,_ # tune para X theta, nlaht, score, varht, c, d, eta,_ # outputs X wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Binary data Multiple smoothing parameter DRiver. X # Purpose: This routine implements the iterative algorithm for estimating # mutivariate logit probability for binary data with multiple smoothing # parameters estimated by GCV/GML/URE method. X # WARNING: Please be sure that you understand what this routine does before # you call it. Pilot runs with small problems are recommended. This # routine performs VERY INTENSIVE numerical calculations for big nobs. X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1,_ X maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol1, tol2, prec1, prec2,_ X theta(*), nlaht, score, varht, c(*), d(*),_ X wk(*), eta(*), swk(lds,*), qwk(ldqr,ldqc,*),_ X ywk(*), u(*), w(*) X character*2 vmu X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S, of size (lds,nnull). # nobs the number of observations. # nnull the dimension of the null space. # q the matrices Q_{i}'s, of dimension (ldqr,ldqc,nq). # nq the number of Q_{i}'s. # y the response vector of size (nobs) # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 the tolerance for truncation in the tridiagonalization; usually # set to 0.d0. # init 0 : no initial values provided for the theta. # 1 : initial values provided for the theta. # theta initial values of theta if init = 1. # prec1 precision requested for the minimum score value when calling # DMUDR, where precision is the weaker of the absolute and # relative precisions. # maxiter1 maximum number of iterations allowed for DMUDR subroutine; # usually 20 is enough. # prec2 precision for stopping the iteration when estimating the logits; # usually 30 is enough. # maxiter2 maximum number of iterations allowed for the iteration when # estimating the logits. # varht known variance if vmu=='u'. varht=1.0 if no dispersion. X # On exit: # init init = 1. # maxiter2 the number left out of the total number allowed. # theta the vector of parameter log10(theta) used in the final model, # of dimension (nq). -25 indicates effective minus infinity. # nlaht the estimated log10(n*lambda)|theta in the final model. # score the minimum GCV/GML/URE score found at (theta, nlaht). # varht the variance estimate. # c,d the coefficient estimates. # eta the estimated logit of probabilities at design points. # info 0 : normal termination. # -1 : dimension error. # -2 : F_{2}^{T} Q_{*}^{theta} F_{2} !>= 0. # -3 : tuning parameters are out of scope. # -4 : DMUDR fails to converge within maxiter1 steps. # -5 : fails to find a reasonable descent direction. # -6 : Logit estimation fail to converge within maxiter2 steps. # -7 : There are some w's equals to zero. # >0 : the matrix S is rank deficient: rank(S)+1. # s,q,y not destroyed. # others intact. X # Work arrays: # wk of size (nobs*nobs*(nq+2)) # swk same size of s. # qwk same size of q. # ywk same size of y. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dmudr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal, dswap, idamax # Blas2 -- dgemv, dsymv, dsyr2 # Fortran -- dabs, dexp, dfloat, dlog, dlog10, dmax1, dsqrt # Linpack -- dpbfa, dpbsl, dpofa, dposl, dqrdc, dqrsl, dtrsl # Rkpack -- dcoef, dcore, ddeev, deval, dgold, dmcdc, dqrslm, # dstup, dsytr, dtrev, dmudr1 # Other -- dprmut, dset X # Written: Yuedong Wang, Department of Statistics, # University of Wisconsin - Madison. # Latest version 7/6/93. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat { X maxiter2 = maxiter2 - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) > 700.d0) tmp = 1.d0 X else tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) X u(j) = tmp - y(j) X w(j) = tmp * (1 - tmp) X if (w(j) <= mtol) { X info = -7 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -7) break X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X for (i=1;i<=nq;i=i+1) { X for (j=1;j<=ldqr;j=j+1) { X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X } X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dmudr (vmu,_ X swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk,_ X tol2, init, prec1, maxiter1,_ X theta, nlaht, score, varht, c, d,_ X wk, info) X X init = 1 X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec2 ) break X if ( maxiter2 < 1 ) { X info = -6 X break X } } X return end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbmdr.r' && chmod 0644 'grkpack/grkpack/dbmdr.r' || echo 'restore of grkpack/grkpack/dbmdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dbmdr.r'`" test 6897 -eq "$shar_count" || echo "grkpack/grkpack/dbmdr.r: original size 6897, current size $shar_count" fi # ============= grkpack/grkpack/dbisdr.r ============== if test -f 'grkpack/grkpack/dbisdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbisdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dbisdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbisdr.r' && X #:::::::::::: # dbisdr #:::::::::::: X subroutine dbisdr (vmu,_ X s, lds, nobs, nnull, y, q, ldq,_ # data X tol1, tol2, job, limnla, prec, maxiter,_ # job requests X nlaht, score, varht, c, d, eta,_ # output X qraux, jpvt, wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Binomial data Single smoothing parameter DRiver. X X character*2 vmu integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter double precision s(lds,*), y(2,*), q(ldq,*), tol1, tol2, limnla(2), nlaht, score(*),_ X varht, c(*), d(*), qraux(*), wk(*), prec, eta(*),_ X swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S of size (nobs,nnull). # lds the leading dimension of s. # nobs the number of observations. # nnull the dimension of the null space. # y the observations. The first column is the largest possible counts # and the second column is the counts actually obsered. # q the matrix Q, only the lower triangle referred. # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 tolerance for truncation in `dsytr'. If 0.d0, set to # square of machine precision. # job <=0 : golden-section search # 0 -- searching interval specified automatically. # -1 -- search on (limnla(1), limnla(2)). # >0 : regular grid search on [limnla(1), limnla(2)] # #(grids) = job + 1. # limnla the searching interval (in log10 scale), see job. # varht known variance and only has effect when vmu=='u'. varht=1.0 # if no dispersion. # prec precision for stopping the iteration. # maxiter maximum number of iterations allowed for the iteration. X # On exit: # nlaht the GCV/GML/URE estimate of log10(nobs*lambda). # limnla searching range for nlaht. # score job <= 0 : GCV/GML/URE value at nlaht. # job > 0 : GCV/GML/URE vector on the regular grid points. # varht the variance estimate. # c the parameters c. # d the parameters d. # eta the estimated logit of probabilities at design points. # swk,qraux,jpvt # QR decomposition of SWK=FR, as from Linpack `dqrdc'. # qwk first nnull columns: F^{T} Q F_{1}. # BOTTOM-RIGHT corner: tridiagonalization of # F_{2}^{T} Q F_{2}. # info 0: normal termination. # -1: dimension error. # -2: F_{2}^{T} Q F_{2} !>= 0. # -3: vmu is out of scope. # -4: fail to converge at the maxiter steps. # -5: There are some w's equals to zero. # >0: the matrix S is rank deficient: rank(S)+1. # others intact. X # Work arrays: # wk of size at least (3*nobs). # swk same size of s. # qwk same size of q. # ywk of size of nobs. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dsidr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Fortran -- dexp, dfloat, dlog, dlog10, dsqrt # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal # Blas2 -- dsymv, dsyr2 # Linpack -- dpbfa, dpbsl, dqrdc, dqrsl, dtrsl # Rkpack -- deval, dgold, dqrslm, dsytr, dtrev # Other -- dprmut, dset X # Written: YUEDONG WANG, Department of Statistics, University of Wisconsin - Madison. # Latest version 7/1/93. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat{ X maxiter = maxiter - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) > 700.d0) tmp = 1.d0 X else tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) X u(j) = y(1,j) * tmp - y(2,j) X w(j) = y(1,j) * tmp * (1 - tmp) X if (w(j) <= mtol) { X info = -5 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -5) break X call dcopy (ldq*nobs, q, 1, qwk, 1) X for (j=1;j<=nobs;j=j+1) { X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dsidr (vmu,_ X swk, lds, nobs, nnull, ywk, qwk, ldq,_ # data X tol2, job, limnla,_ # job requests X nlaht, score, varht, c, d,_ # output X qraux, jpvt, wk,_ # work arrays X info) # error message X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec ) break X if ( maxiter < 1 ) { X info = -4 X break X } } X return end X #................................................................................ SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbisdr.r' && chmod 0644 'grkpack/grkpack/dbisdr.r' || echo 'restore of grkpack/grkpack/dbisdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dbisdr.r'`" test 6244 -eq "$shar_count" || echo "grkpack/grkpack/dbisdr.r: original size 6244, current size $shar_count" fi # ============= grkpack/grkpack/dpsdr.r ============== if test -f 'grkpack/grkpack/dpsdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dpsdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dpsdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dpsdr.r' && X #:::::::::::: # dpsdr #:::::::::::: X subroutine dpsdr (vmu,_ X s, lds, nobs, nnull, y, q, ldq,_ # data X tol1, tol2, job, limnla, prec, maxiter,_ # job requests X nlaht, score, varht, c, d, eta,_ # output X qraux, jpvt, wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Poisson data Single smoothing parameter DRiver. X X character*2 vmu integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter double precision s(lds,*), y(*), q(ldq,*), tol1, tol2, limnla(2), nlaht, score(*),_ X varht, c(*), d(*), qraux(*), wk(*), prec, eta(*),_ X swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S of size (nobs,nnull). # lds the leading dimension of s. # nobs the number of observations. # nnull the dimension of the null space. # y the observations. # q the matrix Q, only the lower triangle referred. # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 tolerance for truncation in `dsytr'. If 0.d0, set to # square of machine precision. # job <=0 : golden-section search # 0 -- searching interval specified automatically. # -1 -- search on (limnla(1), limnla(2)). # >0 : regular grid search on [limnla(1), limnla(2)] # #(grids) = job + 1. # limnla the searching interval (in log10 scale), see job. # varht known variance and only has effect when vmu=='u'. varht=1.0 # if no dispersion. # prec precision for stopping the iteration. # maxiter maximum number of iterations allowed for the iteration. X # On exit: # nlaht the GCV/GML/URE estimate of log10(nobs*lambda). # limnla searching range for nlaht. # score job <= 0 : GCV/GML/URE value at nlaht. # job > 0 : GCV/GML/URE vector on the regular grid points. # varht the variance estimate. # c the parameters c. # d the parameters d. # eta the estimated logit of probabilities at design points. # swk,qraux,jpvt # QR decomposition of SWK=FR, as from Linpack `dqrdc'. # qwk first nnull columns: F^{T} Q F_{1}. # BOTTOM-RIGHT corner: tridiagonalization of # F_{2}^{T} Q F_{2}. # info 0: normal termination. # -1: dimension error. # -2: F_{2}^{T} Q F_{2} !>= 0. # -3: vmu is out of scope. # -4: fail to converge at the maxiter steps. # -5: There are some w's equals to zero. # >0: the matrix S is rank deficient: rank(S)+1. # others intact. X # Work arrays: # wk of size at least (3*nobs). # swk same size of s. # qwk same size of q. # ywk same size of y. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dsidr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Fortran -- dexp, dfloat, dlog, dlog10, dsqrt # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal # Blas2 -- dsymv, dsyr2 # Linpack -- dpbfa, dpbsl, dqrdc, dqrsl, dtrsl # Rkpack -- deval, dgold, dqrslm, dsytr, dtrev # Other -- dprmut, dset X # Written: YUEDONG WANG, Department of Statistics, University of Wisconsin - Madison. # Latest version 7/1/93. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat{ X maxiter = maxiter - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) > 700.d0) w(j) = 1.d0 X else w(j) = dexp (eta(j)) X u(j) = w(j) - y(j) X if (w(j) <= mtol) { X info = -5 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -5) break X call dcopy (ldq*nobs, q, 1, qwk, 1) X for (j=1;j<=nobs;j=j+1) { X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dsidr (vmu,_ X swk, lds, nobs, nnull, ywk, qwk, ldq,_ # data X tol2, job, limnla,_ # job requests X nlaht, score, varht, c, d,_ # output X qraux, jpvt, wk,_ # work arrays X info) # error message X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec ) break X if ( maxiter < 1 ) { X info = -4 X break X } } X return end X #................................................................................ SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dpsdr.r' && chmod 0644 'grkpack/grkpack/dpsdr.r' || echo 'restore of grkpack/grkpack/dpsdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dpsdr.r'`" test 6046 -eq "$shar_count" || echo "grkpack/grkpack/dpsdr.r: original size 6046, current size $shar_count" fi # ============= grkpack/grkpack/dbisdr.f ============== if test -f 'grkpack/grkpack/dbisdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbisdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dbisdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbisdr.f' && X subroutine dbisdr (vmu, s, lds, nobs, nnull, y, q, ldq, tol1, X &tol2, job, limnla, prec, maxiter, nlaht, score, varht, c, d, eta, X &qraux, jpvt, wk, swk, qwk, ywk, u, w, info) X character*2 vmu X integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter X double precision s(lds,*), y(2,*), q(ldq,*), tol1, tol2, limnla(2) X &, nlaht, score(*), varht, c(*), d(*), qraux(*), wk(*), prec, eta(* X &), swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter = maxiter - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .gt. 700.d0))goto 23010 X tmp = 1.d0 X goto 23011 23010 continue X tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) 23011 continue X u(j) = y(1,j) * tmp - y(2,j) X w(j) = y(1,j) * tmp * (1 - tmp) X if(.not.(w(j) .le. mtol))goto 23012 X info = -5 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -5))goto 23017 X goto 23006 23017 continue X call dcopy (ldq*nobs, q, 1, qwk, 1) X j=1 23019 if(.not.(j.le.nobs))goto 23021 X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X j=j+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23022 X varht = 0.d0 X j=1 23024 if(.not.(j.le.nobs))goto 23026 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23024 23026 continue X varht = varht / dble (nobs) 23022 continue X call dcopy (nobs, ywk, 1, u, 1) X call dsidr (vmu, swk, lds, nobs, nnull, ywk, qwk, ldq, tol2, job, X &limnla, nlaht, score, varht, c, d, qraux, jpvt, wk, info) X mse = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X j=j+1 X goto 23027 23029 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23030 X goto 23006 23030 continue X if(.not.( mse .lt. prec ))goto 23032 X goto 23006 23032 continue X if(.not.( maxiter .lt. 1 ))goto 23034 X info = -4 X goto 23006 23034 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbisdr.f' && chmod 0644 'grkpack/grkpack/dbisdr.f' || echo 'restore of grkpack/grkpack/dbisdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dbisdr.f'`" test 2750 -eq "$shar_count" || echo "grkpack/grkpack/dbisdr.f: original size 2750, current size $shar_count" fi # ============= grkpack/grkpack/dbimdr.r ============== if test -f 'grkpack/grkpack/dbimdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbimdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dbimdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbimdr.r' && #::::::::::: # dbmdr #::::::::::: X subroutine dbimdr (vmu,_ X s, lds, nobs, nnull, q, ldqr, ldqc, nq, y,_ # inputs X tol1, tol2, init, prec1, maxiter1, prec2, maxiter2,_ # tune para X theta, nlaht, score, varht, c, d, eta,_ # outputs X wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Binomial data Multiple smoothing parameter DRiver. X # Purpose: This routine implements the iterative algorithm for estimating # mutivariate logit probability for binomial data with multiple smoothing # parameters estimated by GCV/GML/URE method. X # WARNING: Please be sure that you understand what this routine does before # you call it. Pilot runs with small problems are recommended. This # routine performs VERY INTENSIVE numerical calculations for big nobs. X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1,_ X maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(2,*), tol1, tol2, prec1, prec2,_ X theta(*), nlaht, score, varht, c(*), d(*),_ X wk(*), eta(*), swk(lds,*), qwk(ldqr,ldqc,*),_ X ywk(*), u(*), w(*) X character*2 vmu X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S, of size (lds,nnull). # nobs the number of observations. # nnull the dimension of the null space. # q the matrices Q_{i}'s, of dimension (ldqr,ldqc,nq). # nq the number of Q_{i}'s. # y the response matrix of size (2*nobs). The first column is the # largest possible counts and the second column is the counts # actually obsered. # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 the tolerance for truncation in the tridiagonalization; usually # set to 0.d0. # init 0 : no initial values provided for the theta. # 1 : initial values provided for the theta. # theta initial values of theta if init = 1. # prec1 precision requested for the minimum score value when calling # DMUDR, where precision is the weaker of the absolute and # relative precisions. # maxiter1 maximum number of iterations allowed for DMUDR subroutine; # usually 20 is enough. # prec2 precision for stopping the iteration when estimating the logits; # usually 30 is enough. # maxiter2 maximum number of iterations allowed for the iteration when # estimating the logits. # varht known variance if vmu=='u'. varht=1.0 if no dispersion. X # On exit: # init init = 1. # maxiter2 the number left out of the total number allowed. # theta the vector of parameter log10(theta) used in the final model, # of dimension (nq). -25 indicates effective minus infinity. # nlaht the estimated log10(n*lambda)|theta in the final model. # score the minimum GCV/GML/URE score found at (theta, nlaht). # varht the variance estimate. # c,d the coefficient estimates. # eta the estimated logit of probabilities at design points. # info 0 : normal termination. # -1 : dimension error. # -2 : F_{2}^{T} Q_{*}^{theta} F_{2} !>= 0. # -3 : tuning parameters are out of scope. # -4 : DMUDR fails to converge within maxiter1 steps. # -5 : fails to find a reasonable descent direction. # -6 : Logit estimation fail to converge within maxiter2 steps. # -7 : There are some w's equals to zero. # >0 : the matrix S is rank deficient: rank(S)+1. # s,q,y not destroyed. # others intact. X # Work arrays: # wk of size (nobs*nobs*(nq+2)) # swk same size of s. # qwk same size of q. # ywk of size of nobs. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dmudr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal, dswap, idamax # Blas2 -- dgemv, dsymv, dsyr2 # Fortran -- dabs, dexp, dfloat, dlog, dlog10, dmax1, dsqrt # Linpack -- dpbfa, dpbsl, dpofa, dposl, dqrdc, dqrsl, dtrsl # Rkpack -- dcoef, dcore, ddeev, deval, dgold, dmcdc, dqrslm, # dstup, dsytr, dtrev, dmudr1 # Other -- dprmut, dset X # Written: Yuedong Wang, Department of Statistics, # University of Wisconsin - Madison. # Latest version 7/6/93. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat { X maxiter2 = maxiter2 - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) > 700.d0) tmp = 1.d0 X else tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) X u(j) = y(1,j) * tmp - y(2,j) X w(j) = y(1,j) * tmp * (1 - tmp) X if (w(j) <= mtol) { X info = -7 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -7) break X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X for (i=1;i<=nq;i=i+1) { X for (j=1;j<=ldqr;j=j+1) { X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X } X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dmudr (vmu,_ X swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk,_ X tol2, init, prec1, maxiter1,_ X theta, nlaht, score, varht, c, d,_ X wk, info) X X init = 1 X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec2 ) break X if ( maxiter2 < 1 ) { X info = -6 X break X } } X return end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbimdr.r' && chmod 0644 'grkpack/grkpack/dbimdr.r' || echo 'restore of grkpack/grkpack/dbimdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dbimdr.r'`" test 7067 -eq "$shar_count" || echo "grkpack/grkpack/dbimdr.r: original size 7067, current size $shar_count" fi # ============= grkpack/grkpack/dpsdr.f ============== if test -f 'grkpack/grkpack/dpsdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dpsdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dpsdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dpsdr.f' && X subroutine dpsdr (vmu, s, lds, nobs, nnull, y, q, ldq, tol1, tol2, X & job, limnla, prec, maxiter, nlaht, score, varht, c, d, eta, X &qraux, jpvt, wk, swk, qwk, ywk, u, w, info) X character*2 vmu X integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter X double precision s(lds,*), y(*), q(ldq,*), tol1, tol2, limnla(2), X &nlaht, score(*), varht, c(*), d(*), qraux(*), wk(*), prec, eta(*), X & swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter = maxiter - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .gt. 700.d0))goto 23010 X w(j) = 1.d0 X goto 23011 23010 continue X w(j) = dexp (eta(j)) 23011 continue X u(j) = w(j) - y(j) X if(.not.(w(j) .le. mtol))goto 23012 X info = -5 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -5))goto 23017 X goto 23006 23017 continue X call dcopy (ldq*nobs, q, 1, qwk, 1) X j=1 23019 if(.not.(j.le.nobs))goto 23021 X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X j=j+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23022 X varht = 0.d0 X j=1 23024 if(.not.(j.le.nobs))goto 23026 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23024 23026 continue X varht = varht / dble (nobs) 23022 continue X call dcopy (nobs, ywk, 1, u, 1) X call dsidr (vmu, swk, lds, nobs, nnull, ywk, qwk, ldq, tol2, job, X &limnla, nlaht, score, varht, c, d, qraux, jpvt, wk, info) X mse = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X j=j+1 X goto 23027 23029 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23030 X goto 23006 23030 continue X if(.not.( mse .lt. prec ))goto 23032 X goto 23006 23032 continue X if(.not.( maxiter .lt. 1 ))goto 23034 X info = -4 X goto 23006 23034 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dpsdr.f' && chmod 0644 'grkpack/grkpack/dpsdr.f' || echo 'restore of grkpack/grkpack/dpsdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dpsdr.f'`" test 2676 -eq "$shar_count" || echo "grkpack/grkpack/dpsdr.f: original size 2676, current size $shar_count" fi # ============= grkpack/grkpack/dbimdr.f ============== if test -f 'grkpack/grkpack/dbimdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dbimdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dbimdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dbimdr.f' && X subroutine dbimdr (vmu, s, lds, nobs, nnull, q, ldqr, ldqc, nq, y, X & tol1, tol2, init, prec1, maxiter1, prec2, maxiter2, theta, nlaht, X & score, varht, c, d, eta, wk, swk, qwk, ywk, u, w, info) X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1, X &maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(2,*), tol1, tol2, X &prec1, prec2, theta(*), nlaht, score, varht, c(*), d(*), wk(*), X &eta(*), swk(lds,*), qwk(ldqr,ldqc,*), ywk(*), u(*), w(*) X character*2 vmu X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter2 = maxiter2 - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .gt. 700.d0))goto 23010 X tmp = 1.d0 X goto 23011 23010 continue X tmp = dexp (eta(j)) / (1.d0 + dexp (eta(j))) 23011 continue X u(j) = y(1,j) * tmp - y(2,j) X w(j) = y(1,j) * tmp * (1 - tmp) X if(.not.(w(j) .le. mtol))goto 23012 X info = -7 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -7))goto 23017 X goto 23006 23017 continue X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X i=1 23019 if(.not.(i.le.nq))goto 23021 X j=1 23022 if(.not.(j.le.ldqr))goto 23024 X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X j=j+1 X goto 23022 23024 continue X i=i+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23025 X varht = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23027 23029 continue X varht = varht / dble (nobs) 23025 continue X call dcopy (nobs, ywk, 1, u, 1) X call dmudr (vmu, swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk, X &tol2, init, prec1, maxiter1, theta, nlaht, score, varht, c, d, wk, X & info) X init = 1 X mse = 0.d0 X j=1 23030 if(.not.(j.le.nobs))goto 23032 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X j=j+1 X goto 23030 23032 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23033 X goto 23006 23033 continue X if(.not.( mse .lt. prec2 ))goto 23035 X goto 23006 23035 continue X if(.not.( maxiter2 .lt. 1 ))goto 23037 X info = -6 X goto 23006 23037 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dbimdr.f' && chmod 0644 'grkpack/grkpack/dbimdr.f' || echo 'restore of grkpack/grkpack/dbimdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dbimdr.f'`" test 2926 -eq "$shar_count" || echo "grkpack/grkpack/dbimdr.f: original size 2926, current size $shar_count" fi # ============= grkpack/grkpack/dpmdr.r ============== if test -f 'grkpack/grkpack/dpmdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dpmdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dpmdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dpmdr.r' && #::::::::::: # dpmdr #::::::::::: X subroutine dpmdr (vmu,_ X s, lds, nobs, nnull, q, ldqr, ldqc, nq, y,_ # inputs X tol1, tol2, init, prec1, maxiter1, prec2, maxiter2,_ # tune para X theta, nlaht, score, varht, c, d, eta,_ # outputs X wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Poisson data Multiple smoothing parameter DRiver. X # Purpose: This routine implements the iterative algorithm for estimating # mutivariate logit probability for Poisson data with multiple smoothing # parameters estimated by GCV/GML/URE method. X # WARNING: Please be sure that you understand what this routine does before # you call it. Pilot runs with small problems are recommended. This # routine performs VERY INTENSIVE numerical calculations for big nobs. X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1,_ X maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol1, tol2, prec1, prec2,_ X theta(*), nlaht, score, varht, c(*), d(*),_ X wk(*), eta(*), swk(lds,*), qwk(ldqr,ldqc,*),_ X ywk(*), u(*), w(*) X character*2 vmu X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S, of size (lds,nnull). # nobs the number of observations. # nnull the dimension of the null space. # q the matrices Q_{i}'s, of dimension (ldqr,ldqc,nq). # nq the number of Q_{i}'s. # y the response vector of size (nobs) # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 the tolerance for truncation in the tridiagonalization; usually # set to 0.d0. # init 0 : no initial values provided for the theta. # 1 : initial values provided for the theta. # theta initial values of theta if init = 1. # prec1 precision requested for the minimum score value when calling # DMUDR, where precision is the weaker of the absolute and # relative precisions. # maxiter1 maximum number of iterations allowed for DMUDR subroutine; # usually 20 is enough. # prec2 precision for stopping the iteration when estimating the logits; # usually 30 is enough. # maxiter2 maximum number of iterations allowed for the iteration when # estimating the logits. # varht known variance if vmu=='u'. varht=1.0 if no dispersion. X # On exit: # init init = 1. # maxiter2 the number left out of the total number allowed. # theta the vector of parameter log10(theta) used in the final model, # of dimension (nq). -25 indicates effective minus infinity. # nlaht the estimated log10(n*lambda)|theta in the final model. # score the minimum GCV/GML/URE score found at (theta, nlaht). # varht the variance estimate. # c,d the coefficient estimates. # eta the estimated logit of probabilities at design points. # info 0 : normal termination. # -1 : dimension error. # -2 : F_{2}^{T} Q_{*}^{theta} F_{2} !>= 0. # -3 : tuning parameters are out of scope. # -4 : DMUDR fails to converge within maxiter1 steps. # -5 : fails to find a reasonable descent direction. # -6 : Logit estimation fail to converge within maxiter2 steps. # -7 : There are some w's equals to zero. # >0 : the matrix S is rank deficient: rank(S)+1. # s,q,y not destroyed. # others intact. X # Work arrays: # wk of size (nobs*nobs*(nq+2)) # swk same size of s. # qwk same size of q. # ywk same size of y. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dmudr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal, dswap, idamax # Blas2 -- dgemv, dsymv, dsyr2 # Fortran -- dabs, dexp, dfloat, dlog, dlog10, dmax1, dsqrt # Linpack -- dpbfa, dpbsl, dpofa, dposl, dqrdc, dqrsl, dtrsl # Rkpack -- dcoef, dcore, ddeev, deval, dgold, dmcdc, dqrslm, # dstup, dsytr, dtrev, dmudr1 # Other -- dprmut, dset X # Written: Yuedong Wang, Department of Statistics, # University of Wisconsin - Madison. # Latest version 7/6/93. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat { X maxiter2 = maxiter2 - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) > 700.d0) w(j) = 1.d0 X else w(j) = dexp (eta(j)) X u(j) = w(j) - y(j) X if (w(j) <= mtol) { X info = -7 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -7) break X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X for (i=1;i<=nq;i=i+1) { X for (j=1;j<=ldqr;j=j+1) { X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X } X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dmudr (vmu,_ X swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk,_ X tol2, init, prec1, maxiter1,_ X theta, nlaht, score, varht, c, d,_ X wk, info) X X init = 1 X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec2 ) break X if ( maxiter2 < 1 ) { X info = -6 X break X } } X return end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dpmdr.r' && chmod 0644 'grkpack/grkpack/dpmdr.r' || echo 'restore of grkpack/grkpack/dpmdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dpmdr.r'`" test 6847 -eq "$shar_count" || echo "grkpack/grkpack/dpmdr.r: original size 6847, current size $shar_count" fi # ============= grkpack/grkpack/dpmdr.f ============== if test -f 'grkpack/grkpack/dpmdr.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dpmdr.f (File already exists)' else echo 'x - extracting grkpack/grkpack/dpmdr.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dpmdr.f' && X subroutine dpmdr (vmu, s, lds, nobs, nnull, q, ldqr, ldqc, nq, y, X &tol1, tol2, init, prec1, maxiter1, prec2, maxiter2, theta, nlaht, X &score, varht, c, d, eta, wk, swk, qwk, ywk, u, w, info) X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1, X &maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol1, tol2, X &prec1, prec2, theta(*), nlaht, score, varht, c(*), d(*), wk(*), X &eta(*), swk(lds,*), qwk(ldqr,ldqc,*), ywk(*), u(*), w(*) X character*2 vmu X double precision mse, tmp, dasum, mtol X integer i, j X info = 0 X mtol = 1.d0 23000 if(.not.( 1.d0 + mtol .gt. 1.d0 ))goto 23001 X mtol = mtol / 2.d0 X goto 23000 23001 continue X if(.not.( mtol .lt. tol1 ))goto 23002 X mtol = tol1 23002 continue 23004 continue X maxiter2 = maxiter2 - 1 X j=1 23007 if(.not.(j.le.nobs))goto 23009 X if(.not.(eta(j) .gt. 700.d0))goto 23010 X w(j) = 1.d0 X goto 23011 23010 continue X w(j) = dexp (eta(j)) 23011 continue X u(j) = w(j) - y(j) X if(.not.(w(j) .le. mtol))goto 23012 X info = -7 X goto 23009 23012 continue X i=1 23014 if(.not.(i.le.nnull))goto 23016 X swk(j,i) = s(j,i) * dsqrt (w(j)) X i=i+1 X goto 23014 23016 continue X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X j=j+1 X goto 23007 23009 continue X if(.not.(info .eq. -7))goto 23017 X goto 23006 23017 continue X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X i=1 23019 if(.not.(i.le.nq))goto 23021 X j=1 23022 if(.not.(j.le.ldqr))goto 23024 X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X j=j+1 X goto 23022 23024 continue X i=i+1 X goto 23019 23021 continue X if(.not.(vmu .eq. 'u~'))goto 23025 X varht = 0.d0 X j=1 23027 if(.not.(j.le.nobs))goto 23029 X varht = varht + u(j)**2 / w(j) X j=j+1 X goto 23027 23029 continue X varht = varht / dble (nobs) 23025 continue X call dcopy (nobs, ywk, 1, u, 1) X call dmudr (vmu, swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk, X &tol2, init, prec1, maxiter1, theta, nlaht, score, varht, c, d, wk, X & info) X init = 1 X mse = 0.d0 X j=1 23030 if(.not.(j.le.nobs))goto 23032 X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X j=j+1 X goto 23030 23032 continue X mse = dsqrt (mse / dasum (nobs, w, 1)) X if(.not.( info .ne. 0 ))goto 23033 X goto 23006 23033 continue X if(.not.( mse .lt. prec2 ))goto 23035 X goto 23006 23035 continue X if(.not.( maxiter2 .lt. 1 ))goto 23037 X info = -6 X goto 23006 23037 continue 23005 goto 23004 23006 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dpmdr.f' && chmod 0644 'grkpack/grkpack/dpmdr.f' || echo 'restore of grkpack/grkpack/dpmdr.f failed' shar_count="`wc -c < 'grkpack/grkpack/dpmdr.f'`" test 2852 -eq "$shar_count" || echo "grkpack/grkpack/dpmdr.f: original size 2852, current size $shar_count" fi # ============= grkpack/grkpack/dgsdr.r ============== if test -f 'grkpack/grkpack/dgsdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dgsdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dgsdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dgsdr.r' && X #:::::::::::: # dgsdr #:::::::::::: X subroutine dgsdr (vmu,_ X s, lds, nobs, nnull, y, q, ldq,_ # data X tol1, tol2, job, limnla, prec, maxiter,_ # job requests X nlaht, score, varht, c, d, eta,_ # output X qraux, jpvt, wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Gamma data Single smoothing parameter DRiver. X X character*2 vmu integer lds, nobs, nnull, ldq, job, jpvt(*), info, maxiter double precision s(lds,*), y(*), q(ldq,*), tol1, tol2, limnla(2), nlaht, score(*),_ X varht, c(*), d(*), qraux(*), wk(*), prec, eta(*),_ X swk(lds,*), qwk(ldq,*), ywk(*), u(*), w(*) X X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S of size (nobs,nnull). # lds the leading dimension of s. # nobs the number of observations. # nnull the dimension of the null space. # y the observations. # q the matrix Q, only the lower triangle referred. # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 tolerance for truncation in `dsytr'. If 0.d0, set to # square of machine precision. # job <=0 : golden-section search # 0 -- searching interval specified automatically. # -1 -- search on (limnla(1), limnla(2)). # >0 : regular grid search on [limnla(1), limnla(2)] # #(grids) = job + 1. # limnla the searching interval (in log10 scale), see job. # varht known variance and only has effect when vmu=='u'. varht=1.0 # if no dispersion. # prec precision for stopping the iteration. # maxiter maximum number of iterations allowed for the iteration. X # On exit: # nlaht the GCV/GML/URE estimate of log10(nobs*lambda). # limnla searching range for nlaht. # score job <= 0 : GCV/GML/URE value at nlaht. # job > 0 : GCV/GML/URE vector on the regular grid points. # varht the variance estimate. # c the parameters c. # d the parameters d. # eta the estimated log mean at design points. # swk,qraux,jpvt # QR decomposition of SWK=FR, as from Linpack `dqrdc'. # qwk first nnull columns: F^{T} Q F_{1}. # BOTTOM-RIGHT corner: tridiagonalization of # F_{2}^{T} Q F_{2}. # info 0: normal termination. # -1: dimension error. # -2: F_{2}^{T} Q F_{2} !>= 0. # -3: vmu is out of scope. # -4: fail to converge at the maxiter steps. # -5: There are some w's equals to zero. # >0: the matrix S is rank deficient: rank(S)+1. # others intact. X # Work arrays: # wk of size at least (3*nobs). # swk same size of s. # qwk same size of q. # ywk same size of y. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dsidr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Fortran -- dexp, dfloat, dlog, dlog10, dsqrt # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal # Blas2 -- dsymv, dsyr2 # Linpack -- dpbfa, dpbsl, dqrdc, dqrsl, dtrsl # Rkpack -- deval, dgold, dqrslm, dsytr, dtrev # Other -- dprmut, dset X # Written: YUEDONG WANG, Department of Statistics, University of Wisconsin - Madison. # Latest version 6/3/94. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # Compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat{ X maxiter = maxiter - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) < -700.d0) tmp = 1.d0 X else tmp = dexp (-eta(j)) X u(j) = 1.d0 - y(j) * tmp X w(j) = y(j) * tmp X if (w(j) <= mtol) { X info = -5 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -5) break X call dcopy (ldq*nobs, q, 1, qwk, 1) X for (j=1;j<=nobs;j=j+1) { X call dscal (nobs-j+1, dsqrt (w(j)), qwk(j,j), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1), nobs) X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dsidr (vmu,_ X swk, lds, nobs, nnull, ywk, qwk, ldq,_ # data X tol2, job, limnla,_ # job requests X nlaht, score, varht, c, d,_ # output X qraux, jpvt, wk,_ # work arrays X info) # error message X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+dabs(eta(j)))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec ) break X if ( maxiter < 1 ) { X info = -4 X break X } } X return end X #................................................................................ SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dgsdr.r' && chmod 0644 'grkpack/grkpack/dgsdr.r' || echo 'restore of grkpack/grkpack/dgsdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dgsdr.r'`" test 6062 -eq "$shar_count" || echo "grkpack/grkpack/dgsdr.r: original size 6062, current size $shar_count" fi # ============= grkpack/grkpack/dgmdr.r ============== if test -f 'grkpack/grkpack/dgmdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/grkpack/dgmdr.r (File already exists)' else echo 'x - extracting grkpack/grkpack/dgmdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/grkpack/dgmdr.r' && #::::::::::: # dgmdr #::::::::::: X subroutine dgmdr (vmu,_ X s, lds, nobs, nnull, q, ldqr, ldqc, nq, y,_ # inputs X tol1, tol2, init, prec1, maxiter1, prec2, maxiter2,_ # tune para X theta, nlaht, score, varht, c, d, eta,_ # outputs X wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message X # Acronym: Double precision Gamma data Multiple smoothing parameter DRiver. X # Purpose: This routine implements the iterative algorithm for estimating # mutivariate log mean for gamma data with multiple smoothing # parameters estimated by GCV/GML/URE method. X # WARNING: Please be sure that you understand what this routine does before # you call it. Pilot runs with small problems are recommended. This # routine performs VERY INTENSIVE numerical calculations for big nobs. X integer lds, nobs, nnull, ldqr, ldqc, nq, init, maxiter1,_ X maxiter2, info X double precision s(lds,*), q(ldqr,ldqc,*), y(*), tol1, tol2, prec1, prec2,_ X theta(*), nlaht, score, varht, c(*), d(*),_ X wk(*), eta(*), swk(lds,*), qwk(ldqr,ldqc,*),_ X ywk(*), u(*), w(*) X character*2 vmu X # On entry: # vmu 'v': GCV criterion. Option U. # 'm': GML criterion. # 'u': unbiased risk estimate with known variance. Option U. # 'u~': unbiased risk estimate with unknown variance. Option U~. # s the matrix S, of size (lds,nnull). # nobs the number of observations. # nnull the dimension of the null space. # q the matrices Q_{i}'s, of dimension (ldqr,ldqc,nq). # nq the number of Q_{i}'s. # y the response vector of size (nobs) # tol1 the tolerance for elements of w's. This method needs w!=0. # Usually set to 0.d0. Then the machine precision is used. # tol2 the tolerance for truncation in the tridiagonalization; usually # set to 0.d0. # init 0 : no initial values provided for the theta. # 1 : initial values provided for the theta. # theta initial values of theta if init = 1. # prec1 precision requested for the minimum score value when calling # DMUDR, where precision is the weaker of the absolute and # relative precisions. # maxiter1 maximum number of iterations allowed for DMUDR subroutine; # usually 20 is enough. # prec2 precision for stopping the iteration when estimating the logits; # usually 30 is enough. # maxiter2 maximum number of iterations allowed for the iteration when # estimating the logits. # varht known variance if vmu=='u'. varht=1.0 if no dispersion. X # On exit: # init init = 1. # maxiter2 the number left out of the total number allowed. # theta the vector of parameter log10(theta) used in the final model, # of dimension (nq). -25 indicates effective minus infinity. # nlaht the estimated log10(n*lambda)|theta in the final model. # score the minimum GCV/GML/URE score found at (theta, nlaht). # varht the variance estimate. # c,d the coefficient estimates. # eta the estimated logit of probabilities at design points. # info 0 : normal termination. # -1 : dimension error. # -2 : F_{2}^{T} Q_{*}^{theta} F_{2} !>= 0. # -3 : tuning parameters are out of scope. # -4 : DMUDR fails to converge within maxiter1 steps. # -5 : fails to find a reasonable descent direction. # -6 : Logit estimation fail to converge within maxiter2 steps. # -7 : There are some w's equals to zero. # >0 : the matrix S is rank deficient: rank(S)+1. # s,q,y not destroyed. # others intact. X # Work arrays: # wk of size (nobs*nobs*(nq+2)) # swk same size of s. # qwk same size of q. # ywk same size of y. # u First derivitives. # w Second derivitives. X # Routines called directly: # Rkpack -- dmudr # Fortran -- dexp, dsqrt, dabs # Blas -- dasum, dcopy, dscal # Other -- dset X # Routines called indirectly: # Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal, dswap, idamax # Blas2 -- dgemv, dsymv, dsyr2 # Fortran -- dabs, dexp, dfloat, dlog, dlog10, dmax1, dsqrt # Linpack -- dpbfa, dpbsl, dpofa, dposl, dqrdc, dqrsl, dtrsl # Rkpack -- dcoef, dcore, ddeev, deval, dgold, dmcdc, dqrslm, # dstup, dsytr, dtrev, dmudr1 # Other -- dprmut, dset X # Written: Yuedong Wang, Department of Statistics, # University of Wisconsin - Madison. # Latest version 7/6/93. X double precision mse, tmp, dasum, mtol integer i, j X info = 0 # compute machine precision mtol = 1.d0 while ( 1.d0 + mtol > 1.d0 ) mtol = mtol / 2.d0 if ( mtol < tol1 ) mtol = tol1 X repeat { X maxiter2 = maxiter2 - 1 X for (j=1;j<=nobs;j=j+1) { X if (eta(j) < -700.d0) tmp = 1.d0 X else tmp = dexp (-eta(j)) X u(j) = 1.d0 - y(j) * tmp X w(j) = y(j) * tmp X if (w(j) <= mtol) { X info = -7 X break X } X for (i=1;i<=nnull;i=i+1) swk(j,i) = s(j,i) * dsqrt (w(j)) X ywk(j) = dsqrt (w(j)) * (eta(j) - u(j) / w(j)) X } X if (info == -7) break X call dcopy (ldqr*ldqc*nq, q, 1, qwk, 1) X for (i=1;i<=nq;i=i+1) { X for (j=1;j<=ldqr;j=j+1) { X call dscal (ldqr-j+1, dsqrt (w(j)), qwk(j,j,i), 1) X call dscal (j, dsqrt (w(j)), qwk(j,1,i), ldqr) X } X } X if (vmu == 'u~') { X varht = 0.d0 X for (j=1;j<=nobs;j=j+1){ X varht = varht + u(j)**2 / w(j) X } X varht = varht / dble (nobs) X } X call dcopy (nobs, ywk, 1, u, 1) X X call dmudr (vmu,_ X swk, lds, nobs, nnull, qwk, ldqr, ldqc, nq, ywk,_ X tol2, init, prec1, maxiter1,_ X theta, nlaht, score, varht, c, d,_ X wk, info) X X init = 1 X X mse = 0.d0 X for (j=1;j<=nobs;j=j+1) { X tmp = eta(j) X eta(j) = (u(j) - 10.d0 ** nlaht * c(j)) / dsqrt (w(j)) X c(j) = c(j) * dsqrt (w(j)) X mse = mse + w(j) * ((eta(j)-tmp)/(1.d0+eta(j))) ** 2 X } X mse = dsqrt (mse / dasum (nobs, w, 1)) X if ( info != 0 ) break X if ( mse < prec2 ) break X if ( maxiter2 < 1 ) { X info = -6 X break X } } X return end SHAR_EOF $shar_touch -am 0116120295 'grkpack/grkpack/dgmdr.r' && chmod 0644 'grkpack/grkpack/dgmdr.r' || echo 'restore of grkpack/grkpack/dgmdr.r failed' shar_count="`wc -c < 'grkpack/grkpack/dgmdr.r'`" test 6866 -eq "$shar_count" || echo "grkpack/grkpack/dgmdr.r: original size 6866, current size $shar_count" fi # ============= grkpack/lib/dpbfa.f ============== if test ! -d 'grkpack/lib'; then echo 'x - creating directory grkpack/lib' mkdir 'grkpack/lib' fi if test -f 'grkpack/lib/dpbfa.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dpbfa.f (File already exists)' else echo 'x - extracting grkpack/lib/dpbfa.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dpbfa.f' && X SUBROUTINE DPBFA(ABD,LDA,N,M,INFO) X INTEGER LDA,N,M,INFO X DOUBLE PRECISION ABD(LDA,1) C C DPBFA FACTORS A DOUBLE PRECISION SYMMETRIC POSITIVE DEFINITE C MATRIX STORED IN BAND FORM. C C DPBFA IS USUALLY CALLED BY DPBCO, BUT IT CAN BE CALLED C DIRECTLY WITH A SAVING IN TIME IF RCOND IS NOT NEEDED. C C ON ENTRY C C ABD DOUBLE PRECISION(LDA, N) C THE MATRIX TO BE FACTORED. THE COLUMNS OF THE UPPER C TRIANGLE ARE STORED IN THE COLUMNS OF ABD AND THE C DIAGONALS OF THE UPPER TRIANGLE ARE STORED IN THE C ROWS OF ABD . SEE THE COMMENTS BELOW FOR DETAILS. C C LDA INTEGER C THE LEADING DIMENSION OF THE ARRAY ABD . C LDA MUST BE .GE. M + 1 . C C N INTEGER C THE ORDER OF THE MATRIX A . C C M INTEGER C THE NUMBER OF DIAGONALS ABOVE THE MAIN DIAGONAL. C 0 .LE. M .LT. N . C C ON RETURN C C ABD AN UPPER TRIANGULAR MATRIX R , STORED IN BAND C FORM, SO THAT A = TRANS(R)*R . C C INFO INTEGER C = 0 FOR NORMAL RETURN. C = K IF THE LEADING MINOR OF ORDER K IS NOT C POSITIVE DEFINITE. C C BAND STORAGE C C IF A IS A SYMMETRIC POSITIVE DEFINITE BAND MATRIX, C THE FOLLOWING PROGRAM SEGMENT WILL SET UP THE INPUT. C C M = (BAND WIDTH ABOVE DIAGONAL) C DO 20 J = 1, N C I1 = MAX0(1, J-M) C DO 10 I = I1, J C K = I-J+M+1 C ABD(K,J) = A(I,J) C 10 CONTINUE C 20 CONTINUE C C LINPACK. THIS VERSION DATED 08/14/78 . C CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. C C SUBROUTINES AND FUNCTIONS C C BLAS DDOT C FORTRAN MAX0,DSQRT C C INTERNAL VARIABLES C X DOUBLE PRECISION DDOT,T X DOUBLE PRECISION S X INTEGER IK,J,JK,K,MU C BEGIN BLOCK WITH ...EXITS TO 40 C C X DO 30 J = 1, N X INFO = J X S = 0.0D0 X IK = M + 1 X JK = MAX0(J-M,1) X MU = MAX0(M+2-J,1) X IF (M .LT. MU) GO TO 20 X DO 10 K = MU, M X T = ABD(K,J) - DDOT(K-MU,ABD(IK,JK),1,ABD(MU,J),1) X T = T/ABD(M+1,JK) X ABD(K,J) = T X S = S + T*T X IK = IK - 1 X JK = JK + 1 X 10 CONTINUE X 20 CONTINUE X S = ABD(M+1,J) - S C ......EXIT X IF (S .LE. 0.0D0) GO TO 40 X ABD(M+1,J) = DSQRT(S) X 30 CONTINUE X INFO = 0 X 40 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dpbfa.f' && chmod 0644 'grkpack/lib/dpbfa.f' || echo 'restore of grkpack/lib/dpbfa.f failed' shar_count="`wc -c < 'grkpack/lib/dpbfa.f'`" test 2767 -eq "$shar_count" || echo "grkpack/lib/dpbfa.f: original size 2767, current size $shar_count" fi # ============= grkpack/lib/dpbsl.f ============== if test -f 'grkpack/lib/dpbsl.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dpbsl.f (File already exists)' else echo 'x - extracting grkpack/lib/dpbsl.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dpbsl.f' && X SUBROUTINE DPBSL(ABD,LDA,N,M,B) X INTEGER LDA,N,M X DOUBLE PRECISION ABD(LDA,1),B(1) C C DPBSL SOLVES THE DOUBLE PRECISION SYMMETRIC POSITIVE DEFINITE C BAND SYSTEM A*X = B C USING THE FACTORS COMPUTED BY DPBCO OR DPBFA. C C ON ENTRY C C ABD DOUBLE PRECISION(LDA, N) C THE OUTPUT FROM DPBCO OR DPBFA. C C LDA INTEGER C THE LEADING DIMENSION OF THE ARRAY ABD . C C N INTEGER C THE ORDER OF THE MATRIX A . C C M INTEGER C THE NUMBER OF DIAGONALS ABOVE THE MAIN DIAGONAL. C C B DOUBLE PRECISION(N) C THE RIGHT HAND SIDE VECTOR. C C ON RETURN C C B THE SOLUTION VECTOR X . C C ERROR CONDITION C C A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS C A ZERO ON THE DIAGONAL. TECHNICALLY THIS INDICATES C SINGULARITY BUT IT IS USUALLY CAUSED BY IMPROPER SUBROUTINE C ARGUMENTS. IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED C CORRECTLY AND INFO .EQ. 0 . C C TO COMPUTE INVERSE(A) * C WHERE C IS A MATRIX C WITH P COLUMNS C CALL DPBCO(ABD,LDA,N,RCOND,Z,INFO) C IF (RCOND IS TOO SMALL .OR. INFO .NE. 0) GO TO ... C DO 10 J = 1, P C CALL DPBSL(ABD,LDA,N,C(1,J)) C 10 CONTINUE C C LINPACK. THIS VERSION DATED 08/14/78 . C CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. C C SUBROUTINES AND FUNCTIONS C C BLAS DAXPY,DDOT C FORTRAN MIN0 C C INTERNAL VARIABLES C X DOUBLE PRECISION DDOT,T X INTEGER K,KB,LA,LB,LM C C SOLVE TRANS(R)*Y = B C X DO 10 K = 1, N X LM = MIN0(K-1,M) X LA = M + 1 - LM X LB = K - LM X T = DDOT(LM,ABD(LA,K),1,B(LB),1) X B(K) = (B(K) - T)/ABD(M+1,K) X 10 CONTINUE C C SOLVE R*X = Y C X DO 20 KB = 1, N X K = N + 1 - KB X LM = MIN0(K-1,M) X LA = M + 1 - LM X LB = K - LM X B(K) = B(K)/ABD(M+1,K) X T = -B(K) X CALL DAXPY(LM,T,ABD(LA,K),1,B(LB),1) X 20 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dpbsl.f' && chmod 0644 'grkpack/lib/dpbsl.f' || echo 'restore of grkpack/lib/dpbsl.f failed' shar_count="`wc -c < 'grkpack/lib/dpbsl.f'`" test 2145 -eq "$shar_count" || echo "grkpack/lib/dpbsl.f: original size 2145, current size $shar_count" fi # ============= grkpack/lib/dpofa.f ============== if test -f 'grkpack/lib/dpofa.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dpofa.f (File already exists)' else echo 'x - extracting grkpack/lib/dpofa.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dpofa.f' && X SUBROUTINE DPOFA(A,LDA,N,INFO) X INTEGER LDA,N,INFO X DOUBLE PRECISION A(LDA,1) C C DPOFA FACTORS A DOUBLE PRECISION SYMMETRIC POSITIVE DEFINITE C MATRIX. C C DPOFA IS USUALLY CALLED BY DPOCO, BUT IT CAN BE CALLED C DIRECTLY WITH A SAVING IN TIME IF RCOND IS NOT NEEDED. C (TIME FOR DPOCO) = (1 + 18/N)*(TIME FOR DPOFA) . C C ON ENTRY C C A DOUBLE PRECISION(LDA, N) C THE SYMMETRIC MATRIX TO BE FACTORED. ONLY THE C DIAGONAL AND UPPER TRIANGLE ARE USED. C C LDA INTEGER C THE LEADING DIMENSION OF THE ARRAY A . C C N INTEGER C THE ORDER OF THE MATRIX A . C C ON RETURN C C A AN UPPER TRIANGULAR MATRIX R SO THAT A = TRANS(R)*R C WHERE TRANS(R) IS THE TRANSPOSE. C THE STRICT LOWER TRIANGLE IS UNALTERED. C IF INFO .NE. 0 , THE FACTORIZATION IS NOT COMPLETE. C C INFO INTEGER C = 0 FOR NORMAL RETURN. C = K SIGNALS AN ERROR CONDITION. THE LEADING MINOR C OF ORDER K IS NOT POSITIVE DEFINITE. C C LINPACK. THIS VERSION DATED 08/14/78 . C CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. C C SUBROUTINES AND FUNCTIONS C C BLAS DDOT C FORTRAN DSQRT C C INTERNAL VARIABLES C X DOUBLE PRECISION DDOT,T X DOUBLE PRECISION S X INTEGER J,JM1,K C BEGIN BLOCK WITH ...EXITS TO 40 C C X DO 30 J = 1, N X INFO = J X S = 0.0D0 X JM1 = J - 1 X IF (JM1 .LT. 1) GO TO 20 X DO 10 K = 1, JM1 X T = A(K,J) - DDOT(K-1,A(1,K),1,A(1,J),1) X T = T/A(K,K) X A(K,J) = T X S = S + T*T X 10 CONTINUE X 20 CONTINUE X S = A(J,J) - S C ......EXIT X IF (S .LE. 0.0D0) GO TO 40 X A(J,J) = DSQRT(S) X 30 CONTINUE X INFO = 0 X 40 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dpofa.f' && chmod 0644 'grkpack/lib/dpofa.f' || echo 'restore of grkpack/lib/dpofa.f failed' shar_count="`wc -c < 'grkpack/lib/dpofa.f'`" test 2022 -eq "$shar_count" || echo "grkpack/lib/dpofa.f: original size 2022, current size $shar_count" fi # ============= grkpack/lib/dposl.f ============== if test -f 'grkpack/lib/dposl.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dposl.f (File already exists)' else echo 'x - extracting grkpack/lib/dposl.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dposl.f' && X SUBROUTINE DPOSL(A,LDA,N,B) X INTEGER LDA,N X DOUBLE PRECISION A(LDA,1),B(1) C C DPOSL SOLVES THE DOUBLE PRECISION SYMMETRIC POSITIVE DEFINITE C SYSTEM A * X = B C USING THE FACTORS COMPUTED BY DPOCO OR DPOFA. C C ON ENTRY C C A DOUBLE PRECISION(LDA, N) C THE OUTPUT FROM DPOCO OR DPOFA. C C LDA INTEGER C THE LEADING DIMENSION OF THE ARRAY A . C C N INTEGER C THE ORDER OF THE MATRIX A . C C B DOUBLE PRECISION(N) C THE RIGHT HAND SIDE VECTOR. C C ON RETURN C C B THE SOLUTION VECTOR X . C C ERROR CONDITION C C A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS C A ZERO ON THE DIAGONAL. TECHNICALLY THIS INDICATES C SINGULARITY BUT IT IS USUALLY CAUSED BY IMPROPER SUBROUTINE C ARGUMENTS. IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED C CORRECTLY AND INFO .EQ. 0 . C C TO COMPUTE INVERSE(A) * C WHERE C IS A MATRIX C WITH P COLUMNS C CALL DPOCO(A,LDA,N,RCOND,Z,INFO) C IF (RCOND IS TOO SMALL .OR. INFO .NE. 0) GO TO ... C DO 10 J = 1, P C CALL DPOSL(A,LDA,N,C(1,J)) C 10 CONTINUE C C LINPACK. THIS VERSION DATED 08/14/78 . C CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB. C C SUBROUTINES AND FUNCTIONS C C BLAS DAXPY,DDOT C C INTERNAL VARIABLES C X DOUBLE PRECISION DDOT,T X INTEGER K,KB C C SOLVE TRANS(R)*Y = B C X DO 10 K = 1, N X T = DDOT(K-1,A(1,K),1,B(1),1) X B(K) = (B(K) - T)/A(K,K) X 10 CONTINUE C C SOLVE R*X = Y C X DO 20 KB = 1, N X K = N + 1 - KB X B(K) = B(K)/A(K,K) X T = -B(K) X CALL DAXPY(K-1,T,A(1,K),1,B(1),1) X 20 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dposl.f' && chmod 0644 'grkpack/lib/dposl.f' || echo 'restore of grkpack/lib/dposl.f failed' shar_count="`wc -c < 'grkpack/lib/dposl.f'`" test 1848 -eq "$shar_count" || echo "grkpack/lib/dposl.f: original size 1848, current size $shar_count" fi # ============= grkpack/lib/dqrdc.f ============== if test -f 'grkpack/lib/dqrdc.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dqrdc.f (File already exists)' else echo 'x - extracting grkpack/lib/dqrdc.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dqrdc.f' && X SUBROUTINE DQRDC(X,LDX,N,P,QRAUX,JPVT,WORK,JOB) X INTEGER LDX,N,P,JOB X INTEGER JPVT(1) X DOUBLE PRECISION X(LDX,1),QRAUX(1),WORK(1) C C DQRDC USES HOUSEHOLDER TRANSFORMATIONS TO COMPUTE THE QR C FACTORIZATION OF AN N BY P MATRIX X. COLUMN PIVOTING C BASED ON THE 2-NORMS OF THE REDUCED COLUMNS MAY BE C PERFORMED AT THE USERS OPTION. C C ON ENTRY C C X DOUBLE PRECISION(LDX,P), WHERE LDX .GE. N. C X CONTAINS THE MATRIX WHOSE DECOMPOSITION IS TO BE C COMPUTED. C C LDX INTEGER. C LDX IS THE LEADING DIMENSION OF THE ARRAY X. C C N INTEGER. C N IS THE NUMBER OF ROWS OF THE MATRIX X. C C P INTEGER. C P IS THE NUMBER OF COLUMNS OF THE MATRIX X. C C JPVT INTEGER(P). C JPVT CONTAINS INTEGERS THAT CONTROL THE SELECTION C OF THE PIVOT COLUMNS. THE K-TH COLUMN X(K) OF X C IS PLACED IN ONE OF THREE CLASSES ACCORDING TO THE C VALUE OF JPVT(K). C C IF JPVT(K) .GT. 0, THEN X(K) IS AN INITIAL C COLUMN. C C IF JPVT(K) .EQ. 0, THEN X(K) IS A FREE COLUMN. C C IF JPVT(K) .LT. 0, THEN X(K) IS A FINAL COLUMN. C C BEFORE THE DECOMPOSITION IS COMPUTED, INITIAL COLUMNS C ARE MOVED TO THE BEGINNING OF THE ARRAY X AND FINAL C COLUMNS TO THE END. BOTH INITIAL AND FINAL COLUMNS C ARE FROZEN IN PLACE DURING THE COMPUTATION AND ONLY C FREE COLUMNS ARE MOVED. AT THE K-TH STAGE OF THE C REDUCTION, IF X(K) IS OCCUPIED BY A FREE COLUMN C IT IS INTERCHANGED WITH THE FREE COLUMN OF LARGEST C REDUCED NORM. JPVT IS NOT REFERENCED IF C JOB .EQ. 0. C C WORK DOUBLE PRECISION(P). C WORK IS A WORK ARRAY. WORK IS NOT REFERENCED IF C JOB .EQ. 0. C C JOB INTEGER. C JOB IS AN INTEGER THAT INITIATES COLUMN PIVOTING. C IF JOB .EQ. 0, NO PIVOTING IS DONE. C IF JOB .NE. 0, PIVOTING IS DONE. C C ON RETURN C C X X CONTAINS IN ITS UPPER TRIANGLE THE UPPER C TRIANGULAR MATRIX R OF THE QR FACTORIZATION. C BELOW ITS DIAGONAL X CONTAINS INFORMATION FROM C WHICH THE ORTHOGONAL PART OF THE DECOMPOSITION C CAN BE RECOVERED. NOTE THAT IF PIVOTING HAS C BEEN REQUESTED, THE DECOMPOSITION IS NOT THAT C OF THE ORIGINAL MATRIX X BUT THAT OF X C WITH ITS COLUMNS PERMUTED AS DESCRIBED BY JPVT. C C QRAUX DOUBLE PRECISION(P). C QRAUX CONTAINS FURTHER INFORMATION REQUIRED TO RECOVER C THE ORTHOGONAL PART OF THE DECOMPOSITION. C C JPVT JPVT(K) CONTAINS THE INDEX OF THE COLUMN OF THE C ORIGINAL MATRIX THAT HAS BEEN INTERCHANGED INTO C THE K-TH COLUMN, IF PIVOTING WAS REQUESTED. C C LINPACK. THIS VERSION DATED 08/14/78 . C G.W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB. C C DQRDC USES THE FOLLOWING FUNCTIONS AND SUBPROGRAMS. C C BLAS DAXPY,DDOT,DSCAL,DSWAP,DNRM2 C FORTRAN DABS,DMAX1,MIN0,DSQRT C C INTERNAL VARIABLES C X INTEGER J,JP,L,LP1,LUP,MAXJ,PL,PU X DOUBLE PRECISION MAXNRM,DNRM2,TT X DOUBLE PRECISION DDOT,NRMXL,T X LOGICAL NEGJ,SWAPJ C C X PL = 1 X PU = 0 X IF (JOB .EQ. 0) GO TO 60 C C PIVOTING HAS BEEN REQUESTED. REARRANGE THE COLUMNS C ACCORDING TO JPVT. C X DO 20 J = 1, P X SWAPJ = JPVT(J) .GT. 0 X NEGJ = JPVT(J) .LT. 0 X JPVT(J) = J X IF (NEGJ) JPVT(J) = -J X IF (.NOT.SWAPJ) GO TO 10 X IF (J .NE. PL) CALL DSWAP(N,X(1,PL),1,X(1,J),1) X JPVT(J) = JPVT(PL) X JPVT(PL) = J X PL = PL + 1 X 10 CONTINUE X 20 CONTINUE X PU = P X DO 50 JJ = 1, P X J = P - JJ + 1 X IF (JPVT(J) .GE. 0) GO TO 40 X JPVT(J) = -JPVT(J) X IF (J .EQ. PU) GO TO 30 X CALL DSWAP(N,X(1,PU),1,X(1,J),1) X JP = JPVT(PU) X JPVT(PU) = JPVT(J) X JPVT(J) = JP X 30 CONTINUE X PU = PU - 1 X 40 CONTINUE X 50 CONTINUE X 60 CONTINUE C C COMPUTE THE NORMS OF THE FREE COLUMNS. C X IF (PU .LT. PL) GO TO 80 X DO 70 J = PL, PU X QRAUX(J) = DNRM2(N,X(1,J),1) X WORK(J) = QRAUX(J) X 70 CONTINUE X 80 CONTINUE C C PERFORM THE HOUSEHOLDER REDUCTION OF X. C X LUP = MIN0(N,P) X DO 200 L = 1, LUP X IF (L .LT. PL .OR. L .GE. PU) GO TO 120 C C LOCATE THE COLUMN OF LARGEST NORM AND BRING IT C INTO THE PIVOT POSITION. C X MAXNRM = 0.0D0 X MAXJ = L X DO 100 J = L, PU X IF (QRAUX(J) .LE. MAXNRM) GO TO 90 X MAXNRM = QRAUX(J) X MAXJ = J X 90 CONTINUE X 100 CONTINUE X IF (MAXJ .EQ. L) GO TO 110 X CALL DSWAP(N,X(1,L),1,X(1,MAXJ),1) X QRAUX(MAXJ) = QRAUX(L) X WORK(MAXJ) = WORK(L) X JP = JPVT(MAXJ) X JPVT(MAXJ) = JPVT(L) X JPVT(L) = JP X 110 CONTINUE X 120 CONTINUE X QRAUX(L) = 0.0D0 X IF (L .EQ. N) GO TO 190 C C COMPUTE THE HOUSEHOLDER TRANSFORMATION FOR COLUMN L. C X NRMXL = DNRM2(N-L+1,X(L,L),1) X IF (NRMXL .EQ. 0.0D0) GO TO 180 X IF (X(L,L) .NE. 0.0D0) NRMXL = DSIGN(NRMXL,X(L,L)) X CALL DSCAL(N-L+1,1.0D0/NRMXL,X(L,L),1) X X(L,L) = 1.0D0 + X(L,L) C C APPLY THE TRANSFORMATION TO THE REMAINING COLUMNS, C UPDATING THE NORMS. C X LP1 = L + 1 X IF (P .LT. LP1) GO TO 170 X DO 160 J = LP1, P X T = -DDOT(N-L+1,X(L,L),1,X(L,J),1)/X(L,L) X CALL DAXPY(N-L+1,T,X(L,L),1,X(L,J),1) X IF (J .LT. PL .OR. J .GT. PU) GO TO 150 X IF (QRAUX(J) .EQ. 0.0D0) GO TO 150 X TT = 1.0D0 - (DABS(X(L,J))/QRAUX(J))**2 X TT = DMAX1(TT,0.0D0) X T = TT X TT = 1.0D0 + 0.05D0*TT*(QRAUX(J)/WORK(J))**2 X IF (TT .EQ. 1.0D0) GO TO 130 X QRAUX(J) = QRAUX(J)*DSQRT(T) X GO TO 140 X 130 CONTINUE X QRAUX(J) = DNRM2(N-L,X(L+1,J),1) X WORK(J) = QRAUX(J) X 140 CONTINUE X 150 CONTINUE X 160 CONTINUE X 170 CONTINUE C C SAVE THE TRANSFORMATION. C X QRAUX(L) = X(L,L) X X(L,L) = -NRMXL X 180 CONTINUE X 190 CONTINUE X 200 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dqrdc.f' && chmod 0644 'grkpack/lib/dqrdc.f' || echo 'restore of grkpack/lib/dqrdc.f failed' shar_count="`wc -c < 'grkpack/lib/dqrdc.f'`" test 7032 -eq "$shar_count" || echo "grkpack/lib/dqrdc.f: original size 7032, current size $shar_count" fi # ============= grkpack/lib/dqrsl.f ============== if test -f 'grkpack/lib/dqrsl.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dqrsl.f (File already exists)' else echo 'x - extracting grkpack/lib/dqrsl.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dqrsl.f' && X SUBROUTINE DQRSL(X,LDX,N,K,QRAUX,Y,QY,QTY,B,RSD,XB,JOB,INFO) X INTEGER LDX,N,K,JOB,INFO X DOUBLE PRECISION X(LDX,1),QRAUX(1),Y(1),QY(1),QTY(1),B(1),RSD(1), X * XB(1) C C DQRSL APPLIES THE OUTPUT OF DQRDC TO COMPUTE COORDINATE C TRANSFORMATIONS, PROJECTIONS, AND LEAST SQUARES SOLUTIONS. C FOR K .LE. MIN(N,P), LET XK BE THE MATRIX C C XK = (X(JPVT(1)),X(JPVT(2)), ... ,X(JPVT(K))) C C FORMED FROM COLUMNNS JPVT(1), ... ,JPVT(K) OF THE ORIGINAL C N X P MATRIX X THAT WAS INPUT TO DQRDC (IF NO PIVOTING WAS C DONE, XK CONSISTS OF THE FIRST K COLUMNS OF X IN THEIR C ORIGINAL ORDER). DQRDC PRODUCES A FACTORED ORTHOGONAL MATRIX Q C AND AN UPPER TRIANGULAR MATRIX R SUCH THAT C C XK = Q * (R) C (0) C C THIS INFORMATION IS CONTAINED IN CODED FORM IN THE ARRAYS C X AND QRAUX. C C ON ENTRY C C X DOUBLE PRECISION(LDX,P). C X CONTAINS THE OUTPUT OF DQRDC. C C LDX INTEGER. C LDX IS THE LEADING DIMENSION OF THE ARRAY X. C C N INTEGER. C N IS THE NUMBER OF ROWS OF THE MATRIX XK. IT MUST C HAVE THE SAME VALUE AS N IN DQRDC. C C K INTEGER. C K IS THE NUMBER OF COLUMNS OF THE MATRIX XK. K C MUST NNOT BE GREATER THAN MIN(N,P), WHERE P IS THE C SAME AS IN THE CALLING SEQUENCE TO DQRDC. C C QRAUX DOUBLE PRECISION(P). C QRAUX CONTAINS THE AUXILIARY OUTPUT FROM DQRDC. C C Y DOUBLE PRECISION(N) C Y CONTAINS AN N-VECTOR THAT IS TO BE MANIPULATED C BY DQRSL. C C JOB INTEGER. C JOB SPECIFIES WHAT IS TO BE COMPUTED. JOB HAS C THE DECIMAL EXPANSION ABCDE, WITH THE FOLLOWING C MEANING. C C IF A.NE.0, COMPUTE QY. C IF B,C,D, OR E .NE. 0, COMPUTE QTY. C IF C.NE.0, COMPUTE B. C IF D.NE.0, COMPUTE RSD. C IF E.NE.0, COMPUTE XB. C C NOTE THAT A REQUEST TO COMPUTE B, RSD, OR XB C AUTOMATICALLY TRIGGERS THE COMPUTATION OF QTY, FOR C WHICH AN ARRAY MUST BE PROVIDED IN THE CALLING C SEQUENCE. C C ON RETURN C C QY DOUBLE PRECISION(N). C QY CONNTAINS Q*Y, IF ITS COMPUTATION HAS BEEN C REQUESTED. C C QTY DOUBLE PRECISION(N). C QTY CONTAINS TRANS(Q)*Y, IF ITS COMPUTATION HAS C BEEN REQUESTED. HERE TRANS(Q) IS THE C TRANSPOSE OF THE MATRIX Q. C C B DOUBLE PRECISION(K) C B CONTAINS THE SOLUTION OF THE LEAST SQUARES PROBLEM C C MINIMIZE NORM2(Y - XK*B), C C IF ITS COMPUTATION HAS BEEN REQUESTED. (NOTE THAT C IF PIVOTING WAS REQUESTED IN DQRDC, THE J-TH C COMPONENT OF B WILL BE ASSOCIATED WITH COLUMN JPVT(J) C OF THE ORIGINAL MATRIX X THAT WAS INPUT INTO DQRDC.) C C RSD DOUBLE PRECISION(N). C RSD CONTAINS THE LEAST SQUARES RESIDUAL Y - XK*B, C IF ITS COMPUTATION HAS BEEN REQUESTED. RSD IS C ALSO THE ORTHOGONAL PROJECTION OF Y ONTO THE C ORTHOGONAL COMPLEMENT OF THE COLUMN SPACE OF XK. C C XB DOUBLE PRECISION(N). C XB CONTAINS THE LEAST SQUARES APPROXIMATION XK*B, C IF ITS COMPUTATION HAS BEEN REQUESTED. XB IS ALSO C THE ORTHOGONAL PROJECTION OF Y ONTO THE COLUMN SPACE C OF X. C C INFO INTEGER. C INFO IS ZERO UNLESS THE COMPUTATION OF B HAS C BEEN REQUESTED AND R IS EXACTLY SINGULAR. IN C THIS CASE, INFO IS THE INDEX OF THE FIRST ZERO C DIAGONAL ELEMENT OF R AND B IS LEFT UNALTERED. C C THE PARAMETERS QY, QTY, B, RSD, AND XB ARE NOT REFERENCED C IF THEIR COMPUTATION IS NOT REQUESTED AND IN THIS CASE C CAN BE REPLACED BY DUMMY VARIABLES IN THE CALLING PROGRAM. C TO SAVE STORAGE, THE USER MAY IN SOME CASES USE THE SAME C ARRAY FOR DIFFERENT PARAMETERS IN THE CALLING SEQUENCE. A C FREQUENTLY OCCURING EXAMPLE IS WHEN ONE WISHES TO COMPUTE C ANY OF B, RSD, OR XB AND DOES NOT NEED Y OR QTY. IN THIS C CASE ONE MAY IDENTIFY Y, QTY, AND ONE OF B, RSD, OR XB, WHILE C PROVIDING SEPARATE ARRAYS FOR ANYTHING ELSE THAT IS TO BE C COMPUTED. THUS THE CALLING SEQUENCE C C CALL DQRSL(X,LDX,N,K,QRAUX,Y,DUM,Y,B,Y,DUM,110,INFO) C C WILL RESULT IN THE COMPUTATION OF B AND RSD, WITH RSD C OVERWRITING Y. MORE GENERALLY, EACH ITEM IN THE FOLLOWING C LIST CONTAINS GROUPS OF PERMISSIBLE IDENTIFICATIONS FOR C A SINGLE CALLINNG SEQUENCE. C C 1. (Y,QTY,B) (RSD) (XB) (QY) C C 2. (Y,QTY,RSD) (B) (XB) (QY) C C 3. (Y,QTY,XB) (B) (RSD) (QY) C C 4. (Y,QY) (QTY,B) (RSD) (XB) C C 5. (Y,QY) (QTY,RSD) (B) (XB) C C 6. (Y,QY) (QTY,XB) (B) (RSD) C C IN ANY GROUP THE VALUE RETURNED IN THE ARRAY ALLOCATED TO C THE GROUP CORRESPONDS TO THE LAST MEMBER OF THE GROUP. C C LINPACK. THIS VERSION DATED 08/14/78 . C G.W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB. C C DQRSL USES THE FOLLOWING FUNCTIONS AND SUBPROGRAMS. C C BLAS DAXPY,DCOPY,DDOT C FORTRAN DABS,MIN0,MOD C C INTERNAL VARIABLES C X INTEGER I,J,JJ,JU,KP1 X DOUBLE PRECISION DDOT,T,TEMP X LOGICAL CB,CQY,CQTY,CR,CXB C C C SET INFO FLAG. C X INFO = 0 C C DETERMINE WHAT IS TO BE COMPUTED. C X CQY = JOB/10000 .NE. 0 X CQTY = MOD(JOB,10000) .NE. 0 X CB = MOD(JOB,1000)/100 .NE. 0 X CR = MOD(JOB,100)/10 .NE. 0 X CXB = MOD(JOB,10) .NE. 0 X JU = MIN0(K,N-1) C C SPECIAL ACTION WHEN N=1. C X IF (JU .NE. 0) GO TO 40 X IF (CQY) QY(1) = Y(1) X IF (CQTY) QTY(1) = Y(1) X IF (CXB) XB(1) = Y(1) X IF (.NOT.CB) GO TO 30 X IF (X(1,1) .NE. 0.0D0) GO TO 10 X INFO = 1 X GO TO 20 X 10 CONTINUE X B(1) = Y(1)/X(1,1) X 20 CONTINUE X 30 CONTINUE X IF (CR) RSD(1) = 0.0D0 X GO TO 250 X 40 CONTINUE C C SET UP TO COMPUTE QY OR QTY. C X IF (CQY) CALL DCOPY(N,Y,1,QY,1) X IF (CQTY) CALL DCOPY(N,Y,1,QTY,1) X IF (.NOT.CQY) GO TO 70 C C COMPUTE QY. C X DO 60 JJ = 1, JU X J = JU - JJ + 1 X IF (QRAUX(J) .EQ. 0.0D0) GO TO 50 X TEMP = X(J,J) X X(J,J) = QRAUX(J) X T = -DDOT(N-J+1,X(J,J),1,QY(J),1)/X(J,J) X CALL DAXPY(N-J+1,T,X(J,J),1,QY(J),1) X X(J,J) = TEMP X 50 CONTINUE X 60 CONTINUE X 70 CONTINUE X IF (.NOT.CQTY) GO TO 100 C C COMPUTE TRANS(Q)*Y. C X DO 90 J = 1, JU X IF (QRAUX(J) .EQ. 0.0D0) GO TO 80 X TEMP = X(J,J) X X(J,J) = QRAUX(J) X T = -DDOT(N-J+1,X(J,J),1,QTY(J),1)/X(J,J) X CALL DAXPY(N-J+1,T,X(J,J),1,QTY(J),1) X X(J,J) = TEMP X 80 CONTINUE X 90 CONTINUE X 100 CONTINUE C C SET UP TO COMPUTE B, RSD, OR XB. C X IF (CB) CALL DCOPY(K,QTY,1,B,1) X KP1 = K + 1 X IF (CXB) CALL DCOPY(K,QTY,1,XB,1) X IF (CR .AND. K .LT. N) CALL DCOPY(N-K,QTY(KP1),1,RSD(KP1),1) X IF (.NOT.CXB .OR. KP1 .GT. N) GO TO 120 X DO 110 I = KP1, N X XB(I) = 0.0D0 X 110 CONTINUE X 120 CONTINUE X IF (.NOT.CR) GO TO 140 X DO 130 I = 1, K X RSD(I) = 0.0D0 X 130 CONTINUE X 140 CONTINUE X IF (.NOT.CB) GO TO 190 C C COMPUTE B. C X DO 170 JJ = 1, K X J = K - JJ + 1 X IF (X(J,J) .NE. 0.0D0) GO TO 150 X INFO = J C ......EXIT X GO TO 180 X 150 CONTINUE X B(J) = B(J)/X(J,J) X IF (J .EQ. 1) GO TO 160 X T = -B(J) X CALL DAXPY(J-1,T,X(1,J),1,B,1) X 160 CONTINUE X 170 CONTINUE X 180 CONTINUE X 190 CONTINUE X IF (.NOT.CR .AND. .NOT.CXB) GO TO 240 C C COMPUTE RSD OR XB AS REQUIRED. C X DO 230 JJ = 1, JU X J = JU - JJ + 1 X IF (QRAUX(J) .EQ. 0.0D0) GO TO 220 X TEMP = X(J,J) X X(J,J) = QRAUX(J) X IF (.NOT.CR) GO TO 200 X T = -DDOT(N-J+1,X(J,J),1,RSD(J),1)/X(J,J) X CALL DAXPY(N-J+1,T,X(J,J),1,RSD(J),1) X 200 CONTINUE X IF (.NOT.CXB) GO TO 210 X T = -DDOT(N-J+1,X(J,J),1,XB(J),1)/X(J,J) X CALL DAXPY(N-J+1,T,X(J,J),1,XB(J),1) X 210 CONTINUE X X(J,J) = TEMP X 220 CONTINUE X 230 CONTINUE X 240 CONTINUE X 250 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dqrsl.f' && chmod 0644 'grkpack/lib/dqrsl.f' || echo 'restore of grkpack/lib/dqrsl.f failed' shar_count="`wc -c < 'grkpack/lib/dqrsl.f'`" test 9058 -eq "$shar_count" || echo "grkpack/lib/dqrsl.f: original size 9058, current size $shar_count" fi # ============= grkpack/lib/dtrsl.f ============== if test -f 'grkpack/lib/dtrsl.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dtrsl.f (File already exists)' else echo 'x - extracting grkpack/lib/dtrsl.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dtrsl.f' && X SUBROUTINE DTRSL(T,LDT,N,B,JOB,INFO) X INTEGER LDT,N,JOB,INFO X DOUBLE PRECISION T(LDT,1),B(1) C C C DTRSL SOLVES SYSTEMS OF THE FORM C C T * X = B C OR C TRANS(T) * X = B C C WHERE T IS A TRIANGULAR MATRIX OF ORDER N. HERE TRANS(T) C DENOTES THE TRANSPOSE OF THE MATRIX T. C C ON ENTRY C C T DOUBLE PRECISION(LDT,N) C T CONTAINS THE MATRIX OF THE SYSTEM. THE ZERO C ELEMENTS OF THE MATRIX ARE NOT REFERENCED, AND C THE CORRESPONDING ELEMENTS OF THE ARRAY CAN BE C USED TO STORE OTHER INFORMATION. C C LDT INTEGER C LDT IS THE LEADING DIMENSION OF THE ARRAY T. C C N INTEGER C N IS THE ORDER OF THE SYSTEM. C C B DOUBLE PRECISION(N). C B CONTAINS THE RIGHT HAND SIDE OF THE SYSTEM. C C JOB INTEGER C JOB SPECIFIES WHAT KIND OF SYSTEM IS TO BE SOLVED. C IF JOB IS C C 00 SOLVE T*X=B, T LOWER TRIANGULAR, C 01 SOLVE T*X=B, T UPPER TRIANGULAR, C 10 SOLVE TRANS(T)*X=B, T LOWER TRIANGULAR, C 11 SOLVE TRANS(T)*X=B, T UPPER TRIANGULAR. C C ON RETURN C C B B CONTAINS THE SOLUTION, IF INFO .EQ. 0. C OTHERWISE B IS UNALTERED. C C INFO INTEGER C INFO CONTAINS ZERO IF THE SYSTEM IS NONSINGULAR. C OTHERWISE INFO CONTAINS THE INDEX OF C THE FIRST ZERO DIAGONAL ELEMENT OF T. C C LINPACK. THIS VERSION DATED 08/14/78 . C G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB. C C SUBROUTINES AND FUNCTIONS C C BLAS DAXPY,DDOT C FORTRAN MOD C C INTERNAL VARIABLES C X DOUBLE PRECISION DDOT,TEMP X INTEGER CASE,J,JJ C C BEGIN BLOCK PERMITTING ...EXITS TO 150 C C CHECK FOR ZERO DIAGONAL ELEMENTS. C X DO 10 INFO = 1, N C ......EXIT X IF (T(INFO,INFO) .EQ. 0.0D0) GO TO 150 X 10 CONTINUE X INFO = 0 C C DETERMINE THE TASK AND GO TO IT. C X CASE = 1 X IF (MOD(JOB,10) .NE. 0) CASE = 2 X IF (MOD(JOB,100)/10 .NE. 0) CASE = CASE + 2 X GO TO (20,50,80,110), CASE C C SOLVE T*X=B FOR T LOWER TRIANGULAR C X 20 CONTINUE X B(1) = B(1)/T(1,1) X IF (N .LT. 2) GO TO 40 X DO 30 J = 2, N X TEMP = -B(J-1) X CALL DAXPY(N-J+1,TEMP,T(J,J-1),1,B(J),1) X B(J) = B(J)/T(J,J) X 30 CONTINUE X 40 CONTINUE X GO TO 140 C C SOLVE T*X=B FOR T UPPER TRIANGULAR. C X 50 CONTINUE X B(N) = B(N)/T(N,N) X IF (N .LT. 2) GO TO 70 X DO 60 JJ = 2, N X J = N - JJ + 1 X TEMP = -B(J+1) X CALL DAXPY(J,TEMP,T(1,J+1),1,B(1),1) X B(J) = B(J)/T(J,J) X 60 CONTINUE X 70 CONTINUE X GO TO 140 C C SOLVE TRANS(T)*X=B FOR T LOWER TRIANGULAR. C X 80 CONTINUE X B(N) = B(N)/T(N,N) X IF (N .LT. 2) GO TO 100 X DO 90 JJ = 2, N X J = N - JJ + 1 X B(J) = B(J) - DDOT(JJ-1,T(J+1,J),1,B(J+1),1) X B(J) = B(J)/T(J,J) X 90 CONTINUE X 100 CONTINUE X GO TO 140 C C SOLVE TRANS(T)*X=B FOR T UPPER TRIANGULAR. C X 110 CONTINUE X B(1) = B(1)/T(1,1) X IF (N .LT. 2) GO TO 130 X DO 120 J = 2, N X B(J) = B(J) - DDOT(J-1,T(1,J),1,B(1),1) X B(J) = B(J)/T(J,J) X 120 CONTINUE X 130 CONTINUE X 140 CONTINUE X 150 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dtrsl.f' && chmod 0644 'grkpack/lib/dtrsl.f' || echo 'restore of grkpack/lib/dtrsl.f failed' shar_count="`wc -c < 'grkpack/lib/dtrsl.f'`" test 3794 -eq "$shar_count" || echo "grkpack/lib/dtrsl.f: original size 3794, current size $shar_count" fi # ============= grkpack/lib/dasum.f ============== if test -f 'grkpack/lib/dasum.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dasum.f (File already exists)' else echo 'x - extracting grkpack/lib/dasum.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dasum.f' && X DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) C C TAKES THE SUM OF THE ABSOLUTE VALUES. C JACK DONGARRA, LINPACK, 3/11/78. C X DOUBLE PRECISION DX(1),DTEMP X INTEGER I,INCX,M,MP1,N,NINCX C X DASUM = 0.0D0 X DTEMP = 0.0D0 X IF(N.LE.0)RETURN X IF(INCX.EQ.1)GO TO 20 C C CODE FOR INCREMENT NOT EQUAL TO 1 C X NINCX = N*INCX X DO 10 I = 1,NINCX,INCX X DTEMP = DTEMP + DABS(DX(I)) X 10 CONTINUE X DASUM = DTEMP X RETURN C C CODE FOR INCREMENT EQUAL TO 1 C C C CLEAN-UP LOOP C X 20 M = MOD(N,6) X IF( M .EQ. 0 ) GO TO 40 X DO 30 I = 1,M X DTEMP = DTEMP + DABS(DX(I)) X 30 CONTINUE X IF( N .LT. 6 ) GO TO 60 X 40 MP1 = M + 1 X DO 50 I = MP1,N,6 X DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I + 1)) + DABS(DX(I + 2)) X * + DABS(DX(I + 3)) + DABS(DX(I + 4)) + DABS(DX(I + 5)) X 50 CONTINUE X 60 DASUM = DTEMP X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dasum.f' && chmod 0644 'grkpack/lib/dasum.f' || echo 'restore of grkpack/lib/dasum.f failed' shar_count="`wc -c < 'grkpack/lib/dasum.f'`" test 934 -eq "$shar_count" || echo "grkpack/lib/dasum.f: original size 934, current size $shar_count" fi # ============= grkpack/lib/daxpy.f ============== if test -f 'grkpack/lib/daxpy.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/daxpy.f (File already exists)' else echo 'x - extracting grkpack/lib/daxpy.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/daxpy.f' && X SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) C C CONSTANT TIMES A VECTOR PLUS A VECTOR. C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C X DOUBLE PRECISION DX(1),DY(1),DA X INTEGER I,INCX,INCY,M,MP1,N C X IF(N.LE.0)RETURN X IF (DA .EQ. 0.0D0) RETURN X IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 C C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS C NOT EQUAL TO 1 C X IX = 1 X IY = 1 X IF(INCX.LT.0)IX = (-N+1)*INCX + 1 X IF(INCY.LT.0)IY = (-N+1)*INCY + 1 X DO 10 I = 1,N X DY(IY) = DY(IY) + DA*DX(IX) X IX = IX + INCX X IY = IY + INCY X 10 CONTINUE X RETURN C C CODE FOR BOTH INCREMENTS EQUAL TO 1 C C C CLEAN-UP LOOP C X 20 M = MOD(N,4) X IF( M .EQ. 0 ) GO TO 40 X DO 30 I = 1,M X DY(I) = DY(I) + DA*DX(I) X 30 CONTINUE X IF( N .LT. 4 ) RETURN X 40 MP1 = M + 1 X DO 50 I = MP1,N,4 X DY(I) = DY(I) + DA*DX(I) X DY(I + 1) = DY(I + 1) + DA*DX(I + 1) X DY(I + 2) = DY(I + 2) + DA*DX(I + 2) X DY(I + 3) = DY(I + 3) + DA*DX(I + 3) X 50 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/daxpy.f' && chmod 0644 'grkpack/lib/daxpy.f' || echo 'restore of grkpack/lib/daxpy.f failed' shar_count="`wc -c < 'grkpack/lib/daxpy.f'`" test 1151 -eq "$shar_count" || echo "grkpack/lib/daxpy.f: original size 1151, current size $shar_count" fi # ============= grkpack/lib/dcopy.f ============== if test -f 'grkpack/lib/dcopy.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dcopy.f (File already exists)' else echo 'x - extracting grkpack/lib/dcopy.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dcopy.f' && X SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) C C COPIES A VECTOR, X, TO A VECTOR, Y. C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C X DOUBLE PRECISION DX(1),DY(1) X INTEGER I,INCX,INCY,IX,IY,M,MP1,N C X IF(N.LE.0)RETURN X IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 C C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS C NOT EQUAL TO 1 C X IX = 1 X IY = 1 X IF(INCX.LT.0)IX = (-N+1)*INCX + 1 X IF(INCY.LT.0)IY = (-N+1)*INCY + 1 X DO 10 I = 1,N X DY(IY) = DX(IX) X IX = IX + INCX X IY = IY + INCY X 10 CONTINUE X RETURN C C CODE FOR BOTH INCREMENTS EQUAL TO 1 C C C CLEAN-UP LOOP C X 20 M = MOD(N,7) X IF( M .EQ. 0 ) GO TO 40 X DO 30 I = 1,M X DY(I) = DX(I) X 30 CONTINUE X IF( N .LT. 7 ) RETURN X 40 MP1 = M + 1 X DO 50 I = MP1,N,7 X DY(I) = DX(I) X DY(I + 1) = DX(I + 1) X DY(I + 2) = DX(I + 2) X DY(I + 3) = DX(I + 3) X DY(I + 4) = DX(I + 4) X DY(I + 5) = DX(I + 5) X DY(I + 6) = DX(I + 6) X 50 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dcopy.f' && chmod 0644 'grkpack/lib/dcopy.f' || echo 'restore of grkpack/lib/dcopy.f failed' shar_count="`wc -c < 'grkpack/lib/dcopy.f'`" test 1128 -eq "$shar_count" || echo "grkpack/lib/dcopy.f: original size 1128, current size $shar_count" fi # ============= grkpack/lib/ddot.f ============== if test -f 'grkpack/lib/ddot.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/ddot.f (File already exists)' else echo 'x - extracting grkpack/lib/ddot.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/ddot.f' && X DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) C C FORMS THE DOT PRODUCT OF TWO VECTORS. C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C X DOUBLE PRECISION DX(1),DY(1),DTEMP X INTEGER I,INCX,INCY,IX,IY,M,MP1,N C X DDOT = 0.0D0 X DTEMP = 0.0D0 X IF(N.LE.0)RETURN X IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 C C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS C NOT EQUAL TO 1 C X IX = 1 X IY = 1 X IF(INCX.LT.0)IX = (-N+1)*INCX + 1 X IF(INCY.LT.0)IY = (-N+1)*INCY + 1 X DO 10 I = 1,N X DTEMP = DTEMP + DX(IX)*DY(IY) X IX = IX + INCX X IY = IY + INCY X 10 CONTINUE X DDOT = DTEMP X RETURN C C CODE FOR BOTH INCREMENTS EQUAL TO 1 C C C CLEAN-UP LOOP C X 20 M = MOD(N,5) X IF( M .EQ. 0 ) GO TO 40 X DO 30 I = 1,M X DTEMP = DTEMP + DX(I)*DY(I) X 30 CONTINUE X IF( N .LT. 5 ) GO TO 60 X 40 MP1 = M + 1 X DO 50 I = MP1,N,5 X DTEMP = DTEMP + DX(I)*DY(I) + DX(I + 1)*DY(I + 1) + X * DX(I + 2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4) X 50 CONTINUE X 60 DDOT = DTEMP X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/ddot.f' && chmod 0644 'grkpack/lib/ddot.f' || echo 'restore of grkpack/lib/ddot.f failed' shar_count="`wc -c < 'grkpack/lib/ddot.f'`" test 1187 -eq "$shar_count" || echo "grkpack/lib/ddot.f: original size 1187, current size $shar_count" fi # ============= grkpack/lib/dscal.f ============== if test -f 'grkpack/lib/dscal.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dscal.f (File already exists)' else echo 'x - extracting grkpack/lib/dscal.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dscal.f' && X SUBROUTINE DSCAL(N,DA,DX,INCX) C C SCALES A VECTOR BY A CONSTANT. C USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE. C JACK DONGARRA, LINPACK, 3/11/78. C X DOUBLE PRECISION DA,DX(1) X INTEGER I,INCX,M,MP1,N,NINCX C X IF(N.LE.0)RETURN X IF(INCX.EQ.1)GO TO 20 C C CODE FOR INCREMENT NOT EQUAL TO 1 C X NINCX = N*INCX X DO 10 I = 1,NINCX,INCX X DX(I) = DA*DX(I) X 10 CONTINUE X RETURN C C CODE FOR INCREMENT EQUAL TO 1 C C C CLEAN-UP LOOP C X 20 M = MOD(N,5) X IF( M .EQ. 0 ) GO TO 40 X DO 30 I = 1,M X DX(I) = DA*DX(I) X 30 CONTINUE X IF( N .LT. 5 ) RETURN X 40 MP1 = M + 1 X DO 50 I = MP1,N,5 X DX(I) = DA*DX(I) X DX(I + 1) = DA*DX(I + 1) X DX(I + 2) = DA*DX(I + 2) X DX(I + 3) = DA*DX(I + 3) X DX(I + 4) = DA*DX(I + 4) X 50 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dscal.f' && chmod 0644 'grkpack/lib/dscal.f' || echo 'restore of grkpack/lib/dscal.f failed' shar_count="`wc -c < 'grkpack/lib/dscal.f'`" test 886 -eq "$shar_count" || echo "grkpack/lib/dscal.f: original size 886, current size $shar_count" fi # ============= grkpack/lib/dswap.f ============== if test -f 'grkpack/lib/dswap.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dswap.f (File already exists)' else echo 'x - extracting grkpack/lib/dswap.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dswap.f' && X SUBROUTINE DSWAP (N,DX,INCX,DY,INCY) C C INTERCHANGES TWO VECTORS. C USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE. C JACK DONGARRA, LINPACK, 3/11/78. C X DOUBLE PRECISION DX(1),DY(1),DTEMP X INTEGER I,INCX,INCY,IX,IY,M,MP1,N C X IF(N.LE.0)RETURN X IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 C C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL C TO 1 C X IX = 1 X IY = 1 X IF(INCX.LT.0)IX = (-N+1)*INCX + 1 X IF(INCY.LT.0)IY = (-N+1)*INCY + 1 X DO 10 I = 1,N X DTEMP = DX(IX) X DX(IX) = DY(IY) X DY(IY) = DTEMP X IX = IX + INCX X IY = IY + INCY X 10 CONTINUE X RETURN C C CODE FOR BOTH INCREMENTS EQUAL TO 1 C C C CLEAN-UP LOOP C X 20 M = MOD(N,3) X IF( M .EQ. 0 ) GO TO 40 X DO 30 I = 1,M X DTEMP = DX(I) X DX(I) = DY(I) X DY(I) = DTEMP X 30 CONTINUE X IF( N .LT. 3 ) RETURN X 40 MP1 = M + 1 X DO 50 I = MP1,N,3 X DTEMP = DX(I) X DX(I) = DY(I) X DY(I) = DTEMP X DTEMP = DX(I + 1) X DX(I + 1) = DY(I + 1) X DY(I + 1) = DTEMP X DTEMP = DX(I + 2) X DX(I + 2) = DY(I + 2) X DY(I + 2) = DTEMP X 50 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dswap.f' && chmod 0644 'grkpack/lib/dswap.f' || echo 'restore of grkpack/lib/dswap.f failed' shar_count="`wc -c < 'grkpack/lib/dswap.f'`" test 1236 -eq "$shar_count" || echo "grkpack/lib/dswap.f: original size 1236, current size $shar_count" fi # ============= grkpack/lib/idamax.f ============== if test -f 'grkpack/lib/idamax.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/idamax.f (File already exists)' else echo 'x - extracting grkpack/lib/idamax.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/idamax.f' && X INTEGER FUNCTION IDAMAX(N,DX,INCX) C C FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE. C JACK DONGARRA, LINPACK, 3/11/78. C X DOUBLE PRECISION DX(1),DMAX X INTEGER I,INCX,IX,N C X IDAMAX = 0 X IF( N .LT. 1 ) RETURN X IDAMAX = 1 X IF(N.EQ.1)RETURN X IF(INCX.EQ.1)GO TO 20 C C CODE FOR INCREMENT NOT EQUAL TO 1 C X IX = 1 X DMAX = DABS(DX(1)) X IX = IX + INCX X DO 10 I = 2,N X IF(DABS(DX(IX)).LE.DMAX) GO TO 5 X IDAMAX = I X DMAX = DABS(DX(IX)) X 5 IX = IX + INCX X 10 CONTINUE X RETURN C C CODE FOR INCREMENT EQUAL TO 1 C X 20 DMAX = DABS(DX(1)) X DO 30 I = 2,N X IF(DABS(DX(I)).LE.DMAX) GO TO 30 X IDAMAX = I X DMAX = DABS(DX(I)) X 30 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/idamax.f' && chmod 0644 'grkpack/lib/idamax.f' || echo 'restore of grkpack/lib/idamax.f failed' shar_count="`wc -c < 'grkpack/lib/idamax.f'`" test 805 -eq "$shar_count" || echo "grkpack/lib/idamax.f: original size 805, current size $shar_count" fi # ============= grkpack/lib/dgemv.f ============== if test -f 'grkpack/lib/dgemv.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dgemv.f (File already exists)' else echo 'x - extracting grkpack/lib/dgemv.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dgemv.f' && ************************************************************************ * X SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, X $ BETA, Y, INCY ) * .. Scalar Arguments .. X DOUBLE PRECISION ALPHA, BETA X INTEGER INCX, INCY, LDA, M, N X CHARACTER*1 TRANS * .. Array Arguments .. X DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) * .. * * Purpose * ======= * * DGEMV performs one of the matrix-vector operations * * y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, * * where alpha and beta are scalars, x and y are vectors and A is an * m by n matrix. * * Parameters * ========== * * TRANS - CHARACTER*1. * On entry, TRANS specifies the operation to be performed as * follows: * * TRANS = 'N' or 'n' y := alpha*A*x + beta*y. * * TRANS = 'T' or 't' y := alpha*A'*x + beta*y. * * TRANS = 'C' or 'c' y := alpha*A'*x + beta*y. * * Unchanged on exit. * * M - INTEGER. * On entry, M specifies the number of rows of the matrix A. * M must be at least zero. * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the number of columns of the matrix A. * N must be at least zero. * Unchanged on exit. * * ALPHA - DOUBLE PRECISION. * On entry, ALPHA specifies the scalar alpha. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). * Before entry, the leading m by n part of the array A must * contain the matrix of coefficients. * Unchanged on exit. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. LDA must be at least * max( 1, m ). * Unchanged on exit. * * X - DOUBLE PRECISION array of DIMENSION at least * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' * and at least * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. * Before entry, the incremented array X must contain the * vector x. * Unchanged on exit. * * INCX - INTEGER. * On entry, INCX specifies the increment for the elements of * X. INCX must not be zero. * Unchanged on exit. * * BETA - DOUBLE PRECISION. * On entry, BETA specifies the scalar beta. When BETA is * supplied as zero then Y need not be set on input. * Unchanged on exit. * * Y - DOUBLE PRECISION array of DIMENSION at least * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' * and at least * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. * Before entry with BETA non-zero, the incremented array Y * must contain the vector y. On exit, Y is overwritten by the * updated vector y. * * INCY - INTEGER. * On entry, INCY specifies the increment for the elements of * Y. INCY must not be zero. * Unchanged on exit. * * * Level 2 Blas routine. * * -- Written on 22-October-1986. * Jack Dongarra, Argonne National Lab. * Jeremy Du Croz, Nag Central Office. * Sven Hammarling, Nag Central Office. * Richard Hanson, Sandia National Labs. * * * .. Parameters .. X DOUBLE PRECISION ONE , ZERO X PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. Local Scalars .. X DOUBLE PRECISION TEMP X INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY * .. External Functions .. X LOGICAL LSAME X EXTERNAL LSAME * .. External Subroutines .. X EXTERNAL XERBLA * .. Intrinsic Functions .. X INTRINSIC MAX * .. * .. Executable Statements .. * * Test the input parameters. * X INFO = 0 X IF ( .NOT.LSAME( TRANS, 'N' ).AND. X $ .NOT.LSAME( TRANS, 'T' ).AND. X $ .NOT.LSAME( TRANS, 'C' ) )THEN X INFO = 1 X ELSE IF( M.LT.0 )THEN X INFO = 2 X ELSE IF( N.LT.0 )THEN X INFO = 3 X ELSE IF( LDA.LT.MAX( 1, M ) )THEN X INFO = 6 X ELSE IF( INCX.EQ.0 )THEN X INFO = 8 X ELSE IF( INCY.EQ.0 )THEN X INFO = 11 X END IF X IF( INFO.NE.0 )THEN X CALL XERBLA( 'DGEMV ', INFO ) X RETURN X END IF * * Quick return if possible. * X IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR. X $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) X $ RETURN * * Set LENX and LENY, the lengths of the vectors x and y, and set * up the start points in X and Y. * X IF( LSAME( TRANS, 'N' ) )THEN X LENX = N X LENY = M X ELSE X LENX = M X LENY = N X END IF X IF( INCX.GT.0 )THEN X KX = 1 X ELSE X KX = 1 - ( LENX - 1 )*INCX X END IF X IF( INCY.GT.0 )THEN X KY = 1 X ELSE X KY = 1 - ( LENY - 1 )*INCY X END IF * * Start the operations. In this version the elements of A are * accessed sequentially with one pass through A. * * First form y := beta*y. * X IF( BETA.NE.ONE )THEN X IF( INCY.EQ.1 )THEN X IF( BETA.EQ.ZERO )THEN X DO 10, I = 1, LENY X Y( I ) = ZERO X 10 CONTINUE X ELSE X DO 20, I = 1, LENY X Y( I ) = BETA*Y( I ) X 20 CONTINUE X END IF X ELSE X IY = KY X IF( BETA.EQ.ZERO )THEN X DO 30, I = 1, LENY X Y( IY ) = ZERO X IY = IY + INCY X 30 CONTINUE X ELSE X DO 40, I = 1, LENY X Y( IY ) = BETA*Y( IY ) X IY = IY + INCY X 40 CONTINUE X END IF X END IF X END IF X IF( ALPHA.EQ.ZERO ) X $ RETURN X IF( LSAME( TRANS, 'N' ) )THEN * * Form y := alpha*A*x + y. * X JX = KX X IF( INCY.EQ.1 )THEN X DO 60, J = 1, N X IF( X( JX ).NE.ZERO )THEN X TEMP = ALPHA*X( JX ) X DO 50, I = 1, M X Y( I ) = Y( I ) + TEMP*A( I, J ) X 50 CONTINUE X END IF X JX = JX + INCX X 60 CONTINUE X ELSE X DO 80, J = 1, N X IF( X( JX ).NE.ZERO )THEN X TEMP = ALPHA*X( JX ) X IY = KY X DO 70, I = 1, M X Y( IY ) = Y( IY ) + TEMP*A( I, J ) X IY = IY + INCY X 70 CONTINUE X END IF X JX = JX + INCX X 80 CONTINUE X END IF X ELSE * * Form y := alpha*A'*x + y. * X JY = KY X IF( INCX.EQ.1 )THEN X DO 100, J = 1, N X TEMP = ZERO X DO 90, I = 1, M X TEMP = TEMP + A( I, J )*X( I ) X 90 CONTINUE X Y( JY ) = Y( JY ) + ALPHA*TEMP X JY = JY + INCY X 100 CONTINUE X ELSE X DO 120, J = 1, N X TEMP = ZERO X IX = KX X DO 110, I = 1, M X TEMP = TEMP + A( I, J )*X( IX ) X IX = IX + INCX X 110 CONTINUE X Y( JY ) = Y( JY ) + ALPHA*TEMP X JY = JY + INCY X 120 CONTINUE X END IF X END IF * X RETURN * * End of DGEMV . * X END * SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dgemv.f' && chmod 0644 'grkpack/lib/dgemv.f' || echo 'restore of grkpack/lib/dgemv.f failed' shar_count="`wc -c < 'grkpack/lib/dgemv.f'`" test 7557 -eq "$shar_count" || echo "grkpack/lib/dgemv.f: original size 7557, current size $shar_count" fi # ============= grkpack/lib/dsymv.f ============== if test -f 'grkpack/lib/dsymv.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dsymv.f (File already exists)' else echo 'x - extracting grkpack/lib/dsymv.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dsymv.f' && ************************************************************************ * X SUBROUTINE DSYMV ( UPLO, N, ALPHA, A, LDA, X, INCX, X $ BETA, Y, INCY ) * .. Scalar Arguments .. X DOUBLE PRECISION ALPHA, BETA X INTEGER INCX, INCY, LDA, N X CHARACTER*1 UPLO * .. Array Arguments .. X DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) * .. * * Purpose * ======= * * DSYMV performs the matrix-vector operation * * y := alpha*A*x + beta*y, * * where alpha and beta are scalars, x and y are n element vectors and * A is an n by n symmetric matrix. * * Parameters * ========== * * UPLO - CHARACTER*1. * On entry, UPLO specifies whether the upper or lower * triangular part of the array A is to be referenced as * follows: * * UPLO = 'U' or 'u' Only the upper triangular part of A * is to be referenced. * * UPLO = 'L' or 'l' Only the lower triangular part of A * is to be referenced. * * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the order of the matrix A. * N must be at least zero. * Unchanged on exit. * * ALPHA - DOUBLE PRECISION. * On entry, ALPHA specifies the scalar alpha. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). * Before entry with UPLO = 'U' or 'u', the leading n by n * upper triangular part of the array A must contain the upper * triangular part of the symmetric matrix and the strictly * lower triangular part of A is not referenced. * Before entry with UPLO = 'L' or 'l', the leading n by n * lower triangular part of the array A must contain the lower * triangular part of the symmetric matrix and the strictly * upper triangular part of A is not referenced. * Unchanged on exit. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. LDA must be at least * max( 1, n ). * Unchanged on exit. * * X - DOUBLE PRECISION array of dimension at least * ( 1 + ( n - 1 )*abs( INCX ) ). * Before entry, the incremented array X must contain the n * element vector x. * Unchanged on exit. * * INCX - INTEGER. * On entry, INCX specifies the increment for the elements of * X. INCX must not be zero. * Unchanged on exit. * * BETA - DOUBLE PRECISION. * On entry, BETA specifies the scalar beta. When BETA is * supplied as zero then Y need not be set on input. * Unchanged on exit. * * Y - DOUBLE PRECISION array of dimension at least * ( 1 + ( n - 1 )*abs( INCY ) ). * Before entry, the incremented array Y must contain the n * element vector y. On exit, Y is overwritten by the updated * vector y. * * INCY - INTEGER. * On entry, INCY specifies the increment for the elements of * Y. INCY must not be zero. * Unchanged on exit. * * * Level 2 Blas routine. * * -- Written on 22-October-1986. * Jack Dongarra, Argonne National Lab. * Jeremy Du Croz, Nag Central Office. * Sven Hammarling, Nag Central Office. * Richard Hanson, Sandia National Labs. * * * .. Parameters .. X DOUBLE PRECISION ONE , ZERO X PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. Local Scalars .. X DOUBLE PRECISION TEMP1, TEMP2 X INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY * .. External Functions .. X LOGICAL LSAME X EXTERNAL LSAME * .. External Subroutines .. X EXTERNAL XERBLA * .. Intrinsic Functions .. X INTRINSIC MAX * .. * .. Executable Statements .. * * Test the input parameters. * X INFO = 0 X IF ( .NOT.LSAME( UPLO, 'U' ).AND. X $ .NOT.LSAME( UPLO, 'L' ) )THEN X INFO = 1 X ELSE IF( N.LT.0 )THEN X INFO = 2 X ELSE IF( LDA.LT.MAX( 1, N ) )THEN X INFO = 5 X ELSE IF( INCX.EQ.0 )THEN X INFO = 7 X ELSE IF( INCY.EQ.0 )THEN X INFO = 10 X END IF X IF( INFO.NE.0 )THEN X CALL XERBLA( 'DSYMV ', INFO ) X RETURN X END IF * * Quick return if possible. * X IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) X $ RETURN * * Set up the start points in X and Y. * X IF( INCX.GT.0 )THEN X KX = 1 X ELSE X KX = 1 - ( N - 1 )*INCX X END IF X IF( INCY.GT.0 )THEN X KY = 1 X ELSE X KY = 1 - ( N - 1 )*INCY X END IF * * Start the operations. In this version the elements of A are * accessed sequentially with one pass through the triangular part * of A. * * First form y := beta*y. * X IF( BETA.NE.ONE )THEN X IF( INCY.EQ.1 )THEN X IF( BETA.EQ.ZERO )THEN X DO 10, I = 1, N X Y( I ) = ZERO X 10 CONTINUE X ELSE X DO 20, I = 1, N X Y( I ) = BETA*Y( I ) X 20 CONTINUE X END IF X ELSE X IY = KY X IF( BETA.EQ.ZERO )THEN X DO 30, I = 1, N X Y( IY ) = ZERO X IY = IY + INCY X 30 CONTINUE X ELSE X DO 40, I = 1, N X Y( IY ) = BETA*Y( IY ) X IY = IY + INCY X 40 CONTINUE X END IF X END IF X END IF X IF( ALPHA.EQ.ZERO ) X $ RETURN X IF( LSAME( UPLO, 'U' ) )THEN * * Form y when A is stored in upper triangle. * X IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN X DO 60, J = 1, N X TEMP1 = ALPHA*X( J ) X TEMP2 = ZERO X DO 50, I = 1, J - 1 X Y( I ) = Y( I ) + TEMP1*A( I, J ) X TEMP2 = TEMP2 + A( I, J )*X( I ) X 50 CONTINUE X Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2 X 60 CONTINUE X ELSE X JX = KX X JY = KY X DO 80, J = 1, N X TEMP1 = ALPHA*X( JX ) X TEMP2 = ZERO X IX = KX X IY = KY X DO 70, I = 1, J - 1 X Y( IY ) = Y( IY ) + TEMP1*A( I, J ) X TEMP2 = TEMP2 + A( I, J )*X( IX ) X IX = IX + INCX X IY = IY + INCY X 70 CONTINUE X Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2 X JX = JX + INCX X JY = JY + INCY X 80 CONTINUE X END IF X ELSE * * Form y when A is stored in lower triangle. * X IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN X DO 100, J = 1, N X TEMP1 = ALPHA*X( J ) X TEMP2 = ZERO X Y( J ) = Y( J ) + TEMP1*A( J, J ) X DO 90, I = J + 1, N X Y( I ) = Y( I ) + TEMP1*A( I, J ) X TEMP2 = TEMP2 + A( I, J )*X( I ) X 90 CONTINUE X Y( J ) = Y( J ) + ALPHA*TEMP2 X 100 CONTINUE X ELSE X JX = KX X JY = KY X DO 120, J = 1, N X TEMP1 = ALPHA*X( JX ) X TEMP2 = ZERO X Y( JY ) = Y( JY ) + TEMP1*A( J, J ) X IX = JX X IY = JY X DO 110, I = J + 1, N X IX = IX + INCX X IY = IY + INCY X Y( IY ) = Y( IY ) + TEMP1*A( I, J ) X TEMP2 = TEMP2 + A( I, J )*X( IX ) X 110 CONTINUE X Y( JY ) = Y( JY ) + ALPHA*TEMP2 X JX = JX + INCX X JY = JY + INCY X 120 CONTINUE X END IF X END IF * X RETURN * * End of DSYMV . * X END * SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dsymv.f' && chmod 0644 'grkpack/lib/dsymv.f' || echo 'restore of grkpack/lib/dsymv.f failed' shar_count="`wc -c < 'grkpack/lib/dsymv.f'`" test 8149 -eq "$shar_count" || echo "grkpack/lib/dsymv.f: original size 8149, current size $shar_count" fi # ============= grkpack/lib/dsyr2.f ============== if test -f 'grkpack/lib/dsyr2.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dsyr2.f (File already exists)' else echo 'x - extracting grkpack/lib/dsyr2.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dsyr2.f' && ************************************************************************ * X SUBROUTINE DSYR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA ) * .. Scalar Arguments .. X DOUBLE PRECISION ALPHA X INTEGER INCX, INCY, LDA, N X CHARACTER*1 UPLO * .. Array Arguments .. X DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) * .. * * Purpose * ======= * * DSYR2 performs the symmetric rank 2 operation * * A := alpha*x*y' + alpha*y*x' + A, * * where alpha is a scalar, x and y are n element vectors and A is an n * by n symmetric matrix. * * Parameters * ========== * * UPLO - CHARACTER*1. * On entry, UPLO specifies whether the upper or lower * triangular part of the array A is to be referenced as * follows: * * UPLO = 'U' or 'u' Only the upper triangular part of A * is to be referenced. * * UPLO = 'L' or 'l' Only the lower triangular part of A * is to be referenced. * * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the order of the matrix A. * N must be at least zero. * Unchanged on exit. * * ALPHA - DOUBLE PRECISION. * On entry, ALPHA specifies the scalar alpha. * Unchanged on exit. * * X - DOUBLE PRECISION array of dimension at least * ( 1 + ( n - 1 )*abs( INCX ) ). * Before entry, the incremented array X must contain the n * element vector x. * Unchanged on exit. * * INCX - INTEGER. * On entry, INCX specifies the increment for the elements of * X. INCX must not be zero. * Unchanged on exit. * * Y - DOUBLE PRECISION array of dimension at least * ( 1 + ( n - 1 )*abs( INCY ) ). * Before entry, the incremented array Y must contain the n * element vector y. * Unchanged on exit. * * INCY - INTEGER. * On entry, INCY specifies the increment for the elements of * Y. INCY must not be zero. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). * Before entry with UPLO = 'U' or 'u', the leading n by n * upper triangular part of the array A must contain the upper * triangular part of the symmetric matrix and the strictly * lower triangular part of A is not referenced. On exit, the * upper triangular part of the array A is overwritten by the * upper triangular part of the updated matrix. * Before entry with UPLO = 'L' or 'l', the leading n by n * lower triangular part of the array A must contain the lower * triangular part of the symmetric matrix and the strictly * upper triangular part of A is not referenced. On exit, the * lower triangular part of the array A is overwritten by the * lower triangular part of the updated matrix. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. LDA must be at least * max( 1, n ). * Unchanged on exit. * * * Level 2 Blas routine. * * -- Written on 22-October-1986. * Jack Dongarra, Argonne National Lab. * Jeremy Du Croz, Nag Central Office. * Sven Hammarling, Nag Central Office. * Richard Hanson, Sandia National Labs. * * * .. Parameters .. X DOUBLE PRECISION ZERO X PARAMETER ( ZERO = 0.0D+0 ) * .. Local Scalars .. X DOUBLE PRECISION TEMP1, TEMP2 X INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY * .. External Functions .. X LOGICAL LSAME X EXTERNAL LSAME * .. External Subroutines .. X EXTERNAL XERBLA * .. Intrinsic Functions .. X INTRINSIC MAX * .. * .. Executable Statements .. * * Test the input parameters. * X INFO = 0 X IF ( .NOT.LSAME( UPLO, 'U' ).AND. X $ .NOT.LSAME( UPLO, 'L' ) )THEN X INFO = 1 X ELSE IF( N.LT.0 )THEN X INFO = 2 X ELSE IF( INCX.EQ.0 )THEN X INFO = 5 X ELSE IF( INCY.EQ.0 )THEN X INFO = 7 X ELSE IF( LDA.LT.MAX( 1, N ) )THEN X INFO = 9 X END IF X IF( INFO.NE.0 )THEN X CALL XERBLA( 'DSYR2 ', INFO ) X RETURN X END IF * * Quick return if possible. * X IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) ) X $ RETURN * * Set up the start points in X and Y if the increments are not both * unity. * X IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN X IF( INCX.GT.0 )THEN X KX = 1 X ELSE X KX = 1 - ( N - 1 )*INCX X END IF X IF( INCY.GT.0 )THEN X KY = 1 X ELSE X KY = 1 - ( N - 1 )*INCY X END IF X JX = KX X JY = KY X END IF * * Start the operations. In this version the elements of A are * accessed sequentially with one pass through the triangular part * of A. * X IF( LSAME( UPLO, 'U' ) )THEN * * Form A when A is stored in the upper triangle. * X IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN X DO 20, J = 1, N X IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN X TEMP1 = ALPHA*Y( J ) X TEMP2 = ALPHA*X( J ) X DO 10, I = 1, J X A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2 X 10 CONTINUE X END IF X 20 CONTINUE X ELSE X DO 40, J = 1, N X IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN X TEMP1 = ALPHA*Y( JY ) X TEMP2 = ALPHA*X( JX ) X IX = KX X IY = KY X DO 30, I = 1, J X A( I, J ) = A( I, J ) + X( IX )*TEMP1 X $ + Y( IY )*TEMP2 X IX = IX + INCX X IY = IY + INCY X 30 CONTINUE X END IF X JX = JX + INCX X JY = JY + INCY X 40 CONTINUE X END IF X ELSE * * Form A when A is stored in the lower triangle. * X IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN X DO 60, J = 1, N X IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN X TEMP1 = ALPHA*Y( J ) X TEMP2 = ALPHA*X( J ) X DO 50, I = J, N X A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2 X 50 CONTINUE X END IF X 60 CONTINUE X ELSE X DO 80, J = 1, N X IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN X TEMP1 = ALPHA*Y( JY ) X TEMP2 = ALPHA*X( JX ) X IX = JX X IY = JY X DO 70, I = J, N X A( I, J ) = A( I, J ) + X( IX )*TEMP1 X $ + Y( IY )*TEMP2 X IX = IX + INCX X IY = IY + INCY X 70 CONTINUE X END IF X JX = JX + INCX X JY = JY + INCY X 80 CONTINUE X END IF X END IF * X RETURN * * End of DSYR2 . * X END * SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dsyr2.f' && chmod 0644 'grkpack/lib/dsyr2.f' || echo 'restore of grkpack/lib/dsyr2.f failed' shar_count="`wc -c < 'grkpack/lib/dsyr2.f'`" test 7419 -eq "$shar_count" || echo "grkpack/lib/dsyr2.f: original size 7419, current size $shar_count" fi # ============= grkpack/lib/uni.f ============== if test -f 'grkpack/lib/uni.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/uni.f (File already exists)' else echo 'x - extracting grkpack/lib/uni.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/uni.f' && X real function uni(jd) c***begin prologue uni c***date written 810915 c***revision date 830805 c***category no. l6a21 c***keywords random numbers, uniform random numbers c***author blue, james, scientific computing division, nbs c kahaner, david, scientific computing division, nbs c marsaglia, george, computer science dept., wash state univ c c***purpose this routine generates quasi uniform random numbers on [0,1 c and can be used on any computer with which allows integers c at least as large as 32767. c***description c c this routine generates quasi uniform random numbers on the inter c [0,1). it can be used with any computer which allows c integers at least as large as 32767. c c c use c first time.... c z = uni(jd) c here jd is any n o n - z e r o integer. c this causes initialization of the program c and the first random number to be returned as z. c subsequent times... c z = uni(0) c causes the next random number to be returned as z. c c c.................................................................. c note: users who wish to transport this program from one computer c to another should read the following information..... c c machine dependencies... c mdig = a lower bound on the number of binary digits available c for representing integers, including the sign bit. c this value must be at least 16, but may be increased c in line with remark a below. c c remarks... c a. this program can be used in two ways: c (1) to obtain repeatable results on different computers, c set 'mdig' to the smallest of its values on each, or, c (2) to allow the longest sequence of random numbers to be c generated without cycling (repeating) set 'mdig' to the c largest possible value. c b. the sequence of numbers generated depends on the initial c input 'jd' as well as the value of 'mdig'. c if mdig=16 one should find that c the first evaluation c z=uni(305) gives z=.027832881... c the second evaluation c z=uni(0) gives z=.56102176... c the third evaluation c z=uni(0) gives z=.41456343... c the thousandth evaluation c z=uni(0) gives z=.19797357... c c***references marsaglia g., "comments on the perfect uniform random c number generator", unpublished notes, wash s. u. c***routines called i1mach,xerror c***end prologue uni X integer m(17) c X save i,j,m,m1,m2 c X data m(1),m(2),m(3),m(4),m(5),m(6),m(7),m(8),m(9),m(10),m(11), X 1 m(12),m(13),m(14),m(15),m(16),m(17) X 2 / 30788,23052,2053,19346,10646,19427,23975, X 3 19049,10949,19693,29746,26748,2796,23890, X 4 29168,31924,16499 / X data m1,m2,i,j / 32767,256,5,17 / c***first executable statement uni X if(jd .eq. 0) go to 3 c fill CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC X mdig=32 C mdig=i1mach(8)+1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC c be sure that mdig at least 16... C if(mdig.lt.16)call xerror('uni--mdig less than 16',22,1,2) X m1= 2**(mdig-2) + (2**(mdig-2)-1) X m2 = 2**(mdig/2) X jseed = min0(iabs(jd),m1) X if( mod(jseed,2).eq.0 ) jseed=jseed-1 X k0 =mod(9069,m2) X k1 = 9069/m2 X j0 = mod(jseed,m2) X j1 = jseed/m2 X do 2 i=1,17 X jseed = j0*k0 X j1 = mod(jseed/m2+j0*k1+j1*k0,m2/2) X j0 = mod(jseed,m2) X 2 m(i) = j0+m2*j1 X i=5 X j=17 c begin main loop here X 3 k=m(i)-m(j) X if(k .lt. 0) k=k+m1 X m(j)=k X i=i-1 X if(i .eq. 0) i=17 X j=j-1 X if(j .eq. 0) j=17 X uni=float(k)/float(m1) X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/uni.f' && chmod 0644 'grkpack/lib/uni.f' || echo 'restore of grkpack/lib/uni.f failed' shar_count="`wc -c < 'grkpack/lib/uni.f'`" test 4020 -eq "$shar_count" || echo "grkpack/lib/uni.f: original size 4020, current size $shar_count" fi # ============= grkpack/lib/rnor.f ============== if test -f 'grkpack/lib/rnor.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/rnor.f (File already exists)' else echo 'x - extracting grkpack/lib/rnor.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/rnor.f' && X real function rnor(jd) c***begin prologue rnor c***date written 810915 c***revision date 830805 c***category no. l6a14 c***keywords random numbers, uniform random numbers c***author kahaner, david, scientific computing division, nbs c marsaglia, george, computer science dept., wash state univ c c***purpose generates quasi normal random numbers, with mean zero and c unit standard deviation, and can be used with any computer c with integers at least as large as 32767. c***description c c rnor generates quasi normal random numbers with zero mean and c unit standard deviation. c it can be used with any computer with integers at least as c large as 32767. c c c use c first time.... c z = rnor(jd) c here jd is any n o n - z e r o integer. c this causes initialization of the program c and the first random number to be returned as z. c subsequent times... c z = rnor(0) c causes the next random number to be returned as z. c c..................................................................... c c note: users who wish to transport this program to other c computers should read the following .... c c machine dependencies... c mdig = a lower bound on the number of binary digits available c for representing integers, including the sign bit. c this must be at least 16, but can be increased in c line with remark a below. c c remarks... c a. this program can be used in two ways: c (1) to obtain repeatable results on different computers, c set 'mdig' to the smallest of its values on each, or, c (2) to allow the longest sequence of random numbers to be c generated without cycling (repeating) set 'mdig' to the c largest possible value. c b. the sequence of numbers generated depends on the initial c input 'jd' as well as the value of 'mdig'. c if mdig=16 one should find that c the first evaluation c z=rnor(87) gives z=-.40079207... c the second evaluation c z=rnor(0) gives z=-1.8728870... c the third evaluation c z=rnor(0) gives z=1.8216004... c the fourth evaluation c z=rnor(0) gives z=.69410355... c the thousandth evaluation c z=rnor(0) gives z=.96782424... c c***references marsaglia & tsang, "a fast, easily implemented c method for sampling from decreasing or c symmetric unimodal density functions", to be c published in siam j sisc 1983. c***routines called i1mach,xerror c***end prologue rnor X real v(65),w(65) X integer m(17) X save i1,j1,m,m1,m2,rmax X data aa,b,c,rmax/12.37586,.4878992,12.67706,3.0518509e-5/ X data c1,c2,pc,xn/.9689279,1.301198,.1958303e-1,2.776994/ X data v/ .3409450, .4573146, .5397793, .6062427, .6631691 X +, .7136975, .7596125, .8020356, .8417227, .8792102, .9148948 X +, .9490791, .9820005, 1.0138492, 1.0447810, 1.0749254, 1.1043917 X +,1.1332738, 1.1616530, 1.1896010, 1.2171815, 1.2444516, 1.2714635 X +,1.2982650, 1.3249008, 1.3514125, 1.3778399, 1.4042211, 1.4305929 X +,1.4569915, 1.4834526, 1.5100121, 1.5367061, 1.5635712, 1.5906454 X +,1.6179680, 1.6455802, 1.6735255, 1.7018503, 1.7306045, 1.7598422 X +,1.7896223, 1.8200099, 1.8510770, 1.8829044, 1.9155830, 1.9492166 X +,1.9839239, 2.0198430, 2.0571356, 2.0959930, 2.1366450, 2.1793713 X +,2.2245175, 2.2725185, 2.3239338, 2.3795007, 2.4402218, 2.5075117 X +,2.5834658, 2.6713916, 2.7769943, 2.7769943, 2.7769943, 2.7769943/ X data w/ .10405134e-04, .13956560e-04, .16473259e-04, X + .18501623e-04, .20238931e-04, .21780983e-04, .23182241e-04, X + .24476931e-04, .25688121e-04, .26832186e-04, .27921226e-04, X + .28964480e-04, .29969191e-04, .30941168e-04, .31885160e-04, X + .32805121e-04, .33704388e-04, .34585827e-04, .35451919e-04, X + .36304851e-04, .37146564e-04, .37978808e-04, .38803170e-04, X + .39621114e-04, .40433997e-04, .41243096e-04, .42049621e-04, X + .42854734e-04, .43659562e-04, .44465208e-04, .45272764e-04, X + .46083321e-04, .46897980e-04, .47717864e-04, .48544128e-04, X + .49377973e-04, .50220656e-04, .51073504e-04, .51937936e-04, X + .52815471e-04, .53707761e-04, .54616606e-04, .55543990e-04, X + .56492112e-04, .57463436e-04, .58460740e-04, .59487185e-04, X + .60546402e-04, .61642600e-04, .62780711e-04, .63966581e-04, X + .65207221e-04, .66511165e-04, .67888959e-04, .69353880e-04, X + .70922996e-04, .72618816e-04, .74471933e-04, .76525519e-04, X + .78843526e-04, .81526890e-04, .84749727e-04, X + .84749727e-04, .84749727e-04, .84749727e-04/ X data m(1),m(2),m(3),m(4),m(5),m(6),m(7),m(8),m(9),m(10),m(11), X 1 m(12),m(13),m(14),m(15),m(16),m(17) X 2 / 30788,23052,2053,19346,10646,19427,23975, X 3 19049,10949,19693,29746,26748,2796,23890, X 4 29168,31924,16499 / X data m1,m2,i1,j1 / 32767,256,5,17 / c fast part... c c c***first executable statement rnor X if(jd.ne.0)go to 27 X 10 continue X i=m(i1)-m(j1) X if(i .lt. 0) i=i+m1 X m(j1)=i X i1=i1-1 X if(i1 .eq. 0) i1=17 X j1=j1-1 X if(j1 .eq. 0) j1=17 X j=mod(i,64)+1 X rnor=i*w(j+1) X if( ( (i/m2)/2 )*2.eq.(i/m2))rnor=-rnor X if(abs(rnor).le.v(j))return c slow part; aa is a*f(0) X x=(abs(rnor)-v(j))/(v(j+1)-v(j)) X y=uni(0) X s=x+y X if(s.gt.c2)go to 11 X if(s.le.c1)return X if(y.gt.c-aa*exp(-.5*(b-b*x)**2))go to 11 X if(exp(-.5*v(j+1)**2)+y*pc/v(j+1).le.exp(-.5*rnor**2))return c tail part; 3.855849 is .5*xn**2 X 22 s=xn-alog(uni(0))/xn X if(3.855849+alog(uni(0))-xn*s.gt.-.5*s**2)go to 22 X rnor=sign(s,rnor) X return X 11 rnor=sign(b-b*x,rnor) X return c fill X 27 continue CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC X mdig=32 C mdig=i1mach(8)+1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC c be sure that mdig at least 16... C if(mdig.lt.16)call xerror('rnor--mdig less than 16',23,1,2) X m1 = 2**(mdig-2) + (2**(mdig-2)-1) X m2 = 2**(mdig/2) X jseed = min0(iabs(jd),m1) X if( mod(jseed,2).eq.0 ) jseed=jseed-1 X k0 =mod(9069,m2) X k1 = 9069/m2 X j0 = mod(jseed,m2) X j1 = jseed/m2 X do 2 i=1,17 X jseed = j0*k0 X j1 = mod(jseed/m2+j0*k1+j1*k0,m2/2) X j0 = mod(jseed,m2) X 2 m(i) = j0+m2*j1 X j1=17 X i1=5 X rmax = 1./float(m1) c seed uniform (0,1) generator. (just a dummy call) X rnor=uni(jd) X do 28 i=1,65 X 28 w(i)=rmax*v(i) X go to 10 X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/rnor.f' && chmod 0644 'grkpack/lib/rnor.f' || echo 'restore of grkpack/lib/rnor.f failed' shar_count="`wc -c < 'grkpack/lib/rnor.f'`" test 6891 -eq "$shar_count" || echo "grkpack/lib/rnor.f: original size 6891, current size $shar_count" fi # ============= grkpack/lib/dset.f ============== if test -f 'grkpack/lib/dset.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dset.f (File already exists)' else echo 'x - extracting grkpack/lib/dset.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dset.f' && X subroutine dset(n,da,dx,incx) X integer n,incx X double precision da,dx(*) c c Purpose : set vector dx to constant da. Unrolled loops are used for c increment equal to one. c c On Entry: c n length of dx c da any constant c incx increment for dx c c On Exit: c dx(n) vector with all n entries set to da c c $Header: dset.f,v 2.1 86/04/08 14:06:25 lindstrom Exp $ c X integer i,m,mp1,nincx c X if(n.le.0)return X if(incx.eq.1)go to 20 c c code for increment not equal to 1 c X nincx = n*incx X do 10 i = 1,nincx,incx X dx(i) = da X 10 continue X return c c code for increment equal to 1 c c c clean-up loop c X 20 m = mod(n,5) X if( m .eq. 0 ) go to 40 X do 30 i = 1,m X dx(i) = da X 30 continue X if( n .lt. 5 ) return X 40 mp1 = m + 1 X do 50 i = mp1,n,5 X dx(i) = da X dx(i + 1) = da X dx(i + 2) = da X dx(i + 3) = da X dx(i + 4) = da X 50 continue X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dset.f' && chmod 0644 'grkpack/lib/dset.f' || echo 'restore of grkpack/lib/dset.f failed' shar_count="`wc -c < 'grkpack/lib/dset.f'`" test 1012 -eq "$shar_count" || echo "grkpack/lib/dset.f: original size 1012, current size $shar_count" fi # ============= grkpack/lib/dprmut.f ============== if test -f 'grkpack/lib/dprmut.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dprmut.f (File already exists)' else echo 'x - extracting grkpack/lib/dprmut.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dprmut.f' && X subroutine dprmut (x,npar,jpvt,job) X integer npar,jpvt(npar),job X double precision x(npar) c c Purpose: permute the elements of the array x according to the index c vector jpvt (either forward or backward permutation). c c On Entry: c x(npar) array to be permuted c npar size of x (and jpvt) c jpvt indices of the permutation c job indicator of forward or backward permutation c if job = 0 forward permutation c x(jpvt(i)) moved to x(i) c if job is nonzero backward permutation c x(i) moved to x(jpvt(i)) c On Exit: c x(npar) array with permuted entries c c Written: Yin Ling U. of Maryland, August,1978 c c $Header: dprmut.f,v 2.1 86/04/08 14:05:53 lindstrom Exp $ c X integer i,j,k X double precision t c X if (npar .le. 1) then X return X endif X do 10 j = 1,npar X jpvt(j) = -jpvt(j) X 10 continue X if (job .eq. 0) then c forward permutation X do 30 i = 1,npar X if (jpvt(i) .gt. 0) then X goto 30 X endif X j = i X jpvt(j) = -jpvt(j) X k = jpvt(j) c while X 20 if (jpvt(k) .lt. 0) then X t = x(j) X x(j) = x(k) X x(k) = t X jpvt(k) = -jpvt(k) X j = k X k = jpvt(k) X goto 20 c endwhile X endif X 30 continue X endif X if (job .ne. 0 ) then c backward permutation X do 50 i = 1,npar X if (jpvt(i) .gt. 0) then X goto 50 X endif X jpvt(i) = -jpvt(i) X j = jpvt(i) c while X 40 if (j .ne. i) then X t = x(i) X x(i) = x(j) X x(j) = t X jpvt(j) = -jpvt(j) X j = jpvt(j) X goto 40 c endwhile X endif X 50 continue X endif X return X end SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dprmut.f' && chmod 0644 'grkpack/lib/dprmut.f' || echo 'restore of grkpack/lib/dprmut.f failed' shar_count="`wc -c < 'grkpack/lib/dprmut.f'`" test 1930 -eq "$shar_count" || echo "grkpack/lib/dprmut.f: original size 1930, current size $shar_count" fi # ============= grkpack/lib/dnrm2.f ============== if test -f 'grkpack/lib/dnrm2.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dnrm2.f (File already exists)' else echo 'x - extracting grkpack/lib/dnrm2.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dnrm2.f' && X DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX) X INTEGER NEXT X DOUBLE PRECISION DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE X DATA ZERO, ONE /0.0D0, 1.0D0/ C C EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE C INCREMENT INCX . C IF N .LE. 0 RETURN WITH RESULT = 0. C IF N .GE. 1 THEN INCX MUST BE .GE. 1 C C C.L.LAWSON, 1978 JAN 08 C C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE C HOPEFULLY APPLICABLE TO ALL MACHINES. C CUTLO = MAXIMUM OF DSQRT(U/EPS) OVER ALL KNOWN MACHINES. C CUTHI = MINIMUM OF DSQRT(V) OVER ALL KNOWN MACHINES. C WHERE C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) C V = LARGEST NO. (OVERFLOW LIMIT) C C BRIEF OUTLINE OF ALGORITHM.. C C PHASE 1 SCANS ZERO COMPONENTS. C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. C C VALUES FOR CUTLO AND CUTHI.. C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE C UNIVAC AND DEC AT 2**(-103) C THUS CUTLO = 2**(-51) = 4.44089E-16 C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. C THUS CUTHI = 2**(63.5) = 1.30438E19 C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. C THUS CUTLO = 2**(-33.5) = 8.23181D-11 C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D19 C DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 / C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / X DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 / C X IF(N .GT. 0) GO TO 10 X DNRM2 = ZERO X GO TO 300 C X 10 ASSIGN 30 TO NEXT X SUM = ZERO X NN = N * INCX C BEGIN MAIN LOOP X I = 1 X 20 GO TO NEXT,(30, 50, 70, 110) X 30 IF( DABS(DX(I)) .GT. CUTLO) GO TO 85 X ASSIGN 50 TO NEXT X XMAX = ZERO C C PHASE 1. SUM IS ZERO C X 50 IF( DX(I) .EQ. ZERO) GO TO 200 X IF( DABS(DX(I)) .GT. CUTLO) GO TO 85 C C PREPARE FOR PHASE 2. X ASSIGN 70 TO NEXT X GO TO 105 C C PREPARE FOR PHASE 4. C X 100 I = J X ASSIGN 110 TO NEXT X SUM = (SUM / DX(I)) / DX(I) X 105 XMAX = DABS(DX(I)) X GO TO 115 C C PHASE 2. SUM IS SMALL. C SCALE TO AVOID DESTRUCTIVE UNDERFLOW. C X 70 IF( DABS(DX(I)) .GT. CUTLO ) GO TO 75 C C COMMON CODE FOR PHASES 2 AND 4. C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. C X 110 IF( DABS(DX(I)) .LE. XMAX ) GO TO 115 X SUM = ONE + SUM * (XMAX / DX(I))**2 X XMAX = DABS(DX(I)) X GO TO 200 C X 115 SUM = SUM + (DX(I)/XMAX)**2 X GO TO 200 C C C PREPARE FOR PHASE 3. C X 75 SUM = (SUM * XMAX) * XMAX C C C FOR REAL OR D.P. SET HITEST = CUTHI/N C FOR COMPLEX SET HITEST = CUTHI/(2*N) C X 85 HITEST = CUTHI/FLOAT( N ) C C PHASE 3. SUM IS MID-RANGE. NO SCALING. C X DO 95 J =I,NN,INCX X IF(DABS(DX(J)) .GE. HITEST) GO TO 100 X 95 SUM = SUM + DX(J)**2 X DNRM2 = DSQRT( SUM ) X GO TO 300 C X 200 CONTINUE X I = I + INCX X IF ( I .LE. NN ) GO TO 20 C C END OF MAIN LOOP. C C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. C X DNRM2 = XMAX * DSQRT(SUM) X 300 CONTINUE X RETURN X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dnrm2.f' && chmod 0644 'grkpack/lib/dnrm2.f' || echo 'restore of grkpack/lib/dnrm2.f failed' shar_count="`wc -c < 'grkpack/lib/dnrm2.f'`" test 3785 -eq "$shar_count" || echo "grkpack/lib/dnrm2.f: original size 3785, current size $shar_count" fi # ============= grkpack/lib/invnor.f ============== if test -f 'grkpack/lib/invnor.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/invnor.f (File already exists)' else echo 'x - extracting grkpack/lib/invnor.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/invnor.f' && X REAL FUNCTION invnor(p) C C********************************************************************** C C REAL FUNCTION INVNOR(P) C NORmal distribution INVerse C C C Function C C C Returns X such that CUMNOR(X) = P, i.e., the integral from - C infinity to X of (1/SQRT(2*PI)) EXP(-U*U) dU is P C C C Arguments C C C P --> The probability whose normal deviate is sought. C P is REAL C C C Method C C C The rational function on page 95 of Kennedy and Gentle, C Statistical Computing, Marcel Dekker, NY , 1980. C C C Note C C C If P .lt. 1.0e-20 then INVNOR returns -10.0. C If P .ge. 1.0 then INVNOR returns 10.0. C C********************************************************************** C C .. Scalar Arguments .. X REAL p C .. C .. Local Scalars .. X DOUBLE PRECISION sign,y,z C .. C .. Local Arrays .. X DOUBLE PRECISION xden(5),xnum(5) C .. C .. External Functions .. X DOUBLE PRECISION devlpl X EXTERNAL devlpl C .. C .. Intrinsic Functions .. X INTRINSIC dble,log,sqrt C .. C .. Data statements .. X DATA xnum/-0.322232431088D0,-1.000000000000D0,-0.342242088547D0, X + -0.204231210245D-1,-0.453642210148D-4/ X DATA xden/0.993484626060D-1,0.588581570495D0,0.531103462366D0, X + 0.103537752850D0,0.38560700634D-2/ C .. C .. Executable Statements .. X IF (.NOT. (p.LT.1.0E-20)) GO TO 10 X invnor = -10.0 X RETURN X X 10 IF (.NOT. (p.GE.1.0)) GO TO 20 X invnor = 10.0 X RETURN X X 20 IF (.NOT. (p.LE.0.5D0)) GO TO 30 X sign = -1.0D0 X z = p X GO TO 40 X X 30 sign = 1.0D0 X z = 1.0D0 - dble(p) X 40 y = sqrt(-2.0D0*log(z)) X invnor = y + devlpl(xnum,5,y)/devlpl(xden,5,y) X invnor = sign*invnor X RETURN X X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/invnor.f' && chmod 0644 'grkpack/lib/invnor.f' || echo 'restore of grkpack/lib/invnor.f failed' shar_count="`wc -c < 'grkpack/lib/invnor.f'`" test 1967 -eq "$shar_count" || echo "grkpack/lib/invnor.f: original size 1967, current size $shar_count" fi # ============= grkpack/lib/README ============== if test -f 'grkpack/lib/README' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/README (File already exists)' else echo 'x - extracting grkpack/lib/README (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/README' && X This directory collects public domain FORTRAN routines called upon by EXPonential RKPACK routines: X Blas -- dasum, daxpy, dcopy, ddot, dnrm2, dscal, dswap, idamax X Blas2 -- dgemv, dsymv, dsyr2 X CDFLIB -- devlpl, dlanor, dln1px, dumnor, invnor X Linpack -- dpbfa, dpbsl, dpofa, dposl, dqrdc, dqrsl, dtrsl X Other -- dprmut, dset, dsort and public domain pseudo random number generators: X Cmlib -- rnor, uni Run `make' under standard UNIX system to compile and archive the *.o files in lib.a. X Yuedong Wang July 18, 1994 SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/README' && chmod 0644 'grkpack/lib/README' || echo 'restore of grkpack/lib/README failed' shar_count="`wc -c < 'grkpack/lib/README'`" test 547 -eq "$shar_count" || echo "grkpack/lib/README: original size 547, current size $shar_count" fi # ============= grkpack/lib/lsame.f ============== if test -f 'grkpack/lib/lsame.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/lsame.f (File already exists)' else echo 'x - extracting grkpack/lib/lsame.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/lsame.f' && X LOGICAL FUNCTION LSAME ( CA, CB ) * .. Scalar Arguments .. X CHARACTER*1 CA, CB * .. * * Purpose * ======= * * LSAME tests if CA is the same letter as CB regardless of case. * CB is assumed to be an upper case letter. LSAME returns .TRUE. if * CA is either the same as CB or the equivalent lower case letter. * * N.B. This version of the routine is only correct for ASCII code. * Installers must modify the routine for other character-codes. * * For EBCDIC systems the constant IOFF must be changed to -64. * For CDC systems using 6-12 bit representations, the system- * specific code in comments must be activated. * * Parameters * ========== * * CA - CHARACTER*1 * CB - CHARACTER*1 * On entry, CA and CB specify characters to be compared. * Unchanged on exit. * * * Auxiliary routine for Level 2 Blas. * * -- Written on 20-July-1986 * Richard Hanson, Sandia National Labs. * Jeremy Du Croz, Nag Central Office. * * .. Parameters .. X INTEGER IOFF X PARAMETER ( IOFF=32 ) * .. Intrinsic Functions .. X INTRINSIC ICHAR * .. Executable Statements .. * * Test if the characters are equal * X LSAME = CA .EQ. CB * * Now test for equivalence * X IF ( .NOT.LSAME ) THEN X LSAME = ICHAR(CA) - IOFF .EQ. ICHAR(CB) X END IF * X RETURN * * The following comments contain code for CDC systems using 6-12 bit * representations. * * .. Parameters .. * INTEGER ICIRFX * PARAMETER ( ICIRFX=62 ) * .. Scalar Arguments .. * CHARACTER*1 CB * .. Array Arguments .. * CHARACTER*1 CA(*) * .. Local Scalars .. * INTEGER IVAL * .. Intrinsic Functions .. * INTRINSIC ICHAR, CHAR * .. Executable Statements .. * * See if the first character in string CA equals string CB. * * LSAME = CA(1) .EQ. CB .AND. CA(1) .NE. CHAR(ICIRFX) * * IF (LSAME) RETURN * * The characters are not identical. Now check them for equivalence. * Look for the 'escape' character, circumflex, followed by the * letter. * * IVAL = ICHAR(CA(2)) * IF (IVAL.GE.ICHAR('A') .AND. IVAL.LE.ICHAR('Z')) THEN * LSAME = CA(1) .EQ. CHAR(ICIRFX) .AND. CA(2) .EQ. CB * END IF * * RETURN * * End of LSAME. * X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/lsame.f' && chmod 0644 'grkpack/lib/lsame.f' || echo 'restore of grkpack/lib/lsame.f failed' shar_count="`wc -c < 'grkpack/lib/lsame.f'`" test 2426 -eq "$shar_count" || echo "grkpack/lib/lsame.f: original size 2426, current size $shar_count" fi # ============= grkpack/lib/xerbla.f ============== if test -f 'grkpack/lib/xerbla.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/xerbla.f (File already exists)' else echo 'x - extracting grkpack/lib/xerbla.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/xerbla.f' && X SUBROUTINE XERBLA ( SRNAME, INFO ) * .. Scalar Arguments .. X INTEGER INFO X CHARACTER*6 SRNAME * .. * * Purpose * ======= * * XERBLA is an error handler for the Level 2 BLAS routines. * * It is called by the Level 2 BLAS routines if an input parameter is * invalid. * * Installers should consider modifying the STOP statement in order to * call system-specific exception-handling facilities. * * Parameters * ========== * * SRNAME - CHARACTER*6. * On entry, SRNAME specifies the name of the routine which * called XERBLA. * * INFO - INTEGER. * On entry, INFO specifies the position of the invalid * parameter in the parameter-list of the calling routine. * * * Auxiliary routine for Level 2 Blas. * * Written on 20-July-1986. * * .. Executable Statements .. * X WRITE (*,99999) SRNAME, INFO * X STOP * 99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2, X $ ' had an illegal value' ) * * End of XERBLA. * X END * SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/xerbla.f' && chmod 0644 'grkpack/lib/xerbla.f' || echo 'restore of grkpack/lib/xerbla.f failed' shar_count="`wc -c < 'grkpack/lib/xerbla.f'`" test 1057 -eq "$shar_count" || echo "grkpack/lib/xerbla.f: original size 1057, current size $shar_count" fi # ============= grkpack/lib/Makefile ============== if test -f 'grkpack/lib/Makefile' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/Makefile (File already exists)' else echo 'x - extracting grkpack/lib/Makefile (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/Makefile' && OBJECTS = dasum.o dpbfa.o dqrdc.o dsymv.o uni.o daxpy.o dpbsl.o dqrsl.o dsyr2.o dcopy.o dpofa.o dscal.o dtrsl.o ddot.o dposl.o dset.o idamax.o dgemv.o dprmut.o dswap.o rnor.o dnrm2.o lsame.o xerbla.o dsort.o devlpl.o dlanor.o dln1px.o dumnor.o invnor.o FLAGS = -O X X.SUFFIXES: .f .o X X.f.o: X f77 -c $(FLAGS) $*.f X lib.a :: $(OBJECTS) X ar rv lib.a $(OBJECTS) X rm *.o X ranlib lib.a SHAR_EOF $shar_touch -am 0201080095 'grkpack/lib/Makefile' && chmod 0644 'grkpack/lib/Makefile' || echo 'restore of grkpack/lib/Makefile failed' shar_count="`wc -c < 'grkpack/lib/Makefile'`" test 380 -eq "$shar_count" || echo "grkpack/lib/Makefile: original size 380, current size $shar_count" fi # ============= grkpack/lib/dsort.f ============== if test -f 'grkpack/lib/dsort.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dsort.f (File already exists)' else echo 'x - extracting grkpack/lib/dsort.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dsort.f' && c this is a subroutine to sort a arrary, using heapsrot method c see "numerical recipes" X X subroutine dsort(n,ra) X integer n X double precision ra(n) X X l=n/2+1 X ir=n X 10 continue X if (l .gt. 1) then X l=l-1 X rra=ra(l) X else X rra=ra(ir) X ra(ir)=ra(1) X ir=ir-1 X if (ir .eq. 1) then X ra(1)=rra X return X endif X endif X i=l X j=l+l X 20 if (j .le. ir) then X if (j .lt. ir) then X if (ra(j) .lt. ra(j+1)) j=j+1 X endif X if (rra .lt. ra(j)) then X ra(i)=ra(j) X i=j X j=j+j X else X j=ir+1 X endif X go to 20 X endif X ra(i)=rra X go to 10 X end X SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dsort.f' && chmod 0644 'grkpack/lib/dsort.f' || echo 'restore of grkpack/lib/dsort.f failed' shar_count="`wc -c < 'grkpack/lib/dsort.f'`" test 776 -eq "$shar_count" || echo "grkpack/lib/dsort.f: original size 776, current size $shar_count" fi # ============= grkpack/lib/devlpl.f ============== if test -f 'grkpack/lib/devlpl.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/devlpl.f (File already exists)' else echo 'x - extracting grkpack/lib/devlpl.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/devlpl.f' && X DOUBLE PRECISION FUNCTION devlpl(a,n,x) C C********************************************************************** C C DOUBLE PRECISION FUNCTION DEVLPL(A,N,X) C Double precision EVALuate a PoLynomial at X C C C Function C C C returns C A(1) + A(2)*X + ... + A(N)*X**(N-1) C C C Arguments C C C A --> Array of coefficients of the polynomial. C A is DOUBLE PRECISION(N) C C N --> Length of A, also degree of polynomial - 1. C N is INTEGER C C X --> Point at which the polynomial is to be evaluated. C X is DOUBLE PRECISION C C********************************************************************** C C .. Scalar Arguments .. X DOUBLE PRECISION x X INTEGER n C .. C .. Array Arguments .. X DOUBLE PRECISION a(n) C .. C .. Local Scalars .. X DOUBLE PRECISION term X INTEGER i C .. C .. Executable Statements .. X term = a(n) X DO 10,i = n - 1,1,-1 X term = a(i) + term*x X 10 CONTINUE X devlpl = term X RETURN X X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/devlpl.f' && chmod 0644 'grkpack/lib/devlpl.f' || echo 'restore of grkpack/lib/devlpl.f failed' shar_count="`wc -c < 'grkpack/lib/devlpl.f'`" test 1211 -eq "$shar_count" || echo "grkpack/lib/devlpl.f: original size 1211, current size $shar_count" fi # ============= grkpack/lib/dumnor.f ============== if test -f 'grkpack/lib/dumnor.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dumnor.f (File already exists)' else echo 'x - extracting grkpack/lib/dumnor.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dumnor.f' && X DOUBLE PRECISION FUNCTION dumnor(x) C********************************************************************** C C DOUBLE PRECISION FUNCTION DUMNOR(X) C C C Function C C C Computes the cumulative of the normal distribution, i.e., C the integral from -infinity to x of C (1/sqrt(2*pi)) exp(-u*u/2) du C C C Method C C C The rational function approximation from pages 90 - 92 of C Kennedy and Gentle, Statistical Computing, Marcel Dekker, NY C 1980. C C C Arguments C C C X --> Argument at which cumulative normal is evaluated C DOUBLE PRECISION X C C********************************************************************** C C C PIM12 IS PI**(-1/2) C SQRT2 IS SQRT(2) C C C C .. Scalar Arguments .. X DOUBLE PRECISION x C .. C .. Local Scalars .. X DOUBLE PRECISION derf,derfc,pim12,sqrt2,z,z2,zm2 X LOGICAL qdirct C .. C .. Local Arrays .. X DOUBLE PRECISION xden1(4),xden2(8),xden3(5),xnum1(4),xnum2(8), X + xnum3(5) C .. C .. External Functions .. X DOUBLE PRECISION devlpl,dlanor X EXTERNAL devlpl,dlanor C .. C .. Intrinsic Functions .. X INTRINSIC abs,exp C .. C .. Data statements .. X DATA xnum1/2.4266795523053175D2,2.1979261618294152D1, X + 6.9963834886191355D0,-3.5609843701815385D-2/ X DATA xden1/2.1505887586986120D2,9.1164905404514901D1, X + 1.5082797630407787D1,1.0000000000000000D0/ X DATA xnum2/3.004592610201616005D2,4.519189537118729422D2, X + 3.393208167343436870D2,1.529892850469404039D2, X + 4.316222722205673530D1,7.211758250883093659D0, X + 5.641955174789739711D-1,-1.368648573827167067D-7/ X DATA xden2/3.004592609569832933D2,7.909509253278980272D2, X + 9.313540948506096211D2,6.389802644656311665D2, X + 2.775854447439876434D2,7.700015293522947295D1, X + 1.278272731962942351D1,1.000000000000000000D0/ X DATA xnum3/-2.99610707703542174D-3,-4.94730910623250734D-2, X + -2.26956593539686930D-1,-2.78661308609647788D-1, X + -2.23192459734184686D-2/ X DATA xden3/1.06209230528467918D-2,1.91308926107829841D-1, X + 1.05167510706793207D0,1.98733201817135256D0, X + 1.00000000000000000D0/ X DATA pim12/0.5641895835477562869480795D0/ X DATA sqrt2/1.4142135623730950488D0/ C .. C .. Executable Statements .. X IF (.NOT. (abs(x).LT.1.0E-30)) GO TO 10 X dumnor = 0.5 X RETURN X X GO TO 50 X X 10 IF (.NOT. (x.LE.-38.0)) GO TO 20 X dumnor = 0.0 X RETURN X X GO TO 50 X X 20 IF (.NOT. (x.LE.-15.0)) GO TO 30 X dumnor = exp(dlanor(x)) X RETURN X X GO TO 50 X X 30 IF (.NOT. (x.GT.6.0)) GO TO 40 X dumnor = 1.0 X RETURN X X GO TO 50 X X 40 CONTINUE X 50 z = abs(x/sqrt2) X z2 = z*z X zm2 = 1.0D0/z2 X IF (z.LT.0.5D0) THEN X derf = z*devlpl(xnum1,4,z2)/devlpl(xden1,4,z2) X qdirct = .TRUE. X X ELSE IF (z.LT.4.0D0) THEN X derfc = exp(-z2)*devlpl(xnum2,8,z)/devlpl(xden2,8,z) X qdirct = .FALSE. X X ELSE X derfc = (exp(-z2)/z)* (pim12+zm2*devlpl(xnum3,5,zm2)/ X + devlpl(xden3,5,zm2)) X qdirct = .FALSE. X END IF X X IF (.NOT. (x.GE.0.0)) GO TO 60 X IF (.NOT. (qdirct)) derf = 1.0D0 - derfc X dumnor = (1.0D0+derf)/2.0D0 X GO TO 70 X X 60 IF (qdirct) derfc = 1.0D0 - derf X dumnor = derfc/2.0D0 X 70 RETURN X X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dumnor.f' && chmod 0644 'grkpack/lib/dumnor.f' || echo 'restore of grkpack/lib/dumnor.f failed' shar_count="`wc -c < 'grkpack/lib/dumnor.f'`" test 3570 -eq "$shar_count" || echo "grkpack/lib/dumnor.f: original size 3570, current size $shar_count" fi # ============= grkpack/lib/dlanor.f ============== if test -f 'grkpack/lib/dlanor.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dlanor.f (File already exists)' else echo 'x - extracting grkpack/lib/dlanor.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dlanor.f' && X DOUBLE PRECISION FUNCTION dlanor(x) C********************************************************************** C C DOUBLE PRECISION FUNCTION DLANOR( X ) C Double precision Logarith of the Asymptotic Normal C C C Function C C C Computes the logarithm of the cumulative normal distribution C from abs( x ) to infinity for abs( x ) >= 5. C C C Arguments C C C X --> Value at which cumulative normal to be evaluated C DOUBLE PRECISION X C C C Method C C C 23 term expansion of formula 26.2.12 of Abramowitz and Stegun. C The relative error at X = 5 is about 0.5E-5. C C C Note C C C ABS(X) must be >= 5 else there is an error stop. C C********************************************************************** C .. Parameters .. X DOUBLE PRECISION dlsqpi X PARAMETER (dlsqpi=0.91893853320467274177D0) C .. C .. Scalar Arguments .. X DOUBLE PRECISION x C .. C .. Local Scalars .. X DOUBLE PRECISION approx,correc,xx,xx2 C .. C .. Local Arrays .. X DOUBLE PRECISION coef(12) C .. C .. External Functions .. X DOUBLE PRECISION devlpl,dln1px X EXTERNAL devlpl,dln1px C .. C .. Intrinsic Functions .. X INTRINSIC abs,log C .. C .. Data statements .. X DATA coef/-1.0D0,3.0D0,-15.0D0,105.0D0,-945.0D0,10395.0D0, X + -135135.0D0,2027025.0D0,-34459425.0D0,654729075.0D0, X + -13749310575D0,316234143225.0D0/ C .. C .. Executable Statements .. X X xx = abs(x) X IF (xx.LT.5.0D0) STOP ' Argument too small in DLANOR' X X approx = -dlsqpi - 0.5*xx*xx - log(xx) X X xx2 = xx*xx X correc = devlpl(coef,12,1.0D0/xx2)/xx2 X correc = dln1px(correc) X X dlanor = approx + correc X X RETURN X X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dlanor.f' && chmod 0644 'grkpack/lib/dlanor.f' || echo 'restore of grkpack/lib/dlanor.f failed' shar_count="`wc -c < 'grkpack/lib/dlanor.f'`" test 1897 -eq "$shar_count" || echo "grkpack/lib/dlanor.f: original size 1897, current size $shar_count" fi # ============= grkpack/lib/dln1px.f ============== if test -f 'grkpack/lib/dln1px.f' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/lib/dln1px.f (File already exists)' else echo 'x - extracting grkpack/lib/dln1px.f (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/lib/dln1px.f' && X DOUBLE PRECISION FUNCTION dln1px(a) C********************************************************************** C C DOUBLE PRECISION FUNCTION DLN1PX(X) C Double precision LN(1+X) C C C Function C C C Returns ln(1+x) C Note that the obvious code of C LOG(1.0+X) C won't work for small X because 1.0+X loses accuracy C C C Arguments C C C X --> Value for which ln(1-x) is desired. C X is DOUBLE PRECISION C C C Method C C C Renames ALNREL from: C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C********************************************************************** C----------------------------------------------------------------------- C EVALUATION OF THE FUNCTION LN(1 + A) C----------------------------------------------------------------------- C .. Scalar Arguments .. X DOUBLE PRECISION a C .. C .. Local Scalars .. X DOUBLE PRECISION p1,p2,p3,q1,q2,q3,t,t2,w,x C .. C .. Intrinsic Functions .. X INTRINSIC abs,dble,dlog C .. C .. Data statements .. X DATA p1/-.129418923021993D+01/,p2/.405303492862024D+00/, X + p3/-.178874546012214D-01/ X DATA q1/-.162752256355323D+01/,q2/.747811014037616D+00/, X + q3/-.845104217945565D-01/ C .. C .. Executable Statements .. C-------------------------- X IF (abs(a).GT.0.375D0) GO TO 10 X t = a/ (a+2.0D0) X t2 = t*t X w = (((p3*t2+p2)*t2+p1)*t2+1.0D0)/ (((q3*t2+q2)*t2+q1)*t2+1.0D0) X dln1px = 2.0D0*t*w X RETURN C X 10 x = 1.D0 + dble(a) X dln1px = dlog(x) X RETURN X X END SHAR_EOF $shar_touch -am 0116120295 'grkpack/lib/dln1px.f' && chmod 0644 'grkpack/lib/dln1px.f' || echo 'restore of grkpack/lib/dln1px.f failed' shar_count="`wc -c < 'grkpack/lib/dln1px.f'`" test 1859 -eq "$shar_count" || echo "grkpack/lib/dln1px.f: original size 1859, current size $shar_count" fi # ============= grkpack/examples/pima.dat ============== if test ! -d 'grkpack/examples'; then echo 'x - creating directory grkpack/examples' mkdir 'grkpack/examples' fi if test -f 'grkpack/examples/pima.dat' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/pima.dat (File already exists)' else echo 'x - extracting grkpack/examples/pima.dat (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/pima.dat' && X 6 148 72 35 0 33.6 0.627 50 1 X 1 85 66 29 0 26.6 0.351 31 0 X 8 183 64 0 0 23.3 0.672 32 1 X 0 137 40 35 168 43.1 2.288 33 1 X 3 78 50 32 88 31.0 0.248 26 1 X 10 115 0 0 0 35.3 0.134 29 0 X 2 197 70 45 543 30.5 0.158 53 1 X 10 168 74 0 0 38.0 0.537 34 1 X 10 139 80 0 0 27.1 1.441 57 0 X 1 189 60 23 846 30.1 0.398 59 1 X 5 166 72 19 175 25.8 0.587 51 1 X 7 100 0 0 0 30.0 0.484 32 1 X 0 118 84 47 230 45.8 0.551 31 1 X 7 107 74 0 0 29.6 0.254 31 1 X 1 103 30 38 83 43.3 0.183 33 0 X 1 115 70 30 96 34.6 0.529 32 1 X 3 126 88 41 235 39.3 0.704 27 0 X 7 196 90 0 0 39.8 0.451 41 1 X 9 119 80 35 0 29.0 0.263 29 1 X 11 143 94 33 146 36.6 0.254 51 1 X 10 125 70 26 115 31.1 0.205 41 1 X 7 147 76 0 0 39.4 0.257 43 1 X 1 97 66 15 140 23.2 0.487 22 0 X 5 109 75 26 0 36.0 0.546 60 0 X 3 158 76 36 245 31.6 0.851 28 1 X 3 88 58 11 54 24.8 0.267 22 0 X 10 122 78 31 0 27.6 0.512 45 0 X 4 103 60 33 192 24.0 0.966 33 0 X 9 102 76 37 0 32.9 0.665 46 1 X 2 90 68 42 0 38.2 0.503 27 1 X 4 111 72 47 207 37.1 1.390 56 1 X 3 180 64 25 70 34.0 0.271 26 0 X 7 106 92 18 0 22.7 0.235 48 0 X 9 171 110 24 240 45.4 0.721 54 1 X 7 159 64 0 0 27.4 0.294 40 0 X 1 103 80 11 82 19.4 0.491 22 0 X 1 101 50 15 36 24.2 0.526 26 0 X 7 150 66 42 342 34.7 0.718 42 0 X 1 73 50 10 0 23.0 0.248 21 0 X 0 100 88 60 110 46.8 0.962 31 0 X 0 146 82 0 0 40.5 1.781 44 0 X 0 105 64 41 142 41.5 0.173 22 0 X 8 133 72 0 0 32.9 0.270 39 1 X 5 44 62 0 0 25.0 0.587 36 0 X 2 141 58 34 128 25.4 0.699 24 0 X 7 114 66 0 0 32.8 0.258 42 1 X 5 99 74 27 0 29.0 0.203 32 0 X 2 109 92 0 0 42.7 0.845 54 0 X 2 100 66 20 90 32.9 0.867 28 1 X 5 139 64 35 140 28.6 0.411 26 0 X 13 126 90 0 0 43.4 0.583 42 1 X 4 129 86 20 270 35.1 0.231 23 0 X 1 79 75 30 0 32.0 0.396 22 0 X 7 62 78 0 0 32.6 0.391 41 0 X 5 95 72 33 0 37.7 0.370 27 0 X 0 131 0 0 0 43.2 0.270 26 1 X 3 113 44 13 0 22.4 0.140 22 0 X 7 83 78 26 71 29.3 0.767 36 0 X 2 110 74 29 125 32.4 0.698 27 0 X 13 106 72 54 0 36.6 0.178 45 0 X 2 100 68 25 71 38.5 0.324 26 0 X 15 136 70 32 110 37.1 0.153 43 1 X 1 107 68 19 0 26.5 0.165 24 0 X 1 80 55 0 0 19.1 0.258 21 0 X 4 123 80 15 176 32.0 0.443 34 0 X 7 81 78 40 48 46.7 0.261 42 0 X 2 142 82 18 64 24.7 0.761 21 0 X 6 144 72 27 228 33.9 0.255 40 0 X 2 92 62 28 0 31.6 0.130 24 0 X 1 71 48 18 76 20.4 0.323 22 0 X 1 122 90 51 220 49.7 0.325 31 1 X 1 151 60 0 0 26.1 0.179 22 0 X 0 125 96 0 0 22.5 0.262 21 0 X 1 81 72 18 40 26.6 0.283 24 0 X 1 126 56 29 152 28.7 0.801 21 0 X 4 144 58 28 140 29.5 0.287 37 0 X 0 95 85 25 36 37.4 0.247 24 1 X 1 89 76 34 37 31.2 0.192 23 0 X 7 160 54 32 175 30.5 0.588 39 1 X 5 78 48 0 0 33.7 0.654 25 0 X 4 97 60 23 0 28.2 0.443 22 0 X 4 99 76 15 51 23.2 0.223 21 0 X 0 162 76 56 100 53.2 0.759 25 1 X 1 88 30 42 99 55.0 0.496 26 1 X 3 120 70 30 135 42.9 0.452 30 0 X 1 118 58 36 94 33.3 0.261 23 0 X 4 173 70 14 168 29.7 0.361 33 1 X 9 122 56 0 0 33.3 1.114 33 1 X 3 170 64 37 225 34.5 0.356 30 1 X 2 125 60 20 140 33.8 0.088 31 0 X 0 93 60 25 92 28.7 0.532 22 0 X 0 129 80 0 0 31.2 0.703 29 0 X 5 105 72 29 325 36.9 0.159 28 0 X 3 128 78 0 0 21.1 0.268 55 0 X 2 108 52 26 63 32.5 0.318 22 0 X 10 108 66 0 0 32.4 0.272 42 1 X 2 106 64 35 119 30.5 1.400 34 0 X 5 147 78 0 0 33.7 0.218 65 0 X 2 90 70 17 0 27.3 0.085 22 0 X 4 114 65 0 0 21.9 0.432 37 0 X 9 156 86 28 155 34.3 1.189 42 1 X 7 152 88 44 0 50.0 0.337 36 1 X 2 99 52 15 94 24.6 0.637 21 0 X 4 151 90 38 0 29.7 0.294 36 0 X 0 114 80 34 285 44.2 0.167 27 0 X 2 100 64 23 0 29.7 0.368 21 0 X 6 104 74 18 156 29.9 0.722 41 1 X 3 148 66 25 0 32.5 0.256 22 0 X 4 110 66 0 0 31.9 0.471 29 0 X 3 111 90 12 78 28.4 0.495 29 0 X 6 102 82 0 0 30.8 0.180 36 1 X 6 134 70 23 130 35.4 0.542 29 1 X 2 87 0 23 0 28.9 0.773 25 0 X 8 179 72 42 130 32.7 0.719 36 1 X 0 129 110 46 130 67.1 0.319 26 1 X 5 143 78 0 0 45.0 0.190 47 0 X 5 130 82 0 0 39.1 0.956 37 1 X 5 73 60 0 0 26.8 0.268 27 0 X 4 141 74 0 0 27.6 0.244 40 0 X 7 194 68 28 0 35.9 0.745 41 1 X 8 181 68 36 495 30.1 0.615 60 1 X 1 128 98 41 58 32.0 1.321 33 1 X 5 139 80 35 160 31.6 0.361 25 1 X 3 111 62 0 0 22.6 0.142 21 0 X 9 123 70 44 94 33.1 0.374 40 0 X 11 135 0 0 0 52.3 0.578 40 1 X 8 85 55 20 0 24.4 0.136 42 0 X 3 107 62 13 48 22.9 0.678 23 1 X 4 109 64 44 99 34.8 0.905 26 1 X 4 148 60 27 318 30.9 0.150 29 1 X 0 113 80 16 0 31.0 0.874 21 0 X 1 138 82 0 0 40.1 0.236 28 0 X 0 108 68 20 0 27.3 0.787 32 0 X 2 99 70 16 44 20.4 0.235 27 0 X 6 103 72 32 190 37.7 0.324 55 0 X 5 111 72 28 0 23.9 0.407 27 0 X 1 96 64 27 87 33.2 0.289 21 0 X 0 147 85 54 0 42.8 0.375 24 0 X 7 179 95 31 0 34.2 0.164 60 0 X 0 140 65 26 130 42.6 0.431 24 1 X 9 112 82 32 175 34.2 0.260 36 1 X 12 151 70 40 271 41.8 0.742 38 1 X 6 125 68 30 120 30.0 0.464 32 0 X 5 112 66 0 0 37.8 0.261 41 1 X 0 177 60 29 478 34.6 1.072 21 1 X 2 158 90 0 0 31.6 0.805 66 1 X 7 119 0 0 0 25.2 0.209 37 0 X 7 142 60 33 190 28.8 0.687 61 0 X 1 87 78 27 32 34.6 0.101 22 0 X 0 101 76 0 0 35.7 0.198 26 0 X 3 162 52 38 0 37.2 0.652 24 1 X 4 197 70 39 744 36.7 2.329 31 0 X 4 142 86 0 0 44.0 0.645 22 1 X 6 134 80 37 370 46.2 0.238 46 1 X 1 79 80 25 37 25.4 0.583 22 0 X 4 122 68 0 0 35.0 0.394 29 0 X 4 171 72 0 0 43.6 0.479 26 1 X 0 179 90 27 0 44.1 0.686 23 1 X 1 91 64 24 0 29.2 0.192 21 0 X 4 91 70 32 88 33.1 0.446 22 0 X 3 139 54 0 0 25.6 0.402 22 1 X 6 119 50 22 176 27.1 1.318 33 1 X 2 146 76 35 194 38.2 0.329 29 0 X 9 184 85 15 0 30.0 1.213 49 1 X 0 165 90 33 680 52.3 0.427 23 0 X 9 124 70 33 402 35.4 0.282 34 0 X 1 111 86 19 0 30.1 0.143 23 0 X 2 129 84 0 0 28.0 0.284 27 0 X 2 90 80 14 55 24.4 0.249 24 0 X 0 86 68 32 0 35.8 0.238 25 0 X 2 114 68 22 0 28.7 0.092 25 0 X 1 193 50 16 375 25.9 0.655 24 0 X 11 155 76 28 150 33.3 1.353 51 1 X 3 191 68 15 130 30.9 0.299 34 0 X 3 141 0 0 0 30.0 0.761 27 1 X 3 142 80 15 0 32.4 0.200 63 0 X 5 96 74 18 67 33.6 0.997 43 0 X 0 138 0 0 0 36.3 0.933 25 1 X 2 128 64 42 0 40.0 1.101 24 0 X 2 146 0 0 0 27.5 0.240 28 1 X 1 71 78 50 45 33.2 0.422 21 0 X 13 106 70 0 0 34.2 0.251 52 0 X 2 100 70 52 57 40.5 0.677 25 0 X 7 106 60 24 0 26.5 0.296 29 1 X 0 104 64 23 116 27.8 0.454 23 0 X 2 108 62 10 278 25.3 0.881 22 0 X 0 146 70 0 0 37.9 0.334 28 1 X 10 129 76 28 122 35.9 0.280 39 0 X 7 133 88 15 155 32.4 0.262 37 0 X 7 136 74 26 135 26.0 0.647 51 0 X 5 155 84 44 545 38.7 0.619 34 0 X 4 96 56 17 49 20.8 0.340 26 0 X 5 108 72 43 75 36.1 0.263 33 0 X 0 78 88 29 40 36.9 0.434 21 0 X 1 128 48 45 194 40.5 0.613 24 1 X 2 146 70 38 360 28.0 0.337 29 1 X 8 112 72 0 0 23.6 0.840 58 0 X 5 115 98 0 0 52.9 0.209 28 1 X 3 150 76 0 0 21.0 0.207 37 0 X 10 161 68 23 132 25.5 0.326 47 1 X 0 137 68 14 148 24.8 0.143 21 0 X 0 128 68 19 180 30.5 1.391 25 1 X 2 124 68 28 205 32.9 0.875 30 1 X 6 80 66 30 0 26.2 0.313 41 0 X 2 155 74 17 96 26.6 0.433 27 1 X 3 113 50 10 85 29.5 0.626 25 0 X 7 109 80 31 0 35.9 1.127 43 1 X 3 99 80 11 64 19.3 0.284 30 0 X 3 182 74 0 0 30.5 0.345 29 1 X 6 194 78 0 0 23.5 0.129 59 1 X 4 129 60 12 231 27.5 0.527 31 0 X 3 112 74 30 0 31.6 0.197 25 1 X 0 124 70 20 0 27.4 0.254 36 1 X 10 179 70 0 0 35.1 0.200 37 0 X 2 102 86 36 120 45.5 0.127 23 1 X 6 105 70 32 68 30.8 0.122 37 0 X 1 180 0 0 0 43.3 0.282 41 1 X 1 95 60 18 58 23.9 0.260 22 0 X 0 165 76 43 255 47.9 0.259 26 0 X 0 117 0 0 0 33.8 0.932 44 0 X 5 115 76 0 0 31.2 0.343 44 1 X 7 178 84 0 0 39.9 0.331 41 1 X 1 130 70 13 105 25.9 0.472 22 0 X 5 122 86 0 0 34.7 0.290 33 0 X 8 95 72 0 0 36.8 0.485 57 0 X 8 126 88 36 108 38.5 0.349 49 0 X 1 139 46 19 83 28.7 0.654 22 0 X 3 99 62 19 74 21.8 0.279 26 0 X 4 137 84 0 0 31.2 0.252 30 0 X 1 90 62 12 43 27.2 0.580 24 0 X 13 129 0 30 0 39.9 0.569 44 1 X 12 88 74 40 54 35.3 0.378 48 0 X 1 196 76 36 249 36.5 0.875 29 1 X 5 189 64 33 325 31.2 0.583 29 1 X 5 158 70 0 0 29.8 0.207 63 0 X 5 103 108 37 0 39.2 0.305 65 0 X 4 146 78 0 0 38.5 0.520 67 1 X 4 147 74 25 293 34.9 0.385 30 0 X 5 99 54 28 83 34.0 0.499 30 0 X 0 101 64 17 0 21.0 0.252 21 0 X 3 81 86 16 66 27.5 0.306 22 0 X 1 133 102 28 140 32.8 0.234 45 1 X 3 173 82 48 465 38.4 2.137 25 1 X 2 105 58 40 94 34.9 0.225 25 0 X 0 98 82 15 84 25.2 0.299 22 0 X 4 156 75 0 0 48.3 0.238 32 1 X 0 93 100 39 72 43.4 1.021 35 0 X 1 107 72 30 82 30.8 0.821 24 0 X 0 105 68 22 0 20.0 0.236 22 0 X 1 90 62 18 59 25.1 1.268 25 0 X 1 125 70 24 110 24.3 0.221 25 0 X 1 119 54 13 50 22.3 0.205 24 0 X 5 116 74 29 0 32.3 0.660 35 1 X 8 105 100 36 0 43.3 0.239 45 1 X 5 144 82 26 285 32.0 0.452 58 1 X 3 100 68 23 81 31.6 0.949 28 0 X 1 100 66 29 196 32.0 0.444 42 0 X 1 131 64 14 415 23.7 0.389 21 0 X 4 116 72 12 87 22.1 0.463 37 0 X 4 158 78 0 0 32.9 0.803 31 1 X 2 127 58 24 275 27.7 1.600 25 0 X 3 96 56 34 115 24.7 0.944 39 0 X 0 131 66 40 0 34.3 0.196 22 1 X 3 82 70 0 0 21.1 0.389 25 0 X 4 95 64 0 0 32.0 0.161 31 1 X 5 168 64 0 0 32.9 0.135 41 1 X 1 172 68 49 579 42.4 0.702 28 1 X 6 102 90 39 0 35.7 0.674 28 0 X 1 112 72 30 176 34.4 0.528 25 0 X 1 143 74 22 61 26.2 0.256 21 0 X 0 138 60 35 167 34.6 0.534 21 1 X 3 173 84 33 474 35.7 0.258 22 1 X 1 97 68 21 0 27.2 1.095 22 0 X 3 129 64 29 115 26.4 0.219 28 1 X 0 102 64 46 78 40.6 0.496 21 0 X 8 151 78 32 210 42.9 0.516 36 1 X 1 181 64 30 180 34.1 0.328 38 1 X 2 99 0 0 0 22.2 0.108 23 0 X 2 139 75 0 0 25.6 0.167 29 0 X 0 141 0 0 0 42.4 0.205 29 1 X 12 140 85 33 0 37.4 0.244 41 0 X 5 147 75 0 0 29.9 0.434 28 0 X 1 97 70 15 0 18.2 0.147 21 0 X 0 189 104 25 0 34.3 0.435 41 1 X 4 117 64 27 120 33.2 0.230 24 0 X 4 117 62 12 0 29.7 0.380 30 1 X 0 180 78 63 14 59.4 2.420 25 1 X 0 95 80 45 92 36.5 0.330 26 0 X 0 104 64 37 64 33.6 0.510 22 1 X 1 82 64 13 95 21.2 0.415 23 0 X 2 134 70 0 0 28.9 0.542 23 1 X 0 91 68 32 210 39.9 0.381 25 0 X 2 100 54 28 105 37.8 0.498 24 0 X 14 175 62 30 0 33.6 0.212 38 1 X 1 135 54 0 0 26.7 0.687 62 0 X 5 86 68 28 71 30.2 0.364 24 0 X 9 134 74 33 60 25.9 0.460 81 0 X 8 74 70 40 49 35.3 0.705 39 0 X 0 74 52 10 36 27.8 0.269 22 0 X 0 97 64 36 100 36.8 0.600 25 0 X 1 144 82 40 0 41.3 0.607 28 0 X 7 136 90 0 0 29.9 0.210 50 0 X 4 114 64 0 0 28.9 0.126 24 0 X 0 137 84 27 0 27.3 0.231 59 0 X 7 114 76 17 110 23.8 0.466 31 0 X 8 126 74 38 75 25.9 0.162 39 0 X 3 158 70 30 328 35.5 0.344 35 1 X 0 123 88 37 0 35.2 0.197 29 0 X 4 85 58 22 49 27.8 0.306 28 0 X 0 145 0 0 0 44.2 0.630 31 1 X 1 139 62 41 480 40.7 0.536 21 0 X 0 173 78 32 265 46.5 1.159 58 0 X 4 99 72 17 0 25.6 0.294 28 0 X 8 194 80 0 0 26.1 0.551 67 0 X 2 83 65 28 66 36.8 0.629 24 0 X 2 89 90 30 0 33.5 0.292 42 0 X 4 99 68 38 0 32.8 0.145 33 0 X 4 125 70 18 122 28.9 1.144 45 1 X 6 166 74 0 0 26.6 0.304 66 0 X 5 110 68 0 0 26.0 0.292 30 0 X 2 81 72 15 76 30.1 0.547 25 0 X 6 154 74 32 193 29.3 0.839 39 0 X 3 84 72 32 0 37.2 0.267 28 0 X 7 94 64 25 79 33.3 0.738 41 0 X 3 96 78 39 0 37.3 0.238 40 0 X 0 180 90 26 90 36.5 0.314 35 1 X 1 130 60 23 170 28.6 0.692 21 0 X 8 120 78 0 0 25.0 0.409 64 0 X 9 91 68 0 0 24.2 0.200 58 0 X 3 163 70 18 105 31.6 0.268 28 1 X 9 145 88 34 165 30.3 0.771 53 1 X 7 125 86 0 0 37.6 0.304 51 0 X 13 76 60 0 0 32.8 0.180 41 0 X 2 68 70 32 66 25.0 0.187 25 0 X 3 124 80 33 130 33.2 0.305 26 0 X 9 130 70 0 0 34.2 0.652 45 1 X 3 125 58 0 0 31.6 0.151 24 0 X 3 87 60 18 0 21.8 0.444 21 0 X 1 97 64 19 82 18.2 0.299 21 0 X 3 116 74 15 105 26.3 0.107 24 0 X 0 111 65 0 0 24.6 0.660 31 0 X 2 122 60 18 106 29.8 0.717 22 0 X 6 91 0 0 0 29.8 0.501 31 0 X 1 77 56 30 56 33.3 1.251 24 0 X 0 105 90 0 0 29.6 0.197 46 0 X 8 100 74 40 215 39.4 0.661 43 1 X 3 128 72 25 190 32.4 0.549 27 1 X 10 90 85 32 0 34.9 0.825 56 1 X 4 84 90 23 56 39.5 0.159 25 0 X 8 186 90 35 225 34.5 0.423 37 1 X 4 131 68 21 166 33.1 0.160 28 0 X 1 164 82 43 67 32.8 0.341 50 0 X 4 189 110 31 0 28.5 0.680 37 0 X 1 116 70 28 0 27.4 0.204 21 0 X 1 88 62 24 44 29.9 0.422 23 0 X 1 84 64 23 115 36.9 0.471 28 0 X 1 97 70 40 0 38.1 0.218 30 0 X 8 110 76 0 0 27.8 0.237 58 0 X 11 103 68 40 0 46.2 0.126 42 0 X 6 125 76 0 0 33.8 0.121 54 1 X 0 198 66 32 274 41.3 0.502 28 1 X 6 99 60 19 54 26.9 0.497 32 0 X 0 91 80 0 0 32.4 0.601 27 0 X 1 99 72 30 18 38.6 0.412 21 0 X 6 92 62 32 126 32.0 0.085 46 0 X 4 154 72 29 126 31.3 0.338 37 0 X 1 119 44 47 63 35.5 0.280 25 0 X 6 108 44 20 130 24.0 0.813 35 0 X 2 118 80 0 0 42.9 0.693 21 1 X 10 133 68 0 0 27.0 0.245 36 0 X 0 151 90 46 0 42.1 0.371 21 1 X 6 109 60 27 0 25.0 0.206 27 0 X 12 121 78 17 0 26.5 0.259 62 0 X 8 100 76 0 0 38.7 0.190 42 0 X 8 124 76 24 600 28.7 0.687 52 1 X 8 143 66 0 0 34.9 0.129 41 1 X 6 103 66 0 0 24.3 0.249 29 0 X 3 176 86 27 156 33.3 1.154 52 1 X 0 73 0 0 0 21.1 0.342 25 0 X 11 111 84 40 0 46.8 0.925 45 1 X 2 112 78 50 140 39.4 0.175 24 0 X 1 89 24 19 25 27.8 0.559 21 0 X 1 173 74 0 0 36.8 0.088 38 1 X 1 109 38 18 120 23.1 0.407 26 0 X 1 108 88 19 0 27.1 0.400 24 0 X 6 96 0 0 0 23.7 0.190 28 0 X 7 150 78 29 126 35.2 0.692 54 1 X 1 124 60 32 0 35.8 0.514 21 0 X 1 181 78 42 293 40.0 1.258 22 1 X 1 92 62 25 41 19.5 0.482 25 0 X 0 152 82 39 272 41.5 0.270 27 0 X 3 106 54 21 158 30.9 0.292 24 0 X 3 174 58 22 194 32.9 0.593 36 1 X 7 168 88 42 321 38.2 0.787 40 1 X 11 138 74 26 144 36.1 0.557 50 1 X 3 106 72 0 0 25.8 0.207 27 0 X 6 117 96 0 0 28.7 0.157 30 0 X 9 112 82 24 0 28.2 1.282 50 1 X 0 119 0 0 0 32.4 0.141 24 1 X 2 112 86 42 160 38.4 0.246 28 0 X 2 92 76 20 0 24.2 1.698 28 0 X 6 183 94 0 0 40.8 1.461 45 0 X 0 94 70 27 115 43.5 0.347 21 0 X 2 108 64 0 0 30.8 0.158 21 0 X 0 125 68 0 0 24.7 0.206 21 0 X 0 132 78 0 0 32.4 0.393 21 0 X 5 128 80 0 0 34.6 0.144 45 0 X 4 94 65 22 0 24.7 0.148 21 0 X 7 114 64 0 0 27.4 0.732 34 1 X 2 111 60 0 0 26.2 0.343 23 0 X 10 92 62 0 0 25.9 0.167 31 0 X 5 104 74 0 0 28.8 0.153 48 0 X 2 94 76 18 66 31.6 0.649 23 0 X 7 97 76 32 91 40.9 0.871 32 1 X 1 100 74 12 46 19.5 0.149 28 0 X 0 102 86 17 105 29.3 0.695 27 0 X 4 128 70 0 0 34.3 0.303 24 0 X 6 147 80 0 0 29.5 0.178 50 1 X 1 167 74 17 144 23.4 0.447 33 1 X 0 179 50 36 159 37.8 0.455 22 1 X 11 136 84 35 130 28.3 0.260 42 1 X 1 117 60 23 106 33.8 0.466 27 0 X 5 123 74 40 77 34.1 0.269 28 0 X 2 120 54 0 0 26.8 0.455 27 0 X 1 106 70 28 135 34.2 0.142 22 0 X 2 155 52 27 540 38.7 0.240 25 1 X 2 101 58 35 90 21.8 0.155 22 0 X 11 127 106 0 0 39.0 0.190 51 0 X 8 167 106 46 231 37.6 0.165 43 1 X 9 145 80 46 130 37.9 0.637 40 1 X 1 112 80 45 132 34.8 0.217 24 0 X 4 145 82 18 0 32.5 0.235 70 1 X 10 111 70 27 0 27.5 0.141 40 1 X 6 98 58 33 190 34.0 0.430 43 0 X 9 154 78 30 100 30.9 0.164 45 0 X 1 99 58 10 0 25.4 0.551 21 0 X 10 68 106 23 49 35.5 0.285 47 0 X 8 91 82 0 0 35.6 0.587 68 0 X 6 195 70 0 0 30.9 0.328 31 1 X 2 101 58 17 265 24.2 0.614 23 0 X 2 56 56 28 45 24.2 0.332 22 0 X 0 162 76 36 0 49.6 0.364 26 1 X 0 95 64 39 105 44.6 0.366 22 0 X 4 125 80 0 0 32.3 0.536 27 1 X 1 140 74 26 180 24.1 0.828 23 0 X 1 144 82 46 180 46.1 0.335 46 1 X 8 107 80 0 0 24.6 0.856 34 0 X 13 158 114 0 0 42.3 0.257 44 1 X 2 121 70 32 95 39.1 0.886 23 0 X 7 129 68 49 125 38.5 0.439 43 1 X 2 90 60 0 0 23.5 0.191 25 0 X 3 169 74 19 125 29.9 0.268 31 1 X 4 127 88 11 155 34.5 0.598 28 0 X 4 118 70 0 0 44.5 0.904 26 0 X 2 122 76 27 200 35.9 0.483 26 0 X 6 125 78 31 0 27.6 0.565 49 1 X 1 168 88 29 0 35.0 0.905 52 1 X 2 129 0 0 0 38.5 0.304 41 0 X 4 110 76 20 100 28.4 0.118 27 0 X 6 80 80 36 0 39.8 0.177 28 0 X 2 127 46 21 335 34.4 0.176 22 0 X 2 93 64 32 160 38.0 0.674 23 1 X 3 158 64 13 387 31.2 0.295 24 0 X 5 126 78 27 22 29.6 0.439 40 0 X 10 129 62 36 0 41.2 0.441 38 1 X 0 134 58 20 291 26.4 0.352 21 0 X 3 102 74 0 0 29.5 0.121 32 0 X 7 187 50 33 392 33.9 0.826 34 1 X 3 173 78 39 185 33.8 0.970 31 1 X 10 94 72 18 0 23.1 0.595 56 0 X 5 97 76 27 0 35.6 0.378 52 1 X 4 83 86 19 0 29.3 0.317 34 0 X 1 114 66 36 200 38.1 0.289 21 0 X 1 149 68 29 127 29.3 0.349 42 1 X 1 111 94 0 0 32.8 0.265 45 0 X 1 116 78 29 180 36.1 0.496 25 0 X 2 92 52 0 0 30.1 0.141 22 0 X 3 130 78 23 79 28.4 0.323 34 1 X 8 120 86 0 0 28.4 0.259 22 1 X 2 174 88 37 120 44.5 0.646 24 1 X 2 106 56 27 165 29.0 0.426 22 0 X 0 126 86 27 120 27.4 0.515 21 0 X 8 65 72 23 0 32.0 0.600 42 0 X 2 99 60 17 160 36.6 0.453 21 0 X 1 102 74 0 0 39.5 0.293 42 1 X 3 102 44 20 94 30.8 0.400 26 0 X 1 109 58 18 116 28.5 0.219 22 0 X 9 140 94 0 0 32.7 0.734 45 1 X 13 153 88 37 140 40.6 1.174 39 0 X 1 81 74 41 57 46.3 1.096 32 0 X 3 187 70 22 200 36.4 0.408 36 1 X 1 121 78 39 74 39.0 0.261 28 0 X 8 154 78 32 0 32.4 0.443 45 1 X 1 106 76 0 0 37.5 0.197 26 0 X 6 190 92 0 0 35.5 0.278 66 1 X 2 88 58 26 16 28.4 0.766 22 0 X 9 170 74 31 0 44.0 0.403 43 1 X 9 89 62 0 0 22.5 0.142 33 0 X 10 101 76 48 180 32.9 0.171 63 0 X 1 126 60 0 0 30.1 0.349 47 1 SHAR_EOF $shar_touch -am 0116120295 'grkpack/examples/pima.dat' && chmod 0644 'grkpack/examples/pima.dat' || echo 'restore of grkpack/examples/pima.dat failed' shar_count="`wc -c < 'grkpack/examples/pima.dat'`" test 23500 -eq "$shar_count" || echo "grkpack/examples/pima.dat: original size 23500, current size $shar_count" fi # ============= grkpack/examples/pima1.r ============== if test -f 'grkpack/examples/pima1.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/pima1.r (File already exists)' else echo 'x - extracting grkpack/examples/pima1.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/pima1.r' && # THIS PROGRAM ILLUSTRATES THE USE OF DBMDR.R ROUTINES IN FITTING BINARY DATA # WITH MODEL # logit(p(x1,x2)) = C + f1(x1) + f2(x2) + f12(x1,x2) # USING TENSOR PRODUCT SPLINES WITH CUBIC SPLINE SPACE AS MARGINALS # AND WITH INTEGRATION SIDE CONDITIONS. THE PROGRAM CALCULATES ESTIMATES OF # MAIN EFFECTS, INTERACTIONS AND THE OVERALL FUNCTION AT EQUALLY SPACED GRID # POINTS FOR PLOT. BAYESIAN CONFIDENCE INTERVALS ARE ALSO CALCULATED AT THESE # GRID POINTS. # THIS IS THE PROGRAM FOR MODEL II OF WAHBA ET AL (1994). # WAHBA, G., GU, C., WANG, Y. AND CHAPPELL, R. (1994), SOFT # CLASSIFICATION, A. K. A. RISK ESTIMATION, VIA PENALIZED LOG LIKELIHOOD # AND SMOOTHING SPLINE ANALYSIS OF VARIANCE, IN D. WOLPERT, ED., `THE # MATHEMATICS OF GENERALIZATION, SANTA FE INSTITUTE STUDIES IN THE SCIENCES # OF COMPLEXITY, PROC. VOL. XX', ADDISON-WESLEY, READING, MA, PP 329-360, # AVAILABLE IN THE PUBLIC FILE ftp.stat.wisc.edu/pub/wahba/soft-class.ps.gz. X X program pima1 X parameter ( nobs = 500, nnull = 4, nq = 5, ncov = 2, nplot = 50 ) X # PARAMETERS: # nobs number of observations. # nnull dimension of null space. # nq number of smoothing parameters. # ncov number of covariates used in the model. # nplot number of equally spaced points that the estimations and # variances are calculated. X double precision x(nobs,9), s(nobs,nnull), swk(nobs,nnull), q(nobs,nobs,nq),_ X qwk(nobs,nobs,nq), y(nobs), ywk(nobs), prec, theta(nq), nlaht,_ X score, varht, c(nobs), d(nnull), wk(nobs*nobs*(nq+2)),_ X eta(nobs), u(nobs), w(nobs), xmin(ncov), xmax(ncov),_ X mse, tmp, dk2, dk4, xi1, xi3, xi5, ddot,_ X main(nplot,ncov), mainsd(nplot,ncov),_ X inter(nplot,nplot), intersd(nplot,nplot),_ X z(nplot), r(nobs,nplot,2*ncov), rr(nobs,nplot*nplot,2),_ X cr(nobs,nplot,ncov), dr(nnull,nplot,ncov), sms(nnull,nnull),_ X crr(nobs,nplot*nplot), drr(nnull,nplot*nplot),_ X limnla(2), qraux(nnull), b X integer info, i, j, maxiter, job, cov(ncov), ii,jj, jpvt(nnull) X # SPECIFY WHICH COLUMNS IN THE DATA ARE USED AS COVARIATES. IN THIS EXAMPLE, # COLUMN 2 and 6 ARE USED. COULMN 9 CONTAINS THE BINARY OBSERVATIONS. data (cov(i), i=1,ncov)/2, 6/ X # SET ALGORITHMIC PARAMETERS prec = 1.d-6 maxiter = 30 job = 0 varht = 1.d0 X # INPUT DATA open (8,file="pima.dat", status="unknown") for (j=1;j<=nobs;j=j+1) read (8,*) (x(j,i), i=1,9) close (8) X # OPEN FILES FOR OUTPUT open (11,file="workinf.pima1", status="unknown") # Contains work information: number of X # iterations, information number and X # smoothing parameters open (12,file="mainest.pima1", status="unknown") # Contains main effects estimations and X # their posterior standard deviations open (13,file="interest.pima1", status="unknown") # Contains interaction estimations and X # their posterior standard deviations open (14,file="overall.pima1", status="unknown") # Contains estimates of overall function X # on logit scale and standard deviations open (15,file="plotpoint.pima1", status="unknown") # Grid points of covariates for plots X # FIND THE MINIMUM AND MAXIMUM OF COVARIATES for (i=1;i<=ncov;i=i+1) { X for (j=1;j<=nobs;j=j+1) y(j)=x(j,cov(i)) X call dsort(nobs,y) X xmin(i)=y(1) X xmax(i)=y(nobs) } X # GENERATE S, Q, AND Y call dset (nobs, 1.d0, s(1,1), 1) # constant for (j=1;j<=nobs;j=j+1) { X s(j,2) = (x(j,cov(1))-xmin(1)) / (xmax(1)-xmin(1)) - .5d0 # linear(x_1) X s(j,3) = (x(j,cov(2))-xmin(2)) / (xmax(2)-xmin(2)) - .5d0 # linear(x_2) X s(j,4) = s(j,2) * s(j,3) # linear(x_1)*linear(x_2) } for (j=1;j<=nobs;j=j+1) { X for (i=1;i<=nobs;i=i+1) { X q(j,i,1) = xi1 (s(i,2)+.5d0, s(j,2)+.5d0) # smooth(x_1) X q(j,i,2) = xi1 (s(i,3)+.5d0, s(j,3)+.5d0) # smooth(x_2) X q(j,i,3) = q(j,i,1) * s(j,3) * s(i,3) # smooth(x_1)*linear(x_2) X q(j,i,4) = q(j,i,2) * s(j,2) * s(i,2) # linear(x_1)*smooth(x_2) X q(j,i,5) = q(j,i,1) * q(j,i,2) # smooth(x_1)*smooth(x_2) X } X y(j) = x(j,9) # observation } X # CALL BINARY DATA MULTIVARIATE DRIVER call dset (nobs, 0.d0, eta, 1) # starting estimate of logit of probability call dbmdr ('u',_ X s, nobs, nobs, nnull, q, nobs, nobs, nq, y,_ X 0.d0, 0.d0, job, prec, 15, prec, maxiter,_ X theta, nlaht, score, varht, c, d, eta,_ X wk, swk, qwk, ywk, u, w,_ X info) write (11,*) 30-maxiter, info, (sngl (nlaht-theta(i)), i=1,nq) X # GENERATE GRID FOR PLOT for (j=1;j<=nplot;j=j+1) z(j) = (dble(j)-1.d0) / (dble(nplot) - 1.d0) X # GENERATE (W^{1/2}\theta R)'s IN r( , ,1:ncov) FOR CALCULATING c_r AND d_r # NEEDED FOR POSTERIOR COVARIANCES OF MAIN EFFECTS. for (k=1;k<=ncov;k=k+1){ X for (j=1;j<=nplot;j=j+1){ X for (i=1;i<=nobs;i=i+1){ X r(i,j,k) = dsqrt (w(i)) * 10.d0**theta(k) * xi1 (s(i,k+1)+5.d-1, z(j)) X } X } } # GENERATE (W^{1/2}\theta R)'s IN rr( , ,1) FOR CALCULATING c_rr AND d_rr # NEEDED FOR POSTERIOR COVARIANCES OF INTERACTIONS. for (i=1;i<=nobs;i=i+1) { X for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X tmp = 10.d0**theta(3) * xi3(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) + _ X 10.d0**theta(4) * xi3(z(jj),z(ii),s(i,3)+5.d-1,s(i,2)+5.d-1) + _ X 10.d0**theta(5) * xi5(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) X rr(i,j,1) = dsqrt (w(i)) * tmp X } } X # MATRIX DECOMPOSITION FOR CALCULATING c_r, d_r, AND sms for (j=1;j<=nobs;j=j+1) call dset (nobs-j+1, 0.d0, qwk(j,j,1), 1) for (i=1;i<=nq;i=i+1) { X for (j=1;j<=nobs;j=j+1) X call daxpy (nobs-j+1, 10.d0**theta(i), q(j,j,i), 1, qwk(j,j,1), 1) } X maxiter = 30 limnla(1) = nlaht - 1.d0 limnla(2) = nlaht + 1.d0 call dbsdr('u',_ X s, nobs, nobs, nnull, y, qwk(1,1,1), nobs,_ X 0.d0, 0.d0, -1, limnla, prec, maxiter,_ X nlaht, score, varht, c, d, eta,_ X qraux, jpvt, wk, swk, qwk(1,1,2), ywk, u, w,_ X info) write (11,*) 30-maxiter, info, sngl (nlaht) b = varht / 10.d0**nlaht X # CALCULATE c_r, d_r FOR MAIN EFFECTS for (i=1;i<=ncov;i=i+1){ call dcrdr (swk, nobs, nobs, nnull, qraux, jpvt, qwk(1,1,2), nobs, nlaht,_ X r(1,1,i), nobs, nplot, cr(1,1,i), nobs, dr(1,1,i), nnull, wk, info) } # CALCULATE c_r, d_r FOR INTERACTION call dcrdr (swk, nobs, nobs, nnull, qraux, jpvt, qwk(1,1,2), nobs, nlaht,_ X rr(1,1,1), nobs, nplot*nplot, crr, nobs, drr, nnull, wk, info) # CALCULATE sms call dsms (swk, nobs, nobs, nnull, jpvt, qwk(1,1,2), nobs, nlaht,_ X sms, nnull, wk, info) X # GENERATE (W^{1/2}\theta R)'s IN r( , ,1:ncov) FOR MULTIPLYING WITH c_r. # GENERATE (\theta R)'s IN r( , ,(ncov+1):2*ncov) FOR MULTIPLYING WITH c. for (k=1;k<=ncov;k=k+1){ X for (j=1;j<=nplot;j=j+1){ X for (i=1;i<=nobs;i=i+1){ X r(i,j,k+ncov) = 10.d0**theta(k) * xi1 (s(i,k+1)+5.d-1, z(j)) X r(i,j,k) = dsqrt (w(i)) * r(i,j,k+ncov) X } X } } # GENERATE (W^{1/2}\theta R)'s IN rr( , ,1) FOR MULTIPLYING WITH c_rr. # GENERATE (\theta R)'s IN rr( , ,2) FOR MULTIPLYING WITH c. for (i=1;i<=nobs;i=i+1) { X for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X rr(i,j,2) = 10.d0**theta(3) * xi3(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) + _ X 10.d0**theta(4) * xi3(z(jj),z(ii),s(i,3)+5.d-1,s(i,2)+5.d-1) + _ X 10.d0**theta(5) * xi5(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) X rr(i,j,1) = dsqrt (w(i)) * rr(i,j,2) X } } X # CALCULATE THE POSTERIOR MEAN OF MAIN EFFECTS AND THEIR VARIANCES for (j=1;j<=nplot;j=j+1) { X for (i=1;i<=ncov;i=i+1) { X # MAIN EFFECT ON GRID: POSTERIOR MEAN. f_i(x_i) = linear(x_i) + smooth(x_i) X main(j,i) = d(i+1) * (z(j)-5.d-1) + _ # linear(x_i) X ddot (nobs, r(1,j,i+ncov), 1, c, 1) # smooth(x_i) X # MAIN EFFECT ON GRID: POSTERIOR VARIANCE. X tmp = 10.d0**theta(i) * xi1 (z(j), z(j)) - _ # X ddot (nobs, r(1,j,i), 1, cr(1,j,i), 1) + _ # Var(s(x_i),s(x_i)) X (z(j)-5.d-1) * (z(j)-5.d-1) * sms(i+1,i+1) - _ # Var(l(x_i),l(x_i)) X 2.d0 * (z(j)-5.d-1) * dr(i+1,j,i) # 2*Cov(l(x_i),s(x_i)) X mainsd(j,i) = dsqrt (max (0.d0, b * tmp)) X } X write (12,*) sngl (d(1)), _ # constant X ( sngl (main(j,i)), i=1, ncov), _ # main effects X sngl ( dsqrt (max (0.d0, b * sms(1,1)))), _ # s.d. of constant X ( sngl (mainsd(j,i)), i=1, ncov) # s.d. of main effects } X # CALCULATE THE POSTERIOR MEAN OF COMBINED INTERACTION AND THEIR VARIANCES for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X # INTERACTIONS ON GRIDS: POSTERIOR MEAN. X # f_{12}(x_1,x_2) = linear(x_1)*linear(x_2) + smooth(x_1)*linear(x_2) X # + linear(x_1)*smooth(x_2) + smooth(x_1)*smooth(x_2) X inter(ii,jj) = d(4) * (z(ii) - .5d0) * (z(jj) - .5d0) _ # linear(x_1)*linear(x_2) X + ddot (nobs, c, 1, rr(1,j,2), 1) # three smooth parts X # INTERACTIONS ON GRIDS: POSTERIOR STANDARD DEVIATION X tmp = 10.d0**theta(3) * xi3 (z(ii),z(jj),z(ii),z(jj)) + _ # Var(s(x_1)*l(x_2)) X 10.d0**theta(4) * xi3 (z(jj),z(ii),z(jj),z(ii)) + _ # Var(l(x_1)*s(x_2)) X 10.d0**theta(5) * xi5 (z(ii),z(jj),z(ii),z(jj)) - _ # Var(s(x_1)*s(x_2)) X ddot (nobs, rr(1,j,1), 1, crr(1,j), 1) + _ # Var & Covariances X sms(4,4) * ((z(ii) - .5d0) * (z(jj) - .5d0)) ** 2 - _ # Var(l(x_1)*l(x_2)) X 2.d0 * (z(ii) - .5d0) * (z(jj) - .5d0) * drr(4,j) # Covariances X intersd(ii,jj) = dsqrt (max( 0.d0, b * tmp)) X write (13,*) sngl (inter(ii,jj)), _ # interaction X sngl (intersd(ii,jj)) # s.d. of interaction } X # CALCULATE THE POSTERIOR MEAN OF OVERALL FUNCTION AND THEIR VARIANCES for (j=1;j<=nplot;j=j+1){ for (i=1;i<=nplot;i=i+1){ X # Var(C) + Var(f_1(x_1)) + Var(f_2(x_2)) + Var(f_{12}(x_1,x_2)) X tmp = b*sms(1,1) + mainsd(i,1)**2 + mainsd(j,2)**2 + intersd(i,j)**2 X # Cov(C,f_1(x_1)) + Cov(C,f_2(x_2)) + Cov(C,f_{12}(x_1,x_2)) X mse = (z(i)-5.d-1)*sms(1,2) - dr(1,i,1) + _ X (z(j)-5.d-1)*sms(1,3) - dr(1,j,2) + _ X (z(i)-5.d-1)*(z(j)-5.d-1)*sms(1,4) - drr(1,i+(j-1)*nplot) X tmp = tmp + 2.d0*b*mse X # Cov(f_1(x_1),f_2(x_2)) X mse = (z(i)-5.d-1)*(z(j)-5.d-1)*sms(2,3) - _ X (z(i)-5.d-1)*dr(2,j,2) - (z(j)-5.d-1)*dr(3,i,1) - _ X ddot (nobs, r(1,j,2), 1, cr(1,i,1), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f_1(x_1),f_{12}(x_1,x_2)) X mse = (z(i)-5.d-1)**2*(z(j)-5.d-1)*sms(2,4) - _ X (z(i)-5.d-1)*drr(2,i+(j-1)*nplot) - _ X (z(i)-5.d-1)*(z(j)-5.d-1)*dr(4,i,1) - _ X ddot (nobs, rr(1,i+(j-1)*nplot,1), 1, cr(1,i,1), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f_2(x_2),f_{12}(x_1,x_2)) X mse = (z(i)-5.d-1)*(z(j)-5.d-1)**2*sms(3,4) - _ X (z(j)-5.d-1)*drr(3,i+(j-1)*nplot) - _ X (z(i)-5.d-1)*(z(j)-5.d-1)*dr(4,j,2) - _ X ddot (nobs, rr(1,i+(j-1)*nplot,1), 1, cr(1,j,2), 1) X tmp = tmp + 2.d0*b*mse X tmp = dsqrt (max( 0.d0, tmp)) X mse = d(1) + main(i,1) + main(j,2) + inter(i,j) X write (14,*) sngl (mse), _ # overall estimate in logit scale X sngl (tmp) # s.d. of overall estimate }} X # OUTPUT GRID POINTS FOR PLOTS for (i=1;i<=nplot;i=i+1) { write (15,*) ( sngl (z(i)*(xmax(j)-xmin(j))+xmin(j)), j=1, ncov ) } X close (11) close (12) close (13) close (14) close (15) X X X X X stop end X # AUXILIARY FUNCTION FOR CALCULATING REPRODUCING KERNELS double precision function dk2 (x) X double precision x X x = dabs (x) dk2 = ( x - .5d0 ) ** 2 dk2 = ( dk2 - 1.d0 / 12.d0 ) / 2.d0 X return end X X double precision function dk4 (x) X double precision x X x = dabs (x) dk4 = ( x - .5d0 ) ** 2 dk4 = ( dk4 ** 2 - dk4 / 2.d0 + 7.d0 / 240.d0 ) / 24.d0 X return end X X double precision function xi1(x1,x2) X double precision x1, x2, dk2, dk4 X xi1 = dk2(x1)*dk2(x2) - dk4(x1-x2) X return end X X double precision function xi3(x1,y1,x2,y2) X double precision x1, x2, y1, y2, xi1 X xi3 = xi1(x1,x2)*(y1-0.5)*(y2-0.5) X return end X X double precision function xi5(x1,y1,x2,y2) X double precision x1, x2, y1, y2, xi1 X xi5 = xi1(x1,x2)*xi1(y1,y2) X return end X SHAR_EOF $shar_touch -am 0202072795 'grkpack/examples/pima1.r' && chmod 0644 'grkpack/examples/pima1.r' || echo 'restore of grkpack/examples/pima1.r failed' shar_count="`wc -c < 'grkpack/examples/pima1.r'`" test 13251 -eq "$shar_count" || echo "grkpack/examples/pima1.r: original size 13251, current size $shar_count" fi # ============= grkpack/examples/README ============== if test -f 'grkpack/examples/README' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/README (File already exists)' else echo 'x - extracting grkpack/examples/README (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/README' && X This directory collects several programs illustrating the usage of single driver for binary data DBSDR and multiple driver for binary data DBMDR, and utility routines DCRDR and DSMS. The programs are all briefly commented. X Please note that these programs are intended as sample programs but NOT black boxes with which one may trade data for smooth functions. X To compile the programs under standard UNIX system, simply type `make ', where is to be replaced by bbci, pima1, pima2 and wesdr. You need ../grkpack/grkpack.a, ../lib/lib.a and ../rkpack/rkpack.a in the compilation. Also included is the Pima Indian Diabeties Data 'pima.dat' and the Wisconsin Epidemiological Study of Diabetic Retinopathy data 'wesdr.dat'. The documentations for these two data sets are 'pima.doc' and 'wesdr.doc' respectively. X Yuedong Wang January 25, 1995 SHAR_EOF $shar_touch -am 0201070895 'grkpack/examples/README' && chmod 0644 'grkpack/examples/README' || echo 'restore of grkpack/examples/README failed' shar_count="`wc -c < 'grkpack/examples/README'`" test 860 -eq "$shar_count" || echo "grkpack/examples/README: original size 860, current size $shar_count" fi # ============= grkpack/examples/Makefile ============== if test -f 'grkpack/examples/Makefile' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/Makefile (File already exists)' else echo 'x - extracting grkpack/examples/Makefile (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/Makefile' && FLAGS = -O LIBS = ../grkpack/grkpack.a ../rkpack/rkpack.a ../lib/lib.a X bbci : bbci.o X f77 $(FLAGS) -o bbci bbci.o $(LIBS) X pima1 : pima1.o X f77 $(FLAGS) -o pima1 pima1.o $(LIBS) X pima2 : pima2.o X f77 $(FLAGS) -o pima2 pima2.o $(LIBS) X wesdr : wesdr.o X f77 $(FLAGS) -o wesdr wesdr.o $(LIBS) X X.SUFFIXES: .r .o X X.r.o: X f77 -c $(FLAGS) $*.r SHAR_EOF $shar_touch -am 0126103695 'grkpack/examples/Makefile' && chmod 0644 'grkpack/examples/Makefile' || echo 'restore of grkpack/examples/Makefile failed' shar_count="`wc -c < 'grkpack/examples/Makefile'`" test 338 -eq "$shar_count" || echo "grkpack/examples/Makefile: original size 338, current size $shar_count" fi # ============= grkpack/examples/pima2.r ============== if test -f 'grkpack/examples/pima2.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/pima2.r (File already exists)' else echo 'x - extracting grkpack/examples/pima2.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/pima2.r' && # THIS PROGRAM ILLUSTRATES THE USE OF DBMDR.R ROUTINES IN FITTING BINARY DATA # WITH A PARTIAL SPLINE MODEL # logit(p(x1,x2,x_3)) = C + C_1 + C_2 + C_3 + f1(x1) + f2(x2) + f12(x1,x2) # USING TENSOR PRODUCT SPLINES WITH CUBIC SPLINE SPACE AS MARGINALS # AND WITH INTEGRATION SIDE CONDITIONS. HERE X_3 IS DIVIDED INTO FOUR CATEGORIES # 1, 2, 3 and 4. WE SET THE EFFECT OF CATEGORY 4 AS ZERO. THREE DUMMY VARIABLES # C_1, C_2 AND C_3 ARE CREATED. C_I' ARE INDICATOR FUNCTIONS # OF X_3 THAT EQUALES TO 1 IF X_3 IS IN THE COTEGORY I AND 0 OTHERWISE, I=1,2,3. # THE PROGRAM CALCULATES ESTIMATES OF MAIN EFFECTS, INTERACTIONS AND THE OVERALL # FUNCTION AT EQUALLY SPACED GRID POINTS FOR PLOT. BAYESIAN CONFIDENCE INTERVALS # ARE ALSO CALCULATED AT THESE GRID POINTS. # THIS IS THE PROGRAM FOR MODEL III OF WAHBA ET AL (1994). # WAHBA, G., GU, C., WANG, Y. AND CHAPPELL, R. (1994), SOFT # CLASSIFICATION, A. K. A. RISK ESTIMATION, VIA PENALIZED LOG LIKELIHOOD # AND SMOOTHING SPLINE ANALYSIS OF VARIANCE, IN D. WOLPERT, ED., `THE # MATHEMATICS OF GENERALIZATION, SANTA FE INSTITUTE STUDIES IN THE SCIENCES # OF COMPLEXITY, PROC. VOL. XX', ADDISON-WESLEY, READING, MA, PP 329-360, # AVAILABLE IN THE PUBLIC FILE ftp.stat.wisc.edu/pub/wahba/soft-class.ps.gz. X X program pima2 X parameter ( nobs = 500, nnull = 7, nq = 5, ncov = 2, nplot = 30 ) X # PARAMETERS: # nobs number of observations. # nnull dimension of null space. # nq number of smoothing parameters. # ncov number of covariates used in the model. # nplot number of equally spaced points that the estimations and # variances are calculated. X double precision x(nobs,9), s(nobs,nnull), swk(nobs,nnull), q(nobs,nobs,nq),_ X qwk(nobs,nobs,nq), y(nobs), ywk(nobs), prec, theta(nq), nlaht,_ X score, varht, c(nobs), d(nnull), wk(nobs*nobs*(nq+2)),_ X eta(nobs), u(nobs), w(nobs), xmin(ncov), xmax(ncov),_ X mse, tmp, dk2, dk4, xi1, xi3, xi5, ddot,_ X main(nplot,ncov), mainsd(nplot,ncov),_ X inter(nplot,nplot), intersd(nplot,nplot),_ X z(nplot), r(nobs,nplot,2*ncov), rr(nobs,nplot*nplot,2),_ X cr(nobs,nplot,ncov), dr(nnull,nplot,ncov), sms(nnull,nnull),_ X crr(nobs,nplot*nplot), drr(nnull,nplot*nplot),_ X limnla(2), qraux(nnull), b X integer info, i, j, k, maxiter, job, cov(ncov), ii,jj, jpvt(nnull) X # SPECIFY WHICH COLUMNS IN THE DATA ARE USED AS COVARIATES. IN THIS EXAMPLE, # COLUMN 2 and 6 ARE USED. COULMN 9 CONTAINS THE BINARY OBSERVATIONS. data (cov(i), i=1,ncov)/2, 6/ X # SET ALGORITHMIC PARAMETERS prec = 1.d-6 maxiter = 30 job = 0 varht = 1.d0 X # INPUT DATA open (8,file="pima.dat", status="unknown") for (j=1;j<=nobs;j=j+1) read (8,*) (x(j,i), i=1,9) close (8) X # OPEN FILES FOR OUTPUT open (11,file="workinf.pima2", status="unknown") # Contains work information: number of X # iterations, information number and X # smoothing parameters open (12,file="mainest.pima2", status="unknown") # Contains main effects estimations and X # their posterior standard deviations open (13,file="interest.pima2", status="unknown") # Contains interaction estimations and X # their posterior standard deviations open (14,file="overall.pima2", status="unknown") # Contains estimates of overall function X # on logit scale and standard deviations open (15,file="plotpoint.pima2", status="unknown") # Grid points of covariates for plots X # FIND THE MINIMUM AND MAXIMUM OF COVARIATES for (i=1;i<=ncov;i=i+1) { X for (j=1;j<=nobs;j=j+1) y(j)=x(j,cov(i)) X call dsort(nobs,y) X xmin(i)=y(1) X xmax(i)=y(nobs) } X # GENERATE S, Q, AND Y call dset (nobs, 1.d0, s(1,1), 1) # constant C for (j=1;j<=nobs;j=j+1) { X s(j,2) = (x(j,cov(1))-xmin(1)) / (xmax(1)-xmin(1)) - .5d0 # linear(x_1) X s(j,3) = (x(j,cov(2))-xmin(2)) / (xmax(2)-xmin(2)) - .5d0 # linear(x_2) X s(j,4) = s(j,2) * s(j,3) # linear(x_1)*linear(x_2) X s(j,5) = 0.d0 X s(j,6) = 0.d0 X s(j,7) = 0.d0 X if (x(j,1) == 0.d0) X s(j,5) = 1.d0 # C_1 X else if (x(j,1) == 1.d0 | x(j,1) == 2.d0) X s(j,6) = 1.d0 # C_2 X else if (x(j,1) >= 3.d0 & x(j,1) <= 5.d0) X s(j,7) = 1.d0 # C_3 } for (j=1;j<=nobs;j=j+1) { X for (i=1;i<=nobs;i=i+1) { X q(j,i,1) = xi1 (s(i,2)+.5d0, s(j,2)+.5d0) # smooth(x_1) X q(j,i,2) = xi1 (s(i,3)+.5d0, s(j,3)+.5d0) # smooth(x_2) X q(j,i,3) = q(j,i,1) * s(j,3) * s(i,3) # smooth(x_1)*linear(x_2) X q(j,i,4) = q(j,i,2) * s(j,2) * s(i,2) # linear(x_1)*smooth(x_2) X q(j,i,5) = q(j,i,1) * q(j,i,2) # smooth(x_1)*smooth(x_2) X } X y(j) = x(j,9) # observation } X # CALL BINARY DATA MULTIVARIATE DRIVER call dset (nobs, 0.d0, eta, 1) # starting estimate of logit of probability call dbmdr ('u',_ X s, nobs, nobs, nnull, q, nobs, nobs, nq, y,_ X 0.d0, 0.d0, job, prec, 15, prec, maxiter,_ X theta, nlaht, score, varht, c, d, eta,_ X wk, swk, qwk, ywk, u, w,_ X info) write (11,*) 30-maxiter, info, (sngl (nlaht-theta(i)), i=1,nq) X # GENERATE GRID FOR PLOT for (j=1;j<=nplot;j=j+1) z(j) = (dble(j)-1.d0) / (dble(nplot) - 1.d0) X # GENERATE (W^{1/2}\theta R)'s IN r( , ,1:ncov) FOR CALCULATING c_r AND d_r # NEEDED FOR POSTERIOR COVARIANCES OF MAIN EFFECTS. for (k=1;k<=ncov;k=k+1){ X for (j=1;j<=nplot;j=j+1){ X for (i=1;i<=nobs;i=i+1){ X r(i,j,k) = dsqrt (w(i)) * 10.d0**theta(k) * xi1 (s(i,k+1)+5.d-1, z(j)) X } X } } # GENERATE (W^{1/2}\theta R)'s IN rr( , ,1) FOR CALCULATING c_rr AND d_rr # NEEDED FOR POSTERIOR COVARIANCES OF INTERACTIONS. for (i=1;i<=nobs;i=i+1) { X for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X tmp = 10.d0**theta(3) * xi3(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) + _ X 10.d0**theta(4) * xi3(z(jj),z(ii),s(i,3)+5.d-1,s(i,2)+5.d-1) + _ X 10.d0**theta(5) * xi5(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) X rr(i,j,1) = dsqrt (w(i)) * tmp X } } X # MATRIX DECOMPOSITION FOR CALCULATING c_r, d_r, AND sms for (j=1;j<=nobs;j=j+1) call dset (nobs-j+1, 0.d0, qwk(j,j,1), 1) for (i=1;i<=nq;i=i+1) { X for (j=1;j<=nobs;j=j+1) X call daxpy (nobs-j+1, 10.d0**theta(i), q(j,j,i), 1, qwk(j,j,1), 1) } X maxiter = 30 limnla(1) = nlaht - 1.d0 limnla(2) = nlaht + 1.d0 call dbsdr('u',_ X s, nobs, nobs, nnull, y, qwk(1,1,1), nobs,_ X 0.d0, 0.d0, -1, limnla, prec, maxiter,_ X nlaht, score, varht, c, d, eta,_ X qraux, jpvt, wk, swk, qwk(1,1,2), ywk, u, w,_ X info) write (11,*) 30-maxiter, info, sngl (nlaht) b = varht / 10.d0**nlaht X # CALCULATE c_r, d_r FOR MAIN EFFECTS for (i=1;i<=ncov;i=i+1){ call dcrdr (swk, nobs, nobs, nnull, qraux, jpvt, qwk(1,1,2), nobs, nlaht,_ X r(1,1,i), nobs, nplot, cr(1,1,i), nobs, dr(1,1,i), nnull, wk, info) } # CALCULATE c_r, d_r FOR INTERACTION call dcrdr (swk, nobs, nobs, nnull, qraux, jpvt, qwk(1,1,2), nobs, nlaht,_ X rr(1,1,1), nobs, nplot*nplot, crr, nobs, drr, nnull, wk, info) # CALCULATE sms call dsms (swk, nobs, nobs, nnull, jpvt, qwk(1,1,2), nobs, nlaht,_ X sms, nnull, wk, info) X # GENERATE (W^{1/2}\theta R)'s IN r( , ,1:ncov) FOR MULTIPLYING WITH c_r. # GENERATE (\theta R)'s IN r( , ,(ncov+1):2*ncov) FOR MULTIPLYING WITH c. for (k=1;k<=ncov;k=k+1){ X for (j=1;j<=nplot;j=j+1){ X for (i=1;i<=nobs;i=i+1){ X r(i,j,k+ncov) = 10.d0**theta(k) * xi1 (s(i,k+1)+5.d-1, z(j)) X r(i,j,k) = dsqrt (w(i)) * r(i,j,k+ncov) X } X } } # GENERATE (W^{1/2}\theta R)'s IN rr( , ,1) FOR MULTIPLYING WITH c_rr. # GENERATE (\theta R)'s IN rr( , ,2) FOR MULTIPLYING WITH c. for (i=1;i<=nobs;i=i+1) { X for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X rr(i,j,2) = 10.d0**theta(3) * xi3(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) + _ X 10.d0**theta(4) * xi3(z(jj),z(ii),s(i,3)+5.d-1,s(i,2)+5.d-1) + _ X 10.d0**theta(5) * xi5(z(ii),z(jj),s(i,2)+5.d-1,s(i,3)+5.d-1) X rr(i,j,1) = dsqrt (w(i)) * rr(i,j,2) X } } X # CALCULATE THE POSTERIOR MEAN OF MAIN EFFECTS AND THEIR VARIANCES for (j=1;j<=nplot;j=j+1) { X for (i=1;i<=ncov;i=i+1) { X # MAIN EFFECT ON GRID: POSTERIOR MEAN. f_i(x_i) = linear(x_i) + smooth(x_i) X main(j,i) = d(i+1) * (z(j)-5.d-1) + _ # linear(x_i) X ddot (nobs, r(1,j,i+ncov), 1, c, 1) # smooth(x_i) X # MAIN EFFECT ON GRID: POSTERIOR VARIANCE. X tmp = 10.d0**theta(i) * xi1 (z(j), z(j)) - _ # X ddot (nobs, r(1,j,i), 1, cr(1,j,i), 1) + _ # Var(s(x_i),s(x_i)) X (z(j)-5.d-1) * (z(j)-5.d-1) * sms(i+1,i+1) - _ # Var(l(x_i),l(x_i)) X 2.d0 * (z(j)-5.d-1) * dr(i+1,j,i) # 2*Cov(l(x_i),s(x_i)) X mainsd(j,i) = dsqrt (max (0.d0, b * tmp)) X } X write (12,*) sngl (d(1)), _ # constant C X sngl (d(5)), _ # C_1 X sngl (d(6)), _ # C_2 X sngl (d(7)), _ # C_3 X ( sngl (main(j,i)), i=1, ncov), _ # main effects X sngl ( dsqrt (max (0.d0, b * sms(1,1)))), _ # s.d. of constant C X sngl ( dsqrt (max (0.d0, b * sms(5,5)))), _ # s.d. of C_1 X sngl ( dsqrt (max (0.d0, b * sms(6,6)))), _ # s.d. of C_2 X sngl ( dsqrt (max (0.d0, b * sms(7,7)))), _ # s.d. of C_3 X ( sngl (mainsd(j,i)), i=1, ncov) # s.d. of main effects } X # CALCULATE THE POSTERIOR MEAN OF COMBINED INTERACTION AND THEIR VARIANCES for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X # INTERACTIONS ON GRIDS: POSTERIOR MEAN. X # f_{12}(x_1,x_2) = linear(x_1)*linear(x_2) + smooth(x_1)*linear(x_2) X # + linear(x_1)*smooth(x_2) + smooth(x_1)*smooth(x_2) X inter(ii,jj) = d(4) * (z(ii) - .5d0) * (z(jj) - .5d0)_ # linear(x_1)*linear(x_2) X + ddot (nobs, c, 1, rr(1,j,2), 1) # three smooth parts X # INTERACTIONS ON GRIDS: POSTERIOR STANDARD DEVIATION X tmp = 10.d0**theta(3) * xi3 (z(ii),z(jj),z(ii),z(jj)) + _ # Var(s(x_1)*l(x_2)) X 10.d0**theta(4) * xi3 (z(jj),z(ii),z(jj),z(ii)) + _ # Var(l(x_1)*s(x_2)) X 10.d0**theta(5) * xi5 (z(ii),z(jj),z(ii),z(jj)) - _ # Var(s(x_1)*s(x_2)) X ddot (nobs, rr(1,j,1), 1, crr(1,j), 1) + _ # Var & Covariances X sms(4,4) * ((z(ii) - .5d0) * (z(jj) - .5d0)) ** 2 - _ # Var(l(x_1)*l(x_2)) X 2.d0 * (z(ii) - .5d0) * (z(jj) - .5d0) * drr(4,j) # Covariances X intersd(ii,jj) = dsqrt (max( 0.d0, b * tmp)) X write (13,*) sngl (inter(ii,jj)), _ # interaction X sngl (intersd(ii,jj)) # s.d. of interaction } X # CALCULATE THE POSTERIOR MEAN OF OVERALL FUNCTION AND THEIR VARIANCES for (j=1;j<=nplot;j=j+1){ for (i=1;i<=nplot;i=i+1){ X # Var(C) + Var(f_1(x_1)) + Var(f_2(x_2)) + Var(f_{12}(x_1,x_2)) X tmp = b*sms(1,1) + b*sms(5,5) + b*sms(6,6) + b*sms(7,7) + _ X mainsd(i,1)**2 + mainsd(j,2)**2 + intersd(i,j)**2 X # Cov(C,f_1(x_1)) + Cov(C,f_2(x_2)) + Cov(C,f_{12}(x_1,x_2)) X mse = (z(i)-5.d-1)*sms(1,2) - dr(1,i,1) + _ X (z(j)-5.d-1)*sms(1,3) - dr(1,j,2) + _ X (z(i)-5.d-1)*(z(j)-5.d-1)*sms(1,4) - drr(1,i+(j-1)*nplot) X tmp = tmp + 2.d0*b*mse X # Cov(f_1(x_1),f_2(x_2)) X mse = (z(i)-5.d-1)*(z(j)-5.d-1)*sms(2,3) - _ X (z(i)-5.d-1)*dr(2,j,2) - (z(j)-5.d-1)*dr(3,i,1) - _ X ddot (nobs, r(1,j,2), 1, cr(1,i,1), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f_1(x_1),f_{12}(x_1,x_2)) X mse = (z(i)-5.d-1)**2*(z(j)-5.d-1)*sms(2,4) - _ X (z(i)-5.d-1)*drr(2,i+(j-1)*nplot) - _ X (z(i)-5.d-1)*(z(j)-5.d-1)*dr(4,i,1) - _ X ddot (nobs, rr(1,i+(j-1)*nplot,1), 1, cr(1,i,1), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f_2(x_2),f_{12}(x_1,x_2)) X mse = (z(i)-5.d-1)*(z(j)-5.d-1)**2*sms(3,4) - _ X (z(j)-5.d-1)*drr(3,i+(j-1)*nplot) - _ X (z(i)-5.d-1)*(z(j)-5.d-1)*dr(4,j,2) - _ X ddot (nobs, rr(1,i+(j-1)*nplot,1), 1, cr(1,j,2), 1) X tmp = tmp + 2.d0*b*mse X wk(7) = d(1) + main(i,1) + main(j,2)_ # posterior mean and posterior s.d. as X + inter(i,j) # function of x_1 and x_2 for x_3 in X wk(8) = dsqrt (max( 0.d0, tmp)) # category 4 X # Var(C_1) + 2*( Cov(C,C_1) + Cov(C_1,f_1(x_1)) + Cov(C_1,f_2(x_2)) X # + Cov(C_1,f_{12}(x_1,x_2))) X mse = sms(5,1) + _ X (z(i)-5.d-1)*sms(5,2) - dr(5,i,1) + _ X (z(j)-5.d-1)*sms(5,3) - dr(5,j,2) + _ X (z(i)-5.d-1)*(z(j)-5.d-1)*sms(5,4) - drr(5,i+(j-1)*nplot) X tmp = wk(8)**2 + b*sms(5,5) + 2.d0*b*mse X wk(1) = wk(7) + d(5) # posterior mean and posterior s.d. as X # function of x_1 and x_2 for x_3 in X wk(2) = dsqrt (max( 0.d0, tmp)) # category 1 X # Var(C_2) + 2*( Cov(C,C_2) + Cov(C_2,f_1(x_1)) + Cov(C_2,f_2(x_2)) X # + Cov(C_2,f_{12}(x_1,x_2))) X mse = sms(6,1) + _ X (z(i)-5.d-1)*sms(6,2) - dr(6,i,1) + _ X (z(j)-5.d-1)*sms(6,3) - dr(6,j,2) + _ X (z(i)-5.d-1)*(z(j)-5.d-1)*sms(6,4) - drr(6,i+(j-1)*nplot) X tmp = wk(8)**2 + b*sms(6,6) + 2.d0*b*mse X wk(3) = wk(7) + d(6) # posterior mean and posterior s.d. as X # function of x_1 and x_2 for x_3 in X wk(4) = dsqrt (max( 0.d0, tmp)) # category 2 X # Var(C_3) + 2*( Cov(C,C_3) + Cov(C_3,f_1(x_1)) + Cov(C_3,f_2(x_2)) X # + Cov(C_3,f_{12}(x_1,x_2))) X mse = sms(7,1) + _ X (z(i)-5.d-1)*sms(7,2) - dr(7,i,1) + _ X (z(j)-5.d-1)*sms(7,3) - dr(7,j,2) + _ X (z(i)-5.d-1)*(z(j)-5.d-1)*sms(7,4) - drr(7,i+(j-1)*nplot) X tmp = wk(8)**2 + b*sms(7,7) + 2.d0*b*mse X wk(5) = wk(7) + d(7) # posterior mean and posterior s.d. as X # function of x_1 and x_2 for x_3 in X wk(6) = dsqrt (max( 0.d0, tmp)) # category 3 X X write (14,*) ( sngl (wk(k)), k=1,8) }} X # OUTPUT GRID POINTS FOR PLOTS for (i=1;i<=nplot;i=i+1) { write (15,*) ( sngl (z(i)*(xmax(j)-xmin(j))+xmin(j)), j=1, ncov ) } X close (11) close (12) close (13) close (14) close (15) X X X X X stop end X # AUXILIARY FUNCTION FOR CALCULATING REPRODUCING KERNELS double precision function dk2 (x) X double precision x X x = dabs (x) dk2 = ( x - .5d0 ) ** 2 dk2 = ( dk2 - 1.d0 / 12.d0 ) / 2.d0 X return end X X double precision function dk4 (x) X double precision x X x = dabs (x) dk4 = ( x - .5d0 ) ** 2 dk4 = ( dk4 ** 2 - dk4 / 2.d0 + 7.d0 / 240.d0 ) / 24.d0 X return end X X double precision function xi1(x1,x2) X double precision x1, x2, dk2, dk4 X xi1 = dk2(x1)*dk2(x2) - dk4(x1-x2) X return end X X double precision function xi3(x1,y1,x2,y2) X double precision x1, x2, y1, y2, xi1 X xi3 = xi1(x1,x2)*(y1-0.5)*(y2-0.5) X return end X X double precision function xi5(x1,y1,x2,y2) X double precision x1, x2, y1, y2, xi1 X xi5 = xi1(x1,x2)*xi1(y1,y2) X return end X SHAR_EOF $shar_touch -am 0202072895 'grkpack/examples/pima2.r' && chmod 0644 'grkpack/examples/pima2.r' || echo 'restore of grkpack/examples/pima2.r failed' shar_count="`wc -c < 'grkpack/examples/pima2.r'`" test 16110 -eq "$shar_count" || echo "grkpack/examples/pima2.r: original size 16110, current size $shar_count" fi # ============= grkpack/examples/bbci.r ============== if test -f 'grkpack/examples/bbci.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/bbci.r (File already exists)' else echo 'x - extracting grkpack/examples/bbci.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/bbci.r' && # THIS PROGRAM ILLUSTRATES THE USE OF DBSDR.R ROUTINE IN FITTING A MODEL # logit(p(x)) = C + f(x) # ON [0,1] USING CUBIC SPLINES. THE DESIGN POINTS HAVE UNIFORM DISTRIBUTION # ON [0,1]. THE PROGRAM CALCULATES THE FIT, BAYESIAN CONFIDENCE INTERVALS AND # SEVERAL VARIATIONS OF BOOTSTRAP CONFIDENCE INTERVALS ON THE DESIGN POINTS, # AND COLLECTS COVERAGE PERCENTAGES FOR INTERVALS OF NOMINAL COVERAGES 95%, # 90%, 75%, AND 50%. # THIS IS THE PROGRAM FOR SECTION 4 OF WAHBA AND WANG (1993, UW-TR-913). # THIS PAPER IS AVAILABLE IN THE PUBLIC FTP FILE # ftp.stat.wisc.edu/pub/wahba/boot.ps.gz. X program bbci X Parameter ( nobs = 100, nnull = 2, nrep = 100, nboot = 100 ) X # PARAMETERS: # nobs number of observations. # nnull dimension of null space. # nrep number of replications of the experiments. # nboot number of relications of the bootstrap. X double precision s(nobs,nnull), swk(nobs,nnull), q(nobs,nobs), qwk(nobs,nobs),_ X y(nobs), ywk(nobs), prec, nlaht, score, varht,_ X c(nobs), d(nnull), b, qraux(nnull), wk(3*nobs), _ X limnla(2), eta(nobs), u(nobs), w(nobs), r(nobs,nobs),_ X cr(nobs,nobs), dr(nnull,nobs), sms(nnull,nnull),_ X booty(nobs), boot(nobs,nboot), bfit(nboot),_ X var, bmse, pse, tmp, fun, xi1, ddot,_ X alpha(4), qt(4), z, dumnor, _ X perupb(4), perudb(4), pivupb(4), pivudb(4), bcupb(4), bcudb(4) real uni, invnor integer jpvt(nnull), info, i, ii, j, k, kk, job, maxiter,_ X cbayes(4), pbayes(nobs,4), cnor(4), pnor(nobs,4), _ X cper(4), pper(nobs,4), cpiv(4), ppiv(nobs,4), cbc(4), pbc(nobs,4) X # SET PARAMETERS FOR CONFIDENCE INTERVALS data (alpha(i), i=1,4)/5.d-2, 1.d-1, 2.5d-1, 5.d-1/ data (qt(i), i=1,4)/1.9604d0, 1.6452d0, 1.1504d0, 0.6742d0/ X # SET ALGORITHMIC PARAMETERS prec = 1.d-6 varht = 1.d0 job = -1 limnla(1) = - 6.d0 limnla(2) = 0.d0 X # SET THE SEED y(1) = uni (5732) X # OPEN FILES FOR OUTPUT open (11, file="workinf.bbci", status="unknown") # Contains work information: number of X # iterations, information number and X # smoothing parameters open (12, file="fit.bbci", status="unknown") # Contains design points, true probability X # function, observations, estimates of the X # true function on logit scale, posterior X # standard deviations and bootstrap mse's open (13, file="coverage-c.bbci", status="unknown") # Curve-wise coverage of the Bayesian X # confidence intervals and various bootstrap X # confidence intervals open (14, file="coverage-p.bbci", status="unknown") # Point-wise coverage of the Bayesian X # confidence intervals and various bootstrap X # confidence intervals X # GENERATE S AND Q. s(j,2)'s ARE ALSO THE DESIGN POINTS. call dset (nobs, 1.d0, s(1,1), 1) # constant for (j=1;j<=nobs;j=j+1) s(j,2) = (dble (j) - .5d0 ) / dble (nobs) # linear for (j=1;j<=nobs;j=j+1) { X for (i=1;i<=nobs;i=i+1) q(j,i) = xi1 (s(j,2), s(i,2)) # smooth } X # BEGIN REPLICATIONS OF EXPERIMENT for (k=1;k<=nrep;k=k+1) { X # GENERATE OBSERVATIONS for (j=1;j<=nobs;j=j+1) { X if ( dble (uni (0)) < fun (s(j,2)) ) y(j) = 1.d0 X else y(j) = 0.d0 } X # CALL BINARY DATA SINGLE DRIVER call dset (nobs, 0.d0, eta, 1) # starting estimate of logit of probability maxiter = 30 call dbsdr('u',_ # smoothing parameter X s, nobs, nobs, nnull, y, q, nobs,_ # input matrices X 0.d0, 0.d0, job, limnla, prec, maxiter,_ # job requests X nlaht, score, varht, c, d, eta,_ # output X qraux, jpvt, wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message write (11,*) 30-maxiter, info, sngl (nlaht) b = varht / 10.d0**nlaht X # GENERATE (W^{1/2}R)'s IN r FOR CALCULATING c_r AND d_r # NEEDED FOR POSTERIOR COVARIANCES. for (i=1;i<=nobs;i=i+1) { X for (j=1;j<=nobs;j=j+1) r(i,j) = q(i,j) * dsqrt (w(i)) } X # CALCULATE CR AND DR call dcrdr (swk, nobs, nobs, nnull, qraux, jpvt, qwk, nobs, nlaht,_ X r, nobs, nobs, cr, nobs, dr, nnull, wk, info) # CALCULATE sms call dsms (swk, nobs, nobs, nnull, jpvt, qwk, nobs, nlaht,_ X sms, nnull, wk, info) X # GENERATE (W^{1/2}R)'s IN r FOR MULTIPLYING c_r for (i=1;i<=nobs;i=i+1){ X for (j=1;j<=nobs;j=j+1) r(i,j) = q(i,j) * dsqrt (w(i)) } X # REPLICATION OF BOOTSTRAP RESAMPLING bmse = 0.d0 for (kk=1;kk<=nboot;kk=kk+1){ X # GENERATE A BOOTSTRAP SAMPLE for (j=1;j<=nobs;j=j+1) { X tmp = 1.d0 - 1.d0 / (1.d0 + dexp(eta(j))) X if ( dble (uni (0)) < tmp ) booty(j) = 1.d0 X else booty(j) = 0.d0 } X # CALL BINARY DATA SINGLE DRIVER FOR THE BOOTSTRAP SAMPLE call dset (nobs, 0.d0, boot(1,kk), 1) maxiter = 30 X call dbsdr('u',_ # smoothing parameter X s, nobs, nobs, nnull, booty, q, nobs,_ # input matrices X 0.d0, 0.d0, job, limnla, prec, maxiter,_ # job requests X nlaht, score, varht, c, d, boot(1,kk),_ # output X qraux, jpvt, wk, swk, qwk, ywk, u, w,_ # work arrays X info) } X # COLLECTING COVERAGE INFORMATION ON THE DESIGN POINTS for (i=1;i<=4;i=i+1) { X cbayes(i) = 0 X cnor(i) = 0 X cper(i) = 0 X cpiv(i) = 0 X cbc(i) = 0 } for (j=1;j<=nobs;j=j+1) { X # CALCULATE THE POSTERIOR VARIANCE X tmp = sms(1,1) + _ # Var(C) X sms(2,2) * s(j,2) ** 2 + _ # Var(linear(x)) X q(j,j) - ddot (nobs, r(1,j), 1, cr(1,j), 1) + _ # Var(smooth(x)) X 2.d0 * sms(2,1) * s(j,2) - _ # Cov(C,linear(x)) X 2.d0 * dr(1,j) - _ # Cov(C,smooth(x)) X 2.d0 * s(j,2) * dr(2,j) # Cov(linear(x),smooth(x)) X var = dsqrt (max (0.d0, b * tmp)) X # CALCULATE BOOTSTRAP ESTIMATES X pse = 0.d0 X z = 0 X for (i=1;i<=nboot;i=i+1) { X bfit(i) = boot(j,i) # at a fixed design point X if ( bfit(i) <= eta(j) ) z = z + 1.d0 X pse = pse + (boot(j,i) - eta(j)) ** 2 X } X z = dble (invnor (real (z) / real (nboot))) # z value of baised corrected X pse = dsqrt (pse/dble(nboot)) # boostrap estimate of mse X call dsort(nboot,bfit) # sorted for percentile method X for (i=1;i<=4;i=i+1){ X tmp = dble (nboot) * alpha(i) / 2.d0 X ii = int (tmp) X perudb(i) = (1.d0 - tmp + ii) * bfit(ii) + (tmp - ii) * bfit(ii+1) X tmp = dble (nboot) * (1.d0 - alpha(i) / 2.d0) X ii = int (tmp) X perupb(i) = (1.d0 - tmp + ii) * bfit(ii) + (tmp - ii) * bfit(ii+1) X pivudb(i) = 2.d0 * eta(j) - perupb(i) X pivupb(i) = 2.d0 * eta(j) - perudb(i) X tmp = dble (nboot) * dumnor (2.d0*z - qt(i)) X bcudb(i) = bfit(int (tmp) + 1) X tmp = dble (nboot) * dumnor (2.d0*z + qt(i)) X bcupb(i) = bfit(int (tmp) + 1) X } X write (12,*) sngl (s(j,2)), _ # design point X sngl (fun(s(j,2))), _ # true probability function X int (y(j)), _ # observation X sngl (eta(j)), _ # estimate at the design point X sngl (var), _ # posterior standard deviation X sngl (pse) # bootstrap estimate of mse # evaluate the coverage X tmp = fun (s(j,2)) X tmp = dlog (tmp/(1.d0-tmp)) X for (i=1;i<=4;i=i+1){ X if ( dabs (tmp-eta(j)) <= qt(i)*var ) { X cbayes(i) = cbayes(i) + 1 X pbayes(j,i) = pbayes(j,i) + 1 X } X if ( dabs (tmp-eta(j)) <= qt(i)*pse ) { X cnor(i) = cnor(i) + 1 X pnor(j,i) = pnor(j,i) + 1 X } X if ( perupb(i) >= tmp & perudb(i) <= tmp ) { X cper(i) = cper(i) + 1 X pper(j,i) = pper(j,i) + 1 X } X if ( pivupb(i) >= tmp & pivudb(i) <= tmp ) { X cpiv(i) = cpiv(i) + 1 X ppiv(j,i) = ppiv(j,i) + 1 X } X if ( bcupb(i) >= tmp & bcudb(i) <= tmp ) { X cbc(i) = cbc(i) + 1 X pbc(j,i) = pbc(j,i) + 1 X } X } } # NO. OF COVERED DATA POINTS OF 50%, 75%, 90% AND 95% CONFIDENCE INTERVALS. write (13,*) (cbayes(i), i=1,4), (cnor(i), i=1,4), (cper(i), i=1,4), _ X (cpiv(i), i=1,4), (cbc(i), i=1,4) } # NO. OF REPEATITIONS THAT COVER THE TRUE FUNCTION. THEY GIVE POINTWISE COVERAGE. for (j=1;j<=nobs;j=j+1) write (14,*) (pbayes(j,i), i=1,4), _ X (pnor(j,i), i=1,4), (pper(j,i), i=1,4),_ X (ppiv(j,i), i=1,4), (pbc(j,i),i=1,4) X close (11) close (12) close (13) close (14) X stop end X # TRUE FUNCTION USED IN SIMULATION double precision function fun (x) X double precision x X fun = 1.d6 * (x ** 11 * (1.d0 - x) ** 6) + 1.d4 * (x ** 3 * (1.d0 - x) ** 10) fun = .3d0 * fun - 2.d0 fun = 1.d0 - 1.d0 / (1.d0 + dexp (fun)) X return end X X # REPRODUCING KERNEL FOR CUBIC SPLINE ON [0,1] double precision function xi1 (y,x) double precision y, x, dk2, dk4 X xi1 = dk2 (y) * dk2 (x) - dk4 (x-y) X return end X # AUXILIARY FUNCTION FOR CALCULATING REPRODUCING KERNEL double precision function dk2 (x) double precision x X x = dabs (x) dk2 = ( x - .5d0 ) ** 2 dk2 = ( dk2 - 1.d0 / 12.d0 ) / 2.d0 X return end X X # AUXILIARY FUNCTION FOR CALCULATING REPRODUCING KERNEL double precision function dk4 (x) double precision x X x = dabs (x) dk4 = ( x - .5d0 ) ** 2 dk4 = ( dk4 ** 2 - dk4 / 2.d0 + 7.d0 / 240.d0 ) / 24.d0 X return end SHAR_EOF $shar_touch -am 0125152795 'grkpack/examples/bbci.r' && chmod 0644 'grkpack/examples/bbci.r' || echo 'restore of grkpack/examples/bbci.r failed' shar_count="`wc -c < 'grkpack/examples/bbci.r'`" test 10210 -eq "$shar_count" || echo "grkpack/examples/bbci.r: original size 10210, current size $shar_count" fi # ============= grkpack/examples/pima.doc ============== if test -f 'grkpack/examples/pima.doc' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/pima.doc (File already exists)' else echo 'x - extracting grkpack/examples/pima.doc (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/pima.doc' && Note: Pima Indian Data base is in the UCI repository ftp://ftp.ics.uci.edu/pub/machine-learning-databases/pima-indians-diabetes. There are 11 cases of 0 body mass index and 5 cases of 0 plasma glucose in the oringinal data set, both physical impossibilities. We have deleted those cases, leaving 752 cases. This data set is a random sample with size 500 of these 752 case, which we used for fitting in Wahba et al (1994). The remaining 252 were reserved there as a test set. X Wahba, G., Gu, C., Wang, Y. and Chappell, R. (1994), Soft classification, a. k. a. risk estimation, via penalized log likelihood and smoothing spline analysis of variance, in D. Wolpert, ed., `The Mathematics of Generalization, Santa Fe Institute Studies in the Sciences of Complexity, Proc. Vol. XX', Addison-Wesley, Reading, MA, pp 329-360, available in the public file ftp.stat.wisc.edu/pub/wahba/soft-class.ps.gz. X X The following is the documentation in the oringinal data. X 1. Title: Pima Indians Diabetes Database X 2. Sources: X (a) Original owners: National Institute of Diabetes and Digestive and X Kidney Diseases X (b) Donor of database: Vincent Sigillito (vgs@aplcen.apl.jhu.edu) X Research Center, RMI Group Leader X Applied Physics Laboratory X The Johns Hopkins University X Johns Hopkins Road X Laurel, MD 20707 X (301) 953-6231 X (c) Date received: 9 May 1990 X 3. Past Usage: X 1. Smith,~J.~W., Everhart,~J.~E., Dickson,~W.~C., Knowler,~W.~C., \& X Johannes,~R.~S. (1988). Using the ADAP learning algorithm to forecast X the onset of diabetes mellitus. In {\it Proceedings of the Symposium X on Computer Applications and Medical Care} (pp. 261--265). IEEE X Computer Society Press. X X The diagnostic, binary-valued variable investigated is whether the X patient shows signs of diabetes according to World Health Organization X criteria (i.e., if the 2 hour post-load plasma glucose was at least X 200 mg/dl at any survey examination or if found during routine medical X care). The population lives near Phoenix, Arizona, USA. X X Results: Their ADAP algorithm makes a real-valued prediction between X 0 and 1. This was transformed into a binary decision using a cutoff of X 0.448. Using 576 training instances, the sensitivity and specificity X of their algorithm was 76% on the remaining 192 instances. X 4. Relevant Information: X Several constraints were placed on the selection of these instances from X a larger database. In particular, all patients here are females at X least 21 years old of Pima Indian heritage. ADAP is an adaptive learning X routine that generates and executes digital analogs of perceptron-like X devices. It is a unique algorithm; see the paper for details. X 5. Number of Instances: 768 X 6. Number of Attributes: 8 plus class X 7. For Each Attribute: (all numeric-valued) X 1. Number of times pregnant X 2. Plasma glucose concentration a 2 hours in an oral glucose tolerance test X 3. Diastolic blood pressure (mm Hg) X 4. Triceps skin fold thickness (mm) X 5. 2-Hour serum insulin (mu U/ml) X 6. Body mass index (weight in kg/(height in m)^2) X 7. Diabetes pedigree function X 8. Age (years) X 9. Class variable (0 or 1) X 8. Missing Attribute Values: None X 9. Class Distribution: (class value 1 is interpreted as "tested positive for X diabetes") X X Class Value Number of instances X 0 500 X 1 268 X 10. Brief statistical analysis: X X Attribute number: Mean: Standard Deviation: X 1. 3.8 3.4 X 2. 120.9 32.0 X 3. 69.1 19.4 X 4. 20.5 16.0 X 5. 79.8 115.2 X 6. 32.0 7.9 X 7. 0.5 0.3 X 8. 33.2 11.8 SHAR_EOF $shar_touch -am 0201145595 'grkpack/examples/pima.doc' && chmod 0640 'grkpack/examples/pima.doc' || echo 'restore of grkpack/examples/pima.doc failed' shar_count="`wc -c < 'grkpack/examples/pima.doc'`" test 4030 -eq "$shar_count" || echo "grkpack/examples/pima.doc: original size 4030, current size $shar_count" fi # ============= grkpack/examples/wesdr.doc ============== if test -f 'grkpack/examples/wesdr.doc' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/wesdr.doc (File already exists)' else echo 'x - extracting grkpack/examples/wesdr.doc (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/wesdr.doc' && 1. CITATION REQUEST: This diabetic retinopathy database is part of the data collected by the Wisconsin Epidemiologic Study of Diabetic Retinopathy (WESDR), an ongoing population-based cohort study, Dr. Ronald Klein, PI. If you publish results when using this database then please include this information in your acknowledgements. Also, please cite one or more of: X A. Klein, R., Klein, B. E. K., Moss, S. E., Davis, M.D. & X DeMets, D. L. (1984), `The Wisconsin Epidemiologic Study X of Diabetic Retinopathy. II. Prevalence and risk of X diabetic retinopathy when age at diagnosis is less than X 30 years', Arch. Ophthalmol. 102, pp 520-526. X B. Klein, R., Klein, B. E. K., Moss, S. E., Davis, M. D. & X DeMets D. L. (1984), `The Wisconsin Epidemiologic Study of X Diabetic Retinopathy. III. Prevalence and risk of diabetic X retinopathy when age at diagnosis is 30 or more years', X Arch. Ophthalmol. 102, pp 527-532. X C. Klein, R., Klein, B. E. K., Moss, S. E., Davis, M. D. & X DeMets, D. L. (1989), `The Wisconsin Epidemiologic Study of X Diabetic Retinopathy. IX. Four year incidence and progression X of diabetic retinopathy when age at diagnosis is less than 30 X years', Arch. Ophthalmol. 107, pp 237-243. X D. Klein, R., Klein, B. E. K., Moss, S. E., Davis, M. D. & X DeMets, D. L. (1989), `The Wisconsin Epidemiologic Study of X Diabetic Retinopathy. X. Four incidence and progression of X diabetic retinopathy when age at diagnosis is 30 or more years', X Arch. Ophthalmol. 107, pp 244-249. X E. Klein, R., Klein, B. E. K., Moss, S. E., Davis, M. D. & X DeMets, D. L. (1988), `Glycosylated hemoglobin predicts the X incidence and progression of diabetic retinopathy', Journal of X the American Medical Association, 260, pp 2864-2871, X all supported by NIH Grant EY03083. X 2. CONTACT INFORMATION: This data set was provided to Yuedong Wang (yuedong@sph.umich.edu) by Scot Moss (moss@ophth.wisc.edu) of the WESDR group, and is included here by permission. (Contact Yuedong Wang for further information, if necessary) X 3. DISCLAIMER: This data set is provided as it existed in the WESDR study as of December 23, 1992 and as it was used in the example in Wahba, Wang, Gu, Klein and Klein (1994). As in any ongoing study, it is not unusual to discover errors in earlier data as further information is collected during followup. This file will not be updated, however. X 4. DESCRIPTION X This file contains information on 669 subjects with younger-onset diabetes. A description of this population may be found in Wahba, Wang, Gu, Klein and Klein, (1994) and references cited there. X Columns Description ------- ----------- 1-9 WESDR record number. 11-14 Duration of diabetes at examination (years) 16-19 Glycosylated hemoglobin (percent) 21-24 Body mass index (kg/m.m) 26 Progression of retinopathy = 1 Not progression = 0 X See Klein et al (1989) for a description of this endpoint. X 5. REFERENCE X Wahba, G, Y. Wang, C. Gu, R. Klein and B. Klein (1994). Smoothing X Spline ANOVA for Exponential families, with Application to the X Wisconsin Epidemiological Study of Diabetic Retinopathy, X University of Wisconsin, Madison, Statistics Department TR 940, X submitted. Available in the public ftp file X ftp.stat.wisc.edu/pub/wahba/exptl.ssanova.ps.gz. SHAR_EOF $shar_touch -am 0201070695 'grkpack/examples/wesdr.doc' && chmod 0644 'grkpack/examples/wesdr.doc' || echo 'restore of grkpack/examples/wesdr.doc failed' shar_count="`wc -c < 'grkpack/examples/wesdr.doc'`" test 3367 -eq "$shar_count" || echo "grkpack/examples/wesdr.doc: original size 3367, current size $shar_count" fi # ============= grkpack/examples/wesdr.r ============== if test -f 'grkpack/examples/wesdr.r' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/wesdr.r (File already exists)' else echo 'x - extracting grkpack/examples/wesdr.r (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/wesdr.r' && # THIS PROGRAM ILLUSTRATES THE USE OF DBMDR.R ROUTINES IN FITTING BINARY RESPONSES # OF PROGRESSION OF THE WISCONSIN EPIDEMIOLOGICAL STUDY OF DIABETIC RETINOPATHY # (WESDR) WITH MODEL # logit(p(dur,gly,bmi)) = C + f1(dur) + f2(gly) + f3(bmi) + f13(dur,bmi), # WHERE dur (DURATION), gly (GLYCOSYLATED HEMOGLOBIN) AND BMI (BODY MASS INDEX) # ARE THREE CONTINUOUS VARIABLES. USING TENSOR PRODUCT SPLINES WITH CUBIC SPLINE # SPACE AS MARGINALS AND WITH INTEGRATION SIDE CONDITIONS. THE PROGRAM CALCULATES # ESTIMATES OF MAIN EFFECTS, INTERACTIONS AND THE OVERALL FUNCTION AT EQUALLY # SPACED GRID POINTS FOR PLOT. BAYESIAN CONFIDENCE INTERVALS ARE ALSO CALCULATED # AT THESE GRID POINTS. # THIS IS THE PROGRAM FOR MODEL (6.1) OF WAHBA ET AL (1995, UW-TR-940). # THIS PAPER IS AVAILABLE IN THE PUBLIC FTP FILE # ftp.stat..wisc.edu/pub/wahba/exptl.ssanova.ps.gz. X program wesdr X parameter ( nobs = 669, nnull = 5, nq = 6, ncov=3, nplot=50 ) X # PARAMETERS: # nobs number of observations. # nnull dimension of null space. # nq number of smoothing parameters. # ncov number of covariates used in the model. # nplot number of equally spaced points that the estimations and # variances are calculated. X double precision x(nobs,5), s(nobs,nnull), swk(nobs,nnull), q(nobs,nobs,nq), _ X qwk(nobs,nobs,nq), y(nobs), ywk(nobs), xmin(ncov), xmax(ncov), _ X prec, theta(nq), nlaht, score, varht, wk(nobs*nobs*(nq+2)),_ X c(nobs), d(nnull), eta(nobs), u(nobs), w(nobs), _ X mse, tmp, dk2, dk4, xi1, xi3, xi5, ddot, _ X z(nplot), main(nplot,ncov), mainsd(nplot,ncov), inter(nplot,nplot), _ X r(nobs,nplot,2*ncov), rr(nobs,nplot*nplot,2), _ X cr(nobs,nplot,ncov), dr(nnull,nplot,ncov), _ X crr(nobs,nplot*nplot), drr(nnull,nplot*nplot), _ X sms(nnull,nnull), limnla(2), qraux(nnull), b X integer info, i, j, k, job, maxiter, cov(ncov), ii, jj, jpvt(nnull) X # SPECIFY WHICH COLUMNS IN THE DATA ARE USED AS COVARIATES. IN THIS EXAMPLE, # COLUMN 2 (dur), 3 (gly) and 4 (bmi) ARE USED. COULMN 5 CONTAINS THE BINARY OBSERVATIONS. data (cov(i), i=1,ncov)/2, 3, 4/ X # SET ALGORITHMIC PARAMETERS prec = 1.d-6 maxiter = 30 job = 0 varht = 1.d0 X # input data open (8,file="wesdr.dat", status="unknown") for (j=1;j<=nobs;j=j+1) read (8,*) (x(j,i), i=1,5) close (8) X # OPEN FILES FOR OUTPUT open (11,file="workinf.wesdr", status="unknown") # Contains work information: number of X # iterations, information number and X # smoothing parameters open (12,file="mainest.wesdr", status="unknown") # Contains main effects estimations and X # their posterior standard deviations open (13,file="interest.wesdr", status="unknown") # Contains interaction estimations and X # their posterior standard deviations open (14,file="overall.wesdr", status="unknown") # Contains estimates of overall function X # on logit scale and standard deviations open (15,file="plotpoint.wesdr", status="unknown") # Grid points of covariates for plots X # FIND THE MINIMUM AND MAXIMUM OF COVARIATES for (i=1;i<=ncov;i=i+1) { X for (j=1;j<=nobs;j=j+1) y(j)=x(j,cov(i)) X call dsort(nobs,y) X xmin(i)=y(1) X xmax(i)=y(nobs) } X # generate S, Q, and y call dset (nobs, 1.d0, s(1,1), 1) # constant for (j=1;j<=nobs;j=j+1) { X s(j,2) = (x(j,cov(1))-xmin(1)) / (xmax(1)-xmin(1)) - .5d0 # linear(dur) X s(j,3) = (x(j,cov(2))-xmin(2)) / (xmax(2)-xmin(2)) - .5d0 # linear(gly) X s(j,4) = (x(j,cov(3))-xmin(3)) / (xmax(3)-xmin(3)) - .5d0 # linear(bmi) X s(j,5) = s(j,2)*s(j,4) # linear(dur)*linear(bmi) } for (j=1;j<=nobs;j=j+1) { X for (i=1;i<=nobs;i=i+1) { X q(j,i,1) = xi1 (s(i,2)+.5d0, s(j,2)+.5d0) # smooth(dur) X q(j,i,2) = xi1 (s(i,3)+.5d0, s(j,3)+.5d0) # smooth(gly) X q(j,i,3) = xi1 (s(i,4)+.5d0, s(j,4)+.5d0) # smooth(bmi) X q(j,i,4) = q(j,i,3) * s(j,2) * s(i,2) # linear(dur)*smooth(bmi) X q(j,i,5) = q(j,i,1) * s(j,4) * s(i,4) # smooth(bmi)*linear(dur) X q(j,i,6) = q(j,i,1) * q(j,i,3) # smooth(dur)*smooth(bmi) X } X y(j) = x(j,5) # binary response } X # CALL BINARY DATA MULTIVARIATE DRIVER call dset (nobs, 0.d0, eta, 1) # starting estimate of logit of probability call dbmdr ('u',_ # smoothing parameter X s, nobs, nobs, nnull, q, nobs, nobs, nq, y,_ # input matrices X 0.d0, 0.d0, job, prec, 15, prec, maxiter,_ # job requests X theta, nlaht, score, varht, c, d, eta,_ # output X wk, swk, qwk, ywk, u, w,_ # work arrays X info) # error message write (11,*) 30-maxiter, info, (sngl (nlaht-theta(i)), i=1,nq) X # GENERATE GRID FOR PLOT for (j=1;j<=nplot;j=j+1) z(j) = (dble(j)-1.d0) / (dble(nplot) - 1.d0) X # GENERATE (W^{1/2}\theta R)'s IN r( , ,1:ncov) FOR CALCULATING c_r AND d_r # NEEDED FOR POSTERIOR COVARIANCES OF MAIN EFFECTS. for (k=1;k<=ncov;k=k+1){ X for (j=1;j<=nplot;j=j+1){ X for (i=1;i<=nobs;i=i+1){ X r(i,j,k) = dsqrt (w(i)) * 10.d0**theta(k) * xi1 (s(i,k+1)+5.d-1, z(j)) X } X } } X # GENERATE (W^{1/2}\theta R)'s IN rr( , ,1) FOR CALCULATING c_rr AND d_rr # NEEDED FOR POSTERIOR COVARIANCES OF INTERACTIONS. for (i=1;i<=nobs;i=i+1) { X for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X tmp = 10.d0**theta(4) * xi3(z(jj),z(ii),s(i,4)+5.d-1,s(i,2)+5.d-1) + _ X 10.d0**theta(5) * xi3(z(ii),z(jj),s(i,2)+5.d-1,s(i,4)+5.d-1) + _ X 10.d0**theta(6) * xi5(z(ii),z(jj),s(i,2)+5.d-1,s(i,4)+5.d-1) X rr(i,j,1) = dsqrt (w(i)) * tmp X } } X # MATRIX DECOMPOSITION FOR CALCULATING c_r, d_r, AND sms for (j=1;j<=nobs;j=j+1) call dset (nobs-j+1, 0.d0, qwk(j,j,1), 1) for (i=1;i<=nq;i=i+1) { X for (j=1;j<=nobs;j=j+1) X call daxpy (nobs-j+1, 10.d0**theta(i), q(j,j,i), 1, qwk(j,j,1), 1) } X maxiter = 30 limnla(1) = nlaht - 1.d0 limnla(2) = nlaht + 1.d0 call dbsdr('u',_ X s, nobs, nobs, nnull, y, qwk(1,1,1), nobs,_ X 0.d0, 0.d0, -1, limnla, prec, maxiter,_ X nlaht, score, varht, c, d, eta,_ X qraux, jpvt, wk, swk, qwk(1,1,2), ywk, u, w,_ X info) b = varht / 10.d0**nlaht X # CALCULATE c_r, d_r FOR MAIN EFFECTS for (i=1;i<=ncov;i=i+1){ call dcrdr (swk, nobs, nobs, nnull, qraux, jpvt, qwk(1,1,2), nobs, nlaht,_ X r(1,1,i), nobs, nplot, cr(1,1,i), nobs, dr(1,1,i), nnull, wk, info) } # CALCULATE c_r, d_r FOR INTERACTION call dcrdr (swk, nobs, nobs, nnull, qraux, jpvt, qwk(1,1,2), nobs, nlaht,_ X rr(1,1,1), nobs, nplot*nplot, crr, nobs, drr, nnull, wk, info) # CALCULATE sms call dsms (swk, nobs, nobs, nnull, jpvt, qwk(1,1,2), nobs, nlaht,_ X sms, nnull, wk, info) X # GENERATE (W^{1/2}\theta R)'s IN r( , ,1:ncov) FOR MULTIPLYING WITH c_r. # GENERATE (\theta R)'s IN r( , ,(ncov+1):2*ncov) FOR MULTIPLYING WITH c. for (k=1;k<=ncov;k=k+1){ X for (j=1;j<=nplot;j=j+1){ X for (i=1;i<=nobs;i=i+1){ X r(i,j,k+ncov) = 10.d0**theta(k) * xi1 (s(i,k+1)+5.d-1, z(j)) X r(i,j,k) = dsqrt (w(i)) * r(i,j,k+ncov) X } X } } X # GENERATE (W^{1/2}\theta R)'s IN rr( , ,1) FOR MULTIPLYING WITH c_rr. # GENERATE (\theta R)'s IN rr( , ,2) FOR MULTIPLYING WITH c. for (i=1;i<=nobs;i=i+1) { X for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X rr(i,j,2) = 10.d0**theta(4) * xi3(z(jj),z(ii),s(i,4)+5.d-1,s(i,2)+5.d-1) + _ X 10.d0**theta(5) * xi3(z(ii),z(jj),s(i,2)+5.d-1,s(i,4)+5.d-1) + _ X 10.d0**theta(6) * xi5(z(ii),z(jj),s(i,2)+5.d-1,s(i,4)+5.d-1) X rr(i,j,1) = dsqrt (w(i)) * rr(i,j,2) X } } X # CALCULATE THE POSTERIOR MEAN OF MAIN EFFECTS AND THEIR VARIANCES for (j=1;j<=nplot;j=j+1) { X for (i=1;i<=ncov;i=i+1) { X # MAIN EFFECT ON GRID: POSTERIOR MEAN. f_i = linear + smooth X main(j,i) = d(i+1) * (z(j)-5.d-1) + _ # linear X ddot (nobs, r(1,j,i+ncov), 1, c, 1) # smooth X # MAIN EFFECT ON GRID: POSTERIOR VARIANCE. X tmp = (10.d0**theta(i) * xi1 (z(j), z(j)) - _ X ddot (nobs, r(1,j,i), 1, cr(1,j,i), 1)) _ # Var(s,s)/b X + (z(j)-5.d-1) * (z(j)-5.d-1) * sms(i+1,i+1) _ # Var(l,l)/b X - 2.d0 * (z(j)-5.d-1) * dr(i+1,j,i) # 2*Cov(l,s)/b X mainsd(j,i) = dsqrt (max (0.d0, b*tmp)) X } X write (12,*) sngl (d(1)),_ # constant X ( sngl (main(j,i)), i=1, ncov),_ # main effects X sngl ( dsqrt (max (0.d0, b * sms(1,1)))),_ # s.d. of constant X ( sngl (mainsd(j,i)), i=1, ncov) # s.d. of main effects } X # CALCULATE THE POSTERIOR MEAN OF COMBINED INTERACTION AND THEIR VARIANCES for (j=1;j<=nplot*nplot;j=j+1) { X jj = (j - 1) / nplot + 1 # j-TH POINT HAS COORDINATES (z(ii),z(jj)) X ii = j - (jj-1) * nplot # X # INTERACTIONS ON GRIDS: POSTERIOR MEAN X # f13(dur,bmi) = linear(dur)*linear(bmi) + linear(dur)*smooth(bmi) X # + smooth(dur)*linear(bmi) + smooth(dur)*smooth(bmi) X inter(ii,jj) = d(5) * (z(ii) - .5d0) * (z(jj) - .5d0)_ # linear(dur)*linear(bmi) X + ddot (nobs, c, 1, rr(1,j,2), 1) # three smooth terms X # INTERACTIONS ON GRIDS: POSTERIOR STANDARD DEVIATION X wk(j) = 10.d0**theta(4) * xi3 (z(jj),z(ii),z(jj),z(ii)) _ # Var(l(dur)*s(bmi)) X + 10.d0**theta(5) * xi3 (z(ii),z(jj),z(ii),z(jj)) _ # Var(s(dur)*l(bmi)) X + 10.d0**theta(6) * xi5 (z(ii),z(jj),z(ii),z(jj)) _ # Var(s(dur)*s(bmi)) X - ddot (nobs, rr(1,j,1), 1, crr(1,j), 1) _ # Var & Covariances X + sms(5,5) * ((z(ii) - .5d0) * (z(jj) - .5d0)) ** 2 _ # Var(l(dur)*l(bmi)) X - 2.d0 * (z(ii) - .5d0) * (z(jj) - .5d0) * drr(5,j) # Covariances X wk(j) = dsqrt (max( 0.d0, b*wk(j))) X write (13,*) sngl (inter(ii,jj)), _ # interaction X sngl (wk(j)) # s.d. of interaction } X # CALCULATE THE POSTERIOR MEAN OF OVERALL FUNCTION AND THEIR VARIANCES for (k=1;k<=nplot;k=k+1){ for (j=1;j<=nplot;j=j+1){ for (i=1;i<=nplot;i=i+1){ X # Var(C) + Var(f1(dur)) + Var(f2(gly)) + Var(f3(bmi)) + Var(f13(dur,bmi)) X tmp = b*sms(1,1) + mainsd(i,1)**2 + mainsd(j,2)**2 + mainsd(k,3)**2 + _ X wk(i+(k-1)*nplot)**2 X # Cov(C,f1(dur)) + Cov(C,f2(gly)) + Cov(C,f3(bmi)) + Cov(C,f13(dur,bmi)) X mse = (z(i)-5.d-1)*sms(1,2) - dr(1,i,1) + _ X (z(j)-5.d-1)*sms(1,3) - dr(1,j,2) + _ X (z(k)-5.d-1)*sms(1,4) - dr(1,k,3) + _ X (z(i)-5.d-1)*(z(k)-5.d-1)*sms(1,5) - drr(1,i+(k-1)*nplot) X tmp = tmp + 2.d0*b*mse X # Cov(f1(dur),f2(gly)) X mse = (z(i)-5.d-1)*(z(j)-5.d-1)*sms(2,3) - _ X (z(i)-5.d-1)*dr(2,j,2) - (z(j)-5.d-1)*dr(3,i,1) - _ X ddot (nobs, r(1,j,2), 1, cr(1,i,1), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f1(dur),f3(bmi)) X mse = (z(i)-5.d-1)*(z(k)-5.d-1)*sms(2,4) - _ X (z(i)-5.d-1)*dr(2,k,3) - (z(k)-5.d-1)*dr(4,i,1) - _ X ddot (nobs, r(1,k,3), 1, cr(1,i,1), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f2(gly),f3(bmi)) X mse = (z(j)-5.d-1)*(z(k)-5.d-1)*sms(3,4) - _ X (z(j)-5.d-1)*dr(3,k,3) - (z(k)-5.d-1)*dr(4,j,2) - _ X ddot (nobs, r(1,k,3), 1, cr(1,j,2), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f1(dur),f13(dur,bmi)) X mse = (z(i)-5.d-1)**2*(z(k)-5.d-1)*sms(2,5) - _ X (z(i)-5.d-1)*drr(2,i+(k-1)*nplot) - _ X (z(i)-5.d-1)*(z(k)-5.d-1)*dr(5,i,1) - _ X ddot (nobs, rr(1,i+(k-1)*nplot,1), 1, cr(1,i,1), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f2(gly),f13(dur,bmi)) X mse = (z(i)-5.d-1)*(z(j)-5.d-1)*(z(k)-5.d-1)*sms(3,5) - _ X (z(j)-5.d-1)*drr(3,i+(k-1)*nplot) - _ X (z(i)-5.d-1)*(z(k)-5.d-1)*dr(5,j,2) - _ X ddot (nobs, rr(1,i+(k-1)*nplot,1), 1, cr(1,j,2), 1) X tmp = tmp + 2.d0*b*mse X # Cov(f3(bmi),f13(dur,bmi)) X mse = (z(i)-5.d-1)*(z(k)-5.d-1)**2*sms(4,5) - _ X (z(k)-5.d-1)*drr(4,i+(k-1)*nplot) - _ X (z(i)-5.d-1)*(z(k)-5.d-1)*dr(5,k,3) - _ X ddot (nobs, rr(1,i+(k-1)*nplot,1), 1, cr(1,k,3), 1) X tmp = tmp + 2.d0*b*mse X tmp = dsqrt (max( 0.d0, tmp)) X mse = d(1) + main(i,1) + main(j,2) + main(k,3) + inter(i,k) X write (14,*) sngl (mse), _ # overall estimate in logit scale X sngl (tmp) # s.d. of overall estimate }}} X # OUTPUT GRID POINTS FOR PLOTS for (i=1;i<=nplot;i=i+1) { write (15,*) ( sngl (z(i)*(xmax(j)-xmin(j))+xmin(j)), j=1, ncov ) } X close (11) close (12) close (13) close (14) close (15) X stop end X X # AUXILIARY FUNCTION FOR CALCULATING REPRODUCING KERNELS double precision function dk2 (x) X double precision x X x = dabs (x) dk2 = ( x - .5d0 ) ** 2 dk2 = ( dk2 - 1.d0 / 12.d0 ) / 2.d0 X return end X X double precision function dk4 (x) X double precision x X x = dabs (x) dk4 = ( x - .5d0 ) ** 2 dk4 = ( dk4 ** 2 - dk4 / 2.d0 + 7.d0 / 240.d0 ) / 24.d0 X return end X X double precision function xi1(x1,x2) X double precision x1, x2, dk2, dk4 X xi1 = dk2(x1)*dk2(x2) - dk4(x1-x2) X return end X X double precision function xi3(x1,y1,x2,y2) X double precision x1, x2, y1, y2, xi1 X xi3 = xi1(x1,x2)*(y1-0.5)*(y2-0.5) X return end X X double precision function xi5(x1,y1,x2,y2) X double precision x1, x2, y1, y2, xi1 X xi5 = xi1(x1,x2)*xi1(y1,y2) X return end X X X SHAR_EOF $shar_touch -am 0127081195 'grkpack/examples/wesdr.r' && chmod 0644 'grkpack/examples/wesdr.r' || echo 'restore of grkpack/examples/wesdr.r failed' shar_count="`wc -c < 'grkpack/examples/wesdr.r'`" test 14146 -eq "$shar_count" || echo "grkpack/examples/wesdr.r: original size 14146, current size $shar_count" fi # ============= grkpack/examples/wesdr.dat ============== if test -f 'grkpack/examples/wesdr.dat' && test X"$1" != X"-c"; then echo 'x - skipping grkpack/examples/wesdr.dat (File already exists)' else echo 'x - extracting grkpack/examples/wesdr.dat (Text)' sed 's/^X//' << 'SHAR_EOF' > 'grkpack/examples/wesdr.dat' && 101301006 10.3 13.7 23.8 0 101301008 9.9 13.5 23.5 0 101301011 15.6 13.8 24.8 0 101301145 26 13 21.6 1 101301175 13.8 11.1 24.6 1 101301226 31.1 11.3 24.6 1 101301243 2.6 15.1 19.3 0 102301011 39.6 13.4 30.4 1 102301014 7.3 14.6 24.8 1 102303003 8.3 15.4 20.7 1 102304004 18.4 14 21.1 1 102304008 4.4 11.7 22.8 1 102306003 15.8 11.4 30.8 1 102307002 25.5 12.3 24.4 1 102307003 4.5 12.6 24.4 0 102307006 5.3 9.9 21.5 0 103301068 17.4 12.8 24.2 0 103301086 3.3 10.7 45 0 103301106 11.9 9.1 23.3 0 103303017 12.2 15.2 26.8 1 103303049 47 14.3 20 0 103303055 4 8.5 22.4 0 103303057 16.4 10.2 20.8 0 103305005 15.5 11.8 20.1 0 103305041 29.5 11.7 30.8 0 103305046 15.6 11.9 25 0 103308006 7.9 13.2 24 0 103308009 5.9 13.4 25.6 0 103308011 16.6 14.7 21.2 1 103308012 11 14.6 24.5 1 103309014 27.4 13.7 23.6 0 103309020 16.5 9.6 23.9 0 103309022 29.5 9.4 22.8 0 103309026 15.7 16.7 23.5 1 103310002 1.9 7.3 25.8 0 103311003 29.6 14.3 23.1 0 103312001 7.4 12 29.4 0 103312006 19.8 10.6 27 0 103312025 7.2 14.8 25.4 1 103312032 23 13.7 23 0 103313060 17.6 11.9 21.3 0 103315001 2.3 12.6 23.6 1 103316002 26.4 7.7 24.3 0 103401001 2.5 14.3 17.9 0 103401005 14.6 10.1 21.2 1 103401008 7.7 15.6 20.5 0 103402001 3.2 11 20.1 0 103402002 3.3 8.6 19 0 103402003 6.1 12.6 25.4 0 103402004 2 14.2 17.2 0 103402006 3.1 11.5 18.3 0 103402007 6.1 15 19.3 0 103403002 5.1 13.3 22.6 1 103403003 3.3 21.5 18.8 1 103404001 7.6 18.7 23.2 1 103404002 8 17.3 16.8 1 103404008 12.4 11.7 24.7 1 103404009 2.2 17.2 16.3 0 103405007 14.4 9.1 23.1 0 103405008 6.8 11.3 17.9 0 103405009 1.9 10.5 14.9 0 103407003 2.7 16 21.9 1 103409003 4.1 12.3 21.1 0 103409005 8.7 12.2 17.1 1 104101025 13.5 14.9 22.2 0 104102021 13.6 12.4 24.5 1 104201002 2.6 18.2 25.6 1 104201017 11.4 13.2 20.2 1 104203005 5.9 13.4 25.2 1 104301054 6.9 9.6 21.3 0 104301103 9.5 12.2 26.1 1 104304009 13.5 12.8 22.6 1 104304010 20.5 13.7 24.8 1 104305008 19.4 11.2 22.8 0 104306013 29.6 12.6 20.1 0 104306046 16.4 9.7 26.5 0 104306054 21.5 11.1 28.9 0 104306059 11.5 18.5 14.4 1 104306067 11.5 15.8 22.1 1 104307030 5.6 13.7 25.3 1 104307040 19.6 16.8 29 0 104307043 7.5 15 21.4 1 104402003 6.1 9.9 16.2 0 104501013 16.5 9.3 24 0 104701001 16.8 13.2 21.9 0 105201003 5.9 14 23.5 1 105202003 3.4 8.6 22.9 0 105202005 23.5 8.9 19.6 0 105203001 26.4 9.1 23.7 0 105204004 12.5 13.9 22.9 0 105204005 7.5 7.8 24.4 0 106204002 11.5 14.5 20.2 0 106204014 8.6 13 24.6 1 106204018 7.1 9.5 22.5 1 106204020 21.3 9.1 23.6 0 106204022 14.4 15 23.1 0 108401001 8.2 15.6 24 1 108402001 7.4 12.5 23.7 1 108402002 5.9 9.8 22 0 108402004 3.2 12 22.1 0 108402007 9.1 14.7 22 0 108403002 5.3 10.1 15.7 0 108404001 10.4 10.5 22.9 0 108404002 5.1 11.3 16.6 1 108404003 10.7 14.2 25.3 1 108404005 12.5 10.3 23.8 0 108404006 5.8 10.5 24.8 0 108404010 13.1 11.6 21 1 108404012 4.4 12.6 19.9 0 108404013 16.3 15 21.9 0 108404014 7.8 16.5 16.9 1 108404015 4.5 13.2 16.7 0 108404017 4.8 12.3 25.3 0 108404021 12.4 12.5 18.3 0 109201001 36.4 16.1 22.1 0 109201004 3.8 11.6 23.3 0 109201010 37.5 11.1 22.4 0 110302041 16.1 9.4 30.7 0 110307001 9.5 13.3 28.4 1 110307014 9.9 13.4 24 1 110307017 20.4 13.9 22.3 1 110308005 24.4 13.9 18.5 1 110308026 11.6 17.9 24.9 1 110308034 16.4 12.5 21.9 0 110310001 4.5 15.7 20.2 1 110310007 21.6 19.7 21.4 1 110310008 10.6 10.4 19.7 0 110310012 10.4 9.8 28.3 0 110310017 31.6 12.1 22.1 0 110310020 18.1 12.5 21.2 0 110310021 11.6 13.2 21.9 0 110310030 14.7 12.5 37.8 0 110310037 20.6 13.2 21.2 1 110310042 9 17.7 22.6 1 110310055 9.5 9.7 24 0 110311007 10.6 12.5 22.6 1 110311030 3.2 19.9 23.5 1 110311042 10.5 13.6 22.6 1 110311048 4.5 7.5 20.3 0 110311053 7.4 10.1 20 0 110311073 7.2 12.7 26.5 0 110311075 12 13.6 22 0 110311101 26.2 11.6 22.3 1 110311107 19.3 10.6 26.4 0 110311112 31.5 11.3 23.6 0 110311115 8.4 10.7 26.9 0 110311127 13.7 12.2 22.6 1 110312041 14.4 9.6 24.2 0 110312045 39.2 9.9 23.7 1 110313013 12.5 14.1 28.9 0 110401001 10.6 11 25.9 0 110404001 4.2 18.8 23.4 1 110702002 9.5 9.8 28.5 0 112301038 12.7 9.4 25.5 0 112302073 17.1 13 22.5 1 112302086 9.5 9.1 23.2 0 112303003 26.3 11.9 24.2 1 112304025 8.4 10.8 23.8 1 112306029 24 11.6 24.1 0 112306043 21.3 10 21.7 0 112307026 6.6 11.3 23.4 0 112307040 7.6 17.2 22 0 113201008 9.6 11.4 21.6 0 113201018 4.2 13 17.6 1 113201021 11.6 12.5 21.9 1 113204003 3.5 11.4 23.8 0 114202008 25.3 10 22.6 0 114203003 6.4 11.3 21.9 1 114205001 2 9.6 21.7 0 114205004 16.6 16.2 24.9 1 115302053 3.3 9.7 26.7 0 115303005 20.5 15.4 21.7 0 115303011 15.6 18.6 19.2 1 115303014 26.4 15.4 20.9 1 115303022 18.6 12.1 20.6 0 115303030 8.1 8.6 22 0 115303056 6.9 12.1 21.5 0 115303076 14.4 9.8 25.7 0 115304010 10.4 14 19.9 0 115304011 3 11.6 25.2 0 115304020 10.5 14.3 20.5 1 115304024 8 13.5 23 1 115304037 7 11.4 28 1 115304058 2.2 10 23.5 0 115304068 4.2 12.9 20.6 0 115304079 22.5 11.2 23.1 0 115304101 24.4 10.5 27.8 0 115304113 15.5 10.4 22.9 0 115401001 4.5 13.8 18.5 0 115401002 9 12.2 25.2 0 115402002 6 18 20.7 0 115402005 2.8 12.5 16.1 0 115403001 17.3 12.9 28.3 0 115404001 1.5 15.3 15.4 0 115404002 4 18.5 22.7 1 115404004 5.2 14.7 19.9 0 115404007 5.7 14.7 19.3 0 115404009 10.3 20 18.6 1 116302009 9.6 14.9 23.8 1 117301006 16.1 13.8 43.7 1 117301010 6.3 11.7 20.1 0 117301014 2.8 11.9 19.2 0 117302004 9.2 15 26.5 0 117302005 15.6 11.4 26.6 1 117302011 18.6 13.8 22.9 1 117302012 12.2 13.8 20.1 0 117302017 4.9 6.6 22.7 0 117302021 17.3 10.3 24.9 0 117302051 13.8 11.5 23.1 0 117302056 11.3 9.6 18.7 1 117302058 11.3 9.3 23.1 1 117303003 12.3 6 23.7 0 117303005 9.1 9.2 19.9 0 117304001 32.8 11.3 22.2 0 117307008 19.3 9.4 21.4 1 117308012 11.3 9.3 26.9 1 117308018 13.6 11.9 22.4 0 117310002 4.8 14.4 26.7 1 117312002 12.8 11.7 24.6 0 117312003 15.9 16.7 22.5 0 117312004 2.5 11 19.5 0 117312006 17.7 10.2 21.2 0 117312007 6.4 10.9 24.3 0 117312008 4.8 7.9 20.9 0 117312012 5.8 11.2 24.2 0 117312014 20.3 11.7 23.1 0 117312015 15.3 18.1 20.1 1 117312016 7 11.8 20.6 0 117312017 13.8 12.6 25.9 0 117312022 5.8 7.7 24 0 117312023 13 10.8 25 1 117312025 10.8 10.3 26.4 0 117312026 12.8 13 25.5 1 117312027 16.8 9 27.8 0 117312028 16.8 13.3 22.4 1 117312029 4.5 8.8 25.4 0 117312033 14 13.3 18.6 0 117312038 9.6 11.4 18.6 0 117312039 5.9 9 28.2 0 117312047 7.1 9.9 21.1 1 117312048 18.7 10.6 24.9 0 117401001 6.7 14.2 19.6 1 117401002 11.4 14.2 23 1 117402001 15.8 12.2 23.6 1 117402002 6.8 18.2 22.4 1 117402003 9.7 11 30 0 117402009 3.9 17.4 15.4 1 117402010 4.8 9.6 22.1 0 117402011 4.4 9.5 23.8 1 117402012 8.3 14.5 21.3 1 117402013 14 14.6 21.5 1 117402023 5 14.2 18 0 117402025 7.8 17.3 18.1 1 117402039 9.5 11 18.3 0 117402051 10.1 12.3 23.9 0 117402057 6.5 13.3 21.4 1 117402058 8 14.7 15.1 0 117402061 7.3 10.9 23.3 1 117402067 13.6 14.2 19.8 1 117402069 11 12.1 23.9 1 117402076 11.9 14.3 29.7 1 117402079 6.4 15.6 23.3 1 117402087 14.8 15.2 22.9 1 117402096 8.7 11.8 20.2 0 117402097 14.3 16.1 24 1 117402099 5.7 11.2 21.6 1 117402100 5.9 12.6 25 0 117402101 14.8 12.1 20.5 0 117402104 17.3 10 22.9 0 117402105 11.2 14.5 23.7 1 117402108 10.1 9.4 18.6 0 117402115 4 22.6 20.1 1 117402119 3 12.6 16.5 0 117402121 4.7 9.8 17.9 0 117402122 5 17.3 18.2 0 117402123 9.4 9.8 25.5 0 117402124 21.4 11.9 22.4 0 117402125 7.8 15.8 22.8 1 117402126 8.5 13.4 26.5 0 117402127 4.6 10.9 20.2 0 117402129 9.8 10.6 30.1 0 117402131 7.5 7.1 16.1 0 117402132 2.2 10.8 21.6 0 117402134 13.7 9.7 22.6 0 117402136 6.8 10.3 23.3 0 117402137 10.2 9.2 24.6 0 117402139 6.4 17.3 21.7 0 117402140 4.1 14 21.9 0 117402144 6.1 10 25.4 0 117402147 6.8 11 18 0 117402149 8.9 13 24 0 117402150 1.7 9.3 20.6 0 117402152 9.1 18.6 22.5 1 117402153 2.9 10.7 16.9 0 117402156 2.6 9.4 22.1 0 117402163 10 7.6 18.6 0 117403001 7.8 11.8 16.9 0 117403002 16.9 12.9 22 0 117403003 17.9 14 21.8 1 117403005 7 15.8 22.1 1 117403007 18.8 8.5 23.4 0 117403009 2.2 11.2 18.6 0 117403011 7.2 9.2 26.5 0 117403013 3.1 13 29 0 118202010 7.8 13.8 18.4 1 119203003 3.6 14.3 15.5 0 119203005 3.2 9.5 24.8 0 119204009 12.5 12.2 24.9 0 133301029 10.4 14.1 24.3 0 133301040 9.5 13.5 30.7 1 133301041 12.3 9.6 21.7 1 134201009 2.1 11.5 17.3 1 134201020 1.8 13.7 23.1 0 136101004 9.4 11 26.2 1 136101014 5.9 11.7 25.8 1 139301039 6.3 12.4 20.9 0 160102001 3.3 15.8 22.2 1 160102008 21.6 10.5 18.7 0 161102013 9.2 14.7 21.6 1 161102018 6.6 13.4 16.9 0 161102021 33.7 16.7 20 1 161103004 7.6 15.2 21.4 0 161301004 7.8 14.3 20.1 1 161301009 12.6 9.4 23.7 0 164301002 5.6 13.8 21.6 1 170101001 7.3 14.7 16 1 170101006 3.7 8.6 25.5 0 170201002 21.7 14.1 18.7 0 171101011 8.5 8 18.6 0 171101014 6.9 18.4 24 1 172101003 9.7 14.1 26.9 1 172101008 24.7 13.8 23.8 1 173601001 29.7 10.1 17.6 0 173601002 36.1 7.9 25.3 0 174201014 5 11.5 22.4 1 174201015 4.6 13.4 44.6 0 174201033 11.6 7 35.8 0 174201049 8.2 17.7 26.8 1 175101001 1.2 10.4 21.6 0 175102036 21.8 16 20.6 1 181101025 5.1 9.7 18 0 183301001 8.6 11.7 27.2 0 183401001 1.7 11.7 16.6 0 190301002 10.3 12 24.6 1 190301023 32.4 11.8 21.9 1 190302008 1.6 15 21.6 1 190302009 10.9 15.9 20.9 1 190302013 11.3 13.7 21 1 190302014 7.6 11.6 31.7 0 190401001 7.4 7.8 21.4 0 190401006 1.3 12.6 15.6 0 190401009 9.8 9.4 22.1 0 190401010 9.8 16.7 20.3 1 190401011 1.7 8.3 21.2 0 190401014 1.2 8.2 20.5 0 190401015 10.3 13.4 20.5 0 190401017 2.4 13.7 23.5 0 190401019 5.9 9.9 22.4 0 190401020 3.4 9.3 25 1 194101016 13.8 13.7 23.5 1 195201001 3 12.7 24.4 0 195201005 9.4 18.1 19.2 1 260201005 23.7 12.2 25.5 1 261201031 36.8 11.2 28.2 0 270301006 25.8 13.6 30.1 0 270301010 16.7 13.9 18.1 0 270301042 18.2 10.7 25.5 0 270301073 1.2 8 23 0 273201002 3 13.3 18.6 1 273201003 2.5 8.9 14.6 0 273201013 14.7 11.7 25.3 1 273201015 16.7 12.3 19.1 1 274301001 23.1 11 24.2 1 274301005 3 16 20.4 1 280101010 11 14.4 23 1 280101019 17.6 10.7 22.9 1 281101042 3.9 12.7 20.1 1 281101044 1.7 15.5 21.4 0 282201008 20.7 16.5 23.3 1 290101018 1.5 11.8 15.5 0 291101006 47.8 13.8 26.8 1 291101011 3 10.5 19 0 291101025 5 10.9 15.6 0 291102016 6.9 11.3 26.8 1 291201022 23.8 11.1 29 0 291301006 8 8 27.8 0 292101006 4.9 14.5 22.1 0 295101002 18.4 13.8 30 0 295101008 5.4 9.6 19.7 0 295101012 10 15 24.4 1 295101014 11.8 11.1 26.2 1 295201001 14 12.5 24.1 1 295201011 16.9 12.2 32.3 1 303101011 11.1 11.3 18.9 0 303101017 20.7 17 18 0 303102022 6.2 9.9 21.5 0 303103001 8.3 14.7 21.2 1 303103002 13.7 13.6 20.9 1 303103010 10.4 10.2 25.2 1 303103014 11.8 12.7 21.6 1 303202001 4.3 15.1 20.7 1 303203001 10.8 10.3 20.7 1 303203007 11.7 9.6 35.2 0 303204004 4.2 11.3 20.8 0 327301029 11.7 12.6 23.1 0 327301037 29.7 11.9 26.2 1 327301061 17.7 12.7 21.3 1 328101007 3.7 11.8 26.4 1 328101009 6.7 13.2 27.4 0 328101011 18.1 11.2 25.9 1 329101007 21.4 12.4 33.3 1 329101010 5.9 14.2 24.5 1 329101026 6.2 12.1 27.9 1 329101028 5.4 13.2 22.1 0 330301016 30.7 10.8 31.4 0 330301017 10.7 12.9 24.4 0 330301042 11.9 13.1 26.3 0 331601006 6.3 13.3 24.3 1 331601007 35.8 11.3 21.5 0 331601011 29.7 12.3 21.6 0 331601032 5.2 10.6 25.1 0 336101003 4.3 11.9 19.4 0 336101023 8.6 12.7 22.8 0 336101028 1.3 12 18.8 0 337201001 5.3 11 24.1 0 337201005 16.7 11.2 22.1 1 338101017 10.7 11.2 28.6 0 360401001 3 15 21 0 360401002 3.8 11.5 18.7 0 362101021 13.1 12.6 25.9 1 363501002 10.8 14.3 26 0 363501003 17.8 11 24.1 0 365301024 5.8 11 21.5 0 370602020 2.6 10.7 21.8 1 370602023 8 11.6 27.1 1 371401001 6.4 10.8 29.1 1 371401020 5.5 10.3 24.6 0 372101009 1.9 8.1 24.9 0 374101022 41.8 11.1 25.6 0 374101047 5.7 16.8 26 1 401101007 8.9 8.9 26.2 0 401101019 7 10.2 39.8 0 401102010 7.4 15.3 19.6 0 401104001 5.9 16.5 23.2 1 401104005 28 14 23.3 1 401104006 10 12.9 20.4 0 401104011 24 10.5 30.4 0 401104013 4.9 11 20.2 0 401201007 19.5 17.5 28.3 0 401201017 8.2 13 23.3 1 401201020 11 15.3 25.6 1 460102001 3.9 15.2 24.5 1 460102007 2.5 13.6 34.5 0 460102027 5.2 11.9 18.9 0 461101001 7.2 11.9 26.4 0 461101018 10 11.5 19.3 0 464101048 9 10 23.1 1 470101003 4.6 17.7 27.9 1 470101016 8.1 15 24.8 1 470102026 30 11.3 21.4 0 470102068 15 12.1 22 1 470103005 2.2 10.4 18.2 0 471101002 10 10.6 23.4 0 474101001 4.5 12.8 24 0 474101008 6.2 13.4 23.5 1 474101010 15.8 11.1 22.5 1 474101011 9.7 15 21.5 1 501305014 24.1 13.3 20.7 0 501307005 28.1 12.4 24.9 1 501307019 13.1 11.8 23 1 501309020 13.6 13.8 23.9 0 501309026 22 14.5 23.3 0 501309028 5 11 32.9 0 501309038 25.1 15.5 24.1 0 501310041 13.1 9.1 31.1 0 501310071 26.1 14.1 32.5 1 501314021 9.5 15.6 26.9 1 501314063 25.3 14.3 21.7 0 501314085 16.2 21 22.2 1 501315027 27.5 11.5 25.2 0 501315078 26.1 10.8 27.1 1 501316006 21.8 11.6 27.4 0 501316007 13.1 14.7 39.4 1 501317011 19 9.5 24.2 0 501317015 38.3 12.6 29.2 0 501317040 35.1 11.9 21.1 0 501317089 18.1 15.8 19.6 1 501401001 10.7 13.4 26.6 1 501403001 9.2 9.7 27.5 0 501403003 6 15.1 23.9 1 501404003 9.1 17.3 18.3 0 502301002 5.1 9.7 29.6 0 502301004 10.2 12.4 23 0 502301017 8.8 21.3 19.8 1 502301022 1.9 8 19.5 0 502301032 7.3 14.8 24.3 1 502301049 6 11.2 22 1 502301062 7.4 11.6 37 1 560101004 11.8 13.4 27.5 1 560101009 14.1 13.6 22.2 1 561101016 27.2 12 23.4 0 561101030 9.1 13 24.4 1 561101038 13.1 11 28.3 1 562201019 5.8 13.5 25.9 0 562201021 10.1 12.6 18.9 0 562201039 1.6 13 27.1 1 601301006 2 11.1 20.4 0 601301008 4.4 13.5 16.7 0 601301011 2.9 15.8 21 0 602101008 8.9 13.1 26.3 1 603101003 24.2 10.3 30.5 0 604501011 14 15.8 27.5 1 604501012 7 10 30.4 0 634204015 8 9.6 23.6 1 636301007 29.4 9.7 19.7 0 637101050 7.3 10.4 27 0 667101008 32.9 9.7 24.5 0 667104035 27.9 11 22.9 0 667105020 2 8.2 21.8 0 667106017 9.5 8.2 22.7 0 667401001 3.9 15.3 23.9 1 667401002 1.9 9.2 16.6 0 668301027 6.9 13.5 24.3 1 701101039 1.7 12.2 17.8 1 701101045 6.8 14.9 22.2 1 701101047 9.3 13.6 24.5 1 701103001 12.6 7.3 27.6 0 701103012 6 12.1 22.6 1 701103028 4.5 14.4 24.7 0 701103094 1.9 14 18.6 1 702201012 8.4 13.9 26.2 1 702202002 16.4 11.1 23.2 0 702202003 16.4 8.6 27.6 0 702501015 3.4 11.5 21.2 0 703201004 11.4 12.7 24.3 1 703201007 23.4 9.7 25.6 0 727401001 10.4 14.8 17.8 1 727401003 7.8 10.9 17.3 0 727401004 6.3 9.7 20.3 0 730301006 2.8 12.9 22.3 0 730301011 1.5 8.9 37.8 0 770101001 14.2 12.2 26.5 1 774201018 20.4 10 26.4 0 780102004 17.4 13.6 21.2 0 780102007 3.4 11.5 16.6 0 780102008 2.8 16.2 16.9 1 780102012 1.9 7.7 21.3 1 780102013 15 11.8 20.8 1 780102014 7.8 14.8 50.8 1 780102019 3.3 11.5 24.5 0 781203022 8.4 10.3 20.5 1 781203023 5.7 11 20.1 0 790101019 36.4 13.8 23.7 0 790101037 25.4 12.4 23.1 0 790102031 19.4 14.7 22.7 0 790102033 17.4 12.8 24.4 0 790102040 4.9 13.1 22.9 1 792101012 1.9 11.4 26.9 1 794201010 5.1 14.2 25.2 1 794201026 6.2 17.2 24.8 0 801101002 24.2 12.1 25.3 0 801101006 16.6 11.1 24.8 0 801101010 2.5 9.8 29.6 0 801101045 49.2 14.1 17.1 0 801101046 13.1 14.6 24.9 1 801102022 12.8 12.6 28.1 1 801102023 55.2 17.1 27 1 801103010 5.7 9.2 22.1 0 801103015 5.6 8.8 26 1 801103052 10.4 10.8 26.1 0 801104010 12.1 13.2 25.7 1 801104020 12.1 10.4 20.1 1 801104025 5.4 15.2 21.1 1 801301011 9.2 14.4 29.9 1 801301042 21.2 7.3 30.7 0 801301047 3.7 6.8 21.6 0 801301050 9.1 13.5 19.8 1 801302004 5.8 12 19 1 801302006 33.2 13.5 30.7 1 801302027 4.2 7.6 20.3 1 803301004 22.1 9.5 26.9 0 803302014 14.2 13.5 23.2 1 803302022 11.1 13.5 21.8 1 803303005 11.2 17.1 25.8 0 803303006 7.9 11.6 24.8 1 803303007 1.6 12.2 19.8 0 803304022 6.5 15.6 23.9 1 803304029 14.2 12.8 22.8 1 803304030 16.4 14.9 24.7 1 803307001 12.2 13.2 18.7 0 803401001 1.8 10.2 15.5 0 803401002 5.6 10.1 19.7 0 803402001 2.1 14.8 20.7 1 803402002 6.1 17.9 22 1 803402003 5.6 15.9 16.8 0 803403001 2.4 13.4 20.8 0 803403002 16.1 15.9 23.7 1 803403003 3.9 13.3 18.1 0 803403004 5.6 15.7 16.3 0 803403005 1.8 11.2 14.4 0 803403007 1.5 11.8 18.7 0 803403008 1.5 15.8 15.9 0 803404001 6 9 21.7 1 803404002 3.1 12.8 18.6 1 803404003 2.6 10.6 18.7 0 803404004 4.9 11.2 20.2 0 803405002 8.8 14.9 20.2 1 803405004 10.1 12.1 25.3 0 804201001 6.3 13 21.2 1 804202001 3.2 11.5 22.3 0 804202002 9.2 13.5 23 0 804202003 7.2 9.7 23.4 1 826301018 1.8 11.4 20 0 826301020 4.2 11.3 21.2 0 826301021 9.2 14.9 22.5 0 828201013 5.1 12.1 29.3 0 861101008 33.2 12.7 17.4 0 870301074 15.3 12.3 22.5 0 870301136 25.3 14.4 18.5 0 870301147 11.3 12.3 27 0 870301180 11.3 12.4 25.6 1 870303023 15 11.5 24 0 870307019 19.3 12 33 1 870307061 17.3 11.9 22.9 0 870401001 10.9 15.3 24.2 1 870401002 9.8 11 19.3 0 870401005 8.3 13.9 24.3 1 870401006 7.1 15.7 22.2 1 870402001 3.2 16.3 21.2 1 871101007 29.3 9 26.2 0 871102006 14.3 8.9 22.5 0 871102009 3 11.4 29.9 0 871104004 8.9 10.2 23.4 0 871104005 3.3 16 21 1 872101024 11.9 12.3 25 1 872101025 1.9 11.6 15.8 0 872101030 17.6 12.2 35.7 0 872102022 28.3 12 26.2 0 872103021 9.1 18.6 21.7 1 872103022 10 12.4 27.3 1 872103047 15.3 12.4 23.4 1 875101001 5.8 11.8 17.8 0 890601020 26.4 11.9 28.7 0 890601021 27.2 14.1 21.5 0 890601033 15.2 11.7 28 1 890601041 8.8 14.4 20.6 1 891101025 4.9 15.4 21.6 1 891301013 13.1 14.2 25.7 1 960101023 8.2 11.3 20.2 0 960101033 6.5 17.2 34.6 1 960101040 22.8 6.4 23.6 1 960102018 2.5 11.2 21.3 0 960102033 5.1 10.6 18.1 1 960102034 21.8 12 26.9 0 960201022 4.5 16.9 17.1 1 960202022 36.9 11.3 21.5 0 960204003 1.8 9 22.7 0 960204004 3 13.6 21.3 0 960204051 7.3 9.7 19 0 961101019 5 16.9 26.3 0 961101020 6.8 9.6 27.7 0 961101021 6.9 11.1 17 1 965101015 1.4 11 19 0 965203003 7.8 15.6 20.9 1 980101001 5.9 18.7 21.7 1 980101003 6.8 14.6 15.2 0 990101007 5.8 11.9 32.8 1 990203007 4.9 15.9 18.8 1 994601011 10.1 10.1 26.3 0 SHAR_EOF $shar_touch -am 0127081195 'grkpack/examples/wesdr.dat' && chmod 0644 'grkpack/examples/wesdr.dat' || echo 'restore of grkpack/examples/wesdr.dat failed' shar_count="`wc -c < 'grkpack/examples/wesdr.dat'`" test 18063 -eq "$shar_count" || echo "grkpack/examples/wesdr.dat: original size 18063, current size $shar_count" fi exit 0