NCCOOS Trac Projects: Top | Web | Platforms | Processing | Viz | Sprints | Sandbox | (Wind)

root/gliderproc/trunk/MATLAB/opnml/FCAST_1.2/matlab_cen/sortv.f

Revision 495 (checked in by cbc, 11 years ago)

Initial import of Stark code.

Line 
1 c
2       program sortv
3 c
4       parameter(nndim=5000,nkdim=100)
5       real c(nndim,4),x(nndim,nkdim),y(nndim,nkdim),cv,cs(2,nndim)
6       integer ikeep(nndim),jpk(nndim),jmk(nndim),inot(nndim)
7 c
8       open(10,file='c.dat')
9       do i=1,nndim
10       read(10,*,end=100)(c(i,j),j=1,4)
11       ikeep(i)=0
12       enddo
13  100      ndim=i-1
14       open(30,file='cv.dat')
15       read(30,*)cv
16       open(20,file='cxy.dat')
17 c
18       ns=1
19       do k=1,nkdim
20 c start with maximum y
21       cymax=-1.0e06
22       do l=1,ndim
23         do ill=1,ndim
24           if(ikeep(ill).eq.l)goto 80
25         enddo
26         if(c(l,2).gt.cymax)then
27           cymax=c(l,2)
28           lmax=l
29           jp=2
30           jm=4
31         endif
32         if(c(l,4).gt.cymax)then
33           cymax=c(l,4)
34           lmax=l
35           jp=4
36           jm=2
37         endif
38  80      enddo
39 c
40 c set first point
41       x(1,k)=c(lmax,jp-1)
42       y(1,k)=c(lmax,jp)
43       x(2,k)=c(lmax,jm-1)
44       y(2,k)=c(lmax,jm)     
45       il=il+1
46       ikeep(il)=lmax
47       jpk(il)=jp-1
48       jmk(il)=jm-1
49 c
50 c
51       xc=x(2,k)
52       yc=y(2,k)
53       do l=3,2*ndim-1,2
54         do i=1,ndim
55           do ill=1,ndim
56             if(ikeep(ill).eq.i)goto 110
57           enddo
58           if(xc.eq.c(i,1).and.yc.eq.c(i,2))then
59             il=il+1
60             ikeep(il)=i
61             jpk(il)=1
62             jmk(il)=3
63             xc=c(i,3)
64             yc=c(i,4)
65             goto 115
66           elseif(xc.eq.c(i,3).and.yc.eq.c(i,4))then
67             il=il+1
68             ikeep(il)=i
69             jpk(il)=3
70             jmk(il)=1
71             xc=c(i,1)
72             yc=c(i,2)
73             goto 115
74           endif
75  110      enddo
76  115      enddo
77       nl=il
78 c
79 c
80       write(20,*)il,k,cv,2*(nl-ns)+2
81       do i=2*ns-1,2*nl-1,2
82         ik=ik+1
83        ii=ikeep(ik)
84        x(i,k)=c(ii,jpk(ik))
85        y(i,k)=c(ii,jpk(ik)+1)
86        x(i+1,k)=c(ii,jmk(ik))
87        y(i+1,k)=c(ii,jmk(ik)+1)
88        write(20,*)i,k,x(i,k),y(i,k)
89        write(20,*)i+1,k,x(i+1,k),y(i+1,k)
90       enddo
91       ns=nl+1
92       if(nl.ge.ndim)goto 200
93       enddo
94 c
95 c
96  200      stop
97       end
Note: See TracBrowser for help on using the browser.