/[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.12 by molod, Wed Jul 14 17:31:58 2004 UTC revision 1.23 by molod, Fri Oct 22 14:52:14 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "FIZHI_OPTIONS.h"
5         subroutine update_earth_exports (myTime, myIter, myThid)         subroutine update_earth_exports (myTime, myIter, myThid)
6  c----------------------------------------------------------------------  c----------------------------------------------------------------------
7  c  Subroutine update_earth_exports - 'Wrapper' routine to update  c  Subroutine update_earth_exports - 'Wrapper' routine to update
# Line 14  c        getemiss  (Set the surface emis Line 15  c        getemiss  (Set the surface emis
15  c                              and the snow depth)  c                              and the snow depth)
16  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
17         implicit none         implicit none
 #include "CPP_OPTIONS.h"  
18  #include "SIZE.h"  #include "SIZE.h"
19    #include "GRID.h"
20  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
21  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
22  #include "fizhi_coms.h"  #include "fizhi_coms.h"
23    #include "chronos.h"
24  #include "gridalt_mapping.h"  #include "gridalt_mapping.h"
25  #include "fizhi_land_coms.h"  #include "fizhi_land_coms.h"
26  #include "fizhi_earth_coms.h"  #include "fizhi_earth_coms.h"
27  #include "fizhi_ocean_coms.h"  #include "fizhi_ocean_coms.h"
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
29    
30        integer myTime, myIter, myThid        integer myIter, myThid
31          _RL myTime
32    
33        logical alarm        logical alarm
34        external alarm        external alarm
35        _RL lats(sNx,sNy), lons(sNx,sNy), cosz(sNx,sNy)        _RL lats(sNx,sNy), lons(sNx,sNy), cosz(sNx,sNy)
36        _RL fraci(sNx,sNy), fracl(sNx,sNy)        _RL fraci(sNx,sNy), fracl(sNx,sNy)
37        _RL ficetile(nchp)        _RL ficetile(nchp)
38        _RL ra        _RL radius
39        integer i, j, L, bi, bj        _RL tmpij(sNx,sNy)
40          _RL tmpchp(nchp)
41          integer i, j, n, bi, bj
42        integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2        integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
43        integer sec, day, month        integer sec, day, month
44        integer nmonf,ndayf        integer nmonf,ndayf,nsecf
45          nsecf(n) = n/10000*3600 + mod(n,10000)/100* 60 + mod(n,100)
46        nmonf(n) = mod(n,10000)/100        nmonf(n) = mod(n,10000)/100
47        ndayf(n) = mod(n,100)        ndayf(n) = mod(n,100)
48    
# Line 56  c--------------------------------------- Line 62  c---------------------------------------
62        do bi = myBxLo(myThid), myBxHi(myThid)        do bi = myBxLo(myThid), myBxHi(myThid)
63         do j = jm1,jm2         do j = jm1,jm2
64         do i = im1,im2         do i = im1,im2
65          lons(i,j,bi,bj) = xC(i,j,bi,bj)          lons(i,j) = xC(i,j,bi,bj)
66          lats(i,j,bi,bj) = yC(i,j,bi,bj)          lats(i,j) = yC(i,j,bi,bj)
67         enddo         enddo
68         enddo         enddo
69    
70         call get_landfrac(im2,jm2,nSx,nSy,bi,bj,maxtyp,surftype,tilefrac,         call get_landfrac(im2,jm2,nSx,nSy,bi,bj,maxtyp,surftype,tilefrac,
71       .                                                            fracl)       .                                                            fracl)
72    
73         do j = jm1,jm2         do j = jm1,jm2
74         do i = im1,im2         do i = im1,im2
75          if(sea_ice(i,j,bi,bj).gt.0.) then          if(sice(i,j,bi,bj).gt.0.) then
76             fraci(i,j) = 1.             fraci(i,j) = 1.
77          else          else
78             fraci(i,j) = 0.             fraci(i,j) = 0.
# Line 78  C*              Get Leaf-Area-Index and Line 85  C*              Get Leaf-Area-Index and
85  C***********************************************************************  C***********************************************************************
86    
87         if( alarm('turb') .or. alarm('radsw') ) then         if( alarm('turb') .or. alarm('radsw') ) then
88         call getlgr (sec,month,day,chlt,ityp,nchpland,nSx,nSy,bi,bj,         call getlgr (sec,month,day,chlt,ityp,nchpland(bi,bj),
89       .                                                       alai,agrn )       .       nchp,nSx,nSy,bi,bj,alai,agrn )
90         endif         endif
91    
92  C **********************************************************************  C **********************************************************************
# Line 87  C                      Compute Surface A Line 94  C                      Compute Surface A
94  C **********************************************************************  C **********************************************************************
95    
96         if( alarm('radsw') ) then         if( alarm('radsw') ) then
97          call astro(nymd,nhms,lats,lons,im2*jm2,cosz,ra)          call astro(nymd,nhms,lats,lons,im2*jm2,cosz,radius)
98          call getalb(sec,month,day,cosz,snodep,fraci,fracl,im2,jm2,nchp,          call getalb(sec,month,day,cosz,snodep,fraci,fracl,im2,jm2,nchp,
99       .             nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,alai,agrn,       .    nchptot(bi,bj),nchpland(bi,bj),nSx,nSy,bi,bj,igrd,ityp,
100       .             albvisdr,albvisdf,albnirdr,albnirdf )       .    chfr,chlt,alai,agrn,
101         .    albvisdr,albvisdf,albnirdr,albnirdf )
102         endif         endif
103    
   
