/[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.7 by molod, Thu Jun 10 20:17:17 2004 UTC revision 1.8 by molod, Thu Jun 10 20:53:19 2004 UTC
# Line 141  C     ANIRDF:   near infra-red, diffuse Line 141  C     ANIRDF:   near infra-red, diffuse
141  C*******************************************************************  C*******************************************************************
142    
143        IMPLICIT NONE        IMPLICIT NONE
144  #include "CPP_OPTIONS.h"  #include "CPP_EEOPTIONS.h"
145    
146        INTEGER IRUN        INTEGER IRUN
147        _RL AVISDR  (IRUN), ANIRDR (IRUN), AVISDF (IRUN), ANIRDF (IRUN),        _RL AVISDR  (IRUN), ANIRDR (IRUN), AVISDF (IRUN), ANIRDF (IRUN),
# Line 662  cfpp$ expand (coeff) Line 662  cfpp$ expand (coeff)
662        RETURN        RETURN
663        END        END
664        FUNCTION COEFF(TABLE, NTABL, LAI ,DX, DY)        FUNCTION COEFF(TABLE, NTABL, LAI ,DX, DY)
665  #include "CPP_OPTIONS.h"  #include "CPP_EEOPTIONS.h"
666                    
667        INTEGER NTABL, LAI        INTEGER NTABL, LAI
668    
# Line 680  cfpp$ expand (coeff) Line 680  cfpp$ expand (coeff)
680       .                                                      ALAI,AGRN)       .                                                      ALAI,AGRN)
681  C*********************************************************************  C*********************************************************************
682        implicit none        implicit none
683  #include "CPP_OPTIONS"  #include "CPP_EEOPTIONS.h"
684    
685        integer ntyps        integer ntyps
686        _RL one,daylen        _RL one,daylen
# Line 770  C*************************************** Line 770  C***************************************
770          ID = IDAY          ID = IDAY
771        ENDIF        ENDIF
772    
773        FAC = (REAL(ID  -MIDM)*DAYLEN + SEC) /        FAC = (float(ID  -MIDM)*DAYLEN + SEC) /
774       *      (REAL(MIDP-MIDM)*DAYLEN            )       *      (float(MIDP-MIDM)*DAYLEN            )
775    
776        DO 220 I=1,NCHPS        DO 220 I=1,NCHPS
777    
# Line 834  C albnf    - real array [im,jm] of near- Line 834  C albnf    - real array [im,jm] of near-
834  C  C
835  C***********************************************************************  C***********************************************************************
836        implicit none        implicit none
837  #include "CPP_OPTIONS.h"  #include "CPP_EEOPTIONS.h"
838    
839        integer sec,month,day,im,jm,nchp,nchpland,nSx,nSy,bi,bj        integer sec,month,day,im,jm,nchp,nchpland,nSx,nSy,bi,bj
840        _RL cosz(im,jm),fraci(im,jm),fracg(im,jm)        _RL cosz(im,jm),fraci(im,jm),fracg(im,jm)
# Line 892  C finally some transformations back to g Line 892  C finally some transformations back to g
892        return        return
893        end        end
894    
895        subroutine getemiss(fracg,im,jm,nchp,igrd,ityp,chfr,snowdep,fraci,        subroutine getemiss(fracg,im,jm,nchp,nSx,nSy,bi,bj,igrd,ityp,
896       .                                                            emiss)       .                                         chfr,snowdep,fraci,emiss)
897  C***********************************************************************  C***********************************************************************
898  C  PURPOSE  C  PURPOSE
899  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 904  C fracg    - real array in grid space of Line 904  C fracg    - real array in grid space of
904  C im       - model grid longitude dimension  C im       - model grid longitude dimension
905  C jm       - model grid latitude dimension (number of lat. points)  C jm       - model grid latitude dimension (number of lat. points)
906  C nchp     - integer actual number of tiles in tile space  C nchp     - integer actual number of tiles in tile space
907    C nSx      - number of processors in x-direction
908    C nSy      - number of processors in y-direction
909    C bi       - processors index in x-direction
910    C bj       - processors index in y-direction
911  C igrd     - integer array in tile space of grid point number for each  C igrd     - integer array in tile space of grid point number for each
912  C            tile [nchp]  C            tile [nchp]
913  C ityp     - integer array in tile space of land surface type for each  C ityp     - integer array in tile space of land surface type for each
# Line 915  C            in mm [nchp] Line 919  C            in mm [nchp]
919  C fraci    - real array in tile space of sea ice fraction [nchp]  C fraci    - real array in tile space of sea ice fraction [nchp]
920  C  C
921  C OUTPUT:  C OUTPUT:
922  C emiss    - real array [im,jm,10] of surface emissivities (fraction)  C emiss    - real array [im,jm,10,nSx,nSy] - surface emissivity (frac)
923  C  C
924  C***********************************************************************  C***********************************************************************
925        implicit none        implicit none
926  #include "CPP_OPTIONS.h"  #include "CPP_EEOPTIONS.h"
927        integer im,jm,nchp        integer im,jm,nchp,nSx,nSy,bi,bj
928        _RL fracg(im,jm)        _RL fracg(im,jm)
929        _RL chfr(nchp)        _RL chfr(nchp,nSx,nSy)
930        integer igrd(nchp), ityp(nchp)        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)
931        _RL snowdep(nchp),fraci(nchp)        _RL snowdep(nchp,nSx,nSy),fraci(nchp)
932        _RL emiss(im,jm,10)        _RL emiss(im,jm,10,nSx,nSy)
933    
934        _RL emisstile(nchp,10)        _RL emisstile(nchp,10)
935        integer i,n        integer i,j,k,n
936    
937        do i = 1,10        do i = 1,10
938        do n = 1,nchp        do n = 1,nchp
# Line 938  C*************************************** Line 942  C***************************************
942    
943  c call emissivity to get values in tile space  c call emissivity to get values in tile space
944  c -------------------------------------------  c -------------------------------------------
945        call emissivity (snowdep,fraci,nchp,ityp,emisstile)        call emissivity(snowdep(1,bi,bj),fraci,nchp,ityp(1,bi,bj),
946         .                                                    emisstile)
947    
948  c transform back to grid space for emissivities  c transform back to grid space for emissivities
949  c ---------------------------------------------  c ---------------------------------------------
950        do i = 1,10        do k = 1,10
951        emiss(:,:,i) = 0.0        do j = 1,jm
952        call msc2grd (igrd,chfr,emisstile(1,i),nchp,nchp,fracg,emiss(1,1,i),im,jm)        do i = 1,im
953          emiss(i,j,k) = 0.0
954          enddo
955          enddo
956          call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),emisstile(1,k),nchp,nchp,
957         .      fracg,emiss(1,1,k,bi,bj),im,jm)
958        enddo        enddo
959    
960        return        return
# Line 952  c -------------------------------------- Line 962  c --------------------------------------
962    
963        subroutine emissivity (snowdepth,fraci,numpts,ityp,newemis)        subroutine emissivity (snowdepth,fraci,numpts,ityp,newemis)
964        implicit none        implicit none
965  #include "CPP_OPTIONS.h"  #include "CPP_EEOPTIONS.h"
966        integer numpts        integer numpts
967        integer   ityp(numpts)        integer   ityp(numpts)
968        _RL snowdepth(numpts),fraci(numpts)        _RL snowdepth(numpts),fraci(numpts)
# Line 1117  C     To compute the total fraction of l Line 1127  C     To compute the total fraction of l
1127  C  C
1128  C***********************************************************************  C***********************************************************************
1129        implicit none        implicit none
1130  #include "CPP_OPTIONS.h"  #include "CPP_EEOPTIONS.h"
1131    
1132        integer i,j,nSx,nSy,bi,bj,maxtyp        integer i,j,nSx,nSy,bi,bj,maxtyp
1133        integer surftype(im,jm,nSx,nSy)        integer surftype(im,jm,nSx,nSy)
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22