/[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.14 by molod, Fri Jul 16 20:08:08 2004 UTC revision 1.15 by molod, Fri Jul 23 22:32:28 2004 UTC
# Line 68  c--------------------------------------- Line 68  c---------------------------------------
68    
69         call get_landfrac(im2,jm2,nSx,nSy,bi,bj,maxtyp,surftype,tilefrac,         call get_landfrac(im2,jm2,nSx,nSy,bi,bj,maxtyp,surftype,tilefrac,
70       .                                                            fracl)       .                                                            fracl)
71    
72         do j = jm1,jm2         do j = jm1,jm2
73         do i = im1,im2         do i = im1,im2
74          if(sice(i,j,bi,bj).gt.0.) then          if(sice(i,j,bi,bj).gt.0.) then
# Line 83  C*              Get Leaf-Area-Index and Line 84  C*              Get Leaf-Area-Index and
84  C***********************************************************************  C***********************************************************************
85    
86         if( alarm('turb') .or. alarm('radsw') ) then         if( alarm('turb') .or. alarm('radsw') ) then
87         call getlgr (sec,month,day,chlt,ityp,nchpland,nSx,nSy,bi,bj,         call getlgr (sec,month,day,chlt,ityp,nchpland,nchp,nSx,nSy,bi,bj,
88       .                                                       alai,agrn )       .                                                       alai,agrn )
89         endif         endif
90    
# Line 94  C ************************************** Line 95  C **************************************
95         if( alarm('radsw') ) then         if( alarm('radsw') ) then
96          call astro(nymd,nhms,lats,lons,im2*jm2,cosz,radius)          call astro(nymd,nhms,lats,lons,im2*jm2,cosz,radius)
97          call getalb(sec,month,day,cosz,snodep,fraci,fracl,im2,jm2,nchp,          call getalb(sec,month,day,cosz,snodep,fraci,fracl,im2,jm2,nchp,
98       .             nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,alai,agrn,       .    nchptot,nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,alai,agrn,
99       .             albvisdr,albvisdf,albnirdr,albnirdf )       .    albvisdr,albvisdf,albnirdr,albnirdf )
100         endif         endif
101    
102    
# Line 124  C*************************************** Line 125  C***************************************
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,nchp,fracl,tmpij,im2,jm2)       .                           nchp,nchptot,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 690  cfpp$ expand (coeff) Line 691  cfpp$ expand (coeff)
691        RETURN        RETURN
692        END        END
693    
694        SUBROUTINE GETLGR(sec,IMON,IDAY,ALAT,ITYP,NCHPS,nSx,nSy,bi,bj,        SUBROUTINE GETLGR(sec,IMON,IDAY,ALAT,ITYP,NCHPS,nchpdim,
695       .                                                      ALAI,AGRN)       .    nSx,nSy,bi,bj,ALAI,AGRN)
696  C*********************************************************************  C*********************************************************************
697        implicit none        implicit none
698  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
# Line 702  C*************************************** Line 703  C***************************************
703        parameter (one = 1.)        parameter (one = 1.)
704        parameter (daylen = 86400.)        parameter (daylen = 86400.)
705    
706        integer sec, imon, iday, nchps, nSx, nSy, bi, bj        integer sec, imon, iday, nchps, nchpdim, nSx, nSy, bi, bj
707        _RL ALAI(NCHPS,nSx,nSy), AGRN(NCHPS,nSx,nSy)        _RL ALAI(nchpdim,nSx,nSy), AGRN(nchpdim,nSx,nSy)
708        _RL ALAT(NCHPS)        _RL ALAT(nchpdim)
709        integer ITYP(NCHPS,nSx,nSy)        integer ITYP(nchpdim,nSx,nSy)
710    
711        integer i,midmon,midm,midp,id,k1,k2,kk1,kk2        integer i,midmon,midm,midp,id,k1,k2,kk1,kk2
712        _RL fac        _RL fac
# Line 808  C*************************************** Line 809  C***************************************
809        END        END
810    
811        subroutine getalb(sec,month,day,cosz,snodep,fraci,fracg,im,jm,        subroutine getalb(sec,month,day,cosz,snodep,fraci,fracg,im,jm,
812       .                  nchp,nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,       .        nchp,nchptot,nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,
813       .                  alai,agrn,albvr,albvf,albnr,albnf)       .        alai,agrn,albvr,albvf,albnr,albnf)
814  C***********************************************************************  C***********************************************************************
815  C  PURPOSE  C  PURPOSE
816  C     To act as an interface to routine sibalb, which calculates  C     To act as an interface to routine sibalb, which calculates
# Line 850  C*************************************** Line 851  C***************************************
851        implicit none        implicit none
852  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
853    
854        integer sec,month,day,im,jm,nchp,nchpland,nSx,nSy,bi,bj        integer sec,month,day,im,jm,nchp,nchptot,nchpland,nSx,nSy,bi,bj
855        real cosz(im,jm),fraci(im,jm),fracg(im,jm)        real cosz(im,jm),fraci(im,jm),fracg(im,jm)
856        _RL snodep(nchp,nSx,nSy),chfr(nchp,nSx,nSy),chlt(nchp,nSx,nSy)        _RL snodep(nchp,nSx,nSy),chfr(nchp,nSx,nSy),chlt(nchp,nSx,nSy)
857        integer igrd(nchp,nSx,nSy),ityp(nchp,nSx,nSy)        integer igrd(nchp,nSx,nSy),ityp(nchp,nSx,nSy)
# Line 883  C*************************************** Line 884  C***************************************
884         ALBNF(I,J,bi,bj) = ALBVF(I,J,bi,bj)         ALBNF(I,J,bi,bj) = ALBVF(I,J,bi,bj)
885        ENDDO        ENDDO
886        ENDDO        ENDDO
   
