pkg/fizhi/fizhi_init_veg.F

C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_init_veg.F,v 1.20 2005/03/03 21:26:34 molod Exp $
C $Name:  $

#include "FIZHI_OPTIONS.h"

      subroutine fizhi_init_veg(mythid,vegdata,im,jm,Nsx,Nsy,Nxg,Nyg,
     . maxtyp,nchp,nchptot,nchpland,lons,lats,surftype,tilefrac,
     . igrd,ityp,chfr,chlt,chlon)
C***********************************************************************
C Subroutine fizhi_init_veg - routine to read in the land surface types,
C      interpolate to the models grid, and set up tile space for use by 
C      the land surface model, the albedo calculation and the surface 
C      roughness calculation.
C
C INPUT:
C 
C mythid   - thread number (processor number)
C vegdata  - Character*40 Vegetation Dataset name
C im       - longitude dimension
C jm       - latitude dimension (number of lat. points)
C Nsx      - Number of processors in x-direction
C Nsy      - Number of processors in y-direction
C maxtyp   - maximum allowable number of land surface types per grid box
C nchp     - integer per-processor number of tiles in tile space
C lons     - longitude in degrees [im,jm,nSx,nSy]
C lats     - latitude in degrees [im,jm,nSx,nSy]
C
C OUTPUT:
C
C surftype - integer array of land surface types [im,jm,maxtyp,Nsx,Nsy]
C tilefrac - real array of corresponding land surface type fractions 
C            [im,jm,maxtyp,Nsx,Nsy]
C igrd     - integer array in tile space of grid point number for each 
C            tile [nchp,Nsx,Nsy]
C ityp     - integer array in tile space of land surface type for each 
C            tile [nchp,Nsx,Nsy]
C chfr     - real array in tile space of land surface type fraction for 
C            each tile [nchp,Nsx,Nsy]
C
C NOTES:
C       Vegetation type as follows:
C                  1:  BROADLEAF EVERGREEN TREES
C                  2:  BROADLEAF DECIDUOUS TREES
C                  3:  NEEDLELEAF TREES
C                  4:  GROUND COVER
C                  5:  BROADLEAF SHRUBS
C                  6:  DWARF TREES (TUNDRA)
C                  7:  BARE SOIL
C                  8:  DESERT    
C                  9:  GLACIER
C                 10:  DARK DESERT
C                100:  OCEAN
C***********************************************************************
      implicit none
#include "EEPARAMS.h"

      integer mythid,im,jm,maxtyp,nchp,Nsx,Nsy,Nxg,Nyg
      integer nchptot(Nsx,Nsy), nchpland(Nsx,Nsy)
      integer surftype(im,jm,maxtyp,Nsx,Nsy)
      integer igrd(nchp,Nsx,Nsy),ityp(nchp,Nsx,Nsy)
      _RL tilefrac(im,jm,maxtyp,Nsx,Nsy)
      _RL lats(im,jm,nSx,nSy), lons(im,jm,nSx,nSy)
      _RL chfr(nchp,Nsx,Nsy),chlt(nchp,Nsx,Nsy),chlon(nchp,Nsx,Nsy)
      character*40 vegdata
      integer imdata,jmdata,Nxgdata,Nygdata
      integer biglobal,bjglobal

      integer*4 im_32, jm_32, Nxg_32, Nyg_32
      integer*4 iveg_32(im,jm,maxtyp,Nxg,Nyg)
         real*4  veg_32(im,jm,maxtyp,Nxg,Nyg)

      integer i,j,k,bi,bj,ierr1,kveg

      call mdsfindunit( kveg, myThid )
      close(kveg)
      open(kveg,file=vegdata,form='unformatted',access='sequential', 
     .                      iostat=ierr1)
      if( ierr1.eq.0 ) then
          read(kveg)im_32,jm_32,Nxg_32,Nyg_32,IVEG_32,VEG_32
      else
       print *
       print *, 'Veg Dataset: ',vegdata,' not found!'
       print *
       call exit(101)
      endif
      close(kveg)

      IF (myThid.eq.1) THEN
      imdata = im_32
      jmdata = jm_32
      Nxgdata = Nxg_32
      Nygdata = Nyg_32
      if( (imdata.ne.im) .or. (jmdata.ne.jm) .or. 
     .                     (Nxgdata.ne.Nxg) .or. (Nygdata.ne.Nyg) ) then
       print *
       print *, 'Veg Data Resolution is Incorrect! '
       print *,' Model Res: ',im,'x',jm,' Data Res: ',imdata,'x',jmdata
       print *,' Model Nxg Nyg: ',Nxg,' ',Nyg,' Data Nxg Nyg: ',Nxgdata,
     .                    ' ',Nygdata
       print *
       call exit(102)
      ENDIF
      ENDIF

      DO BJ = myByLo(myThid), myByHi(myThid)
      DO BI = myBxLo(myThid), myBxHi(myThid)

      biglobal=bi+(myXGlobalLo-1)/im
      bjglobal=bj+(myYGlobalLo-1)/jm
