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

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

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

revision 1.1 by molod, Fri Jun 4 20:19:26 2004 UTC revision 1.2 by molod, Mon Jun 7 16:04:17 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4        subroutine fizhi_init_veg ( mythid, im,jm,vegdata,        subroutine fizhi_init_veg ( mythid, vegdata,im,jm,bi,bj,maxtyp,
5       .                    maxtyp,nchp,outlons,outlats,       . surftype,tilefrac,igrd,ityp,chfr )
      .                    flwi,nchplnd,surftype,tilefrac,  
      .                    igrd,ityp,chfr )  
6  C***********************************************************************  C***********************************************************************
7  C Subroutine mkwrld - routine to read in the land surface types,  C Subroutine fizhi_init_veg - routine to read in the land surface types,
8  C                     interpolate to the models grid,  C      interpolate to the models grid, and set up tile space for use by
9  C                     and set up tile space for use by the  C      the land surface model, the albedo calculation and the surface
10  C                     land surface model and the albedo calculation  C      roughness calculation.
 C                     and the surface roughness calculation.  
11  C  C
12  C INPUT:  C INPUT:
13  C  C
14  C mythid   - thread number (processor number)  C mythid   - thread number (processor number)
15    C vegdata  - Character*40 Vegetation Dataset name
16  C im       - model grid longitude dimension  C im       - model grid longitude dimension
17  C jm       - model grid latitude dimension (number of lat. points)  C jm       - model grid latitude dimension (number of lat. points)
18  C vegdata  - Character*40 Vegetation Dataset name  C bi       - Number of processors in x-direction
19    C bj       - Number of processors in y-direction
20  C maxtyp   - maximum allowable number of land surface types per grid box  C maxtyp   - maximum allowable number of land surface types per grid box
21  C nchp     - integer actual number of tiles in tile space  C nchpmax  - integer maximum per-processor number of tiles in tile space
 C outlons  - longitude value in degrees at model grid points  
 C outlats  - latitude value in degrees at model grid points  
 C flwi     - land-water mask from the old boundary conditions dataset  
 C            (for the temporary!! compatibility check)  
22  C  C
23  C OUTPUT:  C OUTPUT:
24  C  C
25  C surftype - integer array of land surface types [im,jm,maxtyp]  C surftype - integer array of land surface types [im,jm,maxtyp,bi,bj]
26  C tilefrac - real array of corresponding land surface type fractions  C tilefrac - real array of corresponding land surface type fractions
27  C            [im,jm,maxtyp]  C            [im,jm,maxtyp,bi,bj]
28  C igrd     - integer array in tile space of grid point number for each  C igrd     - integer array in tile space of grid point number for each
29  C            tile [nchp]  C            tile [nchp,bi,bj]
30  C ityp     - integer array in tile space of land surface type for each  C ityp     - integer array in tile space of land surface type for each
31  C            tile [nchp]  C            tile [nchp,bi,bj]
32  C chfr     - real array in tile space of land surface type fraction for  C chfr     - real array in tile space of land surface type fraction for
33  C            each tile [nchp]  C            each tile [nchp,bi,bj]
34  C  C
35  C NOTES:  C NOTES:
36  C       Vegetation type as follows:  C       Vegetation type as follows:
# Line 51  C                  9:  GLACIER Line 46  C                  9:  GLACIER
46  C                 10:  DARK DESERT  C                 10:  DARK DESERT
47  C                100:  OCEAN  C                100:  OCEAN
48  C***********************************************************************  C***********************************************************************
   
49        implicit none        implicit none
50    #include "EEPARAMS.h"
51    
52        integer exist        integer mythid,im,jm,maxtyp,nchpmax
53        real zero,one        integer surftype(im,jm,maxtyp,bi,bj)
54        parameter (zero = 0.)        integer igrd(nchpmax,bi,bj),ityp(nchpmax,bi,bj)
55        parameter (one = 1.)        real tilefrac(im,jm,maxtyp,bi,bj)
56        parameter (exist=11)        real chfr(nchpmax,bi,bj)
   
       integer mythid,im,imdata,jm,jmdata,maxtyp,nchp,nchplnd  
       real chfr(1)  
       integer surftype(im,jm,maxtyp),igrd(1),ityp(1)  
       real tilefrac(im,jm,maxtyp)  
       real outlons(im,jm),outlats(im,jm),flwi(im,jm)  
57        character*40 vegdata        character*40 vegdata
58        character*40 veg1x1        integer imdata,jmdata,bidata,bjdata
59        data veg1x1 /'veg360181.data'/        integer nchp,nchpland
   
       integer*4 im_32, jm_32  
       integer*4 iveg_32(360*181*10)  
          real*4  veg_32(360*181*10)  
          real    vegf  (360*181*10)  
       integer   ivegt  (360*181*10)  
   
       real locfracin(360,181,exist),locfracout(im,jm,exist)  
       real inlons(360*181),inlats(360*181)  
       integer i,ii,iii,iindex,j,jindex,k,kk,kkk,kbig,numtypes  
       real fract(maxtyp),undef,found,biggest  
       integer stype(maxtyp), ierr1, ierr2  
       logical okay,ordered  
       integer whichtypes(exist)  
       integer kveg  
60    
61        real dummy(im,jm)        integer*4 im_32, jm_32, bi_32, bj_32
62          integer*4 iveg_32(im,jm,maxtyp,bi,bj)
63             real*4  veg_32(im,jm,maxtyp,bi,bj)
64    
65        real getcon        integer i,j,k,bilocal,bjlocal,ierr1,kveg
       undef = getcon('UNDEF')  
