CTBTO FLEXPART WO4 (2015-10-15)
 All Classes Files Functions Variables
readlanduse_int1.f90
Go to the documentation of this file.
1 !**********************************************************************
2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 *
3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, *
4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann *
5 ! *
6 ! This file is part of FLEXPART. *
7 ! *
8 ! FLEXPART is free software: you can redistribute it and/or modify *
9 ! it under the terms of the GNU General Public License as published by*
10 ! the Free Software Foundation, either version 3 of the License, or *
11 ! (at your option) any later version. *
12 ! *
13 ! FLEXPART is distributed in the hope that it will be useful, *
14 ! but WITHOUT ANY WARRANTY; without even the implied warranty of *
15 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
16 ! GNU General Public License for more details. *
17 ! *
18 ! You should have received a copy of the GNU General Public License *
19 ! along with FLEXPART. If not, see <http://www.gnu.org/licenses/>. *
20 !**********************************************************************
21 
22 subroutine readlanduse
23 
24  !*****************************************************************************
25  ! *
26  ! Reads the landuse inventory into memory and relates it to Leaf Area *
27  ! Index and roughness length. *
28  ! *
29  ! AUTHOR: Andreas Stohl, 10 January 1994 *
30  ! *
31  !*****************************************************************************
32  ! *
33  ! Variables: *
34  ! i loop indices *
35  ! landinvent(1200,600,13) area fractions of 13 landuse categories *
36  ! LENGTH(numpath) length of the path names *
37  ! PATH(numpath) contains the path names *
38  ! unitland unit connected with landuse inventory *
39  ! *
40  ! ----- *
41  ! Sabine Eckhardt, Dec 06 - new landuse inventary *
42  ! after *
43  ! Belward, A.S., Estes, J.E., and Kline, K.D., 1999, *
44  ! The IGBP-DIS 1-Km Land-Cover Data Set DISCover: *
45  ! A Project Overview: Photogrammetric Engineering and Remote Sensing, *
46  ! v. 65, no. 9, p. 1013-1020 *
47  ! *
48  ! LANDUSE CATEGORIES: *
49  ! *
50  ! 1 Urban land *
51  ! 2 Agricultural land *
52  ! 3 Range land *
53  ! 4 Deciduous forest *
54  ! 5 Coniferous forest *
55  ! 6 Mixed forest including wetland *
56  ! 7 water, both salt and fresh *
57  ! 8 barren land mostly desert *
58  ! 9 nonforested wetland *
59  ! 10 mixed agricultural and range land *
60  ! 11 rocky open areas with low growing shrubs *
61  ! 12 ice *
62  ! 13 rainforest *
63  ! *
64  !*****************************************************************************
65 
66  use par_mod
67  use com_mod
68 
69  implicit none
70 
71  integer :: ix,jy,i,k,lu_cat,lu_perc
72  integer(kind=1) :: ilr
73  integer(kind=1) :: ilr_buffer(2160000)
74  integer :: il,irecread
75  real :: rlr, r2lr
76 
77 
78  ! Read landuse inventory
79  !***********************
80  ! The landuse information is saved in a compressed format and written
81  ! out by records of the length of 1 BYTE. Each grid cell consists of 3
82  ! Bytes, which include 3 landuse categories (val 1-13 and 16 percentage
83  ! categories) So one half byte is used to store the Landusecat the other
84  ! for the percentageclass in 6.25 steps (100/6.25=16)
85  ! e.g.
86  ! 4 3 percentage 4 = 4*6.25 => 25% landuse class 3
87  ! 2 1 percentage 2 = 2*6.25 => 13% landuse class 1
88  ! 1 12 percentage 1 = 1*6.26 => 6.25% landuse class 12
89 
90 
91  write (*,*) 'reading: ',path(1)(1:length(1))
92  open(unitland,file=path(1)(1:length(1)) &
93  //'IGBP_int1.dat',status='old', &
94  form='UNFORMATTED', err=998)
95  read (unitland) (ilr_buffer(i),i=1,2160000)
96  close(unitland)
97  write (*,*) 'reading: '
98 
99  irecread=1
100  do ix=1,1200
101  do jy=1,600
102  ! the 3 most abundant landuse categories in the inventory
103  ! first half byte contains the landuse class
104  ! second half byte contains the respective percentage
105  do k=1,3
106  ! 1 byte is read
107  ilr=ilr_buffer(irecread)
108  irecread=irecread+1
109  ! as only signed integer values exist an unsigned value is constructed
110  if (ilr.lt.0) then
111  il=ilr+256
112  else
113  il=ilr
114  endif
115  ! dividing by 16 has the effect to get rid of the right half of the byte
116  ! so just the left half remains, this corresponds to a shift right of 4
117  ! bits
118  rlr=real(il)/16.
119  lu_cat=int(rlr)
120  ! the left half of the byte is substracted from the whole in order to
121  ! get only the right half of the byte
122  r2lr=rlr-int(rlr)
123  ! shift left by 4
124  lu_perc=r2lr*16.
125  landinvent(ix,jy,k)=lu_cat
126  landinvent(ix,jy,k+3)=lu_perc
127  if ((jy.lt.10).and.(ix.lt.10)) then
128  write(*,*) 'reading: ', ix, jy, lu_cat, lu_perc
129  endif
130  end do
131  end do
132  end do
133 
134  ! Read relation landuse,z0
135  !*****************************
136 
137  open(unitsurfdata,file=path(1)(1:length(1))//'surfdata.t', &
138  status='old',err=999)
139 
140  do i=1,4
141  read(unitsurfdata,*)
142  end do
143  do i=1,numclass
144  read(unitsurfdata,'(45x,f15.3)') z0(i)
145  end do
146  close(unitsurfdata)
147 
148  return
149 
150  ! Issue error messages
151  !*********************
152 
153 998 write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING ####'
154  write(*,*) ' #### LANDUSE INVENTORY DOES NOT EXIST ####'
155  stop
156 
157 999 write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING ####'
158  write(*,*) ' #### RELATION LANDUSE,z0 DOES NOT EXIST ####'
159  stop
160 
161 end subroutine readlanduse
subroutine readlanduse
Definition: readlanduse.f90:22