/[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.17 by molod, Mon Jul 26 20:15:05 2004 UTC revision 1.23 by molod, Fri Oct 22 14:52:14 2004 UTC
# Line 27  c--------------------------------------- Line 27  c---------------------------------------
27  #include "fizhi_ocean_coms.h"  #include "fizhi_ocean_coms.h"
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
29    
30        integer myTime, myIter, myThid        integer myIter, myThid
31          _RL myTime
32    
33        logical alarm        logical alarm
34        external alarm        external alarm
# Line 84  C*              Get Leaf-Area-Index and Line 85  C*              Get Leaf-Area-Index and
85  C***********************************************************************  C***********************************************************************
86    
87         if( alarm('turb') .or. alarm('radsw') ) then         if( alarm('turb') .or. alarm('radsw') ) then
88         call getlgr (sec,month,day,chlt,ityp,nchpland,nchp,nSx,nSy,bi,bj,         call getlgr (sec,month,day,chlt,ityp,nchpland(bi,bj),
89       .                                                       alai,agrn )       .       nchp,nSx,nSy,bi,bj,alai,agrn )
90         endif         endif
91    
92  C **********************************************************************  C **********************************************************************
# Line 95  C ************************************** Line 96  C **************************************
96         if( alarm('radsw') ) then         if( alarm('radsw') ) then
97          call astro(nymd,nhms,lats,lons,im2*jm2,cosz,radius)          call astro(nymd,nhms,lats,lons,im2*jm2,cosz,radius)
98          call getalb(sec,month,day,cosz,snodep,fraci,fracl,im2,jm2,nchp,          call getalb(sec,month,day,cosz,snodep,fraci,fracl,im2,jm2,nchp,
99       .    nchptot,nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,alai,agrn,       .    nchptot(bi,bj),nchpland(bi,bj),nSx,nSy,bi,bj,igrd,ityp,
100         .    chfr,chlt,alai,agrn,
101       .    albvisdr,albvisdf,albnirdr,albnirdf )       .    albvisdr,albvisdf,albnirdr,albnirdf )
102         endif         endif
103    
   
104  C **********************************************************************  C **********************************************************************
105  C                      Compute Surface Emissivity  C                      Compute Surface Emissivity
106  C **********************************************************************  C **********************************************************************
107    
108         if( alarm('radlw') ) then         if( alarm('radlw') ) then
109          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchp)          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchptot(bi,bj))
110          call getemiss(fracl,im2,jm2,nchp,nSx,nSy,bi,bj,igrd,ityp,chfr,          call getemiss(fracl,im2,jm2,nchp,nchptot(bi,bj),nSx,nSy,bi,bj,
111       .      snodep,ficetile,emiss)       .   igrd,ityp,chfr,snodep,ficetile,emiss)
112         endif         endif
113    
   
114  C*********************************************************************  C*********************************************************************
115  C            Ground Temperature Over Ocean is from SST array,  C            Ground Temperature Over Ocean is from SST array,
116  C               Over land is from tcanopy  C               Over land is from tcanopy
# Line 121  C*************************************** Line 121  C***************************************
121          tmpij(i,j) = 0.          tmpij(i,j) = 0.
122         enddo         enddo
123         enddo         enddo
124         do i = 1,nchp         do i = 1,nchpland(bi,bj)
125          tmpchp(i) = tcanopy(i,bi,bj)          tmpchp(i) = tcanopy(i,bi,bj)
126         enddo         enddo
127         call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),tmpchp,         call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),tmpchp,
128       .                           nchp,nchptot,fracl,tmpij,im2,jm2)       .                    nchp,nchpland(bi,bj),fracl,tmpij,im2,jm2)
129         do j = jm1,jm2         do j = jm1,jm2
130         do i = im1,im2         do i = im1,im2
131          tgz(i,j,bi,bj) = tmpij(i,j)          tgz(i,j,bi,bj) = tmpij(i,j)
# Line 892  C and now call sibalb Line 892  C and now call sibalb
892    
893  C finally some transformations back to grid space for albedos  C finally some transformations back to grid space for albedos
894    
       print *,' In getalb, chfr: '  
       print *,(chfr(i,1,1),i=1,nchptot)  
   
