/[MITgcm]/MITgcm/verification/fizhi-gridalt-hs/code/fizhi_init_veg.F
ViewVC logotype

Contents of /MITgcm/verification/fizhi-gridalt-hs/code/fizhi_init_veg.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (show annotations) (download)
Thu Mar 22 14:25:21 2012 UTC (8 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.1: +121 -110 lines
reflect latest changes in standard version from pkg/fizhi

1 C $Header: /u/gcmpack/MITgcm/verification/fizhi-gridalt-hs/code/fizhi_init_veg.F,v 1.1 2004/08/24 19:33:15 molod Exp $
2 C $Name: $
3
4 #include "FIZHI_OPTIONS.h"
5
6 SUBROUTINE FIZHI_INIT_VEG(myThid,vegdata,im,jm,nSx,nSy,Nxg,Nyg,
7 & maxtyp,nchp,nchptot,nchpland,lons,lats,surftype,tilefrac,
8 & igrd,ityp,chfr,chlt,chlon)
9 C***********************************************************************
10 C Subroutine fizhi_init_veg - routine to read in the land surface types,
11 C interpolate to the models grid, and set up tile space for use by
12 C the land surface model, the albedo calculation and the surface
13 C roughness calculation.
14 C
15 C INPUT:
16 C
17 C myThid - thread number (processor number)
18 C vegdata - Character*40 Vegetation Dataset name
19 C im - longitude dimension
20 C jm - latitude dimension (number of lat. points)
21 C nSx - Number of processors in x-direction
22 C nSy - Number of processors in y-direction
23 C maxtyp - maximum allowable number of land surface types per grid box
24 C nchp - integer per-processor number of tiles in tile space
25 C lons - longitude in degrees [im,jm,nSx,nSy]
26 C lats - latitude in degrees [im,jm,nSx,nSy]
27 C
28 C OUTPUT:
29 C
30 C surftype - integer array of land surface types [im,jm,maxtyp,nSx,nSy]
31 C tilefrac - real array of corresponding land surface type fractions
32 C [im,jm,maxtyp,nSx,nSy]
33 C igrd - integer array in tile space of grid point number for each
34 C tile [nchp,nSx,nSy]
35 C ityp - integer array in tile space of land surface type for each
36 C tile [nchp,nSx,nSy]
37 C chfr - real array in tile space of land surface type fraction for
38 C each tile [nchp,nSx,nSy]
39 C
40 C NOTES:
41 C Vegetation type as follows:
42 C 1: BROADLEAF EVERGREEN TREES
43 C 2: BROADLEAF DECIDUOUS TREES
44 C 3: NEEDLELEAF TREES
45 C 4: GROUND COVER
46 C 5: BROADLEAF SHRUBS
47 C 6: DWARF TREES (TUNDRA)
48 C 7: BARE SOIL
49 C 8: DESERT
50 C 9: GLACIER
51 C 10: DARK DESERT
52 C 100: OCEAN
53 C***********************************************************************
54 IMPLICIT NONE
55 #include "EEPARAMS.h"
56
57 INTEGER myThid,im,jm,maxtyp,nchp,nSx,nSy,Nxg,Nyg
58 INTEGER nchptot(nSx,nSy), nchpland(nSx,nSy)
59 INTEGER surftype(im,jm,maxtyp,nSx,nSy)
60 INTEGER igrd(nchp,nSx,nSy),ityp(nchp,nSx,nSy)
61 _RL tilefrac(im,jm,maxtyp,nSx,nSy)
62 _RL lats(im,jm,nSx,nSy), lons(im,jm,nSx,nSy)
63 _RL chfr(nchp,nSx,nSy),chlt(nchp,nSx,nSy),chlon(nchp,nSx,nSy)
64
65 C- local variables:
66 CHARACTER*40 vegdata
67 INTEGER i,j,k,bi,bj
68
69 CHARACTER*15 aim_landfile
70 _RS aim_landFr(-1:34,-1:34,6,1)
71 DATA aim_landfile /'landFrc.2f2.bin'/
72
73 WRITE(standardMessageUnit,'(2A)') ' FIZHI_INIT_VEG: ',
74 & 'defining surface type and fraction: ----------------------'
75
76 CALL READ_REC_XY_RS(aim_LandFile,aim_landFr,1,0,myThid)
77
78 DO bj = myByLo(myThid), myByHi(myThid)
79 DO bi = myBxLo(myThid), myBxHi(myThid)
80
81 do j = 1,jm
82 do i = 1,im
83 if(aim_landfr(i,j,bi,bj).gt.0.1) then
84 surftype(i,j,1,bi,bj) = 1
85 tilefrac(i,j,1,bi,bj) = 0.5 _d 0
86 surftype(i,j,2,bi,bj) = 2
87 tilefrac(i,j,2,bi,bj) = 0.5 _d 0
88 else
89 surftype(i,j,1,bi,bj) = 100
90 tilefrac(i,j,1,bi,bj) = 0.99 _d 0
91 surftype(i,j,2,bi,bj) = 100
92 tilefrac(i,j,2,bi,bj) = 0.01 _d 0
93 endif
94 enddo
95 enddo
96 do k = 3,maxtyp
97 do j = 1,jm
98 do i = 1,im
99 surftype(i,j,k,bi,bj) = 0
100 tilefrac(i,j,k,bi,bj) = 0.
101 enddo
102 enddo
103 enddo
104
105 ENDDO
106 ENDDO
107
108 C create chip arrays for :
109 C igrd : grid index
110 C ityp : veg. type
111 C chfr : vegetation fraction
112 C chlon: chip longitude
113 C chlt : chip latitude
114
115 C nchpland<=nchptot is the actual number of land chips
116 WRITE(standardMessageUnit,'(2A)') ' FIZHI_INIT_VEG: ',
117 & 'setting surface Tiles:'
118
119 DO bj = myByLo(myThid), myByHi(myThid)
120 DO bi = myBxLo(myThid), myBxHi(myThid)
121
122 C- initialise grid index array:
123 do i=1,nchp
124 igrd(i,bi,bj) = 1
125 enddo
126
127 C- land points:
128 nchpland(bi,bj) = 0
129 do k=1,maxtyp
130 do j=1,jm
131 do i=1,im
132 if(surftype(i,j,k,bi,bj).lt.100 .and.
133 & tilefrac(i,j,k,bi,bj).gt.0.) then
134 nchpland(bi,bj) = nchpland(bi,bj) + 1
135 igrd (nchpland(bi,bj),bi,bj) = i + (j-1)*im
136 ityp (nchpland(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
137 chfr (nchpland(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
138 chlon(nchpland(bi,bj),bi,bj) = lons(i,j,bi,bj)
139 chlt (nchpland(bi,bj),bi,bj) = lats(i,j,bi,bj)
140 endif
141 enddo
142 enddo
143 enddo
144
145 C- ocean points:
146 nchptot(bi,bj) = nchpland(bi,bj)
147 do k=1,maxtyp
148 do j=1,jm
149 do i=1,im
150 if(surftype(i,j,k,bi,bj).ge.100 .and.
151 & tilefrac(i,j,k,bi,bj).gt.0.) then
152 nchptot(bi,bj) = nchptot(bi,bj) + 1
153 igrd (nchptot(bi,bj),bi,bj) = i + (j-1)*im
154 ityp (nchptot(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
155 chfr (nchptot(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
156 chlon(nchptot(bi,bj),bi,bj) = lons(i,j,bi,bj)
157 chlt (nchptot(bi,bj),bi,bj) = lats(i,j,bi,bj)
158 endif
159 enddo
160 enddo
161 enddo
162
163 WRITE(standardMessageUnit,'(2(A,I4),2(A,I10))') ' bi=', bi,
164 & ', bj=', bj, ', # of Land Tiles=', nchpland(bi,bj),
165 & ', Total # of Tiles=', nchptot(bi,bj)
166
167 ENDDO
168 ENDDO
169
170 WRITE(standardMessageUnit,'(2A)') ' FIZHI_INIT_VEG: done'
171
172 RETURN
173 END

  ViewVC Help
Powered by ViewVC 1.1.22