22 |
#include "gridalt_mapping.h" |
#include "gridalt_mapping.h" |
23 |
#include "fizhi_land_coms.h" |
#include "fizhi_land_coms.h" |
24 |
#include "fizhi_earth_coms.h" |
#include "fizhi_earth_coms.h" |
25 |
|
#include "fizhi_ocean_coms.h" |
26 |
#include "EEPARAMS.h" |
#include "EEPARAMS.h" |
27 |
|
|
28 |
integer myTime, myIter, myThid |
integer myTime, myIter, myThid |
29 |
|
|
30 |
real lats(sNx,sNy), lons(sNx,sNy), cosz(sNx,sNy) |
real lats(sNx,sNy), lons(sNx,sNy), cosz(sNx,sNy) |
31 |
|
real fraci(sNx,sNy), fracl(sNx,sNy) |
32 |
|
real ficetile(nchp) |
33 |
|
real ra |
34 |
integer i, j, L, bi, bj |
integer i, j, L, bi, bj |
35 |
integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2 |
integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2 |
36 |
integer sec, day, month |
integer sec, day, month |
59 |
enddo |
enddo |
60 |
enddo |
enddo |
61 |
|
|
62 |
|
call get_landfrac(im2,jm2,nSx,nSy,bi,bj,maxtyp,surftype,tilefrac, |
63 |
|
. fracl) |
64 |
|
do j = jm1,jm2 |
65 |
|
do i = im1,im2 |
66 |
|
if(sea_ice(i,j,bi,bj).gt.0.) then |
67 |
|
fraci(i,j) = 1. |
68 |
|
else |
69 |
|
fraci(i,j) = 0. |
70 |
|
endif |
71 |
|
enddo |
72 |
|
enddo |
73 |
|
|
74 |
C*********************************************************************** |
C*********************************************************************** |
75 |
C* Get Leaf-Area-Index and Greenness Index * |
C* Get Leaf-Area-Index and Greenness Index * |
76 |
C*********************************************************************** |
C*********************************************************************** |
77 |
|
|
78 |
if( alarm('turb') .or. alarm('radsw') ) then |
if( alarm('turb') .or. alarm('radsw') ) then |
79 |
call getlgr (sec,month,day,chlt,ityp,nchpland,alai,agrn ) |
call getlgr (sec,month,day,chlt,ityp,nchpland,bi,bj,alai,agrn ) |
80 |
endif |
endif |
81 |
|
|
82 |
C ********************************************************************** |
C ********************************************************************** |
84 |
C ********************************************************************** |
C ********************************************************************** |
85 |
|
|
86 |
if( alarm('radsw') ) then |
if( alarm('radsw') ) then |
87 |
call astro ( nymd,nhms, lats,lons, im2*jm2, cosz,ra ) |
call astro(nymd,nhms,lats,lons,im2*jm2,cosz,ra) |
88 |
call getalb ( sec,month,day,cosz,snodep,fraci,fracl, |
call getalb(sec,month,day,cosz,snodep,fraci,fracl,im2,jm2,nchp, |
89 |
. im,jm,nchp,nchpland,igrd,ityp,chfr,chlt,alai,agrn, |
. nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,alai,agrn, |
90 |
. albvisdr,albvisdf,albnirdr,albnirdf ) |
. albvisdr,albvisdf,albnirdr,albnirdf ) |
91 |
endif |
endif |
92 |
|
|
93 |
|
|
96 |
C ********************************************************************** |
C ********************************************************************** |
97 |
|
|
98 |
if( alarm('radlw') ) then |
if( alarm('radlw') ) then |
99 |
call grd2msc ( fraci,im,jm,igrd,ficetile,nchp,nchp ) |
call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchp) |
100 |
call getemiss ( fracl,im,jm,nchp,igrd,ityp,chfr,snodep,ficetile, |
call getemiss(fracl,im2,jm2,nchp,nSx,nSy,bi,bj,igrd,ityp,chfr, |
101 |
. emiss ) |
. snodep,ficetile,emiss) |
102 |
endif |
endif |
103 |
|
|
104 |
|
|
1093 |
enddo |
enddo |
1094 |
|
|
1095 |
return |
return |
1096 |
|
end |
1097 |
|
subroutine get_landfrac(im,jm,nSx,nSy,bi,bj,maxtyp,surftype, |
1098 |
|
. tilefrac,frac) |
1099 |
|
C*********************************************************************** |
1100 |
|
C Purpose |
1101 |
|
C To compute the total fraction of land within a model grid-box |
1102 |
|
C |
1103 |
|
C*********************************************************************** |
1104 |
|
implicit none |
1105 |
|
#include "CPP_OPTIONS.h" |
1106 |
|
|
1107 |
|
integer i,j,nSx,nSy,bi,bj,maxtyp |
1108 |
|
integer surftype(im,jm,nSx,nSy) |
1109 |
|
_RL surftype(im,jm,nSx,nSy) |
1110 |
|
real frac(im,jm) |
1111 |
|
|
1112 |
|
integer i,j,k |
1113 |
|
|
1114 |
|
do j=1,jm |
1115 |
|
do i=1,im |
1116 |
|
frac(i,j) = 0.0 |
1117 |
|
enddo |
1118 |
|
enddo |
1119 |
|
|
1120 |
|
do k=1,maxtyp |
1121 |
|
do j=1,jm |
1122 |
|
do i=1,im |
1123 |
|
if(surftype(i,j,k,bi,bj).lt.100.and. |
1124 |
|
tilefrac(i,j,k,bi,bj).gt.0.0)then |
1125 |
|
frac(i,j) = frac(i,j) + tilefrac(i,j,k,bi,bj) |
1126 |
|
endif |
1127 |
|
enddo |
1128 |
|
enddo |
1129 |
|
enddo |
1130 |
|
|
1131 |
|
return |
1132 |
end |
end |