[Fortran] 纯文本查看 复制代码
program link
implicit none
external wheat_area,allockey_lei,integrated_wheat,link_area_calendar
integer k,i,j
integer,parameter::nCol
character(90) str(nCol)
character(90) str1(nCol1)
integer,dimension(3166782)::ALLOC_KEY1
integer,dimension(792304)::alloc_key,m_1,n_1
real,dimension(3166782)::X,Y
real,dimension(792304)::lon_1,lat_1,whea,plant_1,harvest_1
character*15,dimension(3166782)::Name
character*15,dimension(792304)::name_1
real,dimension(792304)::lon_1,lat_1,
character*15,dimension(792304)::name_1
integer,parameter::latitude=360,longitude=720
real lon_2(longitude)
real lat_2(latitude)
real plant_2(longtitude,latitude)
real harvest_2(longtitude,latitude)
call wheat_area(str,nCol)
call allockey_lei(str1,nCol1)
call integrated(ALLOC_KEY1,alloc_key,X,Y,lon_1,lat_1,whea,Name,name_1)
call linkall(alloc_key,m_1,n_1,lon_1,lon_2,lat_1,lat_2,whea,plant_1,plant_2,harvest_1,harvest_2,name_1)
end program
!number 1,extract area
subroutine wheat_area(nCol,str)
implicit none
integer k,i
integer,parameter::nCol=113 !Define a constant nCol equal to 113
character(90) str(nCol)
character(9),parameter:: strHead(6)=['alloc_key','whea ','whea_h ','whea_l ', 'whea_i ','whea_s ']
logical (kind=4) L(nCol)
open(10,file="/home/iga_qtong/fortran_xcao/gae_c/spam_p.csv")
open(11,file="/home/iga_qtong/fortran_xcao/gae_c/whout1.csv")
read(10,*) str !read the head of table
L(i)= .false. !determin the column to read
do i=1,nCol
str(i)=AdjustL(str(i))
if(any(Trim(str(i))==strHead))then !if the string equal to the strHead
L(i)= .true.
write(11,"(a,',')",advance='no') Trim(str(i))
end if
end do
write(11,*)
do
read(10,*,iostat=k) str
if(k/=0) exit
do i=1,nCol
if(.NOT.L(i)) cycle
write(11,'(a,",")',advance='no') Trim(str(i))
end do
write(11,*)
end do
end subroutine wheat_area
!number 2,extract longitude and latitude
subroutine allockey_lei(nCol1,str1)
implicit none
integer k,i
integer,parameter::nCol1=6 !Define a constant nCol equal to 6
character(90) str1(nCol1)
character(9),parameter::strHead(4)=['X ','Y ','Name ','ALLOC_KEY']
logical (kind=4) L(nCol1)
open(12,file="/home/iga_qtong/fortran_xcao/gae_c/allockey.csv")
open(13,file="/home/iga_qtong/fortran_xcao/gae_c/al_new1.csv")
read(12,*) str1 !read the head of table
L= .false. !determin the column to read
do i=1,nCol1
str1(i)=AdjustL(str1(i))
if(any(Trim(str1(i))==strHead))then !if the string equal to the strHead
L(i)= .true.
write(12,"(a,',')",advance='no') Trim(str1(i))
end if
end do
do
read(10,*,iostat=k) str1
if(k/=0) exit
do i=1,nCol1
if(.NOT.L(i)) cycle
write(13,'(a,",")',advance='no') Trim(str1(i))
end do
end do
end subroutine allockey_lei
!number 3
subroutine integrated(ALLOC_KEY1,alloc_key,X,Y,lon_1,lat_1,whea,Name,name_1)
implicit none
integer i,j
integer,dimension(3166782)::ALLOC_KEY1 !extract variable from al_new.csv
integer,dimension(792304)::alloc_key !extract variable from whout.csv
real,dimension(3166782)::X,Y !X and Y got from al_new.csv
real,dimension(792304)::whea !wheat area in whout.csv
real,dimension(792304)::lon_1,lat_1 !selected longtitude and latitude to the new file
character*15,dimension(3166782)::Name !country name
character*15,dimension(792304)::name_1 !selected country name
character c !c for null read
open(14,file="/home/iga_qtong/fortran_xcao/gae_c/al_new1.csv")
open(15,file="/home/iga_qtong/fortran_xcao/gae_c/whout1.csv")
open(16,file="/home/iga_qtong/fortran_xcao/gae_c/integrated_wheat1.csv")
!read al_new.csv
read(14,*) c
do i=1,3166782
read(14,*) X(i),Y(i),Name(i),ALLOC_KEY1(i)
end do
write(*,*) X(899920),Y(899920),ALLOC_KEY(899920)
!read whout.csv
read(15,*)c
do j=1,792304
read(15,*) alloc_key(j),whea(j)
end do
write(*,*) 139000,alloc_key(139000),whea(139000)
!tegrated wheat_area and allockey
do j=1,792304
do i=1,3166782
if(alloc_key(j)==ALLOC_KEY1(i)) then
name_1(j)=Name(i)
lon_1(j)=X(i)
lat_1(j)=Y(i)
write(16,10) alloc_key(j),',',name_1(j),',',lon_1(j),',',lat_1(j),',',whea(j)
10 format(I8,A15,F10.3,F10.3,F10.2)
end if
end do
end do
close(14)
close(15)
close(16)
end subroutine integrated
!number 4, to link calendar and area by lon and lat
subroutine linkall(alloc_key,m_1,n_1,lon_1,lon_2,lat_1,lat_2,whea,plant_1,
&plant_2,harvest_1,harvest_2,name_1)
implicit none
integer i,j
integer,dimension(792304)::alloc_key,m_1,n_1
real,dimension(792304)::lon_1,lat_1,whea,plant_1,harvest_1
character*15,dimension(792304)::name_1
integer,parameter::latitude=360,longitude=720 !calendar
integer ierr,ncid,varid,len_file
real lon_2(longitude)
real lat_2(latitude)
real plant_2(longtitude,latitude)
real harvest_2(longtitude,latitude)
character*299 calendar_file
include 'netcdf.inc'
calendar_file="/home/iga_qtong/fortran_xcao/gae_c/Wheat.nc"
plant_1=0.1
harvest_1=0.1
m_1=0
n_1=0
open(17,file="/home/iga_qtong/fortran_xcao/gae_c/integrated_wheat1.csv")
open(18,file="/home/iga_qtong/fortran_xcao/gae_c/link_area_calendar1.csv")
!open the integrated_wheat1.csv and extract information
do i=1,792304
read(17,*) alloc_key(i),name_1(i),lon_1(i),lat_1(i),whea(i)
end do
write(*,*) 1,alloc_key(1),name_1(1),lon_1(1),lat_1(1),whea(1)
write(*,*) i-1,alloc_key(i-1),name_1(i-1),lon_1(i-1),lat_1(i-1),whea(i-1)
!open the Wheat.nc and extract information
len_file=len_trim(calendar_file)
ierr=nf_open(trim(calendar_file),nf_nowrite, ncid)
ierr=nf_inq_varid(ncid, 'plant', varid) !get "plant"
ierr=nf_get_var_real(ncid, varid, plant_2)
write(*,*) "the status of plant is",ierr
write(*,*) plant_2(50,70)
ierr=nf_inq_varid(ncid, 'harvest', varid) !get "harvest"
ierr=nf_get_var_real(ncid, varid, harvest)
write(*,*) "the status of harvest is",ierr
write(*,*) harvest_2(50,70)
ierr=nf_inq_varid(ncid, 'longitude', varid) !get "longitude"
ierr=nf_get_var_real(ncid, varid, lon_2)
write(*,*) "the status of longitude is",ierr
write(*,*) lon_2(50)
ierr=nf_inq_varid(ncid, 'latitude', varid) !get "latitude"
ierr=nf_get_var_real(ncid, varid, lat_2)
write(*,*) "the status of longitude is",ierr
write(*,*) lat_2(50)
! match lon and lat by a loop program
do i=1,793204 !longitude
do j=1,720
if(abs(lon_1(i)-lon_2(j))-mival(abs(lon_1(i)-lon_2(j))==0) then
m_1(i)=j
write(*,*) i,m_1(i)
end if
end do
end do
do i=1,793204 !latitude
do j=1,360
if(abs(lat_1(i)-lat_2(j))-mival(abs(lat_1(i)-lat_2(j))==0) then
n_1(i)=j
write(*,*) i,n_1(i)
end if
end do
end do
do i=1,792304 !assign plant_2 to plant_1
plant_1(i)=plant_2(m_1(i),n_1(i))
write(*,*) plant_1(i)
do i=1,792304 !assign harvest_2 to harvest_1
harvest_1(i)=harvest_2(m_1(i),n_1(i))
write(*,*) harvest_1(i)
end do
! Last, write varibales into a new file
do i=1,793204
write(18,100) alloc_key(i),',',name_1(i),',',lon_1(i),',',lat_1(i),',',whea(i),',',
&plant_1(i),',',harvest_1(i),',',m_1(i),',',n_1(i)
100 format(I8,A15,F10.3,F10.3,F10.2,F10.2,F7.1,I5,I5)
write(*,*) 1,alloc_key(1),name_1(1),lon_1(1),lat_1(1),whea(1)
write(*,*) i,alloc_key(i),name_1(i),lon_1(i),lat_1(i),whea(i)
close(17)
close(18)
subroutine linkall
F 币
贡献
权杖
窥视卡
发表于 2017-4-16 20:46:20
微信
收藏
点赞
点踩
提升卡
置顶卡
变色卡
千斤顶
显身卡
发表于 2017-4-16 21:06:59
楼主
发表于 2017-4-17 16:21:55