completed first pass of code for columnization. WOrking through compi…

…ler errors

components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90

@@ -27,7 +27,7 @@ module EDCohortDynamicsMod
   public :: sort_cohorts
   public :: copy_cohort
   public :: count_cohorts
-  public :: countCohorts
+!  public :: countCohorts
   public :: allocate_live_biomass
 
   logical, parameter :: DEBUG  = .false. ! local debug flag

components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90

@@ -9,7 +9,7 @@ module EDPatchDynamicsMod
   use clm_varctl           , only : iulog 
   use pftconMod            , only : pftcon
   use EDCohortDynamicsMod  , only : fuse_cohorts, sort_cohorts, insert_cohort
-  use EDtypesMod           , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, numPatchesPerGridCell
+  use EDtypesMod           , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax, numPatchesPerCol
   use EDTypesMod           , only : ed_site_type, ed_patch_type, ed_cohort_type, udata
   use EDTypesMod           , only : min_patch_area
   !
@@ -1014,7 +1014,7 @@ subroutine fuse_patches( csite )
     !---------------------------------------------------------------------
 
     !maxpatch = 4  
-    maxpatch = numPatchesPerGridCell
+    maxpatch = numPatchesPerCol
 
     currentSite => csite 
 
@@ -1353,7 +1353,7 @@ subroutine terminate_patches(cs_pnt)
        areatot = areatot + currentPatch%area
        currentPatch => currentPatch%younger
        if((areatot-area) > 0.0000001_r8)then
-          write(iulog,*) 'ED: areatot too large. end terminate', areatot,currentSite%clmgcell
+          write(iulog,*) 'ED: areatot too large. end terminate', areatot
        endif
     enddo
 
@@ -1445,6 +1445,7 @@ function countPatches( bounds, sites, nsites ) result ( totNumPatches )
     ! !LOCAL VARIABLES:
     type (ed_patch_type), pointer :: currentPatch
     integer :: totNumPatches  ! total number of patches.  
+    integer :: s
     !---------------------------------------------------------------------
 
     totNumPatches = 0

components/clm/src/ED/biogeochem/EDPhysiologyMod.F90

@@ -247,6 +247,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst)
     use clm_time_manager, only : get_days_per_year, get_curr_date
     use clm_time_manager, only : get_ref_date, timemgr_datediff 
     use EDTypesMod, only : udata
+    use PatchType , only : patch   
     !
     ! !ARGUMENTS:
     type(ed_site_type)      , intent(inout), target :: currentSite
@@ -255,7 +256,6 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst)
     !
     ! !LOCAL VARIABLES:
     real(r8), pointer :: t_veg24(:) 
-    integer  :: g            ! grid point  
     integer  :: t            ! day of year
     integer  :: ncolddays    ! no days underneath the threshold for leaf drop
     integer  :: ncolddayslim ! critical no days underneath the threshold for leaf drop
@@ -268,6 +268,8 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst)
     integer  :: mon                      ! month (1, ..., 12)
     integer  :: day                      ! day of month (1, ..., 31)
     integer  :: sec                      ! seconds of the day
+    integer  :: patchi                   ! the first CLM/ALM patch index of the associated column
+    integer  :: coli                     ! the CLM/ALM column index of the associated site
 
     real(r8) :: gdd_threshold
     real(r8) :: a,b,c        ! params of leaf-pn model from botta et al. 2000. 
@@ -283,10 +285,13 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst)
 
     !------------------------------------------------------------------------
 
-    t_veg24       => temperature_inst%t_veg24_patch ! Input:  [real(r8) (:)]  avg pft vegetation temperature for last 24 hrs    
+    ! INTERF-TODO: THIS IS A BAND-AID, AS I WAS HOPING TO REMOVE CLM_PNO
+    ! ALREADY REMOVED currentSite%clmcolumn, hence the need for these
 
-    g = currentSite%clmgcell
+    patchi = currentSite%oldest_patch%clm_pno-1
+    coli   = patch%column(patchi)
 
+    t_veg24       => temperature_inst%t_veg24_patch ! Input:  [real(r8) (:)]  avg pft vegetation temperature for last 24 hrs    
 
     call get_curr_date(yr, mon, day, sec)
     curdate = yr*10000 + mon*100 + day
@@ -315,7 +320,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst)
     cold_t   = 7.5_r8  ! ed_ph_coldtemp
 
     t  = udata%time_period
