/[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.4 by molod, Wed Jun 9 18:35:31 2004 UTC revision 1.5 by molod, Wed Jun 9 18:54:20 2004 UTC
# Line 7  c  Subroutine update_earth_exports - 'Wr Line 7  c  Subroutine update_earth_exports - 'Wr
7  c        the fields related to the earth's surface that are needed  c        the fields related to the earth's surface that are needed
8  c        by fizhi.  c        by fizhi.
9  c  c
10  c Call:  getalb    (Set the 4 albedos based on veg type and time)  c Call:  getlgr    (Set the leaf area index and surface greenness,
11    c                              based on veg type and month)
12    c        getalb    (Set the 4 albedos based on veg type, snow and time)
13  c        getemiss  (Set the surface emissivity based on the veg type  c        getemiss  (Set the surface emissivity based on the veg type
14  c                              and the snow depth)  c                              and the snow depth)
 c        getlgr    (Set the leaf area index and surface greenness,  
 c                              based on veg type and month)  
15  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
16         implicit none         implicit none
17  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
18  #include "SIZE.h"  #include "SIZE.h"
 #include "GRID.h"  
19  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
20  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
21  #include "fizhi_coms.h"  #include "fizhi_coms.h"
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"
25  #include "EEPARAMS.h"  #include "EEPARAMS.h"
26    
27        integer myTime, myIter, myThid        integer myTime, myIter, myThid
28    
29          real lats(sNx,sNy), lons(sNx,sNy), cosz(sNx,sNy)
30        integer i, j, L, bi, bj        integer i, j, L, bi, bj
31        integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2        integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
32          integer sec, day, month
33          integer nmonf,ndayf
34          nmonf(n) = mod(n,10000)/100
35          ndayf(n) = mod(n,100)
36    
37        idim1 = 1-OLx        idim1 = 1-OLx
38        idim2 = sNx+OLx        idim2 = sNx+OLx
# Line 37  c--------------------------------------- Line 42  c---------------------------------------
42        im2 = sNx        im2 = sNx
43        jm1 = 1        jm1 = 1
44        jm2 = sNy        jm2 = sNy
45          month = nmonf(nymd)
46          day = ndayf(nymd)
47          sec = nsecf(nhms)
48    
49        do bj = myByLo(myThid), myByHi(myThid)        do bj = myByLo(myThid), myByHi(myThid)
50        do bi = myBxLo(myThid), myBxHi(myThid)        do bi = myBxLo(myThid), myBxHi(myThid)
51           do j = jm1,jm2
52           do i = im1,im2
53            lons(i,j,bi,bj) = xC(i,j,bi,bj)
54            lats(i,j,bi,bj) = yC(i,j,bi,bj)
55           enddo
56           enddo
57    
58  C***********************************************************************  C***********************************************************************
59  C*              Get Leaf-Area-Index and Greenness Index                *  C*              Get Leaf-Area-Index and Greenness Index                *
60  C***********************************************************************  C***********************************************************************
61    
62        if( alarm('turb') .or. alarm('radsw') ) then        if( alarm('turb') .or. alarm('radsw') ) then
63        call getlgr ( sec,month,day,        call getlgr (sec,month,day,chlt,ityp,nchpland,alai,agrn )
      .              land%grid%chlt,coupling%earth%ityp,coupling%earth%nchpland,  
      .              coupling%earth%alai,coupling%earth%agrn )  
64        endif        endif
65    
   
66  C **********************************************************************  C **********************************************************************
67  C                      Compute Surface Albedo  C                      Compute Surface Albedo
68  C **********************************************************************  C **********************************************************************
69    
70        if( alarm('radsw') ) then        if( alarm('radsw') ) then
71        call astro  ( nymd,nhms, alat,alon, im*jm, cosz,ra )         call astro  ( nymd,nhms, lats,lons, im2*jm2, cosz,ra )
72        call getalb ( sec,month,day,cosz,land%vars%snodep,fraci,fracl,         call getalb ( sec,month,day,cosz,snodep,fraci,fracl,
73       .              im,jm,land%grid%nchp,       .              im,jm,nchp,nchpland,igrd,ityp,chfr,chlt,alai,agrn,
74       .              coupling%earth%nchpland,       .              albvisdr,albvisdf,albnirdr,albnirdf )
      .              land%grid%igrd,coupling%earth%ityp,  
      .              coupling%earth%chfr,land%grid%chlt,  
      .              coupling%earth%alai,coupling%earth%agrn,  
      .              coupling%earth%albvisdr,coupling%earth%albvisdf,  
      .              coupling%earth%albnirdr,coupling%earth%albnirdf )  
75        endif        endif
76    
77    
# Line 75  C                      Compute Surface E Line 80  C                      Compute Surface E
80  C **********************************************************************  C **********************************************************************
81    
82        if( alarm('radlw') ) then        if( alarm('radlw') ) then
83           allocate ( ficetile(im*jm*maxtyp) )         call grd2msc  ( fraci,im,jm,igrd,ficetile,nchp,nchp )
84           call grd2msc  ( fraci,im,jm,land%grid%igrd,ficetile,land%grid%nchp,land%grid%nchp )         call getemiss ( fracl,im,jm,nchp,igrd,ityp,chfr,snodep,ficetile,
85           call getemiss ( fracl,im,jm,land%grid%nchp,land%grid%igrd,       .                                             emiss )
      .                   coupling%earth%ityp,coupling%earth%chfr,land%vars%snodep,  
      .                   ficetile,coupling%earth%emiss )  
          deallocate ( ficetile )  
86        endif        endif
87    
88    
# Line 90  C*************************************** Line 92  C***************************************
92    
93        do j = 1,jm        do j = 1,jm
94        do i = 1,im        do i = 1,im
95        if( fracl(i,j).lt.0.3 .and. ocean%vars%sea_ice(i,j).eq.0.0 ) then        if(fracl(i,j).lt.0.3.and.sea_ice(i,j).eq.0.0)tgz(i,j) = sst(i,j)
          coupling%land%tgz(i,j) = ocean%vars%sst(i,j)  
96        endif        endif
97        enddo        enddo
98        enddo        enddo
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22