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