
{"id":116,"date":"2016-04-28T19:05:47","date_gmt":"2016-04-28T19:05:47","guid":{"rendered":"http:\/\/labs.la.utexas.edu\/gilden\/?page_id=116"},"modified":"2016-04-28T19:05:47","modified_gmt":"2016-04-28T19:05:47","slug":"serial-code","status":"publish","type":"page","link":"https:\/\/labs.la.utexas.edu\/gilden\/serial-code\/","title":{"rendered":"Serial Code"},"content":{"rendered":"<pre>program serial\r\n\t\tparameter(nmu=20,nsig=20,nb=10,ntz=16,nd=11)\r\n\t\tparameter (nsim=2000)\r\n\t\tinteger k1,k2,k3,k4,k5,i,j,m,n\r\n\t\treal xmu,sigma,d,b,tz,beta\r\n\t\tdata xmu1\/.02\/,xmu2\/.4\/\r\n\t\tdata sig1\/.2\/,sig2\/4.\/\r\n\t \tdata b1\/0.\/\r\n\t\tdata t1\/200\/,t2\/1000\/\r\n\t\tdata d1\/1.\/,d2\/2.\/\r\n\t\tdata iseed\/-9\/\r\n\t\topen(unit=10,file='s10')\r\n\t\topen(unit=20,file='S1T0s.txt')\r\n\t\t\r\n\t\tr=ran2(iseed)\r\n\t\r\n\t\tread(20,*) n\r\n\t\tread(20,*) m\r\n\t\t\r\n\t\tdo k1=1,nmu\r\n\t\t\txmu=xmu1+(xmu2-xmu1)*(k1-1)\/float(nmu-1)\r\n\t\t \tdo k2=1,nsig\r\n\t\t  \t\tsigma=sig1+(sig2-sig1)*(k2-1)\/float(nsig-1)\r\n\t    \t\tdo k3=1,nd\r\n\t\t  \t  \t\td=d1+(d2-d1)*(k3-1)\/float(nd-1)\r\n\t\t \t  \t\tdo k4=1,nb\r\n\t\t\t\t\t\tb2=10*d\r\n\t\t  \t   \t\t\tbeta=b1+(b2-b1)*(k4-1)\/float(nb-1)\r\n\t\t  \t   \t\t\tdo k5=1,ntz\r\n\t\t   \t\t  \t\t\ttz=t1+(t2-t1)*(k5-1)\/float(ntz-1)\r\n\t\t\t\t\tcall varser(nsim,n,m,d,beta,tz,sigma,xmu)\r\n\t\t     \t\t\tenddo\r\n\t\t    \t\tenddo\r\n\t\t\t\tenddo\r\n\t\t\tenddo\r\n\t\tenddo\r\n\t\tend\t\t\r\n\t\t\r\n\t\tsubroutine varser(nsim,n,m,d,beta,tz,sigma,xmu)\r\n\t\tinteger nsim,n,m,it,icorr,ntime\r\n\t\treal d,beta,tz,sigma,xmu,totcor,totstp,stepsq,pcorr\r\n\t\treal perr,avst,errvar,stvar\r\n\t\ttotcor=0\r\n\t\ttotstp=0\r\n\t\ttotsq=0\r\n\t\tstepsq=0\r\n\t\tdo it=1,nsim\r\n\t\t\tcall trser(beta,tz,sigma,xmu,d,n,m,icorr,ntime) \t\t\t\r\n\t\t\ttotcor=totcor+icorr\r\n\t\t\ttotstp=totstp+ntime\r\n\t\t\tstepsq=stepsq+ntime**2\r\n\t\tenddo\r\n\t\t\t\t\r\n\t\tpcorr=totcor\/nsim\r\n\t\tperr=1.-pcorr\r\n\t\tavst=totstp\/nsim\r\n\t\terrvar=pcorr*perr\/nsim\r\n\t \tstvar=(stepsq-avst**2\/nsim)\/float(nsim-1)\t \t \r\n\t \twrite(10,*) perr,avst,stvar\r\n\t\t\r\n\t\treturn\r\n\t\tend\r\n\t\t\r\n\t\tsubroutine trser(beta,tz,sigma,xmu,d,nel,ntarg,icorr,ntime)\r\n\t \tparameter(targb=20)\r\n\t\tparameter(nelmax=4)\r\n\t\tinteger typetr\r\n\t\tinteger nel,ntarg,icorr,ntime,ndist,iran\r\n\t\treal beta,tz,sigma,xmu,d\r\n\t\tdimension xmean(nelmax),xran(nelmax)\r\n\t\t\r\n\t\tiran=1\r\n\t\ttypetr=0\r\n\t\tntime=0\r\n\t\tndist=nel-ntarg\r\n\t\tdistb0=-d*targb\r\n\t\t\r\n\t\tdo i=1,ntarg\r\n\t\t\txmean(i)=xmu\r\n\t\tenddo\r\n\t\tdo i=1,ndist\r\n\t\t\txmean(i+ntarg)=-xmu\r\n\t\tenddo\r\n\t\tdo i=1,nel\r\n\t\t\txran(i)=ran2(iran)\r\n\t\tenddo\r\n\t\tcall sort2(nel,xran,xmean)\r\n\t\t\r\n\t\tdo iw=1,nel\r\n\t\t\tdistb1=bcalc(nel,tz,beta,ntime,distb0)\r\n\t\t\tcall walker(xmean(iw),sigma,distb1,targb,nstep,typetr)\r\n\t\t\tntime=ntime+nstep\r\n\t\t\tif(typetr .eq. 1 .or. ntime .gt. tz) go to 99\r\n\t\tenddo\r\n\t\t\r\n  99\tcontinue\r\n  \r\n  \t\tif(ntarg .gt. 0) then\t\t\t\r\n\t\t\tif(typetr .eq. 1) then\r\n\t\t\t\ticorr=1\r\n\t\t\telse\r\n\t\t\t\ticorr=0\r\n\t\t\tendif\r\n\t\t\r\n\t\telse\r\n\t\t\tif(typetr .eq. 0) then\r\n\t\t\t\ticorr=1\r\n\t\t\telse\r\n\t\t\t\ticorr=0\r\n\t\t\tendif\r\n\t\tendif\r\n\t\t\t\t\r\n\t\treturn\r\n\t\tend\r\n\t\t\r\n\t\tfunction bcalc(nel,tz,beta,ntime,distb0)\r\n\t\tif(nel .eq. 4) b1=distb0+2*beta\r\n\t\tif(nel .eq. 2) b1=distb0+beta\r\n\t\tif(nel .eq. 1) b1=distb0\r\n\t\ttimfrc=float(ntime)\/tz\r\n\t\trem=1-timfrc\r\n\t\tbcalc=b1*rem\r\n\t\treturn\r\n\t\tend\t\t\r\n\t\t\r\n\t\tsubroutine walker(xm,sig,db,tb,n,idec)\r\n\t\tiran=1\r\n\t\tw=0\r\n\t\tn=0\r\n  10\tcontinue\r\n\t\tstep=gasdev(iran)*sig+xm\r\n\t\tn=n+1\r\n  \t\tw=w+step\r\n\t\tif(w .ge. tb) then\r\n\t\t\tidec=1\r\n\t\t\treturn\r\n\t\tendif\r\n\t\tif(w .le. db) then\r\n\t\t\tidec=0\r\n\t\t\treturn\r\n\t\tendif\r\n\t\tgo to 10\r\n\t\tend\r\n\r\n       FUNCTION gasdev(idum)\r\n       INTEGER idum\r\n       REAL gasdev\r\nCU    USES ran1\r\n       INTEGER iset\r\n       REAL fac,gset,rsq,v1,v2,ran1\r\n\t   SAVE iset,gset\r\n       DATA iset\/0\/\r\n       if (iset.eq.0) then\r\n1       v1=2.*ran2(idum)-1.\r\n         v2=2.*ran2(idum)-1.\r\n         rsq=v1**2+v2**2\r\n         if(rsq.ge.1..or.rsq.eq.0.)goto 1\r\n         fac=sqrt(-2.*alog(rsq)\/rsq)\r\n         gset=v1*fac\r\n         gasdev=v2*fac\r\n         iset=1\r\n       else\r\n         gasdev=gset\r\n         iset=0\r\n       endif\r\n       return\r\n       END\r\n\t  \r\n\t  FUNCTION ran2(idum)\r\n      INTEGER idum,IM1,IM2,IMM1,IA1,IA2,IQ1,IQ2,IR1,IR2,NTAB,NDIV\r\n      REAL ran2,AM,EPS,RNMX\r\n      PARAMETER (IM1=2147483563,IM2=2147483399,AM=1.\/IM1,IMM1=IM1-1)\r\n\t  PARAMETER (IA1=40014,IA2=40692,IQ1=53668,IQ2=52774,IR1=12211)\r\n\t  PARAMETER (IR2=3791,NTAB=32,NDIV=1+IMM1\/NTAB,EPS=1.2e-7)\r\n\t  PARAMETER (RNMX=1.-EPS)\r\n      INTEGER idum2,j,k,iv(NTAB),iy\r\n      SAVE iv,iy,idum2\r\n      DATA idum2\/123456789\/, iv\/NTAB*0\/, iy\/0\/\r\n      if (idum.le.0) then\r\n        idum=max(-idum,1)\r\n        idum2=idum\r\n        do 11 j=NTAB+8,1,-1\r\n          k=idum\/IQ1\r\n          idum=IA1*(idum-k*IQ1)-k*IR1\r\n          if (idum.lt.0) idum=idum+IM1\r\n          if (j.le.NTAB) iv(j)=idum\r\n11      continue\r\n        iy=iv(1)\r\n      endif\r\n      k=idum\/IQ1\r\n      idum=IA1*(idum-k*IQ1)-k*IR1\r\n      if (idum.lt.0) idum=idum+IM1\r\n      k=idum2\/IQ2\r\n      idum2=IA2*(idum2-k*IQ2)-k*IR2\r\n      if (idum2.lt.0) idum2=idum2+IM2\r\n      j=1+iy\/NDIV\r\n      iy=iv(j)-idum2\r\n      iv(j)=idum\r\n      if(iy.lt.1)iy=iy+IMM1\r\n      ran2=min(AM*iy,RNMX)\r\n      return\r\n      END\r\n\t\t\r\n\t  SUBROUTINE sort2(n,arr,brr)\r\n      INTEGER n,M,NSTACK\r\n      REAL arr(n),brr(n),b\r\n      PARAMETER (M=7,NSTACK=50)\r\n      INTEGER i,ir,j,jstack,k,l,istack(NSTACK)\r\n      REAL a,temp\r\n      jstack=0\r\n      l=1\r\n      ir=n\r\n1     if(ir-l.lt.M)then\r\n        do 12 j=l+1,ir\r\n          a=arr(j)\r\n          b=brr(j)\r\n          do 11 i=j-1,1,-1\r\n            if(arr(i).le.a)goto 2\r\n            arr(i+1)=arr(i)\r\n            brr(i+1)=brr(i)\r\n11        continue\r\n          i=0\r\n2         arr(i+1)=a\r\n          brr(i+1)=b\r\n12      continue\r\n        if(jstack.eq.0)return\r\n        ir=istack(jstack)\r\n        l=istack(jstack-1)\r\n        jstack=jstack-2\r\n      else\r\n        k=(l+ir)\/2\r\n        temp=arr(k)\r\n        arr(k)=arr(l+1)\r\n        arr(l+1)=temp\r\n        temp=brr(k)\r\n        brr(k)=brr(l+1)\r\n        brr(l+1)=temp\r\n        if(arr(l+1).gt.arr(ir))then\r\n          temp=arr(l+1)\r\n          arr(l+1)=arr(ir)\r\n          arr(ir)=temp\r\n          temp=brr(l+1)\r\n          brr(l+1)=brr(ir)\r\n          brr(ir)=temp\r\n        endif\r\n        if(arr(l).gt.arr(ir))then\r\n          temp=arr(l)\r\n          arr(l)=arr(ir)\r\n          arr(ir)=temp\r\n          temp=brr(l)\r\n          brr(l)=brr(ir)\r\n          brr(ir)=temp\r\n        endif\r\n        if(arr(l+1).gt.arr(l))then\r\n          temp=arr(l+1)\r\n          arr(l+1)=arr(l)\r\n          arr(l)=temp\r\n          temp=brr(l+1)\r\n          brr(l+1)=brr(l)\r\n          brr(l)=temp\r\n        endif\r\n        i=l+1\r\n        j=ir\r\n        a=arr(l)\r\n        b=brr(l)\r\n3       continue\r\n          i=i+1\r\n        if(arr(i).lt.a)goto 3\r\n4       continue\r\n          j=j-1\r\n        if(arr(j).gt.a)goto 4\r\n        if(j.lt.i)goto 5\r\n        temp=arr(i)\r\n        arr(i)=arr(j)\r\n        arr(j)=temp\r\n        temp=brr(i)\r\n        brr(i)=brr(j)\r\n        brr(j)=temp\r\n        goto 3\r\n5       arr(l)=arr(j)\r\n        arr(j)=a\r\n        brr(l)=brr(j)\r\n        brr(j)=b\r\n        jstack=jstack+2\r\n        if(jstack.gt.NSTACK)pause 'NSTACK too small in sort2'\r\n        if(ir-i+1.ge.j-l)then\r\n          istack(jstack)=ir\r\n          istack(jstack-1)=i\r\n          ir=j-1\r\n        else\r\n          istack(jstack)=j-1\r\n          istack(jstack-1)=l\r\n          l=i\r\n        endif\r\n      endif\r\n      goto 1\r\n      END<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>program serial parameter(nmu=20,nsig=20,nb=10,ntz=16,nd=11) parameter (nsim=2000) integer k1,k2,k3,k4,k5,i,j,m,n real xmu,sigma,d,b,tz,beta data xmu1\/.02\/,xmu2\/.4\/ data sig1\/.2\/,sig2\/4.\/ data b1\/0.\/ data t1\/200\/,t2\/1000\/ data d1\/1.\/,d2\/2.\/ data iseed\/-9\/ open(unit=10,file=&#8217;s10&#8242;) open(unit=20,file=&#8217;S1T0s.txt&#8217;) r=ran2(iseed) read(20,*) n read(20,*) m do k1=1,nmu xmu=xmu1+(xmu2-xmu1)*(k1-1)\/float(nmu-1) do k2=1,nsig sigma=sig1+(sig2-sig1)*(k2-1)\/float(nsig-1) do k3=1,nd d=d1+(d2-d1)*(k3-1)\/float(nd-1) do k4=1,nb b2=10*d beta=b1+(b2-b1)*(k4-1)\/float(nb-1) do k5=1,ntz tz=t1+(t2-t1)*(k5-1)\/float(ntz-1) call varser(nsim,n,m,d,beta,tz,sigma,xmu) enddo enddo enddo enddo enddo end subroutine varser(nsim,n,m,d,beta,tz,sigma,xmu) integer [&hellip;]<\/p>\n","protected":false},"author":107,"featured_media":0,"parent":0,"menu_order":0,"comment_status":"closed","ping_status":"closed","template":"","meta":{"_uag_custom_page_level_css":"","footnotes":""},"class_list":["post-116","page","type-page","status-publish","hentry","entry"],"uagb_featured_image_src":{"full":false,"thumbnail":false,"medium":false,"medium_large":false,"large":false,"1536x1536":false,"2048x2048":false,"site-graphic":false},"uagb_author_info":{"display_name":"ecw255","author_link":"https:\/\/labs.la.utexas.edu\/gilden\/author\/ecw255\/"},"uagb_comment_info":0,"uagb_excerpt":"program serial parameter(nmu=20,nsig=20,nb=10,ntz=16,nd=11) parameter (nsim=2000) integer k1,k2,k3,k4,k5,i,j,m,n real xmu,sigma,d,b,tz,beta data xmu1\/.02\/,xmu2\/.4\/ data sig1\/.2\/,sig2\/4.\/ data b1\/0.\/ data t1\/200\/,t2\/1000\/ data d1\/1.\/,d2\/2.\/ data iseed\/-9\/ open(unit=10,file='s10') open(unit=20,file='S1T0s.txt') r=ran2(iseed) read(20,*) n read(20,*) m do k1=1,nmu xmu=xmu1+(xmu2-xmu1)*(k1-1)\/float(nmu-1) do k2=1,nsig sigma=sig1+(sig2-sig1)*(k2-1)\/float(nsig-1) do k3=1,nd d=d1+(d2-d1)*(k3-1)\/float(nd-1) do k4=1,nb b2=10*d beta=b1+(b2-b1)*(k4-1)\/float(nb-1) do k5=1,ntz tz=t1+(t2-t1)*(k5-1)\/float(ntz-1) call varser(nsim,n,m,d,beta,tz,sigma,xmu) enddo enddo enddo enddo enddo end subroutine varser(nsim,n,m,d,beta,tz,sigma,xmu) integer&hellip;","_links":{"self":[{"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/pages\/116","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/users\/107"}],"replies":[{"embeddable":true,"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/comments?post=116"}],"version-history":[{"count":1,"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/pages\/116\/revisions"}],"predecessor-version":[{"id":118,"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/pages\/116\/revisions\/118"}],"wp:attachment":[{"href":"https:\/\/labs.la.utexas.edu\/gilden\/wp-json\/wp\/v2\/media?parent=116"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}