Subversion Repositories lagranto.ecmwf

Rev

Rev 3 | Rev 15 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3 Rev 5
Line 53... Line 53...
53
         open(fid,file=filename)
53
         open(fid,file=filename)
54
      elseif (mode.eq.3) then
54
      elseif (mode.eq.3) then
55
         open(fid,file=filename,form='unformatted')
55
         open(fid,file=filename,form='unformatted')
56
      elseif (mode.eq.4) then
56
      elseif (mode.eq.4) then
57
         call cdfopn(filename,fid,ierr)
57
         call cdfopn(filename,fid,ierr)
-
 
58
      elseif (mode.eq.5) then
-
 
59
         print*,' ERROR: Reading KML not supported'
-
 
60
         stop
58
      endif
61
      endif
59
 
62
 
60
c     Read header information
63
c     Read header information
61
      call read_hea(fid,time,vars,ntra,ntim,ncol,mode)
64
      call read_hea(fid,time,vars,ntra,ntim,ncol,mode)
62
 
65
 
Line 104... Line 107...
104
         vardim(3)=1
107
         vardim(3)=1
105
         vardim(4)=1
108
         vardim(4)=1
106
         cfn      =trim(filename)//'_cst'
109
         cfn      =trim(filename)//'_cst'
107
         mdv      =-999.98999
110
         mdv      =-999.98999
108
         call crecdf(filename,fid,varmin,varmax,3,cfn,ierr)
111
         call crecdf(filename,fid,varmin,varmax,3,cfn,ierr)
-
 
112
      elseif (mode.eq.5) then
-
 
113
         fid = 10
-
 
114
         open(fid,file=filename)
109
      endif
115
      endif
110
 
116
 
111
c     Write header information
117
c     Write header information
112
      call write_hea(fid,time,vars,ntra,ntim,ncol,mode)
118
      call write_hea(fid,time,vars,ntra,ntim,ncol,mode)
113
 
119
 
Line 216... Line 222...
216
      real         arr(ntra)
222
      real         arr(ntra)
217
      integer      ierr
223
      integer      ierr
218
      real         time
224
      real         time
219
      character*80 vars(ncol+2)
225
      character*80 vars(ncol+2)
220
      integer      nvars
226
      integer      nvars
-
 
227
      character*20 lonstr,latstr,levstr
-
 
228
      character*80 outstr
-
 
229
      real         ref_z(3000),ref_p(3000),ref_t(3000)
-
 
230
      real         lev
-
 
231
      character*80 path
221
 
232
 
222
c     Write ascii mode, sorted by trajectory (mode=1)
233
c     Write ascii mode, sorted by trajectory (mode=1)
223
      if (mode.eq.1) then
234
      if (mode.eq.1) then
224
         do n=1,ntra
235
         do n=1,ntra
225
            write(fid,*)
236
            write(fid,*)
Line 275... Line 286...
275
                  arr(n)=tra(n,i,j)
286
                  arr(n)=tra(n,i,j)
276
               enddo
287
               enddo
277
               call putdat(fid,vars(j),time,0,arr,ierr)
288
               call putdat(fid,vars(j),time,0,arr,ierr)
278
            enddo
289
            enddo
279
         enddo
290
         enddo
-
 
291
 
-
 
292
c     Write KML mode (mode=5)
-
 
293
      elseif (mode.eq.5) then
-
 
294
 
-
 
295
         call getenv('DYN_TOOLS',path)
-
 
296
         path = trim(path)//'/lagranto.ecmwf/goodies/'
-
 
297
 
-
 
