[Dart-dev] DART/branches Revision: 11944

[dart at ucar.edu]

mizzi at ucar.edu
2017-09-20 14:58:57 -0600 (Wed, 20 Sep 2017)
27
Add the Stack/Heap changes



Added: DART/branches/mizzi/models/wrf_chem/run_scripts/RUN_CHINA_EPA/ascii_to_stream.f90
===================================================================
--- DART/branches/mizzi/models/wrf_chem/run_scripts/RUN_CHINA_EPA/ascii_to_stream.f90	                        (rev 0)
+++ DART/branches/mizzi/models/wrf_chem/run_scripts/RUN_CHINA_EPA/ascii_to_stream.f90	2017-09-20 20:58:57 UTC (rev 11944)
@@ -0,0 +1,205 @@
+subroutine write_one_obs(fileid,value,sp,lat,lon,time,sitenum)
+    implicit none
+    integer::fileid,sp,sitenum
+    real(kind=4)::value,lat,lon
+    character(len=25) time
+    real,parameter::space=100.
+    integer,parameter::sp2type(6)=(/150,151,152,153,154,155/)
+    real,parameter::speobsvar(6)=(/1.,1.,1.,0.1,1.,1./)
+    real,parameter::splife(6)=(/1.,2.,0.5,0.5,0.5,0.5/)
+    !real,parameter::spevar(6)=(/36.,121.,12.25,0.0506,12.25,12.25/)
+    write(fileid,*) 1
+    write(fileid,*) sp2type(sp)
+    write(fileid,*) -1
+    write(fileid,*) 1
+    write(fileid,*) lon
+    write(fileid,*) lat
+    write(fileid,"(a4,1x,a2,1x,a2,1x,a2,1x,a2,1x,a2)") &
+    trim(time(1:4)),trim(time(5:6)),trim(time(7:8)),trim(time(9:10)),&
+    trim(time(11:12)),trim(time(13:14))
+    !write(fileid,*) (speobsvar(sp)*sqrt(space/4.0)*splife(sp)/sqrt(real(sitenum))+speobsvar(sp))**2
+    write(fileid,*) ((speobsvar(sp)*sqrt(space/4.0)*splife(sp)/sqrt(real(sitenum))+speobsvar(sp)))**2
+    !write(fileid,*) (value*0.1)**2
+    !write(fileid,*) (value*0.1)**2
+    write(fileid,*) value
+    write(fileid,*) 1
+end subroutine
+    
+    
+    
+    
+    
+program ascii_to_sream
+    implicit none
+    integer(kind=4),parameter::sp=6
+    real(kind=4),parameter::intervalx=1.,intervaly=1.
+    integer(kind=4)::h,si,sis,sites,spc,imax,tempsitenumber
+    integer(kind=4),allocatable::sitenumber(:)
+    real(kind=4),allocatable::obsout(:,:),sitelat(:),sitelon(:)
+    real(kind=4),allocatable::tobsout(:,:),tsitelat(:),tsitelon(:)
+    integer(kind=4),allocatable::tsitecount(:,:)
+    real(kind=8)::temp(6)
+    real::minlat,minlon,maxlat,maxlon
+    integer(kind=8)::max_obs
+    character(len=20)::filein,fileinfo,tempf
+    character(len=25)::time
+    integer(kind=4)::nx,ny,i,j
+    logical::alive
+    logical,parameter::needthin=.true.
+    integer::io
+    call getarg(1,filein)
+    call getarg(2,time)
+    call getarg(3,fileinfo)
+    open(56,file=trim(fileinfo),status="OLD")
+	imax=0
+	do while (.true.)
+		imax=imax+1
+		read(56,"(a1)",end=500) tempf
+	end do
+	500 continue
+	close(56)
+	imax=imax-2
+	sites=imax
+	allocate(sitenumber(sites),sitelat(sites),sitelon(sites),obsout(sp,sites))
+    open(56,file=trim(fileinfo),status="OLD")
+    read(56,"(a1)") tempf
+    do sis=1,sites
+        read(56,*) sitenumber(sis),sitelat(sis),sitelon(sis),tempf
+    end do
+    close(56)
+    inquire(file=trim(filein),exist=alive)
+    if(alive) then
+        open(56,file=filein,status="OLD")
+        io=0;
+        si=1
+        do while(io==0)
+            read(56,fmt="(i4,4x,f8.0,f8.3,4f8.0)",iostat=io) tempsitenumber,temp(:)
+            do sis=si,sites
+                if(tempsitenumber==sitenumber(sis)) then 
+                    if(temp(1)<0.0001.or.temp(1)>1000) then !pm2.5
+                        obsout(6,sis)=-9999.
+                    else
+                        obsout(6,sis)=temp(1)
+                    end if
+                    if(temp(2)<0.0001.or.temp(2)>100) then !co
+                        obsout(4,sis)=-9999.
+                    else
+                        obsout(4,sis)=temp(2)
+                    end if
+                    if(temp(3)<0.0001.or.temp(3)>1000) then !no2
+                        obsout(2,sis)=-9999.
+                    else
+                        obsout(2,sis)=temp(3)
+                    end if
+                    if(temp(4)<0.0001.or.temp(4)>1000) then   !o3
+                        obsout(5,sis)=-9999.
+                    else