! fromexcel.f90 ! program to convert raw data files from Excel spreadsheet to CRU ts format ! written by Dr. Tim Mitchell (Tyndall Centre) on 03.06.03 ! assumes one row of information per variable/station/year combination ! assumes that all relevant info is on each line (including meta data) ! f90 -error_limit 5 -o ./../cruts/fromexcel time.f90 filenames.f90 ! crutsfiles.f90 grimfiles.f90 ./../cruts/fromexcel.f90 program FromExcel use Time use FileNames use CRUtsFiles use GrimFiles implicit none real, pointer, dimension(:) :: Lat,Lon,Elv real, dimension(12) :: fRaw integer, pointer, dimension(:,:,:) :: Proc integer, pointer, dimension(:,:) :: Info integer, pointer, dimension(:) :: YearAD,Code,Beg,End character (len=20),pointer,dimension(:) :: Name character (len=13),pointer,dimension(:) :: Cty character (len= 9),pointer,dimension(:) :: Local integer, parameter :: DataMissVal = -9999 real, parameter :: MissVal = -999.0 real :: Factor,RawMissValA,RawMissValB,RawMulti integer :: AllocStat,ReadStatus, YearAD0,YearAD1 integer :: QSource integer :: iCode,iLat,iLon,iElv,iYear integer :: NYear,NMonth,NLine,NEntry integer :: XYear,XMonth,XLine,XEntry character (len=80) :: Variable,GivenFile,LoadFile,SaveFile,LineFormat character (len= 4) :: Suffix !******************************************************************************* call Intro call Select call Specify call Load call Save call Close contains !******************************************************************************* subroutine Intro open (99,file="/cru/mikeh1/f709762/scratch/log/log-fromexcel.dat", & status="replace",action="write") print* print*, " > ***** FromExcel: convert raw Excel to CRU ts *****" print* end subroutine Intro !******************************************************************************* subroutine Select print*, " > Select the file to load: " do read (*,*,iostat=ReadStatus), GivenFile if (ReadStatus.LE.0.AND.GivenFile.NE."") exit end do LoadFile = LoadPath (GivenFile," ") print*, " > Select source (0=help): " do read (*,*,iostat=ReadStatus), QSource if (ReadStatus.LE.0.AND.QSource.EQ.0) then print*, " > 1. Jian China" end if if (ReadStatus.LE.0.AND.QSource.GT.0) exit end do print*, " > Select variable (form: '.???'): " do read (*,*,iostat=ReadStatus), Suffix if (ReadStatus.LE.0) call CheckVariSuffix (Suffix,Variable,Factor) if (ReadStatus.LE.0.AND.Variable.NE."undefined") exit end do print*, " > Select the file to save (.cts): " do read (*,*,iostat=ReadStatus), GivenFile if (ReadStatus.LE.0.AND.GivenFile.NE."") exit end do SaveFile = SavePath (GivenFile,".cts") end subroutine Select !******************************************************************************* subroutine Specify if (QSource.EQ.1) then LineFormat = "(5i7,f6.1,11f7.1)" RawMissValA = -100.0 ; RawMissValB = 9999.0 ; RawMulti = 1.0 NEntry = 1000 ; YearAD0=1801 ; YearAD1=2020 end if NYear=YearAD1-YearAD0+1 ; NMonth=12 allocate (YearAD(NYear),Proc(NYear,NMonth,NEntry), & Code(NEntry),Name(NEntry),Cty(NEntry),Local(NEntry), & Lat(NEntry),Lon(NEntry),Elv(NEntry), & Beg(NEntry),End(NEntry), stat=AllocStat) if (AllocStat.NE.0) print*, " > ##### alloc #####" Lat=MissVal ; Lon=MissVal ; Elv=MissVal ; Beg=MissVal ; End=MissVal Proc=DataMissVal ; Code=MissVal Name="UNKNOWN" ; Cty="UNKNOWN" ; Local=" nocode" do XYear=1,NYear YearAD(XYear)=XYear-1+YearAD0 end do if (QSource.EQ.1) then Cty="CHINA" end if end subroutine Specify !******************************************************************************* subroutine Load print*, " > Loading..." call system ('wc -l ' // LoadFile // ' > trashme-fromexcel.txt') open (3,file='trashme-fromexcel.txt',status="old",access="sequential", & form="formatted",action="read") read (3,"(i10)"), NLine ! get number of lines close (3) call system ('rm trashme-fromexcel.txt') open (2,file=LoadFile,status="old",access="sequential",form="formatted",action="read") if (QSource.EQ.1) then do XLine = 1, Nline read (2,LineFormat), iCode,iLat,iLon,iElv,iYear,(fRaw(XMonth),XMonth=1,NMonth) XEntry=0 ; iCode=iCode*10 do XEntry=XEntry+1 if (Code(XEntry).EQ.MissVal) then Code(XEntry) = iCode Elv(XEntry) = real(iElv)/10.0 Lat(XEntry) = (mod(real(iLat),100.0)/60.0) + int(real(iLat)/100.0) Lon(XEntry) = (mod(real(iLon),100.0)/60.0) + int(real(iLon)/100.0) Beg(XEntry) = iYear write (99,"(i7,3f8.2)"), Code(XEntry),Lat(XEntry),Lon(XEntry),Elv(XEntry) end if if (Code(XEntry).EQ.iCode) then End(XEntry) = iYear XYear=iYear-YearAD0+1 if (XYear.LT.1.OR.XYear.GT.NYear) then print*, " > ***** Year range is bad. Reset in source code. " else do XMonth=1,NMonth if (fRaw(XMonth).NE.RawMissValA.AND.fRaw(XMonth).NE.RawMissValB) & Proc(XYear,XMonth,XEntry) = nint(fRaw(XMonth)*RawMulti/Factor) end do end if write (99,"(i4,12i5)"), iYear,(Proc(XYear,XMonth,XEntry),XMonth=1,NMonth) end if if (Code(XEntry).NE.iCode.AND.XEntry.EQ.NEntry) & print*, " > ***** NEntry is set too small. Reset in source code. " if (XEntry.EQ.NEntry) exit if (Code(XEntry).EQ.iCode) exit end do end do end if close (2) end subroutine Load !******************************************************************************* subroutine Save ! call MakeStnInfo (Info,Code,Code,Lat,Lon,Elv,1,Data=Proc,YearAD=YearAD) call MakeStnInfo (Info,Code,Code,Lat,Lon,Elv,1,YearAD0=Beg,YearAD1=End) call SaveCTS (Info,Local,Name,Cty,CallFile=SaveFile,YearAD=YearAD,Data=Proc) end subroutine Save !******************************************************************************* subroutine Close print* close (99) end subroutine Close !******************************************************************************* end program FromExcel