casa_inout.F90 Source File


This file depends on

sourcefile~~casa_inout.f90~~EfferentGraph sourcefile~casa_inout.f90 casa_inout.F90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~casa_inout.f90->sourcefile~cable_common.f90 sourcefile~cable_define_types.f90 cable_define_types.F90 sourcefile~casa_inout.f90->sourcefile~cable_define_types.f90 sourcefile~cable_iovars.f90 cable_iovars.F90 sourcefile~casa_inout.f90->sourcefile~cable_iovars.f90 sourcefile~casa_dimension.f90 casa_dimension.F90 sourcefile~casa_inout.f90->sourcefile~casa_dimension.f90 sourcefile~casa_offline_inout.f90 casa_offline_inout.F90 sourcefile~casa_inout.f90->sourcefile~casa_offline_inout.f90 sourcefile~casa_param.f90 casa_param.F90 sourcefile~casa_inout.f90->sourcefile~casa_param.f90 sourcefile~casa_phenology.f90 casa_phenology.F90 sourcefile~casa_inout.f90->sourcefile~casa_phenology.f90 sourcefile~casa_variable.f90 casa_variable.F90 sourcefile~casa_inout.f90->sourcefile~casa_variable.f90 sourcefile~cable_runtime_opts_mod.f90 cable_runtime_opts_mod.F90 sourcefile~cable_common.f90->sourcefile~cable_runtime_opts_mod.f90 sourcefile~cable_climate_type_mod.f90 cable_climate_type_mod.F90 sourcefile~cable_define_types.f90->sourcefile~cable_climate_type_mod.f90 sourcefile~cable_iovars.f90->sourcefile~cable_define_types.f90 sourcefile~casa_dimension.f90->sourcefile~cable_define_types.f90 sourcefile~casa_offline_inout.f90->sourcefile~cable_common.f90 sourcefile~casa_offline_inout.f90->sourcefile~cable_define_types.f90 sourcefile~casa_offline_inout.f90->sourcefile~casa_phenology.f90 sourcefile~casa_offline_inout.f90->sourcefile~casa_variable.f90 sourcefile~casa_ncdf.f90 casa_ncdf.F90 sourcefile~casa_offline_inout.f90->sourcefile~casa_ncdf.f90 sourcefile~casa_param.f90->sourcefile~casa_dimension.f90 sourcefile~casa_phenology.f90->sourcefile~casa_dimension.f90 sourcefile~casa_variable.f90->sourcefile~casa_dimension.f90 sourcefile~casa_variable.f90->sourcefile~casa_param.f90 sourcefile~cable_climate_type_mod.f90->sourcefile~cable_common.f90 sourcefile~grid_constants_cbl.f90 grid_constants_cbl.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~grid_constants_cbl.f90 sourcefile~casa_ncdf.f90->sourcefile~cable_common.f90 sourcefile~casa_ncdf.f90->sourcefile~cable_define_types.f90 sourcefile~casa_ncdf.f90->sourcefile~cable_iovars.f90

Files dependent on this one

sourcefile~~casa_inout.f90~~AfferentGraph sourcefile~casa_inout.f90 casa_inout.F90 sourcefile~biogeochem_casa.f90 biogeochem_casa.F90 sourcefile~biogeochem_casa.f90->sourcefile~casa_inout.f90 sourcefile~cable_input.f90 cable_input.F90 sourcefile~cable_input.f90->sourcefile~casa_inout.f90 sourcefile~cable_mpimaster.f90 cable_mpimaster.F90 sourcefile~cable_mpimaster.f90->sourcefile~casa_inout.f90 sourcefile~cable_mpimaster.f90->sourcefile~cable_input.f90 sourcefile~bgcdriver.f90 bgcdriver.F90 sourcefile~cable_mpimaster.f90->sourcefile~bgcdriver.f90 sourcefile~cable_driver_common.f90 cable_driver_common.F90 sourcefile~cable_mpimaster.f90->sourcefile~cable_driver_common.f90 sourcefile~cable_mpiworker.f90 cable_mpiworker.F90 sourcefile~cable_mpiworker.f90->sourcefile~casa_inout.f90 sourcefile~cable_mpiworker.f90->sourcefile~biogeochem_casa.f90 sourcefile~cable_mpiworker.f90->sourcefile~cable_input.f90 sourcefile~cable_mpiworker.f90->sourcefile~bgcdriver.f90 sourcefile~cable_mpiworker.f90->sourcefile~cable_driver_common.f90 sourcefile~cable_serial.f90 cable_serial.F90 sourcefile~cable_serial.f90->sourcefile~casa_inout.f90 sourcefile~cable_serial.f90->sourcefile~cable_input.f90 sourcefile~cable_serial.f90->sourcefile~bgcdriver.f90 sourcefile~cable_serial.f90->sourcefile~cable_driver_common.f90 sourcefile~casaonly_luc.f90 CASAONLY_LUC.F90 sourcefile~casaonly_luc.f90->sourcefile~casa_inout.f90 sourcefile~casaonly_luc.f90->sourcefile~biogeochem_casa.f90 sourcefile~spincasacnp.f90 spincasacnp.F90 sourcefile~spincasacnp.f90->sourcefile~casa_inout.f90 sourcefile~spincasacnp.f90->sourcefile~biogeochem_casa.f90 sourcefile~bgcdriver.f90->sourcefile~biogeochem_casa.f90 sourcefile~cable_driver_common.f90->sourcefile~cable_input.f90 sourcefile~cable_offline_driver.f90 cable_offline_driver.F90 sourcefile~cable_offline_driver.f90->sourcefile~cable_serial.f90 sourcefile~cable_offline_driver.f90->sourcefile~cable_driver_common.f90

Source Code

