C********************************************************************* C C PROGRAM PTDVLOP C C 水平平均温度・温位鉛直分布作成プログラム(時間発展) C C 1999/06/15 小高正嗣 C 2000/11/21 小高正嗣; D 論用に書き直し C C********************************************************************* program ptdvlop 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 ) integer fnum character*5 nmrun character*4 from character*1 chara character*1 pz character*2 end real*8 \ zgrid ( -2:nzb ), temp0 ( -2:nzb ), tpot0 ( -2:nzb ), \ dens0 ( -2:nzb ), ppai0 ( -2:nzb ), pres0 ( -2:nzb ), \ rvap0 ( -2:nzb ), qvap0 ( -2:nzb ) real*4 ekvis(nzp), eknlv(nzp), ekbuoy(nzp) real*4 dtpad0,dqvad0 real*4 tptend(nzp),tpmean(nzp),dtpadv(nzp), & dtpdif(nzp),dtpdnl(nzp), & dtpdi0(nzp),dtprad(nzp),tperror(nzp), & dtirad(nzp),dtsrad(nzp) real*4 tmean(nzp), zgridp(nzp) character*2 mint character*2 lt character*2 date character*17 header character*100 dumy character CSGI*1 C C===================================================================== open (11,file='exparam') read (11,*) irun read (11,*) time0, nloop1, nloop2, dtime, ntmoni, ntkubu, times read (11,*) ylat, als close(11) tinterv = nloop2 * ( dtime / 2. ) call FOPEN ( irun+1 ) do iz = 1,9 read(16,'(a100)') dumy end do do iz = -2, nzb read(16,*) ii, zgrid(iz), pres0(iz), dens0(iz), temp0(iz), \ tpot0(iz), ppai0(iz), qvap0(iz), rvap0(iz) end do call FCLOSE ( irun+1 ) 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 C CALL SWISET('IWIDTH', 720) C CALL SWISET('IHEIGHT', 360) CALL SWISET('IWIDTH', 840) CALL SWISET('IHEIGHT', 420) call sglset( 'LFULL', .TRUE. ) call swlset( 'LDUMP', .TRUE. ) call gropn(iws) call sglset( 'LCORNER', .FALSE. ) call sldiv( 'Y', 2, 1 ) CALL sglset( 'LCHAR', .TRUE. ) call grfrm call grswnd( 160., 260., 0., 20. ) call grsvpt( 0.2, 0.8, 0.2, 0.8 ) call grstrn(1) call grstrf call ussttl( 'Temperature', 'K', '', 'Z[km]' ) call usdaxs iline = 1 li = 43 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,a6,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 close(fnum) !******************************************************************** write(date, '(I2.2)') INT( time0 / day + 1 ) if ( t_begin .eq. 0.0 ) then t_begin = t_end - tinterv end if t_begin = t_begin + times t_end = t_end + times t_begin = ( t_begin - INT( t_begin / day ) * day ) / hour t_end = ( t_end - INT( t_end / day ) * day ) / hour if ( INT(t_begin) .ge. 24 ) then t_begin = t_begin - 24 end if if ( INT(t_end) .ge. 24 ) then t_end = t_end - 24 end if write(lt, '(I2.2)') INT(t_end) write(mint, '(I2.2)') INT( MOD(t_end,1)*60.0 ) header = 'day=' // date // ' ' // 'LT=' // lt // ':' // mint !******************************************************************** do iz = 1, nzp zgridp(iz) = zgrid(iz) / 1000. end do do iz = 1, NZP tmean(iz) = tpmean(iz) * ppai0(iz-1) end do CALL sgrset( 'FFCT', 0.8 ) CALL sgsplc( lt ) call SGSPLI( li ) call sgplu(nzp, tmean, zgridp) iline = iline +1 li = li - 10 end do header='day=' // date C header='day=' // date // '-07' call uxsttl ( 'T', header, 1. ) CALL sglset( 'LCHAR', .FALSE. ) call grfrm call grswnd( 190., 290., 0., 20. ) call grsvpt( 0.2, 0.8, 0.2, 0.8 ) call grstrn(1) call grstrf call ussttl( CSGI(135), 'K', '', 'Z[km]' ) call usdaxs CALL sglset( 'LCHAR', .TRUE. ) iline = 1 li = 43 do i = ibegin, iend, inter type = type + 0.1 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,a6,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 !******************************************************************** write(date, '(I2.2)') INT( time0 / day + 1 ) if ( t_begin .eq. 0.0 ) then t_begin = t_end - tinterv end if t_begin = t_begin + times t_end = t_end + times t_begin = ( t_begin - INT( t_begin / day ) * day ) / hour t_end = ( t_end - INT( t_end / day ) * day ) / hour if ( INT(t_begin) .ge. 24 ) then t_begin = t_begin - 24 end if if ( INT(t_end) .ge. 24 ) then t_end = t_end - 24 end if write(lt, '(I2.2)') INT(t_end) write(mint, '(I2.2)') INT( MOD(t_end,1)*60.0 ) header = 'day=' // date // ' ' // 'LT=' // lt // ':' // mint !******************************************************************** do iz = 1, nzp zgridp(iz) = zgrid(iz) / 1000. end do C CALL sgrset( 'FFCT', 0.6 ) CALL sgrset( 'FFCT', 0.8 ) CALL sgsplc( lt ) C call uulinz(nzp, tpmean, zgridp, 1, 3) C call uulinz(nzp, tpmean, zgridp, iline, 3) call SGSPLI( li ) call sgplu(nzp, tpmean, zgridp) iline = iline + 1 li = li - 10 close(fnum) end do header='day=' // date C header='day=' // date // '-07' call uxsttl ( 'T', header, 1. ) call grcls end