/[MITgcm]/MITgcm/pkg/fizhi/fizhi_init_veg.F
ViewVC logotype

Annotation of /MITgcm/pkg/fizhi/fizhi_init_veg.F

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

Revision 1.23 - (hide annotations) (download)
Thu May 12 15:38:50 2005 UTC (19 years, 1 month ago) by molod
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint57o_post, checkpoint58e_post, checkpoint57v_post, checkpoint58u_post, checkpoint58w_post, checkpoint57m_post, checkpoint57s_post, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint57k_post, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint58r_post, checkpoint57i_post, checkpoint57y_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint57h_done, checkpoint58f_post, checkpoint57x_post, checkpoint57n_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint57j_post, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58b_post, checkpoint57h_pre, checkpoint58m_post, checkpoint57l_post, checkpoint57h_post
Changes since 1.22: +8 -1 lines 
Fix byteswapping sequence (make calls for integers too)
1 molod 1.23 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_init_veg.F,v 1.22 2005/05/04 22:15:17 molod Exp $
2 molod 1.1 C $Name: $
3    
4 edhill 1.14 #include "FIZHI_OPTIONS.h"
5    
6 molod 1.6 subroutine fizhi_init_veg(mythid,vegdata,im,jm,Nsx,Nsy,Nxg,Nyg,
7 molod 1.15 . maxtyp,nchp,nchptot,nchpland,lons,lats,surftype,tilefrac,
8     . igrd,ityp,chfr,chlt,chlon)
9 molod 1.1 C***********************************************************************
10 molod 1.2 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 molod 1.1 C
15     C INPUT:
16     C
17     C mythid - thread number (processor number)
18 molod 1.2 C vegdata - Character*40 Vegetation Dataset name
19 molod 1.7 C im - longitude dimension
20     C jm - latitude dimension (number of lat. points)
21 molod 1.4 C Nsx - Number of processors in x-direction
22     C Nsy - Number of processors in y-direction
23 molod 1.1 C maxtyp - maximum allowable number of land surface types per grid box
24 molod 1.6 C nchp - integer per-processor number of tiles in tile space
25 molod 1.7 C lons - longitude in degrees [im,jm,nSx,nSy]
26     C lats - latitude in degrees [im,jm,nSx,nSy]
27 molod 1.1 C
28     C OUTPUT:
29     C
30 molod 1.4 C surftype - integer array of land surface types [im,jm,maxtyp,Nsx,Nsy]
31 molod 1.1 C tilefrac - real array of corresponding land surface type fractions
32 molod 1.4 C [im,jm,maxtyp,Nsx,Nsy]
33 molod 1.1 C igrd - integer array in tile space of grid point number for each
34 molod 1.4 C tile [nchp,Nsx,Nsy]
35 molod 1.1 C ityp - integer array in tile space of land surface type for each
36 molod 1.4 C tile [nchp,Nsx,Nsy]
37 molod 1.1 C chfr - real array in tile space of land surface type fraction for
38 molod 1.4 C each tile [nchp,Nsx,Nsy]
39 molod 1.1 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 molod 1.5 #include "EEPARAMS.h"
56 molod 1.1
57 molod 1.18 integer mythid,im,jm,maxtyp,nchp,Nsx,Nsy,Nxg,Nyg
58     integer nchptot(Nsx,Nsy), nchpland(Nsx,Nsy)
59 molod 1.4 integer surftype(im,jm,maxtyp,Nsx,Nsy)
60 molod 1.6 integer igrd(nchp,Nsx,Nsy),ityp(nchp,Nsx,Nsy)
61 molod 1.10 _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 molod 1.1 character*40 vegdata
65 molod 1.6 integer imdata,jmdata,Nxgdata,Nygdata
66 molod 1.15 integer biglobal,bjglobal
67 molod 1.1
68 molod 1.6 integer*4 im_32, jm_32, Nxg_32, Nyg_32
69     integer*4 iveg_32(im,jm,maxtyp,Nxg,Nyg)
70     real*4 veg_32(im,jm,maxtyp,Nxg,Nyg)
71 molod 1.1
72 molod 1.3 integer i,j,k,bi,bj,ierr1,kveg
73 molod 1.1
74     call mdsfindunit( kveg, myThid )
75 molod 1.2 close(kveg)
76     open(kveg,file=vegdata,form='unformatted',access='sequential',
77     . iostat=ierr1)
78 molod 1.1 if( ierr1.eq.0 ) then
79 molod 1.22 rewind(kveg)
80 molod 1.6 read(kveg)im_32,jm_32,Nxg_32,Nyg_32,IVEG_32,VEG_32
81 molod 1.1 else
82     print *
83     print *, 'Veg Dataset: ',vegdata,' not found!'
84     print *
85 molod 1.2 call exit(101)
86 molod 1.1 endif
87 molod 1.2 close(kveg)
88 molod 1.23 #if defined( _BYTESWAPIO ) && defined( ALLOW_MDSIO )
89     call MDS_BYTESWAPI4(1,im_32)
90     call MDS_BYTESWAPI4(1,jm_32)
91     call MDS_BYTESWAPI4(1,nxg_32)
92     call MDS_BYTESWAPI4(1,nyg_32)
93     #endif
94 edhill 1.14
95 molod 1.3 IF (myThid.eq.1) THEN
96 molod 1.2 imdata = im_32
97     jmdata = jm_32
98 molod 1.6 Nxgdata = Nxg_32
99     Nygdata = Nyg_32
100 molod 1.2 if( (imdata.ne.im) .or. (jmdata.ne.jm) .or.
101 molod 1.6 . (Nxgdata.ne.Nxg) .or. (Nygdata.ne.Nyg) ) then
102 molod 1.2 print *
103     print *, 'Veg Data Resolution is Incorrect! '
104     print *,' Model Res: ',im,'x',jm,' Data Res: ',imdata,'x',jmdata
105 molod 1.6 print *,' Model Nxg Nyg: ',Nxg,' ',Nyg,' Data Nxg Nyg: ',Nxgdata,
106     . ' ',Nygdata
107 molod 1.2 print *
108     call exit(102)
109 molod 1.1 ENDIF
110 molod 1.12 ENDIF
111    
112 molod 1.5 DO BJ = myByLo(myThid), myByHi(myThid)
113     DO BI = myBxLo(myThid), myBxHi(myThid)
114    
115     biglobal=bi+(myXGlobalLo-1)/im
116     bjglobal=bj+(myYGlobalLo-1)/jm
117 edhill 1.14 #if defined( _BYTESWAPIO ) && defined( ALLOW_MDSIO )
118 molod 1.13 call MDS_BYTESWAPR4(im*jm*maxtyp,veg_32(1,1,1,biglobal,bjglobal))
119 molod 1.23 call MDS_BYTESWAPI4(im*jm*maxtyp,iveg_32(1,1,1,biglobal,bjglobal))
120 molod 1.13 #endif
121 molod 1.2 do k = 1,maxtyp
122 molod 1.4 do j = 1,jm
123     do i = 1,im
124 molod 1.5 surftype(i,j,k,bi,bj) = iveg_32(i,j,k,biglobal,bjglobal)
125     tilefrac(i,j,k,bi,bj) = veg_32(i,j,k,biglobal,bjglobal)
126 molod 1.2 enddo
127 molod 1.1 enddo
128     enddo
129    
130 edhill 1.14 ENDDO
131     ENDDO
132    
133     c create chip arrays for :
134 molod 1.1 c igrd : grid index
135     c ityp : veg. type
136     c chfr : vegetation fraction
137 molod 1.7 c chlon: chip longitude
138     c chlt : chip latitude
139 molod 1.1
140 molod 1.15 c nchpland<=nchptot is the actual number of land chips
141 molod 1.1
142 edhill 1.14 DO BJ = myByLo(myThid), myByHi(myThid)
143     DO BI = myBxLo(myThid), myBxHi(myThid)
144 molod 1.1
145 edhill 1.14 c land points
146     c -----------
147 molod 1.18 nchpland(bi,bj) = 0
148 edhill 1.14 do k=1,maxtyp
149     do j=1,jm
150     do i=1,im
151     if(surftype(i,j,k,bi,bj).lt.100 .and.
152     . tilefrac(i,j,k,bi,bj).gt.0.) then
153 molod 1.18 nchpland(bi,bj) = nchpland(bi,bj) + 1
154     igrd (nchpland(bi,bj),bi,bj) = i + (j-1)*im
155     ityp (nchpland(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
156     chfr (nchpland(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
157     chlon(nchpland(bi,bj),bi,bj) = lons(i,j,bi,bj)
158     chlt (nchpland(bi,bj),bi,bj) = lats(i,j,bi,bj)
159 edhill 1.14 endif
160     enddo
161     enddo
162     enddo
163    
164     c ocean points
165     c ------------
166 molod 1.18 nchptot(bi,bj) = nchpland(bi,bj)
167 edhill 1.14
168     do k=1,maxtyp
169     do j=1,jm
170     do i=1,im
171     if(surftype(i,j,k,bi,bj).ge.100 .and.
172     . tilefrac(i,j,k,bi,bj).gt.0.) then
173 molod 1.18 nchptot(bi,bj) = nchptot(bi,bj) + 1
174     igrd (nchptot(bi,bj),bi,bj) = i + (j-1)*im
175     ityp (nchptot(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
176     chfr (nchptot(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
177     chlon(nchptot(bi,bj),bi,bj) = lons(i,j,bi,bj)
178     chlt (nchptot(bi,bj),bi,bj) = lats(i,j,bi,bj)
179 edhill 1.14 endif
180     enddo
181     enddo
182     enddo
183    
184 molod 1.21 print *,'No of Total Tiles for bi=',bi,': ',nchptot(bi,bj)
185     print *,'No of Land Tiles for bi=',bi,': ',nchpland(bi,bj)
186 molod 1.18
187 edhill 1.14 ENDDO
188 molod 1.2 ENDDO
189 molod 1.21
190 molod 1.1 RETURN
191     END
  ViewVC Help
Powered by ViewVC 1.1.22