!#define UM_CBL YES
!==============================================================================
! This source code is part of the
! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model.
! This work is licensed under the CSIRO Open Source Software License
! Agreement (variation of the BSD / MIT License).
!
! You may not use this file except in compliance with this License.
! A copy of the License (CSIRO_BSD_MIT_License_v2.0_CABLE.txt) is located
! in each directory containing CABLE code.
!
! ==============================================================================
! Purpose: Input and output code for CASA-CNP when run offline
!          ACCESS version may use some of this code but split into different files?
!
! Contact: Yingping.Wang@csiro.au and Bernard.Pak@csiro.au
!
! History: Developed for offline code.  Expect to re-write for MPI and ACCESS
!          versions
!
!
! ==============================================================================
! casa_inout.f90
!
! the following routines are used when "casacnp" is coupled to "cable"
!   casa_readbiome
!   casa_readphen
!   casa_readpoint   (removed, now done in parameter_module)
!   casa_init
!   casa_poolout
!   casa_cnpflux  (zeros casabal quantites on doy 1 and updates casabal at end of biogeochem)
!   biogeochem

MODULE casa_inout_module

USE casavariable, ONLY : casafile

CONTAINS

  SUBROUTINE casa_readphen(veg,casamet,phen)
    !SUBROUTINE casa_readphen(mvt,veg,casamet,phen)
    ! read in the tabulated modis-derived leaf phenology data
    ! for latitude bands of 79.75 to -55.25
    USE cable_def_types_mod
    USE casadimension
    USE casaparm
    USE casavariable
    USE phenvariable
    IMPLICIT NONE
    !  INTEGER,              INTENT(IN)    :: mvt
    TYPE (veg_parameter_type), INTENT(IN)    :: veg  ! vegetation parameters
    TYPE (casa_met),           INTENT(IN)    :: casamet
    TYPE (phen_variable),      INTENT(INOUT) :: phen

    ! local variables
    INTEGER, PARAMETER            :: nphen=8! was 10(IGBP). changed by Q.Zhang @01/12/2011
    INTEGER np,nx,ilat
    INTEGER, DIMENSION(271,mvtype) :: greenup, fall,  phendoy1
    INTEGER, DIMENSION(nphen)     :: greenupx,fallx,xphendoy1
    INTEGER, DIMENSION(nphen)     :: ivtx
    REAL(r_2), DIMENSION(271)     :: xlat

    ! initilize for evergreen PFTs
    greenup(:,:) = -50
    fall(:,:)    = 367
    phendoy1(:,:)= 2

    OPEN(101,file=casafile%phen)
    READ(101,*)
    READ(101,*) (ivtx(nx),nx=1,nphen) ! fixed at 10, as only 10 of 17 IGBP PFT
    ! have seasonal leaf phenology
    DO ilat=271,1,-1
       READ(101,*) xlat(ilat),(greenupx(nx),nx=1,nphen), &
            (fallx(nx),nx=1,nphen),(xphendoy1(nx),nx=1,nphen)
       DO nx=1,nphen
          greenup(ilat,ivtx(nx)) = greenupx(nx)
          fall(ilat,ivtx(nx))    = fallx(nx)
          phendoy1(ilat,ivtx(nx))= xphendoy1(nx)
       ENDDO
    ENDDO

    DO np=1,mp
       ilat=(casamet%lat(np)+55.25)/0.5+1
       ilat= MIN(271,MAX(1,ilat))
       phen%phase(np) = phendoy1(ilat,veg%iveg(np))
       phen%doyphase(np,1) = greenup(ilat,veg%iveg(np)) ! DOY for greenup
       phen%doyphase(np,2) = phen%doyphase(np,1) +14    ! DOY for steady LAI
       phen%doyphase(np,3) = fall(ilat,veg%iveg(np))    ! DOY for leaf senescence
       phen%doyphase(np,4) = phen%doyphase(np,3) +14    ! DOY for minimal LAI season
       IF (phen%doyphase(np,2) > 365) phen%doyphase(np,2)=phen%doyphase(np,2)-365
       IF (phen%doyphase(np,4) > 365) phen%doyphase(np,4)=phen%doyphase(np,4)-365

    ENDDO

  END SUBROUTINE casa_readphen

  SUBROUTINE casa_init(casabiome,casamet,casaflux,casapool,casabal,veg,phen)
    ! mst not used (BP sep2010)
    ! ! for first time reading file *_1220.csv  (BP may2010)
    !SUBROUTINE casa_init(mst,casapool,casabal,veg)
    ! !SUBROUTINE casa_init(mst,casapool,casabal)
    ! ! end addition (BP may2010)
    !  initialize some values in phenology parameters and leaf growth phase
    USE casadimension
    USE casaparm
    USE casavariable
    USE phenvariable
    ! for first time reading file *_1220.csv  (BP may2010)
    USE cable_def_types_mod
    USE cable_io_vars_module, ONLY: landpt, patch
    USE cable_common_module, ONLY: cable_user
