source: branches/jerome/src_flexwrf_v3.1/readlanduse.f90 @ 16

Last change on this file since 16 was 16, checked in by jebri, 10 years ago

sources for flexwrf v3.1

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