104  C **********************************************************************  C **********************************************************************
105  C                      Compute Surface Emissivity  C                      Compute Surface Emissivity
106  C **********************************************************************  C **********************************************************************
107    
108         if( alarm('radlw') ) then         if( alarm('radlw') ) then
109          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchp)          call grd2msc(fraci,im2,jm2,igrd,ficetile,nchp,nchptot(bi,bj))
110          call getemiss(fracl,im2,jm2,nchp,nSx,nSy,bi,bj,igrd,ityp,chfr,          call getemiss(fracl,im2,jm2,nchp,nchptot(bi,bj),nSx,nSy,bi,bj,
111       .      snodep,ficetile,emiss)       .   igrd,ityp,chfr,snodep,ficetile,emiss)
112         endif         endif
113    
   
114  C*********************************************************************  C*********************************************************************
115  C            Ground Temperature Over Ocean is from SST array,  C            Ground Temperature Over Ocean is from SST array,
116  C               Over land is from tcanopy  C               Over land is from tcanopy
# Line 112  C*************************************** Line 118  C***************************************
118    
119         do j = jm1,jm2         do j = jm1,jm2
120         do i = im1,im2         do i = im1,im2
121          tgz(i,j,bi,bj) = 0.          tmpij(i,j) = 0.
122         enddo         enddo
123         enddo         enddo
124         call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),tcanopy(1,bi,bj),         do i = 1,nchpland(bi,bj)
125       .                           nchp,nchp,fracl,tgz(1,bi,bj),im2,jm2)          tmpchp(i) = tcanopy(i,bi,bj)
126           enddo
127           call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),tmpchp,
128         .                    nchp,nchpland(bi,bj),fracl,tmpij,im2,jm2)
129         do j = jm1,jm2         do j = jm1,jm2
130         do i = im1,im2         do i = im1,im2
131          if(fracl(i,j).lt.0.3.and.sea_ice(i,j,bi,bj).eq.0.0)          tgz(i,j,bi,bj) = tmpij(i,j)
132            if(fracl(i,j).lt.0.3.and.sice(i,j,bi,bj).eq.0.0)
133       .                                 tgz(i,j,bi,bj) = sst(i,j,bi,bj)       .                                 tgz(i,j,bi,bj) = sst(i,j,bi,bj)
134         enddo         enddo
135         enddo         enddo
# Line 151  C     ANIRDF:   near infra-red, diffuse Line 161  C     ANIRDF:   near infra-red, diffuse
161  C*******************************************************************  C*******************************************************************
162    
163        IMPLICIT NONE        IMPLICIT NONE
 #include "CPP_EEOPTIONS.h"  