887    
888  C and now some conversions from grid space to tile space before sibalb  C and now some conversions from grid space to tile space before sibalb
889    
# Line 893  C and now call sibalb Line 893  C and now call sibalb
893    
894        call sibalb(avisdr,anirdr,avisdf,anirdf,alai(1,bi,bj),        call sibalb(avisdr,anirdr,avisdf,anirdf,alai(1,bi,bj),
895       .  agrn(1,bi,bj),zenith,snodep(1,bi,bj),ityp(1,bi,bj),nchpland)       .  agrn(1,bi,bj),zenith,snodep(1,bi,bj),ityp(1,bi,bj),nchpland)
896    
897  C finally some transformations back to grid space for albedos  C finally some transformations back to grid space for albedos
898    
899          print *,' In getalb, chfr: '
900          print *,(chfr(i,1,1),i=1,nchptot)
901    
902        DO I=1,IM        DO I=1,IM
903        DO J=1,JM        DO J=1,JM
904         tmpij(i,j) = 0.         tmpij(i,j) = albvr(i,j,bi,bj)
905        ENDDO        ENDDO
906        ENDDO        ENDDO
907        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),avisdr,nchp,nchpland,        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),avisdr,nchp,nchpland,
908       .                                     fracg,tmpij,im,jm)       .                                     fracg,tmpij,im,jm)
909    
910          print *,' back from first msc2grd call '
911          stop
912    
913        DO I=1,IM        DO I=1,IM
914        DO J=1,JM        DO J=1,JM
915         albvr(i,j,bi,bj) = tmpij(i,j)         albvr(i,j,bi,bj) = tmpij(i,j)
# Line 910  C finally some transformations back to g Line 917  C finally some transformations back to g
917        ENDDO        ENDDO
918        DO I=1,IM        DO I=1,IM
919        DO J=1,JM        DO J=1,JM
920         tmpij(i,j) = 0.         tmpij(i,j) = albvf(i,j,bi,bj)
921        ENDDO        ENDDO
922        ENDDO        ENDDO
923        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),avisdf,nchp,nchpland,        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),avisdf,nchp,nchpland,
# Line 922  C finally some transformations back to g Line 929  C finally some transformations back to g
929        ENDDO        ENDDO
930        DO I=1,IM        DO I=1,IM
931        DO J=1,JM        DO J=1,JM
932         tmpij(i,j) = 0.         tmpij(i,j) = albnr(i,j,bi,bj)
933        ENDDO        ENDDO
934        ENDDO        ENDDO
935        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),anirdr,nchp,nchpland,        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),anirdr,nchp,nchpland,
# Line 934  C finally some transformations back to g Line 941  C finally some transformations back to g
941        ENDDO        ENDDO
942        DO I=1,IM        DO I=1,IM
943        DO J=1,JM        DO J=1,JM
944         tmpij(i,j) = 0.         tmpij(i,j) = albnf(i,j,bi,bj)
945        ENDDO        ENDDO
946        ENDDO        ENDDO
947        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),anirdf,nchp,nchpland,        call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),anirdf,nchp,nchpland,
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22