{"id":185,"date":"2017-09-13T10:55:54","date_gmt":"2017-09-13T13:55:54","guid":{"rendered":"http:\/\/www.professores.uff.br\/diomarcesarlobao\/?page_id=185"},"modified":"2017-09-13T10:55:54","modified_gmt":"2017-09-13T13:55:54","slug":"quad-f","status":"publish","type":"page","link":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/quad-f\/","title":{"rendered":"quad.f"},"content":{"rendered":"
c<html>\r\nc<head><title>array1.f<\/title><\/head>\r\nc<body>\r\nc<pre>\r\n      program curvefit\r\nc<a name=\"dp\"><font color=\"FF0000\">\r\n      implicit double precision (a-h,o-z)\r\nc<\/a><\/font>\r\nc\r\nc       Take points from specified data file and develop a Quadratic spline\r\nc       fit. This assumes that the data file has an extension \".txt\"\r\nc\r\n      parameter (nmax=20,ndata=1000)\r\n      character*32 infile, arg2, data_name, outfile, sampfile, gnuin\r\n      common\/curf\/ xd(ndata),yd(ndata),b(ndata), c(ndata), d(ndata),\r\n     $ xs(1001),ys(1001),nd\r\n      integer*4 narg\r\n      integer*2 istatus\r\nc\r\n      WRITE(6,'(a)',advance='no')\r\n     &   'PROVIDE INPUT FILE NAME :'\r\n      READ (*,*) infile\r\n      name_len=index(infile,'.')-1\r\n      infile=infile(1:name_len)\/\/'.txt'\r\n      outfile=infile(1:name_len)\/\/'.fit'\r\n      sampfile=infile(1:name_len)\/\/'.sam'\r\nc     gnuin=infile(1:name_len)\/\/'.plt'\r\n      gnuin = 'quadfit.plt'\r\n      open (11,file=infile)\r\n      open (12,file=outfile)\r\n      open (14,file=gnuin, position = 'append')\r\n      open (16,file=sampfile)\r\n      i=1\r\n  10  read (11,*,end=20) xd(i),yd(i)\r\n      i=i+1\r\n      go to 10\r\n   20 nd=i-1\r\n      write(6,2000) nd\r\n 2000 format(1x,i4,' data points read from input file')\r\n      if(nd.le.0) then\r\n         write(6,*) ' No curve data found.'\r\n         stop\r\n         endif\r\n      if(nd.eq.1) then\r\n         write(6,*) 'More than one data data point required for a fit.'\r\n         stop\r\n         endif\r\nc\r\nc   Generate splines\r\nc\r\n      call quad (nd, xd, yd, b, c)\r\nc\r\nc   Sample the interpolation table for a plot\r\nc\r\n      write(16,*) xd(1),yd(1)\r\n      x=xd(1)\r\n      dx=(xd(nd)-x)*.001\r\n      do 100 i=2,1001\r\n         x=x+dx\r\n         call quadint (x,y,xd,yd,b,c,nd)\r\n         write(16,*) x,y\r\n 100  continue\r\nc\r\nc   Write information for data table\r\nc\r\n      do 200 i=1,nd\r\n         write(12,2020) xd(i),yd(i),b(i),c(i)\r\n 200  continue\r\n 2020 format(1p,5x,'& ',4(e15.8,',') )\r\n         call plotit(infile(1:name_len))\r\n 500  stop\r\n      end\r\n      subroutine plotit(infile)\r\n      implicit real*8 (a-h,o-z)\r\n      character*(*) infile\r\n      character*80 line\r\n      write(14,*) 'set data style lines'\r\n      write(14,*) 'set nokey'\r\n      line = 'set title '\/\/\r\n     $ '''Quadratic Fit to Data for : '\/\/infile\/\/''''\r\n      ii=index(line,':')\r\n      ii=index(line(ii+2:80),' ')+ii\r\n      write(14,'(a)') line(1:ii)\r\n      line = 'plot '''\/\/infile\/\/'.sam'' using 1:2 , \\\\'\r\n      ii=index(line,'\\\\')\r\n      write(14,'(a)' ) line(1:ii)\r\n      line = ' '''\/\/infile\/\/'.txt'' using 1:2 with points'\r\n      ii=index(line,'ts')\r\n      write(14,'(a)' ) line(1:ii+1)\r\n      write(14,*) 'pause -1'\r\nc      call system ('gnuplot gnuin-fit')\r\n      return\r\n      end\r\n      subroutine quad (n, x, y, b, c)\r\n      implicit real*8 (a-h,o-z)\r\n      integer n\r\n      real*8 x(n), y(n), b(n), c(n)\r\nc\r\nc  the coefficients b(i), c(i) i=1,2,...,n are computed\r\nc  for a quadratic with continuous derivatives\r\nc\r\nc    s(x) = y(i) + b(i)*(x-x(i)) + c(i)*(x-x(i))**2\r\nc\r\nc    for  x(i) .le. x .le. x(i+1)\r\nc\r\nc  input..\r\nc\r\nc    n = the number of data points or knots (n.ge.2)\r\nc    x = the abscissas of the knots in strictly increasing order\r\nc    y = the ordinates of the knots\r\nc\r\nc  output..\r\nc\r\nc    b, c     = arrays of quadratic coefficients as defined above.\r\nc\r\n      c(1)=((y(3)-y(1))\/(x(3)-x(1))-(y(2)-y(1))\/(x(2)-x(1)))\/(x(3)-x(2))\r\n      b(1)=(y(2)-y(1))\/(x(2)-x(1))-c(1)*(x(2)-x(1))\r\n      do 100 i=2,n-1\r\n         b(i)=b(i-1)+2*c(i-1)*(x(i)-x(i-1))\r\n         c(i)=((y(i+1)-y(i))\/(x(i+1)-x(i))-b(i))\/(x(i+1)-x(i))\r\n  100 continue\r\n         b(n)=0.\r\n         c(n)=0.\r\nc\r\nc\r\n      return\r\n      end\r\nc\r\n      subroutine quadint(x,y,xtab,ytab,bcoef,ccoef,ntab)\r\n      implicit real*8 (a-h,o-z)\r\nc\r\nc    Perform Quadratic interpolation on a table of data with\r\nc    precomputed coefficients\r\nc\r\n      real*8 xtab(ntab),ytab(ntab),bcoef(ntab),ccoef(ntab)\r\n      save ilast\r\n      data ilast\/1\/\r\n\r\nc    Start the search from the last point of table use index\r\nc\r\n      if (x.le.xtab(ilast+1)) then\r\nc\r\nc    Search down the table from point of last use\r\nc\r\n          do 20 i1=ilast,1,-1\r\n              if(x.ge.xtab(i1)) go to 60\r\n  20          continue\r\n          write(6,*) 'x = ', x, '  is below the table range'  \r\n          i1=1\r\n          go to 60\r\n      else\r\nc\r\nc    Search up the table from point of last use\r\nc\r\n          do 40 i1=ilast+1,ntab-1\r\n              if(x.le.xtab(i1+1)) go to 60\r\n  40          continue\r\n          write(6,*) 'x = ', x, '  is above the table range'\r\n          i1=ntab-1\r\n          go to 60\r\n      endif\r\nc\r\nc   Bounding points found, interpolate\r\nc\r\n  60  dx=(x-xtab(i1))\r\n      y=ytab(i1)+bcoef(i1)*dx+ccoef(i1)*dx**2\r\n      ilast=i1\r\n      return\r\n      end\r\nc<\/pre>\r\nc<\/body>\r\nc<\/html><\/pre>\n","protected":false},"excerpt":{"rendered":"
c<html> c<head><title>array1.f<\/title><\/head> c<body> c<pre> program curvefit c<a name=”dp”><font color=”FF0000″> implicit double precision (a-h,o-z) c<\/a><\/font> c c Take points from specified data file and develop a Quadratic spline c fit. This assumes that the data file has an extension “.txt” c parameter (nmax=20,ndata=1000) character*32 infile, arg2, data_name, outfile, sampfile, gnuin common\/curf\/ xd(ndata),yd(ndata),b(ndata), c(ndata), d(ndata), $ xs(1001),ys(1001),nd […]<\/p>\n","protected":false},"author":22,"featured_media":0,"parent":0,"menu_order":0,"comment_status":"closed","ping_status":"closed","template":"","meta":{"_exactmetrics_skip_tracking":false,"_exactmetrics_sitenote_active":false,"_exactmetrics_sitenote_note":"","_exactmetrics_sitenote_category":0,"footnotes":""},"categories":[],"tags":[],"class_list":["post-185","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/185","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/users\/22"}],"replies":[{"embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/comments?post=185"}],"version-history":[{"count":1,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/185\/revisions"}],"predecessor-version":[{"id":186,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/185\/revisions\/186"}],"wp:attachment":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/media?parent=185"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/categories?post=185"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/tags?post=185"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}