/[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.21 by molod, Wed Jul 28 22:08:40 2004 UTC
# Line 99  C ************************************** Line 99  C **************************************
99       .    albvisdr,albvisdf,albnirdr,albnirdf )       .    albvisdr,albvisdf,albnirdr,albnirdf )
100         endif         endif
101    
   
102  C **********************************************************************  C **********************************************************************
103  C                      Compute Surface Emissivity  C                      Compute Surface Emissivity
104  C **********************************************************************  C **********************************************************************
105    
106         if( alarm('radlw') ) then         if( alarm('radlw') ) then
107          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchp)          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchptot)
108          call getemiss(fracl,im2,jm2,nchp,nSx,nSy,bi,bj,igrd,ityp,chfr,          call getemiss(fracl,im2,jm2,nchp,nchptot,nSx,nSy,bi,bj,
109       .      snodep,ficetile,emiss)       .   igrd,ityp,chfr,snodep,ficetile,emiss)
110         endif         endif
111    
   
112  C*********************************************************************  C*********************************************************************
113  C            Ground Temperature Over Ocean is from SST array,  C            Ground Temperature Over Ocean is from SST array,
114  C               Over land is from tcanopy  C               Over land is from tcanopy
# Line 121  C*************************************** Line 119  C***************************************
119          tmpij(i,j) = 0.          tmpij(i,j) = 0.
120         enddo         enddo
121         enddo         enddo
122         do i = 1,nchp         do i = 1,nchpland
123          tmpchp(i) = tcanopy(i,bi,bj)          tmpchp(i) = tcanopy(i,bi,bj)
124         enddo         enddo
125         call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),tmpchp,         call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),tmpchp,
126       .                           nchp,nchptot,fracl,tmpij,im2,jm2)       .                           nchp,nchpland,fracl,tmpij,im2,jm2)
127         do j = jm1,jm2         do j = jm1,jm2
128         do i = im1,im2         do i = im1,im2
129          tgz(i,j,bi,bj) = tmpij(i,j)          tgz(i,j,bi,bj) = tmpij(i,j)
# Line 892  C and now call sibalb Line 890  C and now call sibalb
890    
891  C finally some transformations back to grid space for albedos  C finally some transformations back to grid space for albedos
892    
       print *,' In getalb, chfr: '  
       print *,(chfr(i,1,1),i=1,nchptot)  
   
893        DO I=1,IM        DO I=1,IM
894        DO J=1,JM        DO J=1,JM
895         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 943  C finally some transformations back to g
943        return        return
944        end        end
945    
946        subroutine getemiss(fracg,im,jm,nchp,nSx,nSy,bi,bj,igrd,ityp,        subroutine getemiss(fracg,im,jm,nchp,nchptot,nSx,nSy,bi,bj,
947       .                                         chfr,snowdep,fraci,emiss)       .   igrd,ityp,chfr,snowdep,fraci,emiss)
948  C***********************************************************************  C***********************************************************************
949  C  PURPOSE  C  PURPOSE
950  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 974  C emiss    - real array [im,jm,10,nSx,nS
974  C  C
975  C***********************************************************************  C***********************************************************************
976        implicit none        implicit none
977        integer im,jm,nchp,nSx,nSy,bi,bj        integer im,jm,nchp,nchptot,nSx,nSy,bi,bj
978        _RL fracg(im,jm)        _RL fracg(im,jm)
979        _RL chfr(nchp,nSx,nSy)        _RL chfr(nchp,nSx,nSy)
980        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)
# Line 992  C*************************************** Line 987  C***************************************
987        integer i,j,k,n        integer i,j,k,n
988    
989        do i = 1,10        do i = 1,10
990        do n = 1,nchp        do n = 1,nchptot
991           emisstile(n,i) = 1.           emisstile(n,i) = 1.
992        enddo        enddo
993        enddo        enddo
994    
995  c call emissivity to get values in tile space  c call emissivity to get values in tile space
996  c -------------------------------------------  c -------------------------------------------
997        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),
998       .                                                    emisstile)       .                                                    emisstile)
999    
1000  c transform back to grid space for emissivities  c transform back to grid space for emissivities
# Line 1010  c -------------------------------------- Line 1005  c --------------------------------------
1005         tmpij(i,j) = 0.0         tmpij(i,j) = 0.0
1006        enddo        enddo
1007        enddo        enddo
1008        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,
1009       .      fracg,tmpij,im,jm)       .  nchptot,fracg,tmpij,im,jm)
1010        do j = 1,jm        do j = 1,jm
1011        do i = 1,im        do i = 1,im
1012         emiss(i,j,k,bi,bj) = tmpij(i,j)         emiss(i,j,k,bi,bj) = tmpij(i,j)
# Line 1022  c -------------------------------------- Line 1017  c --------------------------------------
1017        return        return
1018        end        end
1019    
1020        subroutine emissivity (snowdepth,fraci,numpts,ityp,newemis)        subroutine emissivity (snowdepth,fraci,nchp,numpts,ityp,newemis)
1021        implicit none        implicit none
1022        integer numpts        integer nchp,numpts
1023        integer   ityp(numpts)        integer   ityp(nchp)
1024        _RL snowdepth(numpts)        _RL snowdepth(nchp)
1025        _RL fraci(numpts)        _RL fraci(nchp)
1026        _RL newemis(numpts,10)        _RL newemis(nchp,10)
1027    
1028        _RL emis(12,11)        _RL emis(12,11)
1029        _RL fac        _RL fac
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22