fizhi-cs-aqualev20/code/fizhi_init_veg.F

7ae8fb32b5 Andr*0001 #include "FIZHI_OPTIONS.h"
                0002
d58f306b82 Jean*0003       SUBROUTINE FIZHI_INIT_VEG(myThid,vegdata,im,jm,nSx,nSy,Nxg,Nyg,
                0004      & maxtyp,nchp,nchptot,nchpland,lons,lats,surftype,tilefrac,
                0005      & igrd,ityp,chfr,chlt,chlon)
7ae8fb32b5 Andr*0006 C***********************************************************************
                0007 C Subroutine fizhi_init_veg - routine to read in the land surface types,
d58f306b82 Jean*0008 C      interpolate to the models grid, and set up tile space for use by
                0009 C      the land surface model, the albedo calculation and the surface
7ae8fb32b5 Andr*0010 C      roughness calculation.
                0011 C
                0012 C INPUT:
d58f306b82 Jean*0013 C
                0014 C myThid   - thread number (processor number)
7ae8fb32b5 Andr*0015 C vegdata  - Character*40 Vegetation Dataset name
                0016 C im       - longitude dimension
                0017 C jm       - latitude dimension (number of lat. points)
d58f306b82 Jean*0018 C nSx      - Number of processors in x-direction
                0019 C nSy      - Number of processors in y-direction
7ae8fb32b5 Andr*0020 C maxtyp   - maximum allowable number of land surface types per grid box
                0021 C nchp     - integer per-processor number of tiles in tile space
                0022 C lons     - longitude in degrees [im,jm,nSx,nSy]
                0023 C lats     - latitude in degrees [im,jm,nSx,nSy]
                0024 C
                0025 C OUTPUT:
                0026 C
d58f306b82 Jean*0027 C surftype - integer array of land surface types [im,jm,maxtyp,nSx,nSy]
                0028 C tilefrac - real array of corresponding land surface type fractions
                0029 C            [im,jm,maxtyp,nSx,nSy]
                0030 C igrd     - integer array in tile space of grid point number for each
                0031 C            tile [nchp,nSx,nSy]
                0032 C ityp     - integer array in tile space of land surface type for each
                0033 C            tile [nchp,nSx,nSy]
                0034 C chfr     - real array in tile space of land surface type fraction for
                0035 C            each tile [nchp,nSx,nSy]
7ae8fb32b5 Andr*0036 C
                0037 C NOTES:
                0038 C       Vegetation type as follows:
                0039 C                  1:  BROADLEAF EVERGREEN TREES
                0040 C                  2:  BROADLEAF DECIDUOUS TREES
                0041 C                  3:  NEEDLELEAF TREES
                0042 C                  4:  GROUND COVER
                0043 C                  5:  BROADLEAF SHRUBS
                0044 C                  6:  DWARF TREES (TUNDRA)
                0045 C                  7:  BARE SOIL
d58f306b82 Jean*0046 C                  8:  DESERT
7ae8fb32b5 Andr*0047 C                  9:  GLACIER
                0048 C                 10:  DARK DESERT
                0049 C                100:  OCEAN
                0050 C***********************************************************************
d58f306b82 Jean*0051       IMPLICIT NONE
7ae8fb32b5 Andr*0052 #include "EEPARAMS.h"
                0053
d58f306b82 Jean*0054       INTEGER myThid,im,jm,maxtyp,nchp,nSx,nSy,Nxg,Nyg
                0055       INTEGER nchptot(nSx,nSy), nchpland(nSx,nSy)
                0056       INTEGER surftype(im,jm,maxtyp,nSx,nSy)
                0057       INTEGER igrd(nchp,nSx,nSy),ityp(nchp,nSx,nSy)
                0058       _RL tilefrac(im,jm,maxtyp,nSx,nSy)