-    temp_in_C = t_veg24(currentSite%oldest_patch%clm_pno-1) - tfrz
+    temp_in_C = t_veg24(patchi) - tfrz
 
     !-----------------Cold Phenology--------------------!              
 
@@ -359,7 +364,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst)
     endif
     !
     ! accumulate the GDD using daily mean temperatures
-    if (t_veg24(currentSite%oldest_patch%clm_pno-1) .gt. tfrz) then
+    if (t_veg24(patchi) .gt. tfrz) then
        currentSite%ED_GDD_site = currentSite%ED_GDD_site + t_veg24(currentSite%oldest_patch%clm_pno-1) - tfrz
     endif
 
@@ -437,7 +442,7 @@ subroutine phenology( currentSite, temperature_inst, waterstate_inst)
     ! distinction actually matter??).... 
 
     !Accumulate surface water memory of last 10 days.
-    currentSite%water_memory(1) = waterstate_inst%h2osoi_vol_col(currentSite%clmcolumn,1) 
+    currentSite%water_memory(1) = waterstate_inst%h2osoi_vol_col(coli,1) 
     do i = 1,9 !shift memory along one
        currentSite%water_memory(11-i) = currentSite%water_memory(10-i)
     enddo
@@ -1140,6 +1145,7 @@ subroutine fragmentation_scaler( currentPatch, temperature_inst )
     ! !USES:
     use shr_const_mod      , only : SHR_CONST_PI, SHR_CONST_TKFRZ
     use EDSharedParamsMod  , only : EDParamsShareInst
+    use PatchType , only : patch 
     !
     ! !ARGUMENTS    
     type(ed_patch_type)    , intent(inout) :: currentPatch
@@ -1165,8 +1171,9 @@ subroutine fragmentation_scaler( currentPatch, temperature_inst )
 
     catanf_30 = catanf(30._r8)
 
-    c = currentPatch%siteptr%clmcolumn
+!    c = currentPatch%siteptr%clmcolumn
     p = currentPatch%clm_pno
+    c = patch%column(p)
 
     ! set "froz_q10" parameter
     froz_q10  = EDParamsShareInst%froz_q10  

components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90

@@ -20,7 +20,7 @@ module EDAccumulateFluxesMod
 contains
 
   !------------------------------------------------------------------------------
-  subroutine AccumulateFluxes_ED(bounds, p, ed_allsites_inst, photosyns_inst)
+  subroutine AccumulateFluxes_ED(bounds, p, sites, nsites, hsites , photosyns_inst)
     !
     ! !DESCRIPTION:
     ! see above
@@ -36,14 +36,18 @@ subroutine AccumulateFluxes_ED(bounds, p, ed_allsites_inst, photosyns_inst)
     ! !ARGUMENTS    
     type(bounds_type)    , intent(in)            :: bounds  
     integer              , intent(in)            :: p     !patch/'p'
-    type(ed_site_type)   , intent(inout), target :: ed_allsites_inst( bounds%begg: )
+    type(ed_site_type)   , intent(inout), target :: sites(nsites)
+    integer              , intent(in)            :: nsites
+    integer              , intent(in)            :: hsites(bounds%begc:bounds%endc)
+
     type(photosyns_type) , intent(inout)         :: photosyns_inst
     !
     ! !LOCAL VARIABLES:
     type(ed_cohort_type), pointer  :: currentCohort ! current cohort
     type(ed_patch_type) , pointer  :: currentPatch ! current patch
     integer :: iv !leaf layer
-    integer :: g  !gridcell
+    integer :: c  ! clm/alm column
+    integer :: s  ! ed site
     !----------------------------------------------------------------------
 
     associate(& 
@@ -55,8 +59,10 @@ subroutine AccumulateFluxes_ED(bounds, p, ed_allsites_inst, photosyns_inst)
 
       if (patch%is_veg(p)) then
 
-         g = patch%gridcell(p)
-         currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) 
+         c = patch%column(p)
+         s = hsites(c)
+
+         currentPatch => map_clmpatch_to_edpatch(sites(s), p) 
          currentCohort => currentPatch%shortest
 
          do while(associated(currentCohort))

components/clm/src/ED/biogeophys/EDBtranMod.F90

@@ -25,7 +25,7 @@ module EDBtranMod
 contains 
 
   !------------------------------------------------------------------------------
