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

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

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

revision 1.5 by molod, Wed Jun 9 18:54:20 2004 UTC revision 1.6 by molod, Wed Jun 9 20:33:37 2004 UTC
# Line 22  c--------------------------------------- Line 22  c---------------------------------------
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
# Line 55  c--------------------------------------- Line 59  c---------------------------------------
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 **********************************************************************
# Line 68  C                      Compute Surface A Line 84  C                      Compute Surface A
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    
# Line 80  C                      Compute Surface E Line 96  C                      Compute Surface E
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    
# Line 1077  c-------------------------------- Line 1093  c--------------------------------
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
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22