7ae8fb32b5 Andr*0059       _RL lats(im,jm,nSx,nSy), lons(im,jm,nSx,nSy)
d58f306b82 Jean*0060       _RL chfr(nchp,nSx,nSy),chlt(nchp,nSx,nSy),chlon(nchp,nSx,nSy)
7ae8fb32b5 Andr*0061
d58f306b82 Jean*0062 C-    local variables:
                0063       CHARACTER*40 vegdata
                0064       INTEGER i,j,k,bi,bj
                0065
                0066       WRITE(standardMessageUnit,'(2A)') ' FIZHI_INIT_VEG: ',
                0067      &   'defining surface type and fraction: ----------------------'
                0068
                0069       DO bj = myByLo(myThid), myByHi(myThid)
                0070        DO bi = myBxLo(myThid), myBxHi(myThid)
                0071
                0072         do j = 1,jm
                0073          do i = 1,im
                0074            surftype(i,j,1,bi,bj) = 100
                0075            tilefrac(i,j,1,bi,bj) = 0.99 _d 0
                0076            surftype(i,j,2,bi,bj) = 100
                0077            tilefrac(i,j,2,bi,bj) = 0.01 _d 0
                0078          enddo
                0079         enddo
                0080         do k = 3,maxtyp
                0081          do j = 1,jm
                0082           do i = 1,im
                0083            surftype(i,j,k,bi,bj) = 0
                0084            tilefrac(i,j,k,bi,bj) = 0.
                0085           enddo
                0086          enddo
                0087         enddo
                0088
                0089        ENDDO
7ae8fb32b5 Andr*0090       ENDDO
                0091
d58f306b82 Jean*0092 C     create chip arrays for :
                0093 C      igrd :  grid index
                0094 C      ityp :  veg. type
                0095 C      chfr :  vegetation fraction
                0096 C      chlon:  chip longitude
                0097 C      chlt :  chip latitude
                0098
                0099 C     nchpland<=nchptot is the actual number of land chips
                0100       WRITE(standardMessageUnit,'(2A)') ' FIZHI_INIT_VEG: ',
                0101      &   'setting surface Tiles:'
                0102
                0103       DO bj = myByLo(myThid), myByHi(myThid)
                0104        DO bi = myBxLo(myThid), myBxHi(myThid)
                0105
                0106 C-       initialise grid index array:
                0107          do i=1,nchp
                0108            igrd(i,bi,bj) = 1
                0109          enddo
                0110
                0111 C-       land points:
                0112          nchpland(bi,bj) = 0
                0113
                0114 C-       ocean points:
                0115          nchptot(bi,bj) = nchpland(bi,bj)
                0116          do k=1,maxtyp
                0117           do j=1,jm
                0118            do i=1,im
                0119              if(surftype(i,j,k,bi,bj).ge.100 .and.
                0120      &            tilefrac(i,j,k,bi,bj).gt.0.) then
                0121                nchptot(bi,bj)  = nchptot(bi,bj) + 1
                0122                igrd (nchptot(bi,bj),bi,bj) = i + (j-1)*im
                0123                ityp (nchptot(bi,bj),bi,bj) = surftype(i,j,k,bi,bj)
                0124                chfr (nchptot(bi,bj),bi,bj) = tilefrac(i,j,k,bi,bj)
                0125                chlon(nchptot(bi,bj),bi,bj) = lons(i,j,bi,bj)
                0126                chlt (nchptot(bi,bj),bi,bj) = lats(i,j,bi,bj)
                0127              endif
                0128            enddo
7ae8fb32b5 Andr*0129           enddo
d58f306b82 Jean*0130          enddo
                0131
                0132          WRITE(standardMessageUnit,'(2(A,I4),2(A,I10))') '  bi=', bi,
                0133      &    ', bj=', bj, ', # of Land Tiles=', nchpland(bi,bj),
                0134      &                 ', Total # of Tiles=', nchptot(bi,bj)
7ae8fb32b5 Andr*0135
d58f306b82 Jean*0136        ENDDO
7ae8fb32b5 Andr*0137       ENDDO
                0138
d58f306b82 Jean*0139       WRITE(standardMessageUnit,'(2A)') ' FIZHI_INIT_VEG: done'
                0140
7ae8fb32b5 Andr*0141       RETURN
                0142       END