Ignore:
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/src/gridcheck.f90

    r27 r20  
    8484  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
    8585  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
    86   integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl,parID
     86  integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl
    8787  !HSO  end
    8888  integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
    89   real :: sizesouth,sizenorth,xauxa,pint,conversion_factor
     89  real :: sizesouth,sizenorth,xauxa,pint
    9090
    9191  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
     
    9898
    9999  integer :: isec1(56),isec2(22+nxmax+nymax)
    100   real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
     100  !real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
     101  real(kind=4) :: zsec2(184),zsec4(jpunp)
    101102  character(len=1) :: opt
    102103
     
    171172  call grib_check(iret,gribFunction,gribErrorMsg)
    172173  call grib_get_int(igrib,'level',valSurf,iret)
    173   call grib_check(iret,gribFunction,gribErrorMsg)
    174   call grib_get_int(igrib,'paramId',parId,iret)
    175174  call grib_check(iret,gribFunction,gribErrorMsg)
    176175
     
    194193  elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
    195194    isec1(6)=135         ! indicatorOfParameter
    196   elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot
    197     isec1(6)=135         ! indicatorOfParameter
    198195  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP
    199196    isec1(6)=151         ! indicatorOfParameter
     
    208205  elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD
    209206    isec1(6)=141         ! indicatorOfParameter
    210   elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC
     207  elseif ((parCat.eq.6).and.(parNum.eq.1)) then ! CC
    211208    isec1(6)=164         ! indicatorOfParameter
    212   elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP
     209  elseif ((parCat.eq.1).and.(parNum.eq.9)) then ! LSP
    213210    isec1(6)=142         ! indicatorOfParameter
    214211  elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
     
    218215  elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR
    219216    isec1(6)=176         ! indicatorOfParameter
    220   elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS
     217  elseif ((parCat.eq.2).and.(parNum.eq.17)) then ! EWSS
    221218    isec1(6)=180         ! indicatorOfParameter
    222   elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS
     219  elseif ((parCat.eq.2).and.(parNum.eq.18)) then ! NSSS
    223220    isec1(6)=181         ! indicatorOfParameter
    224221  elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
    225222    isec1(6)=129         ! indicatorOfParameter
    226   elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO
     223  elseif ((parCat.eq.3).and.(parNum.eq.7)) then ! SDO
    227224    isec1(6)=160         ! indicatorOfParameter
    228225  elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
     
    233230         parCat,parNum,typSurf
    234231  endif
    235   if(parId .ne. isec1(6) .and. parId .ne. 77) then
    236     write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
    237 !    stop
    238   endif
    239232
    240233  endif
     
    272265
    273266  !HSO  get the second part of the grid dimensions only from GRiB1 messages
    274   if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then
     267  if ((gribVer.eq.1).and.(gotGrid.eq.0)) then
    275268    call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
    276269         xaux2in,iret)
     
    298291    dyconst=180./(dy*r_earth*pi)
    299292    gotGrid=1
     293
    300294  ! Check whether fields are global
    301295  ! If they contain the poles, specify polar stereographic map
     
    443437  !********************
    444438
    445   write(*,'(a,2i7)') ' Vertical levels in ECMWF data: ', &
     439  write(*,*)
     440  write(*,*)
     441  write(*,'(a,2i7)') '# of vertical levels in ECMWF data: ', &
    446442       nuvz+1,nwz
    447443  write(*,*)
    448   write(*,'(a)') ' Mother domain:'
    449   write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Longitude range: ', &
     444  write(*,'(a)') 'Mother domain:'
     445  write(*,'(a,f10.2,a1,f10.2,a,f10.2)') '  Longitude range: ', &
    450446       xlon0,' to ',xlon0+(nx-1)*dx,'   Grid distance: ',dx
    451   write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Latitude range : ', &
     447  write(*,'(a,f10.2,a1,f10.2,a,f10.2)') '  Latitude range: ', &
    452448       ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
    453449  write(*,*)
     
    471467    k=nlev_ec+1+numskip+i
    472468    akm(nwz-i+1)=zsec2(j)
    473   !   write (*,*) 'ifield:',ifield,k,j,zsec2(10+j)
    474469    bkm(nwz-i+1)=zsec2(k)
    475470  end do
     
    558553
    559554end subroutine gridcheck
    560 
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG