{"id":209,"date":"2017-09-13T11:14:14","date_gmt":"2017-09-13T14:14:14","guid":{"rendered":"http:\/\/www.professores.uff.br\/diomarcesarlobao\/?page_id=209"},"modified":"2017-09-13T11:14:14","modified_gmt":"2017-09-13T14:14:14","slug":"lsq-f","status":"publish","type":"page","link":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/lsq-f\/","title":{"rendered":"lsq.f"},"content":{"rendered":"
c<html>\r\nc<head><title>lsq.f<\/title><\/head>\r\nc<body>\r\nc<pre>\r\n      module arrays\r\n      real, allocatable :: t(:), z(:)\r\n      integer np\r\nc\r\nc   t   -  array containing times (seconds) at which positions are measured\r\nc   z   -  measured distance of the falling object from the nominal point of\r\nc          release (fit may let you estimate any offset in the actual release\r\nc          point\r\nc   np  -  number of data points\r\nc\r\n      end module\r\nc\r\n      program leastsq\r\n      use arrays\r\n      implicit none\r\nc\r\nc   Program designed to perform a least squares fit of a quadratic equation\r\nc   to some data.  In this specific example the data is the result of\r\nc   measuring the location of a falling object at various times.  The result\r\nc   of interest is gravitational acceleration obtained from the coefficient\r\nc   off t**2.\r\nc\r\nc       John Mahaffy   2\/6\/95\r\nc\r\n      real coef(0:2),g\r\nc\r\nc   Variables\r\nc\r\nc   t   -  array containing times (seconds) at which positions are measured\r\nc   z   -  measured distance of the falling object from the nominal point of\r\nc          release (fit may let you estimate any offset in the actual release\r\nc          point\r\nc   np  -  number of data points\r\nc   coef - Coefficients in the second order polynomial approximating the data\r\nc          z = coef(0) + coef(1)*t + coef(2)*t**2\r\nc   g   -  approximation to the gravitational acceleration deduced from data\r\nc\r\nc\r\n      call getdata\r\n      call quadfit(t,z,np,coef(0))\r\n      g=2*coef(2)\r\n      write(6,2000) g\r\n 2000 format (' Predicted value of g = ', f6.3,' m\/s**2')\r\n      write(6,2001) coef(0),coef(1)\r\n 2001 format(' Predicted initial offset = ',f7.4,' m'\/\r\n     #         ' Predicted initial velocity = ',f7.4,' m\/s')\r\n      stop\r\n      end\r\n      subroutine getdata\r\n      use arrays\r\n      implicit none\r\nc\r\nc   Get Experimental Data\r\nc\r\nc   Input Arguments: NONE\r\nc   Output Arguments:\r\nc     t     -    time (sec) of measurement\r\nc     s     -    distance of fall measured (meters)\r\nc     np    -    number of data points\r\nc\r\n      integer i, iend\r\n      open(11,file='fall.data')\r\nc\r\nc    Count Data Pairs in fall.data\r\nc\r\n      np=-1\r\n      do while (iend.eq.0)\r\n         read(11,*,iostat=iend)\r\n         np = np + 1\r\n      enddo\r\n      if (iend.gt.0.or. np.lt.1) then\r\n         print *, 'Empty or Bad File, check fall.data'\r\n         stop\r\n      endif\r\nc\r\nc    Rewind, Allocate Arrays, and Read data\r\nc\r\n      rewind (11)\r\n      print *, np, ' data points read.'\r\n      allocate (t(1:np),z(1:np))\r\n      do i = 1,np\r\n        read (11,*) t(i),z(i)\r\n      enddo\r\nc\r\n      end\r\nc\r\n      subroutine quadfit (xd,yd,ndata,c)\r\n      implicit none\r\nc\r\nc       Take corresponding data points from the arrays xd and yd and fit\r\nc       them with the following equation:\r\nc\r\nc       y = c(1) + c(2) * x + c(3) * x**2\r\nc\r\n       real xd(ndata),yd(ndata),aa(3,3),c(3),fs,suma,sumb,sqrt,rsid\r\n       integer ipvt(3),ir,is,ij,ndata, info\r\nc\r\nc    Input Arguments:\r\nc      xd   -   x values for data points\r\nc      yd   -   y valuess for data point pairs\r\nc      ndata -  number of data points\r\nc\r\nc    Output Arguements:\r\nc      c    -   array containing the three coefficients in the 2nd order\r\nc               polynomial that provide the \"best\" fit to the data from a\r\nc               least squares method.  Note that it also temporarily holds\r\nc               the values of the right hand sides of each Least Squares\r\nc               equation.\r\nc    Other Key Variables:\r\nc      aa   -   matrix containing coefficients of the system of equations\r\nc               generated by the least squares method\r\nc      suma -   a variable that tallies the sum that is needed to generate\r\nc               each element of aa.\r\nc      sumb -   a variable that tallies the sum that is needed for the right\r\nc               hand side of each Least Squares equation.\r\nc      ir   -   an index that is used to keep track of the equation number\r\nc               within the system of equations .\r\nc      is   -   an index used to track the coefficient number within a given\r\nc               Least Squares equation.\r\nc\r\nc\r\nc    DO loop 55 generates terms for each of the 3 Least Squares Equations\r\nc\r\n      do 55 ir=1,3\r\nc\r\nc       DO loop 45 generates the right hand side for a given equation\r\nc\r\n         sumb=0.\r\n         do 45 ij=1,ndata\r\n  45        sumb=sumb+yd(ij)*xd(ij)**(ir-1)\r\n         c(ir)=sumb\r\nc\r\nc       DO loop 50 generates the coefficients a given equation\r\nc\r\n         do 50 is=1,3\r\n            suma=0.\r\n            do 52 ij=1,ndata\r\n  52           suma=suma+xd(ij)**(is-1)*xd(ij)**(ir-1)\r\n  50        aa(ir,is)=suma\r\n  55     continue\r\nc\r\nc    Solve the Least Squares Equations\r\nc\r\n            call sgefa(aa,3,3,ipvt,info)\r\n            call sgesl(aa,3,3,ipvt,c ,0)\r\nc\r\nc    Calculate a measure of mean error between the data and the curve\r\nc\r\n            rsid=0.\r\n            do 65 ir=1,ndata\r\n               fs=0.\r\n               do 60 is=1,3\r\n   60             fs=fs+c(is)*xd(ir)**(is-1)\r\n   65          rsid=rsid+(yd(ir)-fs)**2\r\nc<a name=1><font color=FF0000>\r\n            rsid=sqrt(rsid\/float(ndata-1))\r\nc<\/font>\r\n            write(6,2001) rsid\r\n 2001       format(' Fit to 2nd order polynomial has a mean error of',\r\n     $             1p,e12.5)\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>lsq.f<\/title><\/head> c<body> c<pre> module arrays real, allocatable :: t(:), z(:) integer np c c t – array containing times (seconds) at which positions are measured c z – measured distance of the falling object from the nominal point of c release (fit may let you estimate any offset in the actual release c point […]<\/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-209","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/209","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=209"}],"version-history":[{"count":1,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/209\/revisions"}],"predecessor-version":[{"id":210,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/209\/revisions\/210"}],"wp:attachment":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/media?parent=209"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/categories?post=209"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/tags?post=209"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}