66    
67        IF (myThid.eq.1) THEN        IF (myThid.eq.1) THEN
68        call mdsfindunit( kveg, myThid )        call mdsfindunit( kveg, myThid )
69        close (kveg)        close(kveg)
70        open  (kveg, file=vegdata, form='unformatted', access='sequential', iostat=ierr1)        open(kveg,file=vegdata,form='unformatted',access='sequential',
71         .                      iostat=ierr1)
72        if( ierr1.eq.0 ) then        if( ierr1.eq.0 ) then
73            read  (kveg) im_32,jm_32, (IVEG_32(i),i=1,im_32*jm_32*maxtyp),            read(kveg)im_32,jm_32,bi_32,bj_32,IVEG_32,VEG_32
      .                               (VEG_32(i),i=1,im_32*jm_32*maxtyp)  
74        else        else
75         print *         print *
76         print *, 'Veg Dataset: ',vegdata,' not found!'         print *, 'Veg Dataset: ',vegdata,' not found!'
77         print *         print *
78         call exit (101)         call exit(101)
79        endif        endif
80        close (kveg)        close(kveg)
81          imdata = im_32
82          jmdata = jm_32
83          bidata = bi_32
84          bjdata = bj_32
85          if( (imdata.ne.im) .or. (jmdata.ne.jm) .or.
86         .                        (bi.ne.bidata) .or. (bjdata.ne.bj) ) then
87           print *
88           print *, 'Veg Data Resolution is Incorrect! '
89           print *,' Model Res: ',im,'x',jm,' Data Res: ',imdata,'x',jmdata
90           print *,' Model Bij: ',bi,'x',bj,' Data Bij: ',bidata,'x',bjdata
91           print *
92           call exit(102)
93        ENDIF        ENDIF
94                                                                                    
95        imdata = im_32        imdata = im_32
96        jmdata = jm_32        jmdata = jm_32
97        do i = 1,im_32*jm_32*maxtyp        bidata = bi_32
98        ivegt(i) = iveg_32(i)        bjdata = bj_32
        vegf(i) =  veg_32(i)  
       enddo  
99    
100        do iii = 1,im*jm*maxtyp        DO BJLOCAL = myByLo(myThid), myByHi(myThid)
101         tilefrac(iii,1,1) = vegf(iii)        DO BILOCAL = myBxLo(myThid), myBxHi(myThid)
102         surftype(iii,1,1) = ivegt(iii)                                                                                  
103          do k = 1,maxtyp
104          do j = 1,jm_32
105          do i = 1,im_32
106           surftype(i,j,k,bilocal,bjlocal) = iveg_32(i,j,k,bilocal,bjlocal)
107           tilefrac(i,j,k,bilocal,bjlocal) = veg_32(i,j,k,bilocal,bjlocal)
108          enddo
109          enddo
110        enddo        enddo
111    
112  c   create chip arrays for :  c   create chip arrays for :
# Line 130  c ----------- Line 122  c -----------
122        do k=1,maxtyp        do k=1,maxtyp
123        do j=1,jm        do j=1,jm
124        do i=1,im        do i=1,im
125        if(surftype(i,j,k).lt.100 .and. tilefrac(i,j,k).gt.0.) then        if(surftype(i,j,k,bi,bj).lt.100.and.
126         .                                  tilefrac(i,j,k,bi,bj).gt.0.)then
127               nchplnd  = nchplnd + 1               nchplnd  = nchplnd + 1
128         igrd (nchplnd) = i + (j-1)*im         igrd (nchplnd,bi,bj) = i + (j-1)*im
129         ityp (nchplnd) = surftype(i,j,k)         ityp (nchplnd,bi,bj) = surftype(i,j,k,bi,bj)
130         chfr (nchplnd) = tilefrac(i,j,k)         chfr (nchplnd,bi,bj) = tilefrac(i,j,k,bi,bj)
131        endif        endif
132        enddo        enddo
133        enddo        enddo
# Line 147  c ------------ Line 140  c ------------
140        do k=1,maxtyp        do k=1,maxtyp
141        do j=1,jm        do j=1,jm
142        do i=1,im        do i=1,im
143        if(surftype(i,j,k).ge.100 .and. tilefrac(i,j,k).gt.0. ) then        if(surftype(i,j,k,bi,bj).ge.100 .and.
144         .                                  tilefrac(i,j,k,bi,bj).gt.0.)then
145               nchp  = nchp + 1               nchp  = nchp + 1
146         igrd (nchp) = i + (j-1)*im         igrd (nchp,bi,bj) = i + (j-1)*im
147         ityp (nchp) = surftype(i,j,k)         ityp (nchp,bi,bj) = surftype(i,j,k,bi,bj)
148         chfr (nchp) = tilefrac(i,j,k)         chfr (nchp,bi,bj) = tilefrac(i,j,k,bi,bj)
149        endif        endif
150        enddo        enddo
151        enddo        enddo
152        enddo        enddo
153    
154          print *, 'bi ',bilocal,' bj ',bjlocal
155        print *, 'Number of Total Tiles: ',nchp        print *, 'Number of Total Tiles: ',nchp
156        print *, 'Number of Land  Tiles: ',nchplnd        print *, 'Number of Land  Tiles: ',nchplnd
157        print *        print *
158    
159          ENDDO
160          ENDDO
161    
162        RETURN        RETURN
163        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22