895        DO I=1,IM        DO I=1,IM
896        DO J=1,JM        DO J=1,JM
897         tmpij(i,j) = albvr(i,j,bi,bj)         tmpij(i,j) = albvr(i,j,bi,bj)
# Line 948  C finally some transformations back to g Line 945  C finally some transformations back to g
945        return        return
946        end        end
947    
948        subroutine getemiss(fracg,im,jm,nchp,nSx,nSy,bi,bj,igrd,ityp,        subroutine getemiss(fracg,im,jm,nchp,nchptot,nSx,nSy,bi,bj,
949       .                                         chfr,snowdep,fraci,emiss)       .   igrd,ityp,chfr,snowdep,fraci,emiss)
950  C***********************************************************************  C***********************************************************************
951  C  PURPOSE  C  PURPOSE
952  C     To act as an interface to routine to emissivity, which calculates  C     To act as an interface to routine to emissivity, which calculates
# Line 979  C emiss    - real array [im,jm,10,nSx,nS Line 976  C emiss    - real array [im,jm,10,nSx,nS
976  C  C
977  C***********************************************************************  C***********************************************************************
978        implicit none        implicit none
979        integer im,jm,nchp,nSx,nSy,bi,bj        integer im,jm,nchp,nchptot,nSx,nSy,bi,bj
980        _RL fracg(im,jm)        _RL fracg(im,jm)
981        _RL chfr(nchp,nSx,nSy)        _RL chfr(nchp,nSx,nSy)
982        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)
# Line 992  C*************************************** Line 989  C***************************************
989        integer i,j,k,n        integer i,j,k,n
990    
991        do i = 1,10        do i = 1,10
992        do n = 1,nchp        do n = 1,nchptot
993           emisstile(n,i) = 1.           emisstile(n,i) = 1.
994        enddo        enddo
995        enddo        enddo
996    
997  c call emissivity to get values in tile space  c call emissivity to get values in tile space
998  c -------------------------------------------  c -------------------------------------------
999        call emissivity(snowdep(1,bi,bj),fraci,nchp,ityp(1,bi,bj),        call emissivity(snowdep(1,bi,bj),fraci,nchp,nchptot,ityp(1,bi,bj),
1000       .                                                    emisstile)       .                                                    emisstile)
1001    
1002  c transform back to grid space for emissivities  c transform back to grid space for emissivities
# Line 1010  c -------------------------------------- Line 1007  c --------------------------------------
1007         tmpij(i,j) = 0.0         tmpij(i,j) = 0.0
1008        enddo        enddo
1009        enddo        enddo
1010        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),emisstile(1,k),nchp,nchp,        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),emisstile(1,k),nchp,
1011       .      fracg,tmpij,im,jm)       .  nchptot,fracg,tmpij,im,jm)
1012        do j = 1,jm        do j = 1,jm
1013        do i = 1,im        do i = 1,im
1014         emiss(i,j,k,bi,bj) = tmpij(i,j)         emiss(i,j,k,bi,bj) = tmpij(i,j)
# Line 1022  c -------------------------------------- Line 1019  c --------------------------------------
1019        return        return
1020        end        end
1021    
1022        subroutine emissivity (snowdepth,fraci,numpts,ityp,newemis)        subroutine emissivity (snowdepth,fraci,nchp,numpts,ityp,newemis)
1023        implicit none        implicit none
1024        integer numpts        integer nchp,numpts
1025        integer   ityp(numpts)        integer   ityp(nchp)
1026        _RL snowdepth(numpts)        _RL snowdepth(nchp)
1027        _RL fraci(numpts)        _RL fraci(nchp)
1028        _RL newemis(numpts,10)        _RL newemis(nchp,10)
1029    
1030        _RL emis(12,11)        _RL emis(12,11)
1031        _RL fac        _RL fac
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22