-  subroutine btran_ed( bounds, p, ed_allsites_inst, &
+  subroutine btran_ed( bounds, p, sites, nsites, hsites, &
        soilstate_inst, waterstate_inst, temperature_inst, energyflux_inst)
     !
     ! !DESCRIPTION:
@@ -49,15 +49,17 @@ subroutine btran_ed( bounds, p, ed_allsites_inst, &
     ! !ARGUMENTS    
     type(bounds_type)      , intent(in)            :: bounds  ! clump bounds
     integer                , intent(in)            :: p       ! patch/'p'
-    type(ed_site_type)     , intent(inout), target :: ed_allsites_inst( bounds%begg: )
+    type(ed_site_type)     , intent(inout), target :: sites(nsites)
+    integer                , intent(in)            :: nsites
+    integer                , intent(in)            :: hsites(bounds%begc:bounds%endc)
     type(soilstate_type)   , intent(inout)         :: soilstate_inst
     type(waterstate_type)  , intent(in)            :: waterstate_inst
     type(temperature_type) , intent(in)            :: temperature_inst
     type(energyflux_type)  , intent(inout)         :: energyflux_inst
     !
     ! !LOCAL VARIABLES:
     integer :: iv !leaf layer
-    integer :: g  !gridcell
+    integer :: s  !site
     integer :: c  !column
     integer :: j  !soil layer
     integer :: ft ! plant functional type index
@@ -140,9 +142,10 @@ subroutine btran_ed( bounds, p, ed_allsites_inst, &
       if (patch%is_veg(p)) then
 
          c = patch%column(p)
-         g = patch%gridcell(p)
+         s = hsites(c)
 
-         currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) 
+         currentPatch => map_clmpatch_to_edpatch(sites(s), p) 
+
          do FT = 1,numpft_ed
             currentPatch%btran_ft(FT) = 0.0_r8
             do j = 1,nlevgrnd

components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90

@@ -20,7 +20,7 @@ module EDPhotosynthesisMod
 
   !---------------------------------------------------------
   subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, &
-       rb, dayl_factor, ed_allsites_inst, &
+       rb, dayl_factor, sites, nsites, hsites, &
        atm2lnd_inst, temperature_inst, canopystate_inst, photosyns_inst)
     !
     ! !DESCRIPTION:
@@ -61,7 +61,9 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, &
     real(r8)               , intent(in)            :: cair( bounds%begp: )        ! Atmospheric CO2 partial pressure (Pa)
     real(r8)               , intent(inout)         :: rb( bounds%begp: )          ! boundary layer resistance (s/m)
     real(r8)               , intent(in)            :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength
-    type(ed_site_type)     , intent(inout), target :: ed_allsites_inst( bounds%begg: )
+    type(ed_site_type)     , intent(inout), target :: sites(nsites)
+    integer                , intent(in)            :: nsites
+    integer                , intent(in)            :: hsites(bounds%begc:bounds%endc)
     type(atm2lnd_type)     , intent(in)            :: atm2lnd_inst
     type(temperature_type) , intent(in)            :: temperature_inst
     type(canopystate_type) , intent(inout)         :: canopystate_inst
@@ -145,7 +147,7 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, &
     real(r8) :: theta_ip                          ! empirical curvature parameter for ap photosynthesis co-limitation
 
     ! Other
-    integer  :: c,CL,f,g,iv,j,p,ps,ft             ! indices
+    integer  :: c,CL,f,s,iv,j,p,ps,ft             ! indices
     integer  :: NCL_p                             ! number of canopy layers in patch
     real(r8) :: cf                                ! s m**2/umol -> s/m
     real(r8) :: rsmax0                            ! maximum stomatal resistance [s/m]
@@ -323,10 +325,11 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, &
          gccanopy(p)  = 0._r8  
 
          if (patch%is_veg(p)) then
-            g = patch%gridcell(p)
+
             c = patch%column(p)
+            s = hsites(c)
 
-            currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) 
+            currentPatch => map_clmpatch_to_edpatch(sites(s), p) 
 
             currentPatch%ncan(:,:) = 0
             !redo the canopy structure algorithm to get round a bug that is happening for site 125, FT13. 
@@ -401,10 +404,11 @@ subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, &
       do f = 1,fn
          p = filterp(f)
          c = patch%column(p)
+         s = hsites(c)
 
          if (patch%is_veg(p)) then
-            g = patch%gridcell(p)
-            currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) 
+
+            currentPatch => map_clmpatch_to_edpatch(sites(s), p) 
 
             do FT = 1,numpft_ed
                if (nint(c3psn(FT)) == 1)then

components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90

