/[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.18 by molod, Mon Jul 26 20:23:16 2004 UTC
# Line 106  C ************************************** Line 106  C **************************************
106    
107         if( alarm('radlw') ) then         if( alarm('radlw') ) then
108          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchp)          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchp)
109          call getemiss(fracl,im2,jm2,nchp,nSx,nSy,bi,bj,igrd,ityp,chfr,          call getemiss(fracl,im2,jm2,nchp,nchptot,nSx,nSy,bi,bj,
110       .      snodep,ficetile,emiss)       .   igrd,ityp,chfr,snodep,ficetile,emiss)
111         endif         endif
112    
113    
# Line 948  C finally some transformations back to g Line 948  C finally some transformations back to g
948        return        return
949        end        end
950    
951        subroutine getemiss(fracg,im,jm,nchp,nSx,nSy,bi,bj,igrd,ityp,        subroutine getemiss(fracg,im,jm,nchp,nchptot,nSx,nSy,bi,bj,
952       .                                         chfr,snowdep,fraci,emiss)       .   igrd,ityp,chfr,snowdep,fraci,emiss)
953  C***********************************************************************  C***********************************************************************
954  C  PURPOSE  C  PURPOSE
955  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 979  C emiss    - real array [im,jm,10,nSx,nS
979  C  C
980  C***********************************************************************  C***********************************************************************
981        implicit none        implicit none
982        integer im,jm,nchp,nSx,nSy,bi,bj        integer im,jm,nchp,nchptot,nSx,nSy,bi,bj
983        _RL fracg(im,jm)        _RL fracg(im,jm)
984        _RL chfr(nchp,nSx,nSy)        _RL chfr(nchp,nSx,nSy)
985        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)
# Line 992  C*************************************** Line 992  C***************************************
992        integer i,j,k,n        integer i,j,k,n
993    
994        do i = 1,10        do i = 1,10
995        do n = 1,nchp        do n = 1,nchptot
996           emisstile(n,i) = 1.           emisstile(n,i) = 1.
997        enddo        enddo
998        enddo        enddo
999    
1000  c call emissivity to get values in tile space  c call emissivity to get values in tile space
1001  c -------------------------------------------  c -------------------------------------------
1002        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),
1003       .                                                    emisstile)       .                                                    emisstile)
1004    
1005  c transform back to grid space for emissivities  c transform back to grid space for emissivities
# Line 1010  c -------------------------------------- Line 1010  c --------------------------------------
1010         tmpij(i,j) = 0.0         tmpij(i,j) = 0.0
1011        enddo        enddo
1012        enddo        enddo
1013        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,
1014       .      fracg,tmpij,im,jm)       .  nchptot,fracg,tmpij,im,jm)
1015        do j = 1,jm        do j = 1,jm
1016        do i = 1,im        do i = 1,im
1017         emiss(i,j,k,bi,bj) = tmpij(i,j)         emiss(i,j,k,bi,bj) = tmpij(i,j)
# Line 1022  c -------------------------------------- Line 1022  c --------------------------------------
1022        return        return
1023        end        end
1024    
1025        subroutine emissivity (snowdepth,fraci,numpts,ityp,newemis)        subroutine emissivity (snowdepth,fraci,nchp,numpts,ityp,newemis)
1026        implicit none        implicit none
1027        integer numpts        integer nchp,numpts
1028        integer   ityp(numpts)        integer   ityp(nchp)
1029        _RL snowdepth(numpts)        _RL snowdepth(nchp)
1030        _RL fraci(numpts)        _RL fraci(nchp)
1031        _RL newemis(numpts,10)        _RL newemis(nchp,10)
1032    
1033        _RL emis(12,11)        _RL emis(12,11)
1034        _RL fac        _RL fac
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22