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), |
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 |
|
|
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 |
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 |
|
|
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) |
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 |
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 |
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 |
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 |
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) |
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) |