C*********************************************************************
C
C     PROGRAM QVDVLOP
C
C     水平平均混合比鉛直分布作成プログラム(時間発展)
C
C     1999/06/15 小高正嗣
C     2000/11/21 小高正嗣; D 論用に書き直し
C
C*********************************************************************
      program qvdvlop
C---------------------------------------------------------------------  
      IMPLICIT REAL*8 ( A-H, O-Z )                                      
C---------------------------------------------------------------------  
#include "grid_size_M.f"
      parameter ( nzprof = 100 )                              
      parameter ( nzp = nz+1   )
C---------------------------------------------------------------------  
C
      parameter ( day = 86400.0 )
      parameter ( hour = 3600.0 )
                                                                     
      character*5  nmrun
      character*4  from
      character*1  chara
      character*1  pz
      character*2  end

      real*4 ekvis(nzp), eknlv(nzp), ekbuoy(nzp)

      real*4  dtpad0,dqvad0
      real*4  zgrid(nzp)
      real*4  tptend(nzp),tpmean(nzp),dtpadv(nzp),
     &        dtpdif(nzp),dtpdnl(nzp),
     &        dtpdi0(nzp),dtprad(nzp),tperror(nzp),
     &        dtirad(nzp),dtsrad(nzp)

      real*4  qvtend(nzp),qvmean(nzp),dqvadv(nzp),
     &        dqvdif(nzp),dqvdnl(nzp),
     &        dqvdi0(nzp),dqvnfl(nzp),qverror(nzp)

      real*8  dqvad0_d
      real*8  zgrid_d(nzp)
      real*8  qvtend_d(nzp),qvmean_d(nzp),dqvadv_d(nzp),
     &        dqvdif_d(nzp),dqvdnl_d(nzp),
     &        dqvdi0_d(nzp),dqvnfl_d(nzp),qverror_d(nzp)


      real*4 QVMAX, charset

      integer fnum
      character*2 mint
      character*2 lt
      character*2 date
      character*17 header

      character*100 dumy
      character CSGI*1
C
C=====================================================================  
      QVMAX = 1.0e-4

      open (11,file='exparam')
      read (11,*) irun
      read (11,*) time0, nloop1, nloop2, dtime, ntmoni, ntkubu,times
      read (11,*) ylat, als
      close(11)

      write(6,*) 'data number = ', nloop1
      write(0,*) 'ibegin(1-', nloop1, 
     &           ') iend(1-', nloop1,  
     &           ') inter(1-', nloop1, ')'
      read (5,*) ibegin, iend, inter

      call sgpwsn
      read(*,*) iws
      call gropn(iws)
      call sglset( 'LCORNER', .FALSE. )
      CALL sglset( 'LCHAR', .TRUE. )
      call sldiv ( 'Y', 2, 1 )

      call grfrm
      call grswnd( 0., QVMAX, 0., 20. )
      call grsvpt( 0.2, 0.8, 0.2, 0.8 )
      call grstrn(1)
      call grstrf
      call ussttl ( 'Dust Mixing Ratio', '[kg/kg]', '', 'Z[km]' )
      call usdaxs

      charset = 0.05
      iline = 1
      itype = 3

      do i = ibegin, iend, inter

         fnum = 50 + i
         open(fnum)

!********************************************************************
! * kinetic energy production & dissipation *

         read(fnum,'(a2,a15,g15.7,a6,g15.7,a4)') 
     &        chara, nmrun, t_begin, from, t_end,
     &        pz

         do iz = 1, nzp
            read(fnum,*) zgrid(iz), 
     &           ekvis(iz),
     &           eknlv(iz),
     &           ekbuoy(iz)
         end do

!********************************************************************

         read(fnum,'(a2,a15,g15.7,a8,g15.7,a4)') 
     &        chara, nmrun, t_begin, from, t_end,
     &        pz
       
         do iz = 1, nzp
            read(fnum,'(10g15.7)') zgrid(iz), 
     &           tperror(iz),
     &           tptend(iz),
     &           tpmean(iz),
     &           dtpadv(iz),
     &           dtpdif(iz),
     &           dtpdnl(iz),
     &           dtpad0,
     &           dtpdi0(iz),
     &           dtprad(iz),
     &           dtirad(iz),
     &           dtsrad(iz)
         end do

         read(fnum,'(a2,a15,g15.7,a6,g15.7,a4)') 
     &        chara, nmrun, t_begin, from, t_end,
     &        pz

         do iz = 1, nzp
            read(fnum,'(10g15.7)') zgrid_d(iz),
     &           qvtend_d(iz),
     &           qvmean_d(iz),
     &           dqvadv_d(iz),
     &           dqvdif_d(iz),
     &           dqvdnl_d(iz),
     &           dqvad0_d,
     &           dqvdi0_d(iz),
     &           dqvnfl_d(iz),
     &           qverror_d(iz)
         end do

      
         close(fnum)