#ifndef UM_CBL 
USE casa_offline_inout_module, ONLY : READ_CASA_RESTART_NC
#endif

    ! end addition (BP may2010)
    IMPLICIT NONE
    !  INTEGER,        INTENT(IN)    :: mst
    TYPE (casa_biome),   INTENT(IN)    :: casabiome
    TYPE (casa_met),     INTENT(INOUT) :: casamet
    TYPE (casa_flux),    INTENT(INOUT) :: casaflux
    TYPE (casa_pool),    INTENT(INOUT) :: casapool
    TYPE (casa_balance), INTENT(INOUT) :: casabal
    ! for first time reading file *_1220.csv  (BP may2010)
    TYPE (veg_parameter_type), INTENT(IN) :: veg
    TYPE (phen_variable),   INTENT(INOUT) :: phen
    REAL(r_2) :: clabile,cplant(3),clitter(3),csoil(3)
    REAL(r_2) :: nplant(3),nlitter(3),nsoil(3),nsoilmin,pplant(3)
    REAL(r_2) :: plitter(3),psoil(3),psoillab,psoilsorb,psoilocc
    ! end addition (BP may2010)

    ! local variables
    INTEGER   :: np,npt,npz
    INTEGER   :: nyearz,ivtz,istz,isoz
    REAL(r_2) :: latz,lonz,areacellz,glaiz,slaz
    LOGICAL   :: EXRST


    IF (.NOT.cable_user%casa_fromzero) THEN
       PRINT *, 'initial pool from restart file'
    ENDIF
    PRINT *, 'icycle,initcasa,mp ', icycle,initcasa,mp
    !phen%phase = 2

    !CLN initialise all ! THIS NEEDS FIXING because of e.g. ICE-WATER
    casaflux%Cgpp         = 0.
    casaflux%Cnpp         = 0.
    casaflux%Crp          = 0.
    casaflux%Crgplant     = 0.
    ! casaflux%Nminfix      = 0.
    casaflux%Nminuptake   = 0.
    casaflux%Plabuptake   = 0.
    casaflux%Clabloss     = 0.
    casaflux%fracClabile  = 0.
    casaflux%stemnpp      = 0.
    casaflux%frac_sapwood = 1.0
    casaflux%sapwood_area = 0.
    casaflux%FluxCtohwp = 0.
    casaflux%FluxCtoClear = 0.
    casaflux%fracCalloc   = 0.
    casaflux%fracNalloc   = 0.
    casaflux%fracPalloc   = 0.
    casaflux%Crmplant     = 0.
    casaflux%kplant       = 0.

    casaflux%fromPtoL     = 0.

    casaflux%Cnep         = 0.
    casaflux%Crsoil       = 0.
    casapool%dClabiledt = 0.0
    !casaflux%Nmindep      =  casaflux%Nmindep /2.0
    !casaflux%Nmindep      = 0.
    casaflux%Nminloss     = 0.
    casaflux%Nminleach    = 0.
    casaflux%Nupland      = 0.
    casaflux%Nlittermin   = 0.
    casaflux%Nsmin        = 0.
    casaflux%Nsimm        = 0.
    casaflux%Nsnet        = 0.
    !casaflux%fNminloss    = 0.
    !casaflux%fNminleach   = 0.
    !casaflux%Pdep         = 0.
    !casaflux%Pwea         = 0.
    casaflux%Pleach       = 0.
    casaflux%Ploss        = 0.
    casaflux%Pupland      = 0.
    casaflux%Plittermin   = 0.
    casaflux%Psmin        = 0.
    casaflux%Psimm        = 0.
    casaflux%Psnet        = 0.
    !  casaflux%fPleach      = 0. !vh ! this should be a parameter, not a flux variable
    casaflux%kplab        = 0.
    casaflux%kpsorb       = 0.
    casaflux%kpocc        = 0.
    !  casaflux%Psorbmax     = 0. !vh ! this should be a paramter, not a flux variable

    casaflux%klitter      = 0.
    casaflux%ksoil        = 0.
    casaflux%fromLtoS     = 0.
    casaflux%fromStoS     = 0.
    casaflux%fromLtoCO2   = 0.
    casaflux%fromStoCO2   = 0.
    casaflux%FluxCtolitter= 0.
    casaflux%FluxNtolitter= 0.
    casaflux%FluxPtolitter= 0.
    casaflux%FluxCtosoil  = 0.
    casaflux%FluxNtosoil  = 0.
    casaflux%FluxPtosoil  = 0.
    casaflux%FluxCtoCO2   = 0.

    casaflux%Cplant_turnover = 0.
!Ticket #204 - rm phen% clobbing here AND incorrectly so anyway

    IF (initcasa==1) THEN
       IF (.NOT.cable_user%casa_fromzero) THEN
#ifndef UM_CBL 
          CALL READ_CASA_RESTART_NC (  casamet, casapool, casaflux, phen )
#endif
       ELSE
          WRITE(*,*)'casa_init: not using restart file!'
          WRITE(*,*)'Using input from readbiome.!'
          WRITE(*,*) 'initialising frac_sapwood=1 and sapwood_area = 0)'
          casaflux%frac_sapwood(:) = 1.0
          casaflux%sapwood_area(:) = 0.0
       ENDIF
    ENDIF
    WHERE(casamet%lnonwood==1) casapool%cplant(:,WOOD) = 0.0
    WHERE(casamet%lnonwood==1) casapool%nplant(:,WOOD) = 0.0
    WHERE(casamet%lnonwood==1) casapool%pplant(:,WOOD) = 0.0
