This is a fortran program for preprocessing meteorological data from CDC
! Author: zhb
! Date: 2014-10-15
! Description: None
Module Global
integer N_VAR
parameter (N_VAR = 5) ! num of variables
integer N_STATION
parameter (N_STATION = 6) ! num of target stations
integer ID(N_STATION)
character VARIABLES(N_VAR)*3 ! all variables
integer MISS
parameter (MISS = -99999) ! value for missing records
! names of all needed variables
data VARIABLES / “EVP”, “PRE”, “PRS”, “TEM”, “WIN” /
! IDs of target stations
data ID / 55589, 55591, 55597, 55680, 55681, 55696 /
! data ID / 55589, 55591, 55597, 55680, 54471, 59758 /
integer VDATA_LEN(N_VAR)
! num of daily observations for each variable
data VDATA_LEN / 4, 6, 6, 6, 10 /
End Module
Program main
use Global
implicit none
character*200, allocatable :: INFILES(:)
integer nFiles, i, j, k, out_unit(N_STATION), tlen, fid
integer nMonth, date, year, mon, vind, days, vdate, day
character sbuf*200, out_name(N_STATION)*200, GetDate*6, var*3
integer MDays(12), GetInt, GetIntLen, VarIndex
integer, allocatable :: vdata(:,:)
logical Leap
integer m, n, itmp, stat, buf(60), p0, p1
character form*100, GetVar*3
data MDays / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /
Do i = 1, N_STATION
out_unit(i) = i + 100
End Do
call system(“dir *.txt /b > files.ini”)
open (1, file=’files.ini’, status=”old”)
nFiles = 0
Do While(.true.)
read(1, ‘(A200)’, END=101) sbuf
print *, sbuf
nFiles = nFiles + 1
End Do
101 continue
rewind(1)
IF (mod(nFiles,N_VAR) .ne. 0) THEN
print *, “The num of input files is unexpected: “, nFiles
stop
ENDIF
nMonth = nFiles / N_VAR
allocate (INFILES(1:nFiles))
Do i = 1, nFiles
read(1, *) INFILES(i)
End Do
close (1)
call SortByDate(INFILES, nFiles)
Do i = 1, N_STATION
write (out_name(i), ‘(I5, “.csv”)’) ID(i)
open (out_unit(i), file=out_name(i), status=”replace”)
write (out_unit(i), ‘(“Year, month, day”)’, advance=’no’)
Do j = 1, N_VAR
Do k = 1, VDATA_LEN(j)
m = GetIntLen(k)
write (form, *) ‘(“, “, A3, “_”, I’, m, ‘)’
write (out_unit(i), form, advance=’no’)
& VARIABLES(j), k
End Do
End Do
close(out_unit(i))
End Do
tlen = 0
Do i = 1, N_VAR
tlen = tlen + VDATA_LEN(i)
End Do
Do i = 1, nMonth
date = GetInt(GetDate(INFILES(i * N_VAR)), 6)
print *, date, ” is processing”
year = date / 100
mon = date – year * 100
days = MDays(mon)
IF (Leap(year) .and. mon .eq. 2) THEN
days = 29
END IF
Do j = 1, N_STATION
allocate (vdata(1:days, 1:tlen))
Do m = 1, tlen
Do n = 1, days
vdata(n, m) = MISS
End Do
End Do
Do k = 1, N_VAR
fid = (i-1)*N_VAR + k
var = GetVar(INFILES(fid))
vdate = GetInt(GetDate(INFILES(fid)), 6)
IF (vdate .ne. date) THEN
print *, ” Unmatched date : ”
& , date, vdate
stop
END IF
vind = VarIndex(var)
call GetStartEnd(vind, p0, p1)
open (22, file=INFILES(fid), status=’old’)
p1 = 0
DoW: Do While(.true.)
p1 = p1 + 1
read (22, *, iostat=stat)
& (buf(n), n=1, 7 + VDATA_LEN(vind))
IF (stat /= 0) THEN
goto 201
END IF
IF (buf(1) .ne. ID(j)) cycle DoW
Do m = 1, VDATA_LEN(vind)
vdata(buf(7), p0 + m – 1) = buf(7+m)
End Do
End Do DoW
201 continue
print *, p1, INFILES(fid)
close (22)
End Do
open (out_unit(j), file=out_name(j), status=’old’,
& position=’append’)
write (form, *) “(“, 3 + tlen – 1, “(I10, ‘,’), I10)”
Do m = 1, days
write (out_unit(j), form) year, mon, m,
& (vdata(m, n), n=1, tlen)
End Do
deallocate (vdata)
close (out_unit(j))
End Do ! j
End Do ! i
print *, “All work is done!”
pause
End
Subroutine SortByDate (files, n)
character files(n)*200, GetDate*6, swap*200, stmp*6
integer i,j,k,ind
integer date_min, date, GetInt
Do i = 1, n
ind = i
date_min = GetInt(GetDate(files(i)), 6)
Do j = i + 1, n
date = GetInt(GetDate(files(j)), 6)
IF (date .lt. date_min) THEN
date_min = date
ind = j
END IF
End Do
IF (ind .ne. i) THEN
swap = files(ind)
files(ind) = files(i)
files(i) = swap
END IF
End Do
End Subroutine
Function GetDate (name)
character name*200, GetDate*6
write (GetDate, ‘(A6)’) name(32:37)
End Function
Function GetInt (str, n)
integer GetInt, n
character str*n
read (str, *) GetInt
End Function
Function GetVar (name)
character name*200, GetVar*3
write (GetVar, ‘(A3)’) name(22:24)
End Function
Function Leap (year)
integer year
logical Leap
IF (((mod(year,4) .eq. 0) .and. (mod(year,100) .ne. 0))
& .or. (mod(year,400) .eq. 0)) THEN
Leap = .true.
ELSE
Leap = .false.
END IF
End Function
Function VarIndex (var)
use Global
integer i, VarIndex
character var*3
VarIndex = 0
Do i = 1, N_VAR
IF (var .eq. VARIABLES(i)) THEN
VarIndex = i
return
END IF
End Do
End Function
Subroutine GetStartEnd (var_ind, start_ind, end_ind)
use Global
implicit none
integer var_ind, start_ind, end_ind
integer sum, i
sum = 0
Do i = 1, var_ind – 1
sum = sum + VDATA_LEN(i)
End Do
start_ind = sum + 1
end_ind = sum + VDATA_LEN(var_ind)
End Subroutine
Function GetIntLen (int)
integer int, GetIntLen, i
character tmp*100
write (tmp, *) int
tmp = adjustl(tmp)
Do i = 1, 100
IF (tmp(i:i) .eq. ‘ ‘) THEN
exit
END IF
End Do
GetIntLen = i – 1
End Function