164    
165        INTEGER IRUN        INTEGER IRUN
166        _RL AVISDR  (IRUN), ANIRDR (IRUN), AVISDF (IRUN), ANIRDF (IRUN),        _RL AVISDR  (IRUN), ANIRDR (IRUN), AVISDF (IRUN), ANIRDF (IRUN)
167       `       VLAI   (IRUN),   VGRN (IRUN),   ZTH  (IRUN),    SNW (IRUN)        _RL VLAI(IRUN),VGRN (IRUN), SNW(IRUN)
168          _RL ZTH(IRUN)
169        INTEGER ITYP (IRUN)        INTEGER ITYP (IRUN)
170    
171        _RL ALVDRS,  ALIDRS        _RL ALVDRS,  ALIDRS
# Line 211  C                  9:  GLACIER Line 221  C                  9:  GLACIER
221  C                 10:  DARK DESERT  C                 10:  DARK DESERT
222  C  C
223    
224          INTEGER I, LAI
225  * [ Definition of Variables: ]        _RL FAC,GAMMA,BETA,ALPHA,DX,DY,ALA,GRN (2),SNWALB(4,NTYPS)
226  *        _RL COEFF
         INTEGER I, LAI  
   
         _RL FAC,               GAMMA,          BETA,          ALPHA,  
      `       DX,                DY,             ALA,           GRN (2),  
      `       SNWALB (4, NTYPS), SNWMID (NTYPS)  
   
 * [ Definition of Functions: ]  
 *  
         _RL COEFF  
   
 C   Constants used in albedo calculations:  
227    
228        _RL ALVDR (NLAI, 2, NTYPS)        _RL ALVDR (NLAI, 2, NTYPS)
229        _RL BTVDR (NLAI, 2, NTYPS)        _RL BTVDR (NLAI, 2, NTYPS)
# Line 635  C**** ---------------------------------- Line 634  C**** ----------------------------------
634       &             .65, .38, .65, .38       &             .65, .38, .65, .38
635       `            /       `            /
636    
637  #if CRAY  #ifdef CRAY
638  #if f77  #ifdef f77
639  cfpp$ expand (coeff)  cfpp$ expand (coeff)
640  #endif  #endif
641  #endif  #endif
# Line 677  cfpp$ expand (coeff) Line 676  cfpp$ expand (coeff)
676        RETURN        RETURN
677        END        END
678        FUNCTION COEFF(TABLE, NTABL, LAI ,DX, DY)        FUNCTION COEFF(TABLE, NTABL, LAI ,DX, DY)
 #include "CPP_EEOPTIONS.h"  
679                    
680        INTEGER NTABL, LAI        INTEGER NTABL, LAI
681          _RL coeff
682        _RL TABLE (NTABL, 2), DX, DY        _RL TABLE (NTABL, 2), DX, DY
683    
684        COEFF = (TABLE(LAI,  1)        COEFF = (TABLE(LAI,  1)
# Line 691  cfpp$ expand (coeff) Line 689  cfpp$ expand (coeff)
689        RETURN        RETURN
690        END        END
691    
692        SUBROUTINE GETLGR(sec,IMON,IDAY,ALAT,ITYP,NCHPS,nSx,nSy,bi,bj,        SUBROUTINE GETLGR(sec,IMON,IDAY,ALAT,ITYP,NCHPS,nchpdim,
693       .                                                      ALAI,AGRN)       .    nSx,nSy,bi,bj,ALAI,AGRN)
694  C*********************************************************************  C*********************************************************************
695        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
696    
697        integer ntyps        integer ntyps
698        _RL one,daylen        _RL one,daylen
# Line 703  C*************************************** Line 700  C***************************************
700        parameter (one = 1.)        parameter (one = 1.)
701        parameter (daylen = 86400.)        parameter (daylen = 86400.)
702    
703        integer sec, imon, iday, nchps, nSx, nSy, bi, bj        integer sec, imon, iday, nchps, nchpdim, nSx, nSy, bi, bj
704        _RL ALAI(NCHPS,nSx,nSy), AGRN(NCHPS,nSx,nSy)        _RL ALAI(nchpdim,nSx,nSy), AGRN(nchpdim,nSx,nSy)
705        _RL ALAT(NCHPS)        _RL ALAT(nchpdim)
706        integer ITYP(NCHPS,nSx,nSy)        integer ITYP(nchpdim,nSx,nSy)
707    
708        integer i,midmon,midm,midp,id,k1,k2,kk1,kk2        integer i,midmon,midm,midp,id,k1,k2,kk1,kk2
709        _RL fac        _RL fac
# Line 809  C*************************************** Line 806  C***************************************
806        END        END
807    
808        subroutine getalb(sec,month,day,cosz,snodep,fraci,fracg,im,jm,        subroutine getalb(sec,month,day,cosz,snodep,fraci,fracg,im,jm,
809       .                  nchp,nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,       .        nchp,nchptot,nchpland,nSx,nSy,bi,bj,igrd,ityp,chfr,chlt,
810       .                  alai,agrn,albvr,albvf,albnr,albnf)       .        alai,agrn,albvr,albvf,albnr,albnf)
811  C***********************************************************************  C***********************************************************************
812  C  PURPOSE  C  PURPOSE
813  C     To act as an interface to routine sibalb, which calculates  C     To act as an interface to routine sibalb, which calculates
# Line 849  C albnf    - real array [im,jm] of near- Line 846  C albnf    - real array [im,jm] of near-
846  C  C
847  C***********************************************************************  C***********************************************************************
848        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
849    
850        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
851        _RL cosz(im,jm),fraci(im,jm),fracg(im,jm)        _RL cosz(im,jm),fraci(im,jm),fracg(im,jm)
852        _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)
853        integer igrd(nchp,nSx,nSy),ityp(nchp,nSx,nSy)        integer igrd(nchp,nSx,nSy),ityp(nchp,nSx,nSy)
# Line 870  C*************************************** Line 866  C***************************************
866    
867        _RL alboc(im,jm)        _RL alboc(im,jm)
868        _RL AVISDR(nchp),ANIRDR(nchp),AVISDF(nchp)        _RL AVISDR(nchp),ANIRDR(nchp),AVISDF(nchp)
869        _RL ANIRDF(nchp),zenith(nchp)        _RL ANIRDF(nchp)
870          _RL zenith(nchp)
871          _RL tmpij(im,jm)
872        integer i,j        integer i,j
873    
874        DO I=1,IM        DO I=1,IM
875        DO J=1,JM        DO J=1,JM
876         ALBOC(I,J) = A0 + (A1 + (A2 +  A3*cosz(I,J))*cosz(I,J))*cosz(I,J)         ALBOC(I,J) = A0 + (A1 + (A2 +  A3*cosz(I,J))*cosz(I,J))*cosz(I,J)
877         ALBVR(I,J) = ALBSI * FRACI(I,J) + ALBOC(I,J) * (ONE-FRACI(I,J))         ALBVR(I,J,bi,bj) = ALBSI*FRACI(I,J) + ALBOC(I,J)*(ONE-FRACI(I,J))
878         ALBNR(I,J) = ALBVR(I,J)         ALBNR(I,J,bi,bj) = ALBVR(I,J,bi,bj)
879         ALBVF(I,J) = ALBSI * FRACI(I,J) + OCNALB * (ONE-FRACI(I,J))         ALBVF(I,J,bi,bj) = ALBSI * FRACI(I,J) + OCNALB * (ONE-FRACI(I,J))
880         ALBNF(I,J) = ALBVF(I,J)         ALBNF(I,J,bi,bj) = ALBVF(I,J,bi,bj)
881        ENDDO        ENDDO
882        ENDDO        ENDDO
   
883    
884  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
885    
# Line 892  C and now call sibalb Line 889  C and now call sibalb
889    
890        call sibalb(avisdr,anirdr,avisdf,anirdf,alai(1,bi,bj),        call sibalb(avisdr,anirdr,avisdf,anirdf,alai(1,bi,bj),
891       .  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)
892    
893  C finally some transformations back to grid space for albedos  C finally some transformations back to grid space for albedos
894    
895          DO I=1,IM
896          DO J=1,JM
897           tmpij(i,j) = albvr(i,j,bi,bj)
898          ENDDO
899          ENDDO
900        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,
901       .                                      fracg,albvr(1,bi,bj),im,jm)       .                                     fracg,tmpij,im,jm)
902    
903          DO I=1,IM
904          DO J=1,JM
905           albvr(i,j,bi,bj) = tmpij(i,j)
906          ENDDO
907          ENDDO
908          DO I=1,IM
909          DO J=1,JM
910           tmpij(i,j) = albvf(i,j,bi,bj)
911          ENDDO
912          ENDDO
913        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,
914       .                                      fracg,albvf(1,bi,bj),im,jm)       .                                     fracg,tmpij,im,jm)
915          DO I=1,IM
916          DO J=1,JM
917           albvf(i,j,bi,bj) = tmpij(i,j)
918          ENDDO
919          ENDDO
920          DO I=1,IM
921          DO J=1,JM
922           tmpij(i,j) = albnr(i,j,bi,bj)
923          ENDDO
924          ENDDO
925        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,
926       .                                      fracg,albnr(1,bi,bj),im,jm)       .                                     fracg,tmpij,im,jm)
927          DO I=1,IM
928          DO J=1,JM
929           albnr(i,j,bi,bj) = tmpij(i,j)
930          ENDDO
931          ENDDO
932          DO I=1,IM
933          DO J=1,JM
934           tmpij(i,j) = albnf(i,j,bi,bj)
935          ENDDO
936          ENDDO
937        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,
938       .                                      fracg,albnf(1,bi,bj),im,jm)       .                                     fracg,tmpij,im,jm)
939          DO I=1,IM
940          DO J=1,JM
941           albnf(i,j,bi,bj) = tmpij(i,j)
942          ENDDO
943          ENDDO
944    
945        return        return
946        end        end
947    
948        subroutine getemiss(fracg,im,jm,nchp,nSx,nSy,bi,bj,igrd,ityp,        subroutine getemiss(fracg,im,jm,nchp,nchptot,nSx,nSy,bi,bj,
949       .                                         chfr,snowdep,fraci,emiss)       .   igrd,ityp,chfr,snowdep,fraci,emiss)
950  C***********************************************************************  C***********************************************************************
951  C  PURPOSE  C  PURPOSE
952  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 938  C emiss    - real array [im,jm,10,nSx,nS Line 976  C emiss    - real array [im,jm,10,nSx,nS
976  C  C
977  C***********************************************************************  C***********************************************************************
978        implicit none        implicit none
979  #include "CPP_EEOPTIONS.h"        integer im,jm,nchp,nchptot,nSx,nSy,bi,bj
       integer im,jm,nchp,nSx,nSy,bi,bj  
980        _RL fracg(im,jm)        _RL fracg(im,jm)
981        _RL chfr(nchp,nSx,nSy)        _RL chfr(nchp,nSx,nSy)
982        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)        integer igrd(nchp,nSx,nSy), ityp(nchp,nSx,nSy)
983        _RL snowdep(nchp,nSx,nSy),fraci(nchp)        _RL snowdep(nchp,nSx,nSy)
984          _RL fraci(nchp)
985        _RL emiss(im,jm,10,nSx,nSy)        _RL emiss(im,jm,10,nSx,nSy)
986    
987        _RL emisstile(nchp,10)        _RL emisstile(nchp,10)
988          _RL tmpij(im,jm)
989        integer i,j,k,n        integer i,j,k,n
990    
991        do i = 1,10        do i = 1,10
992        do n = 1,nchp        do n = 1,nchptot
993           emisstile(n,i) = 1.           emisstile(n,i) = 1.
994        enddo        enddo
995        enddo        enddo
996    
997  c call emissivity to get values in tile space  c call emissivity to get values in tile space
998  c -------------------------------------------  c -------------------------------------------
999        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),
1000       .                                                    emisstile)       .                                                    emisstile)
1001    
1002  c transform back to grid space for emissivities  c transform back to grid space for emissivities
# Line 965  c -------------------------------------- Line 1004  c --------------------------------------
1004        do k = 1,10        do k = 1,10
1005        do j = 1,jm        do j = 1,jm
1006        do i = 1,im        do i = 1,im
1007        emiss(i,j,k) = 0.0         tmpij(i,j) = 0.0
1008          enddo
1009          enddo
1010          call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),emisstile(1,k),nchp,
1011         .  nchptot,fracg,tmpij,im,jm)
1012          do j = 1,jm
1013          do i = 1,im
1014           emiss(i,j,k,bi,bj) = tmpij(i,j)
1015        enddo        enddo
1016        enddo        enddo
       call msc2grd(igrd(1,bi,bj),chfr(1,bi,bj),emisstile(1,k),nchp,nchp,  
      .      fracg,emiss(1,1,k,bi,bj),im,jm)  
1017        enddo        enddo
1018    
1019        return        return
1020        end        end
1021    
1022        subroutine emissivity (snowdepth,fraci,numpts,ityp,newemis)        subroutine emissivity (snowdepth,fraci,nchp,numpts,ityp,newemis)
1023        implicit none        implicit none
1024  #include "CPP_EEOPTIONS.h"        integer nchp,numpts
1025        integer numpts        integer   ityp(nchp)
1026        integer   ityp(numpts)        _RL snowdepth(nchp)
1027        _RL snowdepth(numpts),fraci(numpts)        _RL fraci(nchp)
1028        _RL   newemis(numpts,10)        _RL newemis(nchp,10)
1029    
1030        _RL emis(12,11)        _RL emis(12,11)
       _RL snwmid(10)  
1031        _RL fac        _RL fac
1032        integer i,j        integer i,j
1033    
# Line 1163  C     To compute the total fraction of l Line 1206  C     To compute the total fraction of l
1206  C  C
1207  C***********************************************************************  C***********************************************************************
1208        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
1209    
1210        integer i,j,nSx,nSy,bi,bj,maxtyp        integer im,jm,nSx,nSy,bi,bj,maxtyp
1211        integer surftype(im,jm,nSx,nSy)        integer surftype(im,jm,maxtyp,nSx,nSy)
1212        _RL surftype(im,jm,nSx,nSy)        _RL tilefrac(im,jm,maxtyp,nSx,nSy)
1213        _RL frac(im,jm)        _RL frac(im,jm)
1214    
1215        integer  i,j,k        integer  i,j,k
# Line 1181  C*************************************** Line 1223  C***************************************
1223        do k=1,maxtyp        do k=1,maxtyp
1224        do j=1,jm        do j=1,jm
1225        do i=1,im        do i=1,im
1226        if(surftype(i,j,k,bi,bj).lt.100.and.        if( (surftype(i,j,k,bi,bj).lt.100.).and.
1227                                         tilefrac(i,j,k,bi,bj).gt.0.0)then       .                               (tilefrac(i,j,k,bi,bj).gt.0.0))then
1228         frac(i,j) = frac(i,j) + tilefrac(i,j,k,bi,bj)         frac(i,j) = frac(i,j) + tilefrac(i,j,k,bi,bj)
1229        endif        endif
1230        enddo        enddo
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22