!$IF (initcasa==1) THEN
!$     INQUIRE( FILE=TRIM(casafile%cnpipool), EXIST=EXRST )
!$! vh_js!
!$     IF ( EXRST ) THEN
!$
!$           PRINT*, ' Reading cnppoolOutfile as input: ,',casafile%cnpipool
!$
!$    OPEN(99,file=casafile%cnpipool)
!$
!$    DO npt =1, mp
!$       SELECT CASE(icycle)
!$       CASE(1)
!$          ! vh_js !
!$          IF (cable_user%CALL_POP) THEN
!$
!$             READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, &
!$                  casamet%glai(npt),slaz,phen%phase(npt) , &
!$                  phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
!$                  casapool%clabile(npt) ,casapool%cplant(npt,:) ,  &
!$                  casapool%clitter(npt,:),casapool%csoil(npt,:), &
!$                  casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt)
!$
!$
!$             ELSE
!$              READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, &
!$                  casamet%glai(npt),slaz,phen%phase(npt) , &
!$                  phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
!$                  casapool%clabile(npt) ,casapool%cplant(npt,:) ,  &
!$                  casapool%clitter(npt,:),casapool%csoil(npt,:)
!$             casaflux%frac_sapwood(:) = 1.0
!$             casaflux%sapwood_area(:) = 0.0
!$          ENDIF
!$
!$
!$       CASE(2)
!$! vh_js !
!$          IF (cable_user%CALL_POP) THEN
!$             READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, &
!$                  casamet%glai(npt),slaz,phen%phase(npt), &
!$                  phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
!$                  casapool%clabile(npt),casapool%cplant(npt,:),   &
!$                  casapool%clitter(npt,:),casapool%csoil(npt,:),       &
!$                  casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt), &
!$                  casapool%nplant(npt,:),casapool%nlitter(npt,:),      &
!$                  casapool%nsoil(npt,:),casapool%nsoilmin(npt)
!$
!$          ELSE
!$             READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, &
!$                  casamet%glai(npt),slaz,phen%phase(npt), &
!$                  phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
!$                  casapool%clabile(npt),casapool%cplant(npt,:),   &
!$                  casapool%clitter(npt,:),casapool%csoil(npt,:),       &
!$                  casapool%nplant(npt,:),casapool%nlitter(npt,:),      &
!$                  casapool%nsoil(npt,:),casapool%nsoilmin(npt)
!$             casaflux%frac_sapwood(:) = 1.0
!$             casaflux%sapwood_area(:) = 0.0
!$
!$          ENDIF
!$       CASE(3)
!$! vh_js !
!$          IF (cable_user%CALL_POP) THEN
!$             READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, &
!$                  casamet%glai(npt),slaz,phen%phase(npt), &
!$                  phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
!$                  casapool%clabile(npt),casapool%cplant(npt,:),   &
!$                  casapool%clitter(npt,:),casapool%csoil(npt,:),       &
!$                  casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt), &
!$                  casapool%nplant(npt,:),casapool%nlitter(npt,:),      &
!$                  casapool%nsoil(npt,:),casapool%nsoilmin(npt),        &
!$                  casapool%pplant(npt,:),casapool%plitter(npt,:),      &
!$                  casapool%psoil(npt,:),casapool%psoillab(npt),        &
!$                  casapool%psoilsorb(npt),casapool%psoilocc(npt)
!$          ELSE
!$             READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, &
!$                  casamet%glai(npt),slaz,phen%phase(npt), &
!$                  phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
!$                  casapool%clabile(npt),casapool%cplant(npt,:),   &
!$                  casapool%clitter(npt,:),casapool%csoil(npt,:),       &
!$                  casapool%nplant(npt,:),casapool%nlitter(npt,:),      &
!$                  casapool%nsoil(npt,:),casapool%nsoilmin(npt),        &
!$                  casapool%pplant(npt,:),casapool%plitter(npt,:),      &
!$                  casapool%psoil(npt,:),casapool%psoillab(npt),        &
!$                  casapool%psoilsorb(npt),casapool%psoilocc(npt)
!$             casaflux%frac_sapwood(:) = 1.0
!$             casaflux%sapwood_area(:) = 0.0
!$
!$
!$          ENDIF
!$       END SELECT
!$       IF (ABS(patch(npt)%longitude - lonz) > 0.9 .OR. &
!$            ABS(patch(npt)%latitude  - latz) > 0.9) THEN
!$          PRINT *, 'patch(npt)%longitude, lonz:', patch(npt)%longitude, lonz
!$          PRINT *, 'patch(npt)%latitude,  latz:', patch(npt)%latitude,  latz
!$          PRINT *, 'npt = ', npt
!$          STOP
!$       ENDIF
!$    ENDDO
!$    CLOSE(99)
!$
!$
!$ ELSE
!$ ! vh_js !
!$    WRITE(*,*)'No valid restart file for casa_init found.'
!$    WRITE(*,*)'Using input from readbiome.!'
!$    WRITE(*,*) 'initialising frac_sapwood=1 and sapwood_area = 0)'
!$    casaflux%frac_sapwood(:) = 1.0
!$    casaflux%sapwood_area(:) = 0.0
!$
!$
!$ ENDIF  ! IF (EXRST)

!$ENDIF
    !92 format(5(i6,2x),5(f18.6,3x),2(i6,',',2x),',',2x,100(f18.6,3x))
