- 积分
- 1967
- 贡献
-
- 精华
- 在线时间
- 小时
- 注册时间
- 2013-8-22
- 最后登录
- 1970-1-1
|
发表于 2015-12-4 13:42:29
|
显示全部楼层
奇怪了，我就把其中read_prepbufr部分写成了f90. 然后ifort 出错了。
报错信息：read_prepbufr.f90(23): error #5082: Syntax error, found IDENTIFIER 'NONE' when expecting one of: ( * , <END-OF-STATEMENT> ; [ / = =>
integer(i_kind) ntbmplicit none
-----------------------------^
read_prepbufr.f90(4): error #7002: Error in opening the compiled module file. Check INCLUDE paths. [KINDS]
use kinds, only: r_single,r_kind,r_double,i_kind
------^
read_prepbufr.f90(19): error #6683: A kind type parameter must be a compile-time constant. [I_KIND]
integer(i_kind) ireadmg,ireadsb,icntpnt,icntpnt2,icount,iiout
----------^
read_prepbufr.f90(20): error #6683: A kind type parameter must be a compile-time constant. [I_KIND]
integer(i_kind) lunin,i,maxobs,j,idomsfc,itemp,it29
----------^
read_prepbufr.f90(21): error #6683: A kind type parameter must be a compile-time constant. [I_KIND]
integer(i_kind) metarcldlevs,metarwthlevs
----------^
read_prepbufr.f90(22): error #6683: A kind type parameter must be a compile-time constant. [I_KIND]
integer(i_kind) k,nmsg,kx, nreal,idate,iret,ncsave,levs
----------^
read_prepbufr.f90(23): error #6683: A kind type parameter must be a compile-time constant. [I_KIND]
integer(i_kind) ntbmplicit none
----------^
read_prepbufr.f90(23): error #6216: This length or width specifier has been incorrectly used in this context. [NTBMPLICIT]
integer(i_kind) ntbmplicit none
------------------^
read_prepbufr.f90(25): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double) vtcd
-------^
read_prepbufr.f90(26): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(8):: hdr
-------^
read_prepbufr.f90(27): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(8,255):: drfdat,qcmark,obserr
-------^
read_prepbufr.f90(28): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(9,255):: obsdat
-------^
read_prepbufr.f90(29): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(8,1):: sstdat
-------^
read_prepbufr.f90(30): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(2,10):: metarcld
-------^
read_prepbufr.f90(31): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(1,10):: metarwth
-------^
read_prepbufr.f90(32): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(1,1) :: metarvis
-------^
read_prepbufr.f90(33): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(4,1) :: geoscld
-------^
read_prepbufr.f90(34): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(1):: satqc
-------^
read_prepbufr.f90(35): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(1,1):: r_prvstg,r_sprvstg
-------^
read_prepbufr.f90(36): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(1,255):: levdat
-------^
read_prepbufr.f90(37): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(255,20):: tpc
-------^
read_prepbufr.f90(38): error #6683: A kind type parameter must be a compile-time constant. [R_DOUBLE]
real(r_double),dimension(2,255,20):: tobaux
-------^
read_prepbufr.f90(69): error #6406: Conflicting attributes or multiple declaration of name. [R_KIND]
satqc=0.0_r_kind
-----------^
read_prepbufr.f90(69): error #6975: A kind-param must be a digit-string or a scalar-int-constant-name [R_KIND]
satqc=0.0_r_kind
-----------^
read_prepbufr.f90(92): error #6404: This name does not have a type, and must have an explicit type. [NTB]
ntb = 0
--^
read_prepbufr.f90(105): error #6406: Conflicting attributes or multiple declaration of name. [R_DOUBLE]
if(satqc(1) < 85.0_r_double) cycle loop_report ! QI w/o fcst (su's setup
-----------------------------^
read_prepbufr.f90(105): error #6975: A kind-param must be a digit-string or a scalar-int-constant-name [R_DOUBLE]
if(satqc(1) < 85.0_r_double) cycle loop_report ! QI w/o fcst (su's setup
-----------------------------^
read_prepbufr.f90(157): error #6406: Conflicting attributes or multiple declaration of name. [R_KIND]
sstdat=1.e11_r_kind
-----------------------^
read_prepbufr.f90(157): error #6975: A kind-param must be a digit-string or a scalar-int-constant-name [R_KIND]
sstdat=1.e11_r_kind
-----------------------^
read_prepbufr.f90(160): error #6406: Conflicting attributes or multiple declaration of name. [R_KIND]
metarcld=1.e11_r_kind
恳求楼主给我看看是哪不对啊
program read_prepbufr
use kinds, only: r_single,r_kind,r_double,i_kind
implicit none
character(len=80) :: infile,obstype
! Declare local variables
character(40) drift,hdstr,qcstr,oestr,sststr,satqcstr,levstr,hdstr2
character(40) metarcldstr,geoscldstr,metarvisstr,metarwthstr
character(80) obstr
character(10) date
character(8) subset
character(8) prvstr,sprvstr
integer(i_kind) ireadmg,ireadsb,icntpnt,icntpnt2,icount,iiout
integer(i_kind) lunin,i,maxobs,j,idomsfc,itemp,it29
integer(i_kind) metarcldlevs,metarwthlevs
integer(i_kind) k,nmsg,kx, nreal,idate,iret,ncsave,levs
integer(i_kind) ntbmplicit none
real(r_double) vtcd
real(r_double),dimension(8):: hdr
real(r_double),dimension(8,255):: drfdat,qcmark,obserr
real(r_double),dimension(9,255):: obsdat
real(r_double),dimension(8,1):: sstdat
real(r_double),dimension(2,10):: metarcld
real(r_double),dimension(1,10):: metarwth
real(r_double),dimension(1,1) :: metarvis
real(r_double),dimension(4,1) :: geoscld
real(r_double),dimension(1):: satqc
real(r_double),dimension(1,1):: r_prvstg,r_sprvstg
real(r_double),dimension(1,255):: levdat
real(r_double),dimension(255,20):: tpc
real(r_double),dimension(2,255,20):: tobaux
! data statements
data hdstr /'SID XOB YOB DHR TYP ELV SAID T29'/
data hdstr2 /'TYP SAID T29 SID'/
data obstr /'POB QOB TOB ZOB UOB VOB PWO CAT PRSS' /
data drift /'XDR YDR HRDR '/
data sststr /'MSST DBSS SST1 SSTQM SSTOE '/
data qcstr /'PQM QQM TQM ZQM WQM NUL PWQ '/
data oestr /'POE QOE TOE NUL WOE NUL PWE '/
data satqcstr /'QIFN'/
data prvstr /'PRVSTG'/
data sprvstr /'SPRVSTG'/
data levstr /'POB'/
data metarcldstr /'CLAM HOCB'/ ! cloud amount and cloud base height
data metarwthstr /'PRWE'/ ! present weather
data metarvisstr /'HOVI'/ ! visibility
data geoscldstr /'CDTP TOCC GCDTT CDTP_QM'/ ! NESDIS cloud products:cloud top pressure, temperature,amount
logical tob,qob,uvob,spdob,sstob,pwob,psob
logical metarcldobs,geosctpobs
logical driftl,convobs
data lunin / 13 /
! Initialize variables
infile='prepbufr'
nreal=0
satqc=0.0_r_kind
obstype='t'
tob = obstype == 't'
uvob = obstype == 'uv'
spdob = obstype == 'spd'
psob = obstype == 'ps'
qob = obstype == 'q'
pwob = obstype == 'pw'
sstob = obstype == 'sst'
metarcldobs = obstype == 'mta_cld'
geosctpobs = obstype == 'gos_ctp'
convobs = tob .or. uvob .or. spdob .or. qob
!------------------------------------------------------------------------
! Open, then read date from bufr data
call closbf(lunin)
open(lunin,file=infile,form='unformatted')
call openbf(lunin,'IN',lunin)
call datelen(10)
maxobs=0
nmsg=0
ntb = 0
msg_report: do while (ireadmg(lunin,subset,idate) == 0)
nmsg=nmsg+1
loop_report: do while (ireadsb(lunin) == 0)
ntb = ntb+1
! Extract type information
call ufbint(lunin,hdr,4,1,iret,hdstr2)
kx=hdr(1)
! For the satellite wind to get quality information and check if it will be used
if( kx ==243 .or. kx == 253 .or. kx ==254 ) then
call ufbint(lunin,satqc,1,1,iret,satqcstr)
if(satqc(1) < 85.0_r_double) cycle loop_report ! QI w/o fcst (su's setup
endif
! Save information for next read
if(ncsave /= 0) then
call ufbint(lunin,levdat,1,255,levs,levstr)
maxobs=maxobs+max(1,levs)
end if
end do loop_report
enddo msg_report
if (nmsg==0) goto 900
write(6,*)'READ_PREPBUFR: messages/reports = ',nmsg,'/',ntb
!------------------------------------------------------------------------
! Obtain program code (VTCD) associated with "VIRTMP" step
if(tob)call ufbqcd(lunin,'VIRTMP',vtcd)
! loop over convinfo file entries; operate on matches
!DTC comment out the loop loop_convinfo because we want to read all typies
!DTC loop_convinfo: do nx=1, ntread
call closbf(lunin)
open(lunin,file=infile,form='unformatted')
call openbf(lunin,'IN',lunin)
call datelen(10)
! Big loop over prepbufr file
ntb = 0
nmsg = 0
icntpnt=0
icntpnt2=0
loop_msg: do while (ireadmg(lunin,subset,idate)== 0)
loop_readsb: do while(ireadsb(lunin) == 0)
! use msg lookup table to decide which messages to skip
! use report id lookup table to only process matching reports
ntb = ntb+1
! Extract type, date, and location information
call ufbint(lunin,hdr,8,1,iret,hdstr)
! Balloon drift information available for these data
!DTC driftl=kx==120.or.kx==220.or.kx==221
! Extract data information on levels
call ufbint(lunin,obsdat,9,255,levs,obstr)
call ufbint(lunin,qcmark,8,255,levs,qcstr)
call ufbint(lunin,obserr,8,255,levs,oestr)
if(sstob)then
sstdat=1.e11_r_kind
call ufbint(lunin,sstdat,8,1,levs,sststr)
else if(metarcldobs) then
metarcld=1.e11_r_kind
metarwth=1.e11_r_kind
metarvis=1.e11_r_kind
call ufbint(lunin,metarcld,2,10,metarcldlevs,metarcldstr)
call ufbint(lunin,metarwth,1,10,metarwthlevs,metarwthstr)
call ufbint(lunin,metarvis,1,1,iret,metarvisstr)
if(levs /= 1 ) then
write(6,*) 'READ_PREPBUFR: error in Metar observations, levs &
sould be 1 !!!'
stop 110
endif
else if(geosctpobs) then
geoscld=1.e11_r_kind
call ufbint(lunin,geoscld,4,1,levs,geoscldstr)
endif
! If temperature ob, extract information regarding virtual
! versus sensible temperature
! if(tob) then
! call ufbevn(lunin,tpc,1,255,20,levs,'TPC')
! if (.not. twodvar_regional .or. .not.tsensible) then
! else !peel back events to store sensible temp in
! case temp is virtual
! call ufbevn(lunin,tobaux,2,255,20,levs,'TOB TQM')
! end if
! end if
end do loop_readsb
!
! End of bufr read loop
enddo loop_msg
! Close unit to bufr file
call closbf(lunin)
! Normal exit
!DTC enddo loop_convinfo! loops over convinfo entry matches
900 continue
close(lunin)
end program read_prepbufr
|
|
窥视卡
雷达卡
显身卡
楼主
{:eb334:}
