Subversion Repositories lagranto.ecmwf

Rev

Rev 3 | Rev 13 | Go to most recent revision | Show entire file | Regard 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
667
806 
 
- 
 
 807 
 
- 
 
 808 
 
- 
 
 809 
 
- 
 
 810