#if defined( _BYTESWAPIO ) && defined( ALLOW_MDSIO )
      call MDS_BYTESWAPR4(im*jm*maxtyp,veg_32(1,1,1,biglobal,bjglobal))
#endif
      do k = 1,maxtyp
      do j = 1,jm
      do i = 1,im
       surftype(i,j,k,bi,bj) = iveg_32(i,j,k,biglobal,bjglobal) 
       tilefrac(i,j,k,bi,bj) = veg_32(i,j,k,biglobal,bjglobal)
      enddo
      enddo
      enddo

      ENDDO
      ENDDO

c     create chip arrays for :
c      igrd :  grid index
c      ityp :  veg. type
c      chfr :  vegetation fraction
c      chlon:  chip longitude
c      chlt :  chip latitude

c     nchpland<=nchptot is the actual number of land chips

      DO BJ = myByLo(myThid), myByHi(myThid)
        DO BI = myBxLo(myThid), myBxHi(myThid)

c         land points
c         -----------
          nchpland(bi,bj) = 0
          do k=1,maxtyp
            do j=1,jm
              do i=1,im
                if(surftype(i,j,k,bi,bj).lt.100 .and.
     .               tilefrac(i,j,k,bi,bj).gt.0.) then
                  nchpland(bi,bj)  = nchpland(bi,bj) + 1
                  igrd (nchpland(bi,bj),bi,bj) = i + (j-1)*im
                  ityp (nchpland(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
                  chfr (nchpland(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
                  chlon(nchpland(bi,bj),bi,bj) = lons(i,j,bi,bj)
                  chlt (nchpland(bi,bj),bi,bj) = lats(i,j,bi,bj)
                endif
              enddo
            enddo
          enddo
          
c         ocean points
c         ------------
          nchptot(bi,bj) = nchpland(bi,bj)
          
          do k=1,maxtyp
            do j=1,jm
              do i=1,im
                if(surftype(i,j,k,bi,bj).ge.100 .and. 
     .               tilefrac(i,j,k,bi,bj).gt.0.) then
                  nchptot(bi,bj)  = nchptot(bi,bj) + 1
                  igrd (nchptot(bi,bj),bi,bj) = i + (j-1)*im
                  ityp (nchptot(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
                  chfr (nchptot(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
                  chlon(nchptot(bi,bj),bi,bj) = lons(i,j,bi,bj)
                  chlt (nchptot(bi,bj),bi,bj) = lats(i,j,bi,bj)
                endif
              enddo
            enddo
          enddo
          
          print *,'No of Total Tiles for bi=',bi,': ',nchptot(bi,bj)
          print *,'No of Land  Tiles for bi=',bi,': ',nchpland(bi,bj)

        ENDDO
      ENDDO

      RETURN
      END
1	molod	1.21	C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_init_veg.F,v 1.20 2005/03/03 21:26:34 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.6	read(kveg)im_32,jm_32,Nxg_32,Nyg_32,IVEG_32,VEG_32
80	molod	1.1	else
81			print *
82			print *, 'Veg Dataset: ',vegdata,' not found!'
83			print *
84	molod	1.2	call exit(101)
85	molod	1.1	endif
86	molod	1.2	close(kveg)
87	edhill	1.14
88	molod	1.3	IF (myThid.eq.1) THEN
89	molod	1.2	imdata = im_32
90			jmdata = jm_32
91	molod	1.6	Nxgdata = Nxg_32
92			Nygdata = Nyg_32
93	molod	1.2	if( (imdata.ne.im) .or. (jmdata.ne.jm) .or.
94	molod	1.6	. (Nxgdata.ne.Nxg) .or. (Nygdata.ne.Nyg) ) then
95	molod	1.2	print *
96			print *, 'Veg Data Resolution is Incorrect! '
97			print *,' Model Res: ',im,'x',jm,' Data Res: ',imdata,'x',jmdata
98	molod	1.6	print *,' Model Nxg Nyg: ',Nxg,' ',Nyg,' Data Nxg Nyg: ',Nxgdata,
99			. ' ',Nygdata
100	molod	1.2	print *
101			call exit(102)
102	molod	1.1	ENDIF
103	molod	1.12	ENDIF
104
105	molod	1.5	DO BJ = myByLo(myThid), myByHi(myThid)
106			DO BI = myBxLo(myThid), myBxHi(myThid)
107
108			biglobal=bi+(myXGlobalLo-1)/im
109			bjglobal=bj+(myYGlobalLo-1)/jm
110	edhill	1.14	#if defined( _BYTESWAPIO ) && defined( ALLOW_MDSIO )
111	molod	1.13	call MDS_BYTESWAPR4(imjmmaxtyp,veg_32(1,1,1,biglobal,bjglobal))
112			#endif
113	molod	1.2	do k = 1,maxtyp
114	molod	1.4	do j = 1,jm
115			do i = 1,im
116	molod	1.5	surftype(i,j,k,bi,bj) = iveg_32(i,j,k,biglobal,bjglobal)
117			tilefrac(i,j,k,bi,bj) = veg_32(i,j,k,biglobal,bjglobal)
118	molod	1.2	enddo
119	molod	1.1	enddo
120			enddo
121
122	edhill	1.14	ENDDO
123			ENDDO
124
125			c create chip arrays for :
126	molod	1.1	c igrd : grid index
127			c ityp : veg. type
128			c chfr : vegetation fraction
129	molod	1.7	c chlon: chip longitude
130			c chlt : chip latitude
131	molod	1.1
132	molod	1.15	c nchpland<=nchptot is the actual number of land chips
133	molod	1.1
134	edhill	1.14	DO BJ = myByLo(myThid), myByHi(myThid)
135			DO BI = myBxLo(myThid), myBxHi(myThid)
136	molod	1.1
137	edhill	1.14	c land points
138			c -----------
139	molod	1.18	nchpland(bi,bj) = 0
140	edhill	1.14	do k=1,maxtyp
141			do j=1,jm
142			do i=1,im
143			if(surftype(i,j,k,bi,bj).lt.100 .and.
144			. tilefrac(i,j,k,bi,bj).gt.0.) then
145	molod	1.18	nchpland(bi,bj) = nchpland(bi,bj) + 1
146			igrd (nchpland(bi,bj),bi,bj) = i + (j-1)*im
147			ityp (nchpland(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
148			chfr (nchpland(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
149			chlon(nchpland(bi,bj),bi,bj) = lons(i,j,bi,bj)
150			chlt (nchpland(bi,bj),bi,bj) = lats(i,j,bi,bj)
151	edhill	1.14	endif
152			enddo
153			enddo
154			enddo
155
156			c ocean points
157			c ------------
158	molod	1.18	nchptot(bi,bj) = nchpland(bi,bj)
159	edhill	1.14
160			do k=1,maxtyp
161			do j=1,jm
162			do i=1,im
163			if(surftype(i,j,k,bi,bj).ge.100 .and.
164			. tilefrac(i,j,k,bi,bj).gt.0.) then
165	molod	1.18	nchptot(bi,bj) = nchptot(bi,bj) + 1
166			igrd (nchptot(bi,bj),bi,bj) = i + (j-1)*im
167			ityp (nchptot(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
168			chfr (nchptot(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
169			chlon(nchptot(bi,bj),bi,bj) = lons(i,j,bi,bj)
170			chlt (nchptot(bi,bj),bi,bj) = lats(i,j,bi,bj)
171	edhill	1.14	endif
172			enddo
173			enddo
174			enddo
175
176	molod	1.21	print *,'No of Total Tiles for bi=',bi,': ',nchptot(bi,bj)
177			print *,'No of Land Tiles for bi=',bi,': ',nchpland(bi,bj)
178	molod	1.18
179	edhill	1.14	ENDDO
180	molod	1.2	ENDDO
181	molod	1.21
182	molod	1.1	RETURN
183			END