!********************************************************************
C         time = time0
C         write(date,'(I2.2)') INT( time / day ) + 1
C         time = ( time - INT( time / day ) * day ) / hour 

         write(date,'(I2.2)') INT( t_end / day ) + 1

         time = ( t_end - INT( t_end / day ) * day + times ) / hour 

         if ( INT(time) .ge. 24 ) then
            time = time - 24
         end if

         write(lt, '(I2.2)') INT(time)
         write(mint, '(I2.2)') INT( MOD(time,1)*60.0 )

         header = 'day=' // date // ' ' // 'LT=' // lt // ':' // mint
!********************************************************************

         do iz = 1, nzp
            qvmean(iz) = REAL(qvmean_d(iz))
         end do

         do iz = 1, nzp
            zgrid(iz) = zgrid(iz) / 1000.
         end do

         CALL sgrset( 'FFCT', 0.001 )
C         CALL sgrset( 'FFCT', charset )
C         CALL sgsplc( lt )
C         CALL sgsplc( date )
         
         if ( i .ge. 6 ) then 
            itype = 1
            iline = 1
         end if

         if ( iline .eq. 5 ) then
            call bitpci ( '1111111100100100', iline )
         end if

         call uulinz(nzp, qvmean, zgrid, iline ,itype)
C         call uulinz(nzp, qvmean, zgrid, 1 ,3)

         charset = charset - 0.007
         iline = iline + 1
      end do

C      header='day=04-' // date
C      header='day=' // date
      call uxsttl ( 'T', header, 1. )

!===========================================================================

      write(6,*) 'data number = ', nloop1
      write(0,*) 'ibegin(1-', nloop1, 
     &           ') iend(1-', nloop1,  
     &           ') inter(1-', nloop1, ')'
      read (5,*) ibegin, iend, inter

      call grfrm
      call grswnd( 0., QVMAX, 0., 20. )
      call grsvpt( 0.2, 0.8, 0.2, 0.8 )
      call grstrn(1)
      call grstrf
      call ussttl ( 'Dust Mixing Ratio', '[kg/kg]', '', 'Z[km]' )
      call usdaxs

      charset = 0.05
      iline = 1
      itype = 3

      do i = ibegin, iend, inter

         fnum = 70 + i
         open(fnum)

!********************************************************************
! * kinetic energy production & dissipation *

      read(fnum,'(a2,a15,g15.7,a6,g15.7,a4)') 
     &     chara, nmrun, t_begin, from, t_end,
     &     pz

      do iz = 1, nzp
         read(fnum,*) zgrid(iz), 
     &           ekvis(iz),
     &           eknlv(iz),
     &           ekbuoy(iz)
         end do

!********************************************************************

         read(fnum,'(a2,a15,g15.7,a8,g15.7,a4)') 
     &        chara, nmrun, t_begin, from, t_end,
     &        pz
       
         do iz = 1, nzp
            read(fnum,'(10g15.7)') zgrid(iz), 
     &           tperror(iz),
     &           tptend(iz),
     &           tpmean(iz),
     &           dtpadv(iz),
     &           dtpdif(iz),
     &           dtpdnl(iz),
     &           dtpad0,
     &           dtpdi0(iz),
     &           dtprad(iz),
     &           dtirad(iz),
     &           dtsrad(iz)
         end do
         read(fnum,'(a2,a15,g15.7,a6,g15.7,a4)') 
     &        chara, nmrun, t_begin, from, t_end,
     &        pz

         do iz = 1, nzp
            read(fnum,'(10g15.7)') zgrid_d(iz),
     &           qvtend_d(iz),
     &           qvmean_d(iz),
     &           dqvadv_d(iz),
     &           dqvdif_d(iz),
     &           dqvdnl_d(iz),
     &           dqvad0_d,
     &           dqvdi0_d(iz),
     &           dqvnfl_d(iz),
     &           qverror_d(iz)
         end do

      
         close(fnum)

!********************************************************************
C         time = time0
C         write(date,'(I2.2)') INT( time / day ) + 1
C         time = ( time - INT( time / day ) * day ) / hour 

         write(date,'(I2.2)') INT( t_end / day ) + 1

         time = ( t_end - INT( t_end / day ) * day + times ) / hour 

         if ( INT(time) .ge. 24 ) then
            time = time - 24
         end if

         write(lt, '(I2.2)') INT(time)
         write(mint, '(I2.2)') INT( MOD(time,1)*60.0 )

         header = 'day=' // date // ' ' // 'LT=' // lt // ':' // mint
!********************************************************************

         do iz = 1, nzp
            qvmean(iz) = REAL(qvmean_d(iz))
         end do

         do iz = 1, nzp
            zgrid(iz) = zgrid(iz) / 1000.
         end do

         CALL sgrset( 'FFCT', 0.001 )
C         CALL sgrset( 'FFCT', charset )
C         CALL sgsplc( lt )
C         CALL sgsplc( date )

         if ( iline .eq. 5 ) then
            call bitpci ( '1111111100100100', iline )
         else if ( iline .ge. 6 ) then
            iline = 1
            itype = 1
         end if

         call uulinz(nzp, qvmean, zgrid, iline ,itype)
C         call uulinz(nzp, qvmean, zgrid, 1 ,3)

         charset = charset - 0.007
         iline = iline + 1
      end do

      header='day=06-' // date
C      header='day=' // date
      call uxsttl ( 'T', header, 1. )

!===========================================================================

      call grcls


      end