298
         open(fid+1,file=trim(path)//'reformat.refprof')
-
 
299
           
-
 
300
           do n=1,6
-
 
301
              read(fid+1,*)
-
 
302
           enddo
-
 
303
           do n=1,3000
-
 
304
              read(fid+1,*)  ref_z(n),ref_t(n),ref_p(n)
-
 
305
              ref_p(n) = 0.01 * ref_p(n)
-
 
306
           enddo
-
 
307
 
-
 
308
         close(fid+1)
-
 
309
 
-
 
310
         do n=1,ntra
-
 
311
           write(fid,"(A)") '<Placemark>'
-
 
312
           write(fid,"(A)") '<name>Absolute Extruded</name>'
-
 
313
           write(fid,"(A)") '<styleUrl>#yellowkLineGreenPoly</styleUrl>'
-
 
314
           write(fid,"(A)") '<LineString>'
-
 
315
           write(fid,"(A)") '<extrude>1</extrude>'
-
 
316
           write(fid,"(A)") '<tessellate>1</tessellate>'
-
 
317
           write(fid,"(A)") '<altitudeMode>absolute</altitudeMode>'
-
 
318
           write(fid,"(A)") '<coordinates>'
-
 
319
 
-
 
320
           do i=1,ntim
-
 
321
             write(lonstr,*) tra(n,i,2)
-
 
322
             write(latstr,*) tra(n,i,3)
-
 
323
             
-
 
324
             call binary(lev,tra(n,i,4),ref_z,ref_p)
-
 
325
             write(levstr,*) lev
-
 
326
 
-
 
327
             outstr = trim(adjustl(lonstr))//','//
-
 
328
     >                trim(adjustl(latstr))//','//
-
 
329
     >                trim(adjustl(levstr))
-
 
330
 
-
 
331
             write(fid,"(A)") outstr
-
 
332
 
-
 
333
           enddo
-
 
334
 
-
 
335
           write(fid,*) '</coordinates>'
-
 
336
           write(fid,*) '</LineString>'
-
 
337
           write(fid,*) '</Placemark>'
-
 
338
         enddo
-
 
339
 
280
      endif
340
      endif
281
 
341
 
282
      end
342
      end
283
 
343
 
284
 
344
 
Line 477... Line 537...
477
         do i=1,6
537
         do i=1,6
478
            rtime(i)=real(time(i))
538
            rtime(i)=real(time(i))
479
         enddo
539
         enddo
480
         call putdat(fid,varname,0.,0,rtime,ierr)
540
         call putdat(fid,varname,0.,0,rtime,ierr)
481
 
541
 
-
 
542
c     Write KML format (mode=5)
-
 
543
      elseif (mode.eq.5) then
-
 
544
 
-
 
545
      write(fid,"(A)") '<?xml version="1.0" encoding="UTF-8"?>'
-
 
546
      write(fid,"(A)") '<kml xmlns="http://www.opengis.net/kml/2.2">'
-
 
547
      write(fid,"(A)") '<Document>'
-
 
548
      write(fid,"(A)") '<name>Paths</name>'
-
 
549
      write(fid,"(A)") '<Style id="yellowLineGreenPoly">'
-
 
550
      write(fid,"(A)") '<LineStyle>'
-
 
551
c      write(fid,*) '<color>7f00ffff</color>'    ! Yellow
-
 
552
      write(fid,"(A)") '<color>500A0A0A</color>'     ! Black
-
 
553
      write(fid,"(A)") '<width>4</width>'
-
 
554
      write(fid,"(A)") '</LineStyle>'
-
 
555
      write(fid,"(A)") '<PolyStyle>'
-
 
556
      write(fid,"(A)") '<color>7f00ff00</color>'
-
 
557
      write(fid,"(A)") '</PolyStyle>'
-
 
558
      write(fid,"(A)") '</Style>'
-
 
559
 
482
      endif
560
      endif
483
 
561
 
484
      end
562
      end
485
      
563
      
486
      
564
      
Line 500... Line 578...
500
      integer      ierr
578
      integer      ierr
501
 
579
 
502
c     Close file
580
c     Close file
503
      if (mode.eq.1) then
581
      if (mode.eq.1) then
504
         close(abs(fid))
582
         close(abs(fid))
-
 
583
 
505
      elseif (mode.eq.2) then
584
      elseif (mode.eq.2) then
506
         close(abs(fid))
585
         close(abs(fid))
-
 
586
 
507
      elseif (mode.eq.3) then
587
      elseif (mode.eq.3) then
508
         close(fid)
588
         close(fid)
-
 
589
 
509
      elseif (mode.eq.4) then
590
      elseif (mode.eq.4) then
510
         call clscdf(fid,ierr)
591
         call clscdf(fid,ierr)
-
 
592
 
-
 
593
      elseif (mode.eq.5) then
-
 
594
          write(fid,"(A)") '</Document>'
-
 
595
          write(fid,"(A)") '</kml>'
-
 
596
         close(abs(fid))
511
      endif
597
      endif
512
 
598
 
513
      end
599
      end
514
      
600
      
515
 
601
 
Line 525... Line 611...
525
      integer        mode
611
      integer        mode
526
      character*80   filename
612
      character*80   filename
527
 
613
 
528
c     Auxiliary variables
614
c     Auxiliary variables
529
      integer        len
615
      integer        len
530
      character      char0,char1
616
      character      char0,char1,char2,char3,char4
531
 
617
 
532
c     Get mode
618
c     Get mode
533
      mode=-1
619
      mode=-1
534
      
620
      
535
      len  = len_trim(filename)
621
      len  = len_trim(filename)
536
 
622
 
-
 
623
c     Mode specified by number
537
      char0 = filename((len-1):(len-1))
624
      char0 = filename((len-1):(len-1))
538
      char1 = filename(len:len)
625
      char1 = filename(len:len)
539
 
626
 
540
      if ( (char0.eq.'.').and.(char1.eq.'1') ) mode=1
627
      if ( (char0.eq.'.').and.(char1.eq.'1') ) mode=1
541
      if ( (char0.eq.'.').and.(char1.eq.'2') ) mode=2
628
      if ( (char0.eq.'.').and.(char1.eq.'2') ) mode=2
542
      if ( (char0.eq.'.').and.(char1.eq.'3') ) mode=3
629
      if ( (char0.eq.'.').and.(char1.eq.'3') ) mode=3
543
      if ( (char0.eq.'.').and.(char1.eq.'4') ) mode=4
630
      if ( (char0.eq.'.').and.(char1.eq.'4') ) mode=4
-
 
631
      if ( (char0.eq.'.').and.(char1.eq.'5') ) mode=5
-
 
632
 
-
 
633
      if ( mode.gt.0 ) return
-
 
634
 
-
 
635
c     Mode specified by appendix
-
 
636
      char0 = filename((len-3):(len-3))
-
 
637
      char1 = filename((len-2):(len-2))
-
 
638
      char2 = filename((len-1):(len-1))
-
 
639
      char3 = filename(len:len)
-
 
640
      if ( (char1.eq.'.').and.(char2.eq.'l').and.(char3.eq.'s') ) mode=1
-
 
641
      if ( (char1.eq.'.').and.(char2.eq.'t').and.(char3.eq.'i') ) mode=2
-
 
642
      if ( (char1.eq.'.').and.(char2.eq.'d').and.(char3.eq.'u') ) mode=3
-
 
643
      if ( (char1.eq.'.').and.(char2.eq.'n').and.(char3.eq.'c') ) mode=4
-
 
644
 
-
 
645
      if ( (char0.eq.'.').and.(char1.eq.'k').and.
-
 
646
     >                        (char2.eq.'m').and.
-
 
647
     >                        (char3.eq.'l') ) mode = 5
544
 
648
 
545
      end
649
      end
546
 
650
 
547
 
651
 
548
c     ----------------------------------------------------------------
652
c     ----------------------------------------------------------------
Line 660... Line 764...
660
         close(fid)
764
         close(fid)
661
      elseif (mode.eq.4) then
765
      elseif (mode.eq.4) then
662
         call clscdf(fid,ierr)
766
         call clscdf(fid,ierr)
663
      endif
767
      endif
664
 
768
 
-
 
769
      end
-
 
770
     
-
 
771
 
-
 
772
c     ----------------------------------------------------------------
-
 
773
c     Binary search algorithm
-
 
774
c     ----------------------------------------------------------------
-
 
775
 
-
 
776
      subroutine binary (z,p,ref_z,ref_p)
-
 
777
 
-
 
778
      implicit none
-
 
779
 
-
 
780
c     Declaration of subroutine parameters
-
 
781
      real   z
-
 
782
      real   p
-
 
783
      real   ref_z(3000)
-
 
784
      real   ref_p(3000)
-
 
785
 
-
 
786
c     Auxiliary variables
-
 
787
      integer i0,i1,im
-
 
788
 
-
 
789
c     Binary search
-
 
790
      i0 = 1
-
 
791
      i1 = 3000
-
 
792
 100  continue
-
 
793
        im = (i0 + i1) / 2
-
 
794
        if ( p.lt.ref_p(im) ) then
-
 
795
           i0 = im
-
 
796
        else 
-
 
797
           i1 = im
-
 
798
        endif
-
 
799
      if ( (i1-i0).gt.1 ) goto 100
-
 
800
 
-
 
801
c     Linear interpolation in between
-
 
802
      z = ref_z(i0) + ( p - ref_p(i0) ) / ( ref_p(i1) - ref_p(i0) ) *
-
 
803
     >                ( ref_z(i1) - ref_z(i0) ) 
665
 
804
 
666
      end
805
      end
-
 
806
 
-
 
807
 
-
 
808
 
-
 
809
 
667
      
810