92  FORMAT(5(i6,',',2x),5(f18.6,',',2x),2(i6,',',2x),',',2x,100(f18.6,',',2x))


    IF(initcasa==0) THEN
       nyearz = 1
       DO npt=1,mp
          casamet%lon(npt) = patch(npt)%longitude
          casamet%lat(npt) = patch(npt)%latitude
       ENDDO
    ENDIF

    ! reset labile C pool,comment out by Q.Zhang 10/09/2011
    !  casapool%clabile    = 0.0
    ! check pool sizes
    casapool%cplant     = MAX(0.0,casapool%cplant)
    casapool%clitter    = MAX(0.0,casapool%clitter)
    casapool%csoil      = MAX(0.0,casapool%csoil)
    casabal%cplantlast  = casapool%cplant
    casabal%clitterlast = casapool%clitter
    casabal%csoillast   = casapool%csoil
    casabal%clabilelast = casapool%clabile
    casabal%sumcbal     = 0.0
    casabal%FCgppyear=0.0;casabal%FCrpyear=0.0
    casabal%FCnppyear=0;casabal%FCrsyear=0.0;casabal%FCneeyear=0.0
    !vh !
    WHERE(casamet%lnonwood==1) casapool%cplant(:,WOOD) = 0.0
    IF (icycle==1) THEN
       casapool%Nplant(:,:) = casapool%cplant(:,:) * casapool%ratioNCplant(:,:)
       casapool%Nsoil(:,:)  = casapool%ratioNCsoil(:,:) * casapool%Csoil(:,:)
       casapool%Psoil(:,:)  = casapool%Nsoil(:,:)/casapool%ratioNPsoil(:,:)
       casapool%Nsoilmin(:) = 2.5
    ENDIF

    IF (icycle >=1) THEN
       casapool%nplant     = MAX(1.e-6,casapool%nplant)
       casapool%nlitter    = MAX(1.e-6,casapool%nlitter)
       casapool%nsoil      = MAX(1.e-6,casapool%nsoil)
       casapool%nsoilmin   = MAX(1.e-6,casapool%nsoilmin)
       casabal%nplantlast  = casapool%nplant
       casabal%nlitterlast = casapool%nlitter
       casabal%nsoillast   = casapool%nsoil
       casabal%nsoilminlast= casapool%nsoilmin
       casabal%sumnbal     = 0.0
       casabal%FNdepyear=0.0;casabal%FNfixyear=0.0;casabal%FNsnetyear=0.0
       casabal%FNupyear=0.0;casabal%FNleachyear=0.0;casabal%FNlossyear=0.0
       !vh !
       WHERE(casamet%lnonwood==1) casapool%nplant(:,WOOD) = 0.0
    ENDIF

    IF (icycle >=1) THEN
       casapool%pplant       = MAX(1.0e-7,casapool%pplant)
       casapool%plitter      = MAX(1.0e-7,casapool%plitter)
       casapool%psoil        = MAX(1.0e-7,casapool%psoil)
       casapool%Psoillab     = MAX(1.0e-7,casapool%psoillab)  ! was 2.0, changed according to  YP
       casapool%psoilsorb    = MAX(1.0e-7,casapool%psoilsorb) ! was 10.0, -
       casapool%psoilocc     = MAX(1.0e-7,casapool%psoilocc)  ! was 50.0, -
       casabal%pplantlast    = casapool%pplant
       casabal%plitterlast   = casapool%plitter
       casabal%psoillast     = casapool%psoil
       casabal%psoillablast  = casapool%psoillab
       casabal%psoilsorblast = casapool%psoilsorb
       casabal%psoilocclast  = casapool%psoilocc
       casabal%sumpbal       = 0.0
       casabal%FPweayear=0.0;casabal%FPdustyear=0.0; casabal%FPsnetyear=0.0
       casabal%FPupyear=0.0;casabal%FPleachyear=0.0;casabal%FPlossyear=0.0
       !vh !
       WHERE(casamet%lnonwood==1) casapool%pplant(:,WOOD) = 0.0
    ENDIF
    
    casapool%cwoodprod=0.0; casapool%nwoodprod=0.0;casapool%pwoodprod=0.0

  END SUBROUTINE casa_init


  SUBROUTINE casa_poolout(ktau,veg,soil,casabiome,casapool,casaflux,casamet, &
       casabal,phen)
    USE cable_def_types_mod
    USE casadimension
    USE casaparm
    USE casavariable
    USE phenvariable
    USE cable_common_module, ONLY: cable_user
    IMPLICIT NONE
    INTEGER,               INTENT(IN)    :: ktau
    TYPE (veg_parameter_type),  INTENT(INOUT) :: veg  ! vegetation parameters
    TYPE (soil_parameter_type), INTENT(INOUT) :: soil ! soil parameters
    TYPE (casa_biome),          INTENT(INOUT) :: casabiome
    TYPE (casa_pool),           INTENT(INOUT) :: casapool
    TYPE (casa_flux),           INTENT(INOUT) :: casaflux
    TYPE (casa_met),            INTENT(INOUT) :: casamet
    TYPE (casa_balance),        INTENT(INOUT) :: casabal
    TYPE (phen_variable),       INTENT(INOUT) :: phen

    ! local variables
    REAL(r_2), DIMENSION(mso) :: Psorder,pweasoil,xpsoil50
    REAL(r_2), DIMENSION(mso) :: fracPlab,fracPsorb,fracPocc,fracPorg
    REAL(r_2), DIMENSION(mp)  :: totpsoil
    INTEGER  npt,nout,nso

    ! Soiltype     soilnumber soil P(g P/m2)
    ! Alfisol     1       61.3
    ! Andisol     2       103.9
    ! Aridisol    3       92.8
    ! Entisol     4       136.9
    ! Gellisol    5       98.2
    ! Histosol    6       107.6
    ! Inceptisol  7       84.1
    ! Mollisol    8       110.1
    ! Oxisol      9       35.4
    ! Spodosol    10      41.0
    ! Ultisol     11      51.5
    ! Vertisol    12      190.6
    DATA psorder/61.3,103.9,92.8,136.9,98.2,107.6,84.1,110.1,35.4,41.0,51.5,190.6/
    DATA pweasoil/0.05,0.04,0.03,0.02,0.01,0.009,0.008,0.007,0.006,0.005,0.004,0.003/
    DATA fracpLab/0.08,0.08,0.10,0.02,0.08,0.08,0.08,0.06,0.02,0.05,0.09,0.05/
    DATA fracPsorb/0.32,0.37,0.57,0.67,0.37,0.37,0.37,0.32,0.24,0.22,0.21,0.38/
    DATA fracPocc/0.36,0.38,0.25,0.26,0.38,0.38,0.38,0.44,0.38,0.38,0.37,0.45/
    DATA fracPorg/0.25,0.17,0.08,0.05,0.17,0.17,0.17,0.18,0.36,0.35,0.34,0.12/
    DATA xpsoil50/7.6,4.1,4.2,3.4,4.1,4.1,4.8,4.1,6.9,6.9,6.9,1.7/
    !
    ! estimated based on Yang, Post and Jain (2013)
    !   Soiltype     soilnumber soil P(g P/m2  top 50 cm)
    !   Alfisol     1       400
    !   Andisol     2       426
    !   Aridisol    3       352
    !   Entisol     4       490
    !   Gellisol    5       403
    !   Histosol    6       441
    !   Inceptisol  7       501
    !   Mollisol    8       358
    !   Oxisol      9       96
    !   Spodosol    10      364
    !   Ultisol     11      272
    !   Vertisol    12      430
    !  DATA psorder/400.0,426.0,352.0,490.0,403.0,441.0,501.0,358.0,96.0,364.0,272.0,430.0/
    !  DATA pweasoil/0.05,0.04,0.03,0.02,0.01,0.009,0.008,0.007,0.006,0.005,0.004,0.003/
    !  DATA fracpLab/0.07,0.04,0.08,0.10,0.08,0.10,0.12,0.05,0.05,0.06,0.06,0.05/
    !  DATA fracPsorb/0.30,0.44,0.69,0.53,0.37,0.14,0.24,0.32,0.15,0.21,0.17,0.35/
    !  DATA fracPocc/0.38,0.22,0.18,0.22,0.38,0.42,0.23,0.44,0.60,0.30,0.51,0.48/
    !  DATA fracPorg/0.25,0.30,0.05,0.15,0.17,0.34,0.41,0.19,0.20,0.43,0.26,0.12/
    !  DATA xpsoil50/1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0/

    PRINT *, 'Within casa_poolout, mp = ', mp
    nout=103
    OPEN(nout,file=casafile%cnpepool)
    PRINT *, 'Opened file ', casafile%cnpepool

    casabal%sumcbal=MIN(9999.0,MAX(-9999.0,casabal%sumcbal))
    casabal%sumnbal=MIN(9999.0,MAX(-9999.0,casabal%sumnbal))
    casabal%sumpbal=MIN(9999.0,MAX(-9999.0,casabal%sumpbal))

    DO npt =1, mp
       nso = casamet%isorder(npt)
       totpsoil(npt) = psorder(nso) *xpsoil50(nso)
       IF(casamet%iveg2(npt)>0 ) THEN
          IF (icycle<2) THEN
             casapool%Nplant(npt,:) = casapool%ratioNCplant(npt,:)  &
                  * casapool%cplant(npt,:)
             casapool%Nlitter(npt,:)= casapool%ratioNClitter(npt,:) &
                  * casapool%clitter(npt,:)
             casapool%Nsoil(npt,:)  = casapool%ratioNCsoil(npt,:)   &
                  * casapool%Csoil(npt,:)
             casapool%nsoilmin(npt) = 2.0
             casabal%sumnbal(npt)   = 0.0
             IF(casamet%iveg2(npt)==grass) THEN
                casapool%nplant(npt,wood) = 0.0
                casapool%nlitter(npt,cwd) = 0.0
             ENDIF
          ENDIF

          IF (icycle<3) THEN
             casabal%sumpbal(npt)   = 0.0
             casapool%pplant(npt,:)  = casapool%Nplant(npt,:)/casapool%ratioNPplant(npt,:)
             casapool%plitter(npt,:) = casapool%Nlitter(npt,:)/(casapool%ratioNPlitter(npt,:)+1.0e-10)
             casapool%psoil(npt,:)   = casapool%Nsoil(npt,:)/casapool%ratioNPsoil(npt,:)
             casapool%psoillab(npt) = totpsoil(npt) *fracpLab(nso)
             casapool%psoilsorb(npt)= casaflux%psorbmax(npt) * casapool%psoillab(npt) &
                  /(casaflux%kmlabp(npt)+casapool%psoillab(npt))
             casapool%psoilocc(npt) = totpsoil(npt) *fracPocc(nso)
             IF(casamet%iveg2(npt)==grass) THEN
                casapool%pplant(npt,wood) = 0.0
                casapool%plitter(npt,cwd) = 0.0
             ENDIF
          ENDIF
       ELSE
          casapool%cplant(npt,:)=0.0; casapool%clitter(npt,:)=0.0; casapool%csoil(npt,:) = 0.0; casapool%clabile(npt) = 0.0
          casapool%nplant(npt,:)=0.0; casapool%nlitter(npt,:)=0.0; casapool%nsoil(npt,:) = 0.0; casapool%nsoilmin(npt) = 0.0
          casapool%pplant(npt,:)=0.0; casapool%plitter(npt,:)=0.0; casapool%psoil(npt,:) = 0.0
          casapool%psoillab(npt) = 0.0; casapool%psoilsorb(npt) = 0.0; casapool%psoilocc(npt) = 0.0
          casabal%sumcbal(npt) =0.0; casabal%sumnbal(npt) =0.0; casabal%sumpbal(npt) = 0.0
       ENDIF

       ! vh_js  !
       IF (cable_user%CALL_POP) THEN

          WRITE(nout,92) ktau,npt,veg%iveg(npt),soil%isoilm(npt) ,     &
               casamet%isorder(npt),casamet%lat(npt),casamet%lon(npt), &
               casamet%areacell(npt)*(1.0e-9),casamet%glai(npt),       &
               casabiome%sla(veg%iveg(npt)), phen%phase(npt), &
               phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
               casapool%clabile(npt), &
               casapool%cplant(npt,:),casapool%clitter(npt,:),casapool%csoil(npt,:), &
               casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt), &
               casapool%nplant(npt,:),casapool%nlitter(npt,:),casapool%nsoil(npt,:), &
               casapool%nsoilmin(npt),casapool%pplant(npt,:),          &
               casapool%plitter(npt,:), casapool%psoil(npt,:),         &
               casapool%psoillab(npt),casapool%psoilsorb(npt),casapool%psoilocc(npt), &
               casabal%sumcbal(npt),casabal%sumnbal(npt),casabal%sumpbal(npt)


       ELSE
          WRITE(nout,92) ktau,npt,veg%iveg(npt),soil%isoilm(npt),     &
               casamet%isorder(npt),casamet%lat(npt),casamet%lon(npt), &
               casamet%areacell(npt)*(1.0e-9),casamet%glai(npt),       &
               casabiome%sla(veg%iveg(npt)), phen%phase(npt), &
               phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), &
               casapool%clabile(npt), &
               casapool%cplant(npt,:),casapool%clitter(npt,:),casapool%csoil(npt,:), &
               casapool%nplant(npt,:),casapool%nlitter(npt,:),casapool%nsoil(npt,:), &
               casapool%nsoilmin(npt),casapool%pplant(npt,:),          &
               casapool%plitter(npt,:), casapool%psoil(npt,:),         &
               casapool%psoillab(npt),casapool%psoilsorb(npt),casapool%psoilocc(npt), &
               casabal%sumcbal(npt),casabal%sumnbal(npt),casabal%sumpbal(npt)
       ENDIF


    ENDDO

    CLOSE(nout)