@@ -65,7 +65,7 @@ subroutine ED_Norman_Radiation (bounds, &
       type(ed_site_type)     , intent(inout), target :: sites(nsites)      ! FATES site vector
       integer                , intent(in)            :: nsites             
       integer                , intent(in)            :: fcolumn(nsites)
-      integer                , intent(in)            :: hsites(bounds_clump%begc:bounds_clump%endc)
+      integer                , intent(in)            :: hsites(bounds%begc:bounds%endc)
       type(surfalb_type) , intent(inout)             :: surfalb_inst 
       !
       ! !LOCAL VARIABLES:
@@ -113,7 +113,7 @@ subroutine ED_Norman_Radiation (bounds, &
       real(r8) :: denom
       real(r8) :: lai_reduction(2)
 
-      integer  :: fp,p,c,iv        ! array indices
+      integer  :: fp,p,c,iv,s      ! array indices
       integer  :: ib               ! waveband number
       real(r8) :: cosz             ! 0.001 <= coszen <= 1.000
       real(r8) :: chil(bounds%begp:bounds%endp)    ! -0.4 <= xl <= 0.6
@@ -245,7 +245,7 @@ subroutine ED_Norman_Radiation (bounds, &
                         end do !iv
                      end do !ft
                   end do !L
-                  g = currentPatch%siteptr%clmgcell
+!                  g = currentPatch%siteptr%clmgcell
 
                   do radtype = 1,2 !do this once for one unit of diffuse, and once for one unit of direct radiation
                      do ib = 1,numrad
@@ -822,7 +822,7 @@ subroutine ED_Norman_Radiation (bounds, &
                            error = abs(currentPatch%sabs_dir(ib)-(currentPatch%tr_soil_dir(ib)*(1.0_r8-albgrd(c,ib))+ &
                                  currentPatch%tr_soil_dir_dif(ib)*(1.0_r8-albgri(c,ib))))
                            if ( abs(error) > 0.0001)then
-                              write(iulog,*)'dir ground absorption error',p,g,error,currentPatch%sabs_dir(ib), &
+                              write(iulog,*)'dir ground absorption error',p,c,error,currentPatch%sabs_dir(ib), &
                                     currentPatch%tr_soil_dir(ib)* &
                                     (1.0_r8-albgrd(c,ib)),currentPatch%NCL_p,ib,sum(ftweight(1,:,1))
                               write(iulog,*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), &
@@ -837,7 +837,7 @@ subroutine ED_Norman_Radiation (bounds, &
                         else
                            if ( abs(currentPatch%sabs_dif(ib)-(currentPatch%tr_soil_dif(ib) * &
                                  (1.0_r8-albgri(c,ib)))) > 0.0001)then
-                              write(iulog,*)'dif ground absorption error',p,g,currentPatch%sabs_dif(ib) , &
+                              write(iulog,*)'dif ground absorption error',p,c,currentPatch%sabs_dif(ib) , &
                                     (currentPatch%tr_soil_dif(ib)* &
                                     (1.0_r8-albgri(c,ib))),currentPatch%NCL_p,ib,sum(ftweight(1,:,1))
                            endif

components/clm/src/ED/fire/SFMainMod.F90

@@ -640,6 +640,7 @@ subroutine  area_burnt ( currentSite )
 
     use domainMod,     only : ldomain
     use EDParamsMod,   only : ED_val_nfires
+    use PatchType,     only : patch 
 
     type(ed_site_type), intent(inout), target :: currentSite
 
@@ -650,7 +651,7 @@ subroutine  area_burnt ( currentSite )
     real db !distance fire has travelled backward
     real(r8) gridarea
     real(r8) size_of_fire
-    integer g
+    integer g, p
 
     currentSite%frac_burnt = 0.0_r8
 
@@ -683,9 +684,17 @@ subroutine  area_burnt ( currentSite )
 
           ! --- calculate area burnt---
           if(lb > 0.0_r8) then
-             g = currentSite%clmgcell
+
+             p = currentPatch%clm_pno
+             g = patch%gridcell(p)
+             ! g = currentSite%clmgcell (DEPRECATED VARIABLE)
+
+             ! INTERF-TODO:
+             ! THIS SHOULD HAVE THE COLUMN AND LU AREA WEIGHT ALSO, NO?
+
              gridarea = ldomain%area(g) *1000000.0_r8 !convert from km2 into m2
              currentPatch%NF = ldomain%area(g) * ED_val_nfires * currentPatch%area/area /365
+
              ! If there are 15  lightening strickes per year, per km2. (approx from NASA product) 
              ! then there are 15/365 s/km2 each day.