c 乾燥断熱線を引くためのデータを作るプログラム
c 2000/10/12
c 2000/11/02 等値線上数値出力追加
c 2000/12/27 上の改良
c by A.Tsubota

c Variable

      real*8 th,po,p,r,cp,minth,midth,maxth,minp,maxp,ii,jj,pw,maxt,pp
      real*8 mmidth,mmidth2,texst,texst1,texst2,texst3,texst4,texst5
      integer stepth,stepth1,stepth2,stepp,thdata,pdata,f
      parameter(po=1000.,r=287.,cp=1004.,minth=240.)
      parameter(midth=300.,maxth=410.,minp=10.,maxp=1050.)
      parameter(stepth1=5.,stepth2=10.,stepp=10.,maxt=60.)
      parameter(thdata=(midth-minth)/stepth1+1+(maxth-midth)/stepth2)
      parameter(pdata=(maxp-minp)/stepp+1,texst1=30,texst2=20)
      parameter(texst3=40,texst4=30,texst5=20.,mmidth=265.,mmidth2=330.)
      parameter(mmidth3=370.)
      dimension theta(pdata,thdata)

c Theta Calculation & Output

      open(10,file='drylapse.dat')
      open(20,file='drytext.dat')

      stepth=stepth1
      th=minth-stepth
      pp=1020.
      texst=texst1
      if(minth-int(minth/10)*10.ne.0) then
	f=1
	else
	  f=0
      endif

      do j=1,thdata

         write(10,50)
 50      format('>')
         th=th+stepth

         do i=1,pdata
            ii=i
            p=(ii-1)*stepp+minp
            theta(i,j)=th/((po/p)**(r/cp))-273.15
            write(10,100)theta(i,j),p
 100        format(f8.2,f8.2)

            if(f.ne.1.and.p.eq.pp) then
               write(20,110)theta(i,j),p,8,0,0,'RB',int(th)
 110           format(f8.2,f8.2,i8,i8,i8,A8,i8)
               if(th.eq.mmidth) then
                  texst=texst2
	       end if
               if(th.eq.midth) then
	          texst=texst3
               end if
               if(th.eq.mmidth2) then
                  texst=texst4
               end if
	       if(th.eq.mmidth3) then
		  texst=texst5
	       end if
               pp=pp-texst
            endif
         enddo

         if(th.eq.midth) then
            stepth=stepth2
	    f=10
         end if
	 if(f.eq.1) then
	    f=f-1
	    else
	      f=f+1
	 end if
      enddo

      close(10)
      close(20)

      end