92  FORMAT(5(i6,',',2x),5(f18.6,',',2x),2(i6,',',2x),100(f18.6,',',2x))
  END SUBROUTINE casa_poolout

  ! casa_fluxout output data for Julie Tang; comment out (BP apr2010)
  SUBROUTINE casa_fluxout(myear,veg,soil,casabal,casamet)
    !SUBROUTINE casa_fluxout(myear,clitterinput,csoilinput)
    USE cable_def_types_mod
    !  USE cableDeclare, ONLY: veg, soil
    USE casadimension
    USE casaparm
    USE casavariable
    USE phenvariable
    !  USE casaDeclare
    IMPLICIT NONE
    TYPE (veg_parameter_type),  INTENT(INOUT) :: veg  ! vegetation parameters
    TYPE (soil_parameter_type), INTENT(INOUT) :: soil ! soil parameters
    TYPE (casa_met),            INTENT(INOUT) :: casamet
    TYPE (casa_balance),        INTENT(INOUT) :: casabal
    INTEGER,               INTENT(IN)    :: myear
    !  REAL(r_2),    INTENT(IN) :: clitterinput(mp,3),csoilinput(mp,3)

    ! local variables
    INTEGER  npt,nout
    REAL(r_2) xyear, totGPP, totNPP

    totGPP =0.0
    totNPP =0.0
    nout=104
    xyear=1.0/FLOAT(myear)
    casabal%FCgppyear=casabal%FCgppyear * xyear
    casabal%FCnppyear=casabal%FCnppyear * xyear
    casabal%FCrmleafyear=casabal%FCrmleafyear * xyear
    casabal%FCrmwoodyear=casabal%FCrmwoodyear * xyear
    casabal%FCrmrootyear=casabal%FCrmrootyear * xyear
    casabal%FCrgrowyear=casabal%FCrgrowyear * xyear
    casabal%FCrsyear=casabal%FCrsyear * xyear
    casabal%FCneeyear=casabal%FCneeyear * xyear
    casabal%FNdepyear=casabal%FNdepyear * xyear
    casabal%FNfixyear=casabal%FNfixyear * xyear
    casabal%FNsnetyear=casabal%FNsnetyear * xyear
    casabal%FNupyear=casabal%FNupyear * xyear
    casabal%FNleachyear=casabal%FNleachyear * xyear
    casabal%FNlossyear=casabal%FNlossyear * xyear
    casabal%FPweayear=casabal%FPweayear * xyear
    casabal%FPdustyear=casabal%FPdustyear * xyear
    casabal%FPsnetyear=casabal%FPsnetyear * xyear
    casabal%FPupyear=casabal%FPupyear * xyear
    casabal%FPleachyear=casabal%FPleachyear * xyear
    casabal%FPlossyear=casabal%FPlossyear * xyear
    !  clitterinput = clitterinput * xyear
    !  csoilinput   = csoilinput   * xyear

    PRINT *, 'writing CNP fluxes out to file ', casafile%cnpflux
    OPEN(nout,file=casafile%cnpflux)
    DO npt =1,mp
       SELECT CASE(icycle)
       CASE(1)

          WRITE(nout,*) myear,npt,veg%iveg(npt),soil%isoilm(npt),    &
               casamet%isorder(npt),casamet%lat(npt),casamet%lon(npt), &
               casamet%areacell(npt)*(1.0e-9),casabal%Fcgppyear(npt),  &
               casabal%Fcnppyear(npt),  &
               casabal%Fcrmleafyear(npt),casabal%Fcrmwoodyear(npt),     &
               casabal%Fcrmrootyear(npt),casabal%Fcrgrowyear(npt),     &
               casabal%Fcrsyear(npt),casabal%Fcneeyear(npt)  ! ,           &
          !            clitterinput(npt,:),csoilinput(npt,:)

       CASE(2)
          WRITE(nout,*) myear,npt,veg%iveg(npt),soil%isoilm(npt),    &
               casamet%isorder(npt),casamet%lat(npt),casamet%lon(npt), &
               casamet%areacell(npt)*(1.0e-9),casabal%Fcgppyear(npt),  &
               casabal%FCnppyear(npt),                                 &
               casabal%FCrmleafyear(npt),casabal%FCrmwoodyear(npt),     &
               casabal%FCrmrootyear(npt),casabal%FCrgrowyear(npt),     &
               casabal%FCrsyear(npt), casabal%FCneeyear(npt),          &
                                !        clitterinput(npt,:),csoilinput(npt,:), &
               casabal%FNdepyear(npt),casabal%FNfixyear(npt),casabal%FNsnetyear(npt), &
               casabal%FNupyear(npt), casabal%FNleachyear(npt),casabal%FNlossyear(npt)

       CASE(3)
          WRITE(nout,*) myear,npt,veg%iveg(npt),soil%isoilm(npt), &
               casamet%isorder(npt),casamet%lat(npt),casamet%lon(npt),  &
               casamet%areacell(npt)*(1.0e-9),casabal%Fcgppyear(npt), &
               casabal%FCnppyear(npt),                                  &
               casabal%Fcrmleafyear(npt),casabal%Fcrmwoodyear(npt),     &
               casabal%Fcrmrootyear(npt),casabal%Fcrgrowyear(npt),     &
               casabal%FCrsyear(npt),   casabal%FCneeyear(npt),         &
                                !        clitterinput(npt,:),csoilinput(npt,:), &
               casabal%FNdepyear(npt),casabal%FNfixyear(npt),  casabal%FNsnetyear(npt),&
               casabal%FNupyear(npt), casabal%FNleachyear(npt),casabal%FNlossyear(npt),&
               casabal%FPweayear(npt),casabal%FPdustyear(npt), casabal%FPsnetyear(npt),&
               casabal%FPupyear(npt), casabal%FPleachyear(npt),casabal%FPlossyear(npt)

       END SELECT
       totGPP = totGPP+casabal%Fcgppyear(npt)* casamet%areacell(npt)


       totNPP = totNPP+casabal%Fcnppyear(npt)* casamet%areacell(npt)
    ENDDO

    PRINT *, 'totGPP global = ', totGPP*(1.0e-15)
    PRINT *, 'totNPP global = ', totNPP*(1.0e-15)
    CLOSE(nout)
