C********************************************************************* C C PROGRAM xzcont_w C C x-z平面等値線図作成プログラム(ダストの増加率) C C 履歴 1997/07/24 中島健介 C 2000/11/02 小高正嗣 C C********************************************************************* program xzcont_w *----------------------------------------------------- implicit real*8 ( a-h, o-z ) *----------------------------------------------------- real cdp ! カラートーン刻み real tlev1,tlev2 ! カラーレベル integer ipat ! トーン番号 integer cmax parameter ( cmax = 56 ) real wmax, wmin C parameter ( wmax = 5., wmin = -5. ) parameter ( wmax = 25., wmin = -25. ) real*4 pti(2,cmax+1) *----------------------------------------------------- #include "grid_size_M.f" parameter ( nbr3 = 3*((nx+6)*(nz+6)/16+1) ) parameter ( nxp = 256, nzp= 102) *----------------------------------------------------- integer ibr(nbr3) *----------------------------------------------------- parameter ( day = 86400.0 ) parameter ( hour = 3600.0 ) parameter ( PI = 3.141592D0 ) 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*8 \ FDZ ( -2:nzb ), FDZM( -2:nzb ) real*8 \ u ( -2:nxb, -2:nzb ), \ w ( -2:nxb, -2:nzb ), \ qvap ( -2:nxb, -2:nzb ) real*4 \ z0p ( 0:nz ), p0p ( 0:nz ), d0p ( 0:nz ), \ temp0p ( 0:nz ), tpot0p ( 0:nz ), pai0p ( 0:nz ), \ rvap0p ( 0:nz ), qvap0p ( 0:nz ) real*4 \ up ( nx+1,nz+1 ), \ wp ( nx+1,nz+1 ), \ qvapp ( nx+1,nz+1 ) character*2 mint character*2 lt character*2 date character*17 header character*100 dumy character CSGI*1 *----------------------------------------------------- open (11,file='exparam') read (11,*) irun read (11,*) time0, nloop1, nloop2, dtime, ntmoni, ntkubu, times read (11,*) ylat, als call SETGRD O ( ZGRID, FDZ, FDZM, DX, D NZ, NZB ) 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 do iz = 0, nz z0p(iz) = zgrid(iz) / 1000.0 p0p(iz) = pres0(iz) d0p(iz) = dens0(iz) temp0p(iz)= temp0(iz) tpot0p(iz)= tpot0(iz) pai0p(iz) = ppai0(iz) rvap0p(iz)= rvap0(iz) qvap0p(iz)= qvap0(iz) end do write(6,*) 'data number = ', nloop1 write(6,*) 'INPUT DATA BEGINING, END, & INTERVAL' write(6,*) 'itb ite interval ?' read (*,*) itb, ite, interv call sgpwsn read(*,*) iws CALL SWISET('IWIDTH', 640) CALL SWISET('IHEIGHT', 300) C call swlset( 'LDUMP', .TRUE. ) C call swlset( 'LWAIT', .FALSE. ) call gropn(iws) C call sldiv( 'T', 2, 6 ) call swlset( 'LALT', .TRUE. ) call sglset( 'LFULL', .TRUE. ) call sglset( 'LCORNER', .FALSE. ) call udlset( 'LMSG', .FALSE. ) call uzfact(0.6) * c------------------------------------------------------------- c cdp = (wmax - wmin)/cmax c do i = 1,cmax c TLEV2 = wmin + i*cdp c TLEV1 = TLEV2 - cdp c ipat = (30+(i-1))*1000 + 999 c call uestlv(TLEV1, TLEV2, IPAT) c end do c------------------------------------------------------------- ipat = (30)*1000 + 999 TLEV2 = wmin TLEV1 = -50.0 call uestlv(TLEV1, TLEV2, IPAT) cdp = (wmax - wmin)/(cmax-2) do i = 1,cmax-2 TLEV2 = wmin + i*cdp TLEV1 = TLEV2 - cdp ipat = (30+i)*1000 + 999 call uestlv(TLEV1, TLEV2, IPAT) end do TLEV2 = 50.0 TLEV1 = wmax ipat = (86)*1000 + 999 call uestlv(TLEV1, TLEV2, IPAT) do k=1, cmax+1 pti(1,k) = wmin + (k-1)*cdp pti(2,k) = wmin + (k-1)*cdp end do do it = 1, ite read(31) time, ((u(ix,iz),ix=-2,nxb), iz=-2,nzb) read(33) time, ((w(ix,iz),ix=-2,nxb), iz=-2,nzb) read(35) time, ((qvap(ix,iz),ix=-2,nxb), iz=-2,nzb) write(0,*) 'reading time = ', time if ( it .ge. itb .and. it .le. ite ) then if ( mod( (it-itb), interv ) .eq. 0 ) then write(0,*) 'writing time = ', time c*** 時刻変換: 秒から LT へ************************************ time = time + times write(date,'(I2.2)') INT( time / day ) + 1 time = ( time - INT( time / day ) * day ) / 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 c************************************************************** c** 2-grid noize の除去 *************************************** do iz = 1,nz+1 do ix = 1, nx+1 up(ix,iz) = u(ix-1,iz) wp(ix,iz) = ( w(ix-2,iz) + \ 2.0*w(ix-1,iz) + w(ix,iz))/4.0 end do end do c************************************************************** call grfrm C call grswnd ( 0.0, 51.2, 10.0, 20.0 ) call grswnd ( 0.0, 51.2, 0.0, 20.0 ) call grsvpt ( 0.1, 0.9, 0.1, 0.42 ) C call grsvpt ( 0.15, 0.95, 0.1, 0.42 ) call grstrn (1) call uspfit call grstrf call udpset ( 'rsizet', 0.01 ) call udpset ( 'ICYCLE', 5 ) call uwsgya ( z0p, nz+1 ) call ussttl ( 'W[m/sec]', 'X[km]', '', 'Z[km]' ) call uetonf ( wp, nx+1, nx+1, nz+1 ) call usdaxs call uxsttl ( 'T', header, 1. ) C call udgcla ( -1.e-7, 1.e-7, 1.e-8 ) C call udcntz ( dqdt, nx+1, nx+1, 103, ibr, nbr3) call udgcla ( -50.0, 50.0, 5.0 ) call udcntz ( wp, nx+1, nx+1, nz+1, ibr, nbr3) C********************************************************************* C トーンバー C********************************************************************* call grfig call uwsgyz( .FALSE. ) call grswnd( 0.0, 1.0, wmin, wmax ) call grsvpt( 0.95, 0.98, 0.1, 0.42 ) call grstrn( 1 ) call grstrf call uetone( pti, 2, 2, cmax+1 ) call slpvpr( 3 ) call uyaxdv( 'L', 2.0, 10.0 ) end if end if end do call grcls call FCLOSE end