92  FORMAT(5(i6,',',2x),100(f15.6,',',2x))
  END SUBROUTINE casa_fluxout

  ! clitterinput and csoilinput are for Julie Tang; comment out (BP apr2010)
  !SUBROUTINE casa_cnpflux(clitterinput,csoilinput)
  SUBROUTINE casa_cnpflux(casaflux,casapool,casabal,zeroflux)
    USE cable_def_types_mod
    USE casadimension
    USE casaparm
    USE casavariable
    IMPLICIT NONE
    TYPE (casa_flux),    INTENT(INOUT) :: casaflux
    TYPE (casa_pool),    INTENT(INOUT) :: casapool
    TYPE (casa_balance), INTENT(INOUT) :: casabal
    LOGICAL :: zeroflux
    !  REAL(r_2), INTENT(INOUT) :: clitterinput(mp,3),csoilinput(mp,3)
    INTEGER n

    IF(zeroflux) THEN
       casabal%FCgppyear    = 0.0
       casabal%FCrpyear     = 0.0
       casabal%FCrmleafyear = 0.0
       casabal%FCrmwoodyear = 0.0
       casabal%FCrmrootyear = 0.0
       casabal%FCrgrowyear  = 0.0
       casabal%FCnppyear    = 0.0
       casabal%FCrsyear     = 0.0
       casabal%FCneeyear    = 0.0
       casabal%dCdtyear    = 0.0


       casabal%FNdepyear    = 0.0
       casabal%FNfixyear    = 0.0
       casabal%FNsnetyear   = 0.0
       casabal%FNupyear     = 0.0
       casabal%FNleachyear  = 0.0
       casabal%FNlossyear   = 0.0

       casabal%FPweayear   = 0.0
       casabal%FPdustyear  = 0.0
       casabal%FPsnetyear  = 0.0
       casabal%FPupyear    = 0.0
       casabal%FPleachyear = 0.0
       casabal%FPlossyear  = 0.0

       casaflux%FluxCtohwp = 0.0
       casaflux%FluxNtohwp = 0.0
       casaflux%FluxPtohwp = 0.0
       casaflux%FluxCtoclear = 0.0
       casaflux%FluxNtoclear = 0.0
       casaflux%FluxPtoclear = 0.0
       casaflux%CtransferLUC = 0.02
    ELSE

       casaflux%Crp(:)   = casaflux%Crmplant(:,leaf) + casaflux%Crmplant(:,wood) + casaflux%Crmplant(:,froot) + casaflux%Crgplant(:)
       casabal%FCgppyear = casabal%FCgppyear + casaflux%Cgpp   * deltpool
       casabal%FCrpyear  = casabal%FCrpyear  + casaflux%Crp    * deltpool
       casabal%FCrmleafyear(:)  = casabal%FCrmleafyear(:)  + casaflux%Crmplant(:,leaf)    * deltpool
       casabal%FCrmwoodyear(:)  = casabal%FCrmwoodyear(:)  + casaflux%Crmplant(:,wood)    * deltpool
       casabal%FCrmrootyear(:)  = casabal%FCrmrootyear(:)  + casaflux%Crmplant(:,froot)   * deltpool
       casabal%FCrgrowyear      = casabal%FCrgrowyear      + casaflux%Crgplant            * deltpool
       ! change made ypwang 17-nov-2013 to accoutn for change in labile carbon pool  size
       casabal%FCnppyear        = casabal%FCnppyear + (casaflux%Cnpp+casapool%dClabiledt)   * deltpool
       casabal%FCrsyear  = casabal%FCrsyear  + casaflux%Crsoil * deltpool
       casabal%FCneeyear = casabal%FCneeyear &
            + (casaflux%Cnpp+casapool%dClabiledt-casaflux%Crsoil) * deltpool
       casabal%dCdtyear =  casabal%dCdtyear + (casapool%Ctot-casapool%Ctot_0)*deltpool

       !  DO n=1,3
       !    clitterinput(:,n)= clitterinput(:,n) + casaflux%kplant(:,n) * casapool%cplant(:,n) * deltpool
       !    csoilinput(:,n) = csoilinput(:,n) + casaflux%fluxCtosoil(:,n) * deltpool
       !    !csoilinput(:,n) = csoilinput(:,n)+casaflux%fluxCtolitter(:,n)*deltpool
       !  ENDDO

       IF (icycle >1) THEN
          casabal%FNdepyear   = casabal%FNdepyear   + casaflux%Nmindep    * deltpool
          casabal%FNfixyear   = casabal%FNfixyear   + casaflux%Nminfix    * deltpool
          casabal%FNsnetyear  = casabal%FNsnetyear  + casaflux%Nsnet      * deltpool
          casabal%FNupyear    = casabal%FNupyear    + casaflux%Nminuptake * deltpool
          casabal%FNleachyear = casabal%FNleachyear + casaflux%Nminleach  * deltpool
          casabal%FNlossyear  = casabal%FNlossyear  + casaflux%Nminloss   * deltpool
       ENDIF

       IF (icycle >2) THEN
          casabal%FPweayear   = casabal%FPweayear   + casaflux%Pwea       * deltpool
          casabal%FPdustyear  = casabal%FPdustyear  + casaflux%Pdep       * deltpool
          casabal%FPsnetyear  = casabal%FPsnetyear  + casaflux%Psnet      * deltpool
          casabal%FPupyear    = casabal%FPupyear    + casaflux%Plabuptake * deltpool
          casabal%FPleachyear = casabal%FPleachyear + casaflux%Pleach     * deltpool
          casabal%FPlossyear  = casabal%FPlossyear  + casaflux%Ploss      * deltpool
       ENDIF
    ENDIF
  END SUBROUTINE casa_cnpflux

END MODULE casa_inout_module