diff --git a/CMakeLists.txt b/CMakeLists.txt index d980cd603..9a9b8e7ca 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -79,6 +79,7 @@ add_library( src/science/canopy/cbl_dryLeaf.F90 src/science/canopy/cbl_friction_vel.F90 src/science/canopy/cbl_fwsoil.F90 + src/science/canopy/cbl_init_wetfac_mod.f90 src/science/canopy/cbl_latent_heat.F90 src/science/canopy/cbl_photosynthesis.F90 src/science/canopy/cbl_pot_evap_snow.F90 diff --git a/documentation/docs/developer_guide/other_resources/api.md b/documentation/docs/developer_guide/other_resources/api.md deleted file mode 100644 index fc21ec21c..000000000 --- a/documentation/docs/developer_guide/other_resources/api.md +++ /dev/null @@ -1,3 +0,0 @@ -The API documentation for CABLE is hosted [here][API]. - -[API]: https://cable.readthedocs.io/en/latest/api/ \ No newline at end of file diff --git a/documentation/docs/user_guide/inputs/pftlookup_csv.md b/documentation/docs/user_guide/inputs/pftlookup_csv.md index 7dba56181..14154b063 100644 --- a/documentation/docs/user_guide/inputs/pftlookup_csv.md +++ b/documentation/docs/user_guide/inputs/pftlookup_csv.md @@ -107,7 +107,7 @@ on soil, vegetation carbon and nutrients dynamics. | fpptoL(frt) | `casabiome%ftransPPtoL(nv,froot)` | Flux factor of root phosphorus to litter pools \( (-) \) | | xkmlabp | `xkmlabp(iso)` | Phosphorus absorption \( (gP \cdot m^{-2}) \) | | xpsorbmax | `xpsorbmax(iso)` | Maximum phosphorus absorption \( (gP \cdot m^{-2}) \) | -| xfpleach | `xfPleach(iso)` | Phosphorus leaching \( (-) \) | +| xfpleach | `xfPleach(iso)` | Phosphorus leaching \( (-) \) (hard-wired in the code for CABLE2.4/ACCESS-ESM1.5 at 1.e-4 independent of pft) | | N:Psoil (mic) | `ratioNPsoil(iso,mic)` | Nitrogen to phosphorus ratio in microbial soil pool \( (gN \cdot gP^{-2}) \) | | N:Psoil (slow) | `ratioNPsoil(iso,slow)` | Nitrogen to phosphorus ratio in slow soil pool \( (gN \cdot gP^{-2}) \) | | N:Psoil (pass) | `ratioNPsoil(iso,pass)` | Nitrogen to phosphorus ratio in passive soil pool \( (gN \cdot gP^{-2}) \) | diff --git a/documentation/mkdocs.yml b/documentation/mkdocs.yml index f310fbc89..4fe4bc6ec 100644 --- a/documentation/mkdocs.yml +++ b/documentation/mkdocs.yml @@ -110,7 +110,8 @@ nav: - Build System: developer_guide/other_resources/build_system.md - Cheat Sheets: developer_guide/other_resources/cheat_sheets.md - CABLE's release process: developer_guide/other_resources/release_process.md - - API documentation: developer_guide/other_resources/api.md + - API documentation: api - Obsolete and deprecated features: developer_guide/other_resources/obsolete_and_deprecated_features/obsolete_and_deprecated_features.md - How-to: - Set up a sensitivity experiment: how-to/sensitivity_exp.md + - API Reference: api diff --git a/src/coupled/AM3/control/cable/CM3/cable_common.F90 b/src/coupled/AM3/control/cable/CM3/cable_common.F90 deleted file mode 100644 index 5c4c15a17..000000000 --- a/src/coupled/AM3/control/cable/CM3/cable_common.F90 +++ /dev/null @@ -1,143 +0,0 @@ -!============================================================================== -! 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: Reads vegetation and soil parameter files, fills vegin, soilin -! NB. Most soil parameters overwritten by spatially explicit datasets -! input as ancillary file (for ACCESS) or surface data file (for offline) -! Module enables accessibility of variables throughout CABLE -! -! Contact: Jhan.Srbinovsky@csiro.au -! -! History: v2.0 vegin%dleaf now calculated from leaf length and width -! Parameter files were read elsewhere in v1.8 (init_subrs) -! -! ============================================================================== - -MODULE cable_common_module - -USE cable_runtime_opts_mod ,ONLY : cable_user -USE cable_runtime_opts_mod ,ONLY : satuparam -USE cable_runtime_opts_mod ,ONLY : wiltparam - - IMPLICIT NONE - - INTEGER, PARAMETER :: pe=120 - !---allows reference to "gl"obal timestep in run (from atm_step) - !---total number of timesteps, and processing node - INTEGER, SAVE :: ktau_gl, kend_gl, knode_gl, kwidth_gl - - LOGICAL :: L_fudge = .FALSE. - - INTEGER, SAVE :: CurYear ! current year of multiannual run - - ! set from environment variable $HOME - CHARACTER(LEN=200) :: & - myhome - - ! switch to calc sil albedo using soil colour - Ticket #27 - LOGICAL :: calcsoilalbedo = .FALSE. - !---Lestevens Sept2012 - !---CASACNP switches and cycle index - LOGICAL, SAVE :: l_casacnp,l_laiFeedbk,l_vcmaxFeedbk - LOGICAL :: l_luc = .FALSE. - LOGICAL :: l_thinforest = .FALSE. - LOGICAL :: l_landuse = .FALSE. - - !---CABLE runtime switches def in this type - TYPE kbl_internal_switches - LOGICAL :: um = .FALSE., um_explicit = .FALSE., um_implicit = .FALSE., & - um_radiation = .FALSE., um_hydrology = .FALSE., esm15 = .FALSE. - LOGICAL :: offline = .FALSE., mk3l = .FALSE. - END TYPE kbl_internal_switches - - ! instantiate internal switches - TYPE(kbl_internal_switches), SAVE :: cable_runtime - - ! hydraulic_redistribution switch _soilsnow module - LOGICAL :: redistrb = .FALSE. - - TYPE organic_soil_params - !Below are the soil properties for fully organic soil - - REAL :: & - hyds_vec_organic = 1.0e-4,& - sucs_vec_organic = 10.3, & - clappb_organic = 2.91, & - ssat_vec_organic = 0.9, & - watr_organic = 0.1, & - sfc_vec_hk = 1.157407e-06, & - swilt_vec_hk = 2.31481481e-8 - - END TYPE organic_soil_params - - TYPE gw_parameters_type - - REAL :: & - MaxHorzDrainRate=2e-4, & !anisintropy * q_max [qsub] - EfoldHorzDrainRate=2.0, & !e fold rate of q_horz - MaxSatFraction=2500.0, & !parameter controll max sat fraction - hkrz=0.5, & !hyds_vec variation with z - zdepth=1.5, & !level where hyds_vec(z) = hyds_vec(no z) - frozen_frac=0.05, & !ice fraction to determine first non-frozen layer for qsub - SoilEvapAlpha = 1.0, & !modify field capacity dependence of soil evap limit - IceAlpha=3.0, & - IceBeta=1.0 - - REAL :: ice_impedence=5.0 - - TYPE(organic_soil_params) :: org - - INTEGER :: level_for_satfrac = 6 - LOGICAL :: ssgw_ice_switch = .FALSE. - - LOGICAL :: subsurface_sat_drainage = .TRUE. - - END TYPE gw_parameters_type - - TYPE(gw_parameters_type), SAVE :: gw_params - - REAL, SAVE :: &!should be able to change parameters! - max_glacier_snowd=1100.0,& - snow_ccnsw = 2.0, & - !jh!an:clobber - effectively force single layer snow - !snmin = 100.0, & ! for 1-layer; - snmin = 1., & ! for 3-layer; - max_ssdn = 750.0, & ! - max_sconds = 2.51, & ! - frozen_limit = 0.85 ! EAK Feb2011 (could be 0.95) - -contains - - ELEMENTAL FUNCTION IS_LEAPYEAR( YYYY ) - IMPLICIT NONE - INTEGER,INTENT(IN) :: YYYY - LOGICAL :: IS_LEAPYEAR - - IS_LEAPYEAR = .FALSE. - IF ( ( ( MOD( YYYY, 4 ) .EQ. 0 .AND. MOD( YYYY, 100 ) .NE. 0 ) .OR. & - MOD( YYYY,400 ) .EQ. 0 ) ) IS_LEAPYEAR = .TRUE. - - END FUNCTION IS_LEAPYEAR - - FUNCTION LEAP_DAY( YYYY ) - IMPLICIT NONE - INTEGER :: YYYY, LEAP_DAY - - IF ( IS_LEAPYEAR ( YYYY ) ) THEN - LEAP_DAY = 1 - ELSE - LEAP_DAY = 0 - END IF - END FUNCTION LEAP_DAY - - - -END MODULE cable_common_module diff --git a/src/offline/cable_mpidrv.F90 b/src/offline/cable_mpidrv.F90 index a3a132e7d..9a0cb6dbf 100644 --- a/src/offline/cable_mpidrv.F90 +++ b/src/offline/cable_mpidrv.F90 @@ -24,8 +24,7 @@ PROGRAM mpi_driver USE cable_mpicommon USE cable_mpimaster USE cable_mpiworker - USE cable_namelist_util, ONLY: get_namelist_file_name,& - CABLE_NAMELIST,arg_not_namelist + USE cable_namelist_util, ONLY: get_namelist_file_name IMPLICIT NONE diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 97ab7b30e..c9f75d09b 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -158,19 +158,19 @@ SUBROUTINE mpidrv_master (comm) USE cable_IO_vars_module, ONLY: logn,gswpfile,ncciy,leaps,globalMetfile, & verbose, fixedCO2,output,check,patchout, & patch_type,landpt,soilparmnew,& - defaultLAI, sdoy, smoy, syear, timeunits, exists, output, & - latitude,longitude, calendar, set_group_output_values + timeunits, exists, output, & + calendar, set_group_output_values USE cable_common_module, ONLY: ktau_gl, kend_gl, knode_gl, cable_user, & - cable_runtime, fileName, myhome, & + cable_runtime, fileName, & redistrb, wiltParam, satuParam, CurYear, & IS_LEAPYEAR, calcsoilalbedo, & kwidth_gl, gw_params - USE casa_ncdf_module, ONLY: is_casa_time -! physical constants -USE cable_phys_constants_mod, ONLY : CTFRZ => TFRZ -USE cable_phys_constants_mod, ONLY : CEMLEAF => EMLEAF -USE cable_phys_constants_mod, ONLY : CEMSOIL => EMSOIL -USE cable_phys_constants_mod, ONLY : CSBOLTZ => SBOLTZ + USE casa_ncdf_module, ONLY: is_casa_time + ! physical constants + USE cable_phys_constants_mod, ONLY : CTFRZ => TFRZ + USE cable_phys_constants_mod, ONLY : CEMLEAF => EMLEAF + USE cable_phys_constants_mod, ONLY : CEMSOIL => EMSOIL + USE cable_phys_constants_mod, ONLY : CSBOLTZ => SBOLTZ USE cable_input_module, ONLY: open_met_file,load_parameters, & get_met_data,close_met_file USE cable_output_module, ONLY: create_restart,open_output_file, & @@ -205,12 +205,12 @@ SUBROUTINE mpidrv_master (comm) USE CABLE_CRU, ONLY: CRU_TYPE, CRU_GET_SUBDIURNAL_MET, CRU_INIT USE cable_namelist_util, ONLY : get_namelist_file_name,& - CABLE_NAMELIST,arg_not_namelist + CABLE_NAMELIST USE landuse_constant, ONLY: mstate,mvmax,mharvw USE landuse_variable -USE bgcdriver_mod, ONLY : bgcdriver -USE casa_offline_inout_module, ONLY : WRITE_CASA_RESTART_NC, WRITE_CASA_OUTPUT_NC + USE bgcdriver_mod, ONLY : bgcdriver + USE casa_offline_inout_module, ONLY : WRITE_CASA_RESTART_NC, WRITE_CASA_OUTPUT_NC IMPLICIT NONE ! MPI: @@ -231,12 +231,9 @@ SUBROUTINE mpidrv_master (comm) ktauday, & ! day counter for CASA-CNP idoy, & ! day of year (1:365) counter for CASA-CNP nyear, & ! year counter for CASA-CNP - casa_it, & ! number of calls to CASA-CNP ctime, & ! day count for casacnp YYYY, & ! LOY, & ! Length of Year - count_sum_casa, & ! number of time steps over which casa pools and fluxes are aggregated (for output) - maxdiff(2) ! location of maximum in convergence test REAL :: dels ! time step size in seconds @@ -310,11 +307,10 @@ SUBROUTINE mpidrv_master (comm) LOGICAL :: loop_exit ! MPI: exit flag for bcast to workers INTEGER :: iktau ! read ahead index of time step = 1 .. kend INTEGER :: oktau ! ktau = 1 .. kend for output - INTEGER :: tmp_kgl ! temp for ktau_gl INTEGER :: icomm ! separate dupes of MPI communicator for send and recv INTEGER :: ocomm ! separate dupes of MPI communicator for send and recv INTEGER :: ierr - INTEGER :: rank, count, off, cnt + INTEGER :: rank, off, cnt ! Vars for standard for quasi-bitwise reproducability b/n runs ! Check triggered by cable_user%consistency_check = .TRUE. in cable.nml @@ -364,13 +360,13 @@ SUBROUTINE mpidrv_master (comm) cable_user, & ! additional USER switches gw_params - INTEGER :: i,x,kk,m,np,ivt + INTEGER :: kk,m,np,ivt INTEGER :: LALLOC - INTEGER, PARAMETER :: mloop = 30 ! CASA-CNP PreSpinup loops + INTEGER, PARAMETER :: mloop = 30 ! CASA-CNP PreSpinup loops REAL :: etime ! for landuse - integer mlon,mlat,mpx + integer mlon,mlat real(r_2), dimension(:,:,:), allocatable, save :: luc_atransit real(r_2), dimension(:,:), allocatable, save :: luc_fharvw real(r_2), dimension(:,:,:), allocatable, save :: luc_xluh2cable @@ -534,7 +530,7 @@ SUBROUTINE mpidrv_master (comm) CALL CPU_TIME(etime) CALL CRU_INIT( CRU ) - dels = CRU%dtsecs + dels = CRU%dtsecs koffset = 0 leaps = .FALSE. ! No leap years in CRU-NCEP exists%Snowf = .FALSE. ! No snow in CRU-NCEP, so ensure it will @@ -598,11 +594,11 @@ SUBROUTINE mpidrv_master (comm) ! vh_js ! - CALL load_parameters( met, air, ssnow, veg,climate,bgc, & - soil, canopy, rough, rad, sum_flux, & - bal, logn, vegparmnew, casabiome, casapool, & + CALL load_parameters( met, air, ssnow, veg,climate,bgc, & + soil, canopy, rough, rad, sum_flux, & + bal, logn, vegparmnew, casabiome, casapool, & casaflux, sum_casapool, sum_casaflux, & - casamet, casabal, phen, POP, spinup, & + casamet, casabal, phen, POP, spinup, & CEMSOIL, CTFRZ, LUC_EXPT, POPLUC ) IF (CABLE_USER%POPLUC .AND. TRIM(CABLE_USER%POPLUC_RunType) .EQ. 'static') & @@ -616,7 +612,7 @@ SUBROUTINE mpidrv_master (comm) met%ofsd = 0.1 - IF (.NOT.spinup) spinConv=.TRUE. + IF (.NOT.spinup) spinConv=.TRUE. ! MPI: above was standard serial code ! now it's time to initialize the workers @@ -634,7 +630,7 @@ SUBROUTINE mpidrv_master (comm) CALL find_extents ! MPI: calculate and broadcast landpoint decomposition to the workers - CALL master_decomp(comm, mland, mp) + CALL master_decomp(comm, mland) ! MPI: set up stuff for new irecv isend code that separates completion ! from posting of requests @@ -670,7 +666,7 @@ SUBROUTINE mpidrv_master (comm) CALL master_casa_params (comm,casabiome,casapool,casaflux,casamet,& & casabal,phen) - IF ( CABLE_USER%CALL_POP ) CALL master_pop_types (comm,casamet,pop) + IF ( CABLE_USER%CALL_POP ) CALL master_pop_types (comm,pop) END IF ! MPI: allocate read ahead buffers for input met and veg data @@ -695,7 +691,7 @@ SUBROUTINE mpidrv_master (comm) casamet, casabal, phen) IF ( CABLE_USER%CASA_DUMP_READ .OR. CABLE_USER%CASA_DUMP_WRITE ) & - CALL master_casa_dump_types( comm, casamet, casaflux, phen, climate ) + CALL master_casa_dump_types( comm, casamet, casaflux, phen ) WRITE(*,*) 'cable_mpimaster, POPLUC: ' , CABLE_USER%POPLUC IF ( CABLE_USER%POPLUC ) & CALL master_casa_LUC_types( comm, casapool, casabal) @@ -715,15 +711,15 @@ SUBROUTINE mpidrv_master (comm) IF( icycle>0 .AND. spincasa) THEN PRINT *, 'EXT spincasacnp enabled with mloop= ', mloop, dels, kstart, kend CALL master_spincasacnp(dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & - casaflux,casamet,casabal,phen,POP,climate,LALLOC, icomm, ocomm) + casaflux,casamet,casabal,phen,POP,climate,icomm, ocomm) SPINconv = .FALSE. CASAONLY = .TRUE. ktau_gl = 0 ktau = 0 ELSEIF ( casaonly .AND. (.NOT. spincasa) .AND. cable_user%popluc) THEN - CALL master_CASAONLY_LUC(dels,kstart,kend,veg,soil,casabiome,casapool, & - casaflux,casamet,casabal,phen,POP,climate,LALLOC, LUC_EXPT, POPLUC, & + CALL master_CASAONLY_LUC(dels,kstart,kend,veg,casabiome,casapool, & + casaflux,casamet,casabal,phen,POP,climate,LUC_EXPT, POPLUC, & icomm, ocomm) SPINconv = .FALSE. ktau_gl = 0 @@ -1099,7 +1095,7 @@ SUBROUTINE mpidrv_master (comm) CALL close_met_file IF (icycle>0 .AND. cable_user%CALL_POP) THEN - WRITE(*,*), 'b4 annual calcs' + WRITE(*,*) 'b4 annual calcs' IF (CABLE_USER%POPLUC) THEN @@ -1221,12 +1217,12 @@ SUBROUTINE mpidrv_master (comm) IF (ktau == kend) PRINT*, "sum_fe[Wm-2], sum_fpn[umol/m2/s]", & new_sumfe/count_bal, new_sumfpn/count_bal IF (ktau == kend) WRITE(logn,*) - IF (ktau == kend) WRITE(logn,*), "time-space-averaged energy & water balances" - IF (ktau == kend) WRITE(logn,*),"Ebal_tot[Wm-2], Wbal_tot[mm per timestep]", & + IF (ktau == kend) WRITE(logn,*) "time-space-averaged energy & water balances" + IF (ktau == kend) WRITE(logn,*) "Ebal_tot[Wm-2], Wbal_tot[mm per timestep]", & SUM(bal%ebal_tot)/mp/count_bal, SUM(bal%wbal_tot)/mp/count_bal - IF (ktau == kend) WRITE(logn,*), "time-space-averaged latent heat and & + IF (ktau == kend) WRITE(logn,*) "time-space-averaged latent heat and & net photosynthesis" - IF (ktau == kend) WRITE(logn,*), "sum_fe[Wm-2], sum_fpn[umol/m2/s]", & + IF (ktau == kend) WRITE(logn,*) "sum_fe[Wm-2], sum_fpn[umol/m2/s]", & new_sumfe/count_bal, new_sumfpn/count_bal @@ -1564,17 +1560,16 @@ END SUBROUTINE renameFiles ! MPI: calculates and sends grid decomposition info to the workers - SUBROUTINE master_decomp (comm, mland, mp) + SUBROUTINE master_decomp (comm, mland) USE mpi - USE cable_IO_vars_module, ONLY : landpt, patch + USE cable_IO_vars_module, ONLY : landpt IMPLICIT NONE INTEGER, INTENT(IN) :: comm ! MPI communicator to talk to the workers INTEGER, INTENT(IN) :: mland ! total number of landpoints in the global grid - INTEGER, INTENT(IN) :: mp ! total number of land patches in the global grid INTEGER :: lpw ! average number of landpoints per worker INTEGER :: rank, rest, nxt, pcnt, ierr, i, tmp @@ -1700,7 +1695,7 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: tsize, localtotal, remotetotal - INTEGER :: stat(MPI_STATUS_SIZE), ierr + INTEGER :: ierr INTEGER, ALLOCATABLE, DIMENSION(:) :: param_ts INTEGER(KIND=MPI_ADDRESS_KIND) :: r1stride, r2stride, istride @@ -3436,7 +3431,7 @@ SUBROUTINE master_casa_params (comm,casabiome,casapool,casaflux,casamet,& INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: tsize, localtotal, remotetotal - INTEGER :: stat(MPI_STATUS_SIZE), ierr + INTEGER :: ierr ! INTEGER :: landp_t, patch_t, param_t INTEGER, ALLOCATABLE, DIMENSION(:) :: casa_ts @@ -6223,9 +6218,6 @@ SUBROUTINE master_casa_types (comm, casapool, casaflux, & INTEGER :: last2d, i - ! MPI: block lenghts for hindexed representing all vectors - INTEGER, ALLOCATABLE, DIMENSION(:) :: blen - ! MPI: block lengths and strides for hvector representing matrices INTEGER :: r1len, r2len, I1LEN INTEGER(KIND=MPI_ADDRESS_KIND) :: r1stride, r2stride, istride @@ -6234,7 +6226,7 @@ SUBROUTINE master_casa_types (comm, casapool, casaflux, & INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: rank, off, cnt - INTEGER :: bidx, midx, vidx, ierr + INTEGER :: bidx, ierr ALLOCATE (casa_ts(wnp)) @@ -6866,10 +6858,7 @@ SUBROUTINE master_climate_types (comm, climate, ktauday) INTEGER, ALLOCATABLE, DIMENSION(:) :: types INTEGER :: ntyp ! number of worker's types - INTEGER :: last2d, i, ktauday - - ! MPI: block lenghts for hindexed representing all vectors - INTEGER, ALLOCATABLE, DIMENSION(:) :: blen + INTEGER :: ktauday ! MPI: block lengths and strides for hvector representing matrices INTEGER :: r1len, r2len, I1LEN @@ -6879,7 +6868,7 @@ SUBROUTINE master_climate_types (comm, climate, ktauday) INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: rank, off, cnt - INTEGER :: bidx, midx, vidx, ierr, ny, nd, ndq + INTEGER :: bidx, ierr, ny, nd, ndq IF (cable_user%call_climate) CALL climate_init ( climate, mp, ktauday ) IF (cable_user%call_climate .AND.(.NOT.cable_user%climate_fromzero)) & @@ -7344,9 +7333,6 @@ SUBROUTINE master_restart_types (comm, canopy, air) INTEGER :: last2d, i - ! MPI: block lenghts for hindexed representing all vectors - INTEGER, ALLOCATABLE, DIMENSION(:) :: blen - ! MPI: block lengths and strides for hvector representing matrices INTEGER :: r1len, r2len INTEGER(KIND=MPI_ADDRESS_KIND) :: r1stride, r2stride @@ -7355,7 +7341,7 @@ SUBROUTINE master_restart_types (comm, canopy, air) INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: rank, off, cnt - INTEGER :: bidx, midx, vidx, ierr + INTEGER :: bidx, ierr ALLOCATE (restart_ts(wnp)) @@ -7507,7 +7493,7 @@ SUBROUTINE master_restart_types (comm, canopy, air) END SUBROUTINE master_restart_types ! MPI: Casa - dump read and write - SUBROUTINE master_casa_dump_types(comm, casamet, casaflux, phen, climate ) + SUBROUTINE master_casa_dump_types(comm, casamet, casaflux, phen ) USE mpi @@ -7520,7 +7506,6 @@ SUBROUTINE master_casa_dump_types(comm, casamet, casaflux, phen, climate ) TYPE (casa_flux) , INTENT(INOUT) :: casaflux TYPE (casa_met) , INTENT(INOUT) :: casamet TYPE (phen_variable), INTENT(INOUT) :: phen - TYPE(climate_type):: climate ! local vars @@ -7534,7 +7519,7 @@ SUBROUTINE master_casa_dump_types(comm, casamet, casaflux, phen, climate ) INTEGER :: tsize, localtotal, remotetotal INTEGER(KIND=MPI_ADDRESS_KIND) :: r1stride, r2stride, Istride - INTEGER :: r1len, r2len, I1LEN, llen ! block lengths + INTEGER :: r1len, r2len, I1LEN ! block lengths INTEGER :: bidx ! block index INTEGER :: ntyp ! total number of blocks INTEGER :: rank ! worker rank @@ -7708,7 +7693,7 @@ SUBROUTINE master_casa_LUC_types(comm, casapool, casabal ) INTEGER :: tsize, localtotal, remotetotal INTEGER(KIND=MPI_ADDRESS_KIND) :: r1stride, r2stride, Istride - INTEGER :: r1len, r2len, I1LEN, llen ! block lengths + INTEGER :: r1len, r2len, I1LEN ! block lengths INTEGER :: bidx ! block index INTEGER :: ntyp ! total number of blocks INTEGER :: rank ! worker rank @@ -7876,39 +7861,24 @@ END SUBROUTINE master_casa_LUC_types ! Creates pop_ts types to broadcast/cscatter the default POP parameters ! to all workers - SUBROUTINE master_pop_types(comm, casamet, pop) + SUBROUTINE master_pop_types(comm, pop) USE mpi USE POP_mpi USE POP_types, ONLY: pop_type USE cable_common_module,ONLY: cable_user - USE casavariable, ONLY: casa_met IMPLICIT NONE INTEGER,INTENT(IN) :: comm - TYPE (casa_met) , INTENT(IN) :: casamet TYPE (pop_type) , INTENT(INOUT) :: pop - ! temp arrays for marshalling all fields into a single struct - INTEGER, ALLOCATABLE, DIMENSION(:) :: blocks - INTEGER(KIND=MPI_ADDRESS_KIND), ALLOCATABLE, DIMENSION(:) :: displs - INTEGER, ALLOCATABLE, DIMENSION(:) :: types - - ! temp vars for verifying block number and total length of inp_t - INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb - INTEGER :: tsize, localtotal, remotetotal - - INTEGER(KIND=MPI_ADDRESS_KIND) :: r2stride, ilstride, idstride - INTEGER :: r2len, illen,idlen ! block lengths - INTEGER :: bidx ! block index - INTEGER :: ntyp ! total number of blocks INTEGER :: rank ! worker rank INTEGER :: off ! first patch index for a worker INTEGER :: cnt ! mp for a worker INTEGER :: ierr - INTEGER :: x, l, prev_mp - INTEGER, ALLOCATABLE :: w_iwood(:), nwoodcells(:) + INTEGER :: prev_mp + INTEGER, ALLOCATABLE :: w_iwood(:) ! Also send Pop relevant info to workers. @@ -7969,7 +7939,6 @@ SUBROUTINE master_receive_pop (POP, comm) USE MPI USE POP_mpi USE POP_Types, ONLY: pop_type - USE cable_common_module, ONLY: cable_user IMPLICIT NONE @@ -8159,7 +8128,7 @@ SUBROUTINE master_end (icycle, restart) END SUBROUTINE master_end SUBROUTINE master_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & - casaflux,casamet,casabal,phen,POP,climate,LALLOC, icomm, ocomm ) + casaflux,casamet,casabal,phen,POP,climate,icomm, ocomm ) !USE cable_mpimaster USE cable_def_types_mod @@ -8172,7 +8141,7 @@ SUBROUTINE master_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo USE POP_Types, ONLY: POP_TYPE USE POPMODULE, ONLY: POPStep USE TypeDef, ONLY: i4b, dp -USE casa_offline_inout_module, ONLY : WRITE_CASA_RESTART_NC + USE casa_offline_inout_module, ONLY : WRITE_CASA_RESTART_NC IMPLICIT NONE !CLN CHARACTER(LEN=99), INTENT(IN) :: fcnpspin @@ -8180,7 +8149,6 @@ SUBROUTINE master_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo INTEGER, INTENT(IN) :: kstart INTEGER, INTENT(IN) :: kend INTEGER, INTENT(IN) :: mloop - INTEGER, INTENT(IN) :: LALLOC TYPE (veg_parameter_type), INTENT(INOUT) :: veg ! vegetation parameters TYPE (soil_parameter_type), INTENT(INOUT) :: soil ! soil parameters TYPE (casa_biome), INTENT(INOUT) :: casabiome @@ -8195,39 +8163,11 @@ SUBROUTINE master_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo ! communicator for error-messages INTEGER, INTENT(IN) :: icomm, ocomm - TYPE (casa_met) :: casaspin - - ! local variables - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cleaf2met, avg_cleaf2str, avg_croot2met, avg_croot2str, avg_cwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nleaf2met, avg_nleaf2str, avg_nroot2met, avg_nroot2str, avg_nwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_pleaf2met, avg_pleaf2str, avg_proot2met, avg_proot2str, avg_pwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cgpp, avg_cnpp, avg_nuptake, avg_puptake - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nsoilmin, avg_psoillab, avg_psoilsorb, avg_psoilocc - !chris 12/oct/2012 for spin up casa - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_ratioNCsoilmic, avg_ratioNCsoilslow, avg_ratioNCsoilpass - REAL(r_2), DIMENSION(:), ALLOCATABLE, SAVE :: avg_xnplimit, avg_xkNlimiting,avg_xklitter, avg_xksoil - ! local variables INTEGER :: myearspin,nyear, nloop1 CHARACTER(LEN=99) :: ncfile CHARACTER(LEN=4) :: cyear - INTEGER :: ktau,ktauday,nday,idoy,ktaux,ktauy,nloop - INTEGER, SAVE :: ndays - REAL, DIMENSION(mp) :: cleaf2met, cleaf2str, croot2met, croot2str, cwood2cwd - REAL, DIMENSION(mp) :: nleaf2met, nleaf2str, nroot2met, nroot2str, nwood2cwd - REAL, DIMENSION(mp) :: pleaf2met, pleaf2str, proot2met, proot2str, pwood2cwd - REAL, DIMENSION(mp) :: xcgpp, xcnpp, xnuptake, xpuptake - REAL, DIMENSION(mp) :: xnsoilmin, xpsoillab, xpsoilsorb,xpsoilocc - REAL(r_2), DIMENSION(mp) :: xnplimit, xkNlimiting, xklitter, xksoil,xkleaf, xkleafcold, xkleafdry - - ! more variables to store the spinup pool size over the last 10 loops. Added by Yp Wang 30 Nov 2012 - REAL, DIMENSION(5,mvtype,mplant) :: bmcplant, bmnplant, bmpplant - REAL, DIMENSION(5,mvtype,mlitter) :: bmclitter, bmnlitter, bmplitter - REAL, DIMENSION(5,mvtype,msoil) :: bmcsoil, bmnsoil, bmpsoil - REAL, DIMENSION(5,mvtype) :: bmnsoilmin,bmpsoillab,bmpsoilsorb, bmpsoilocc - REAL, DIMENSION(mvtype) :: bmarea - INTEGER nptx,nvt,kloop - + INTEGER :: ktau,ktauday,nday,idoy,ktauy,nloop ktauday=INT(24.0*3600.0/dels) nday=(kend-kstart+1)/ktauday @@ -8338,16 +8278,16 @@ SUBROUTINE master_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo END SUBROUTINE master_spincasacnp !============================================================================ - SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & - casaflux,casamet,casabal,phen,POP,climate,LALLOC,LUC_EXPT, POPLUC, & + SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,casabiome,casapool, & + casaflux,casamet,casabal,phen,POP,climate,LUC_EXPT, POPLUC, & icomm, ocomm ) USE cable_def_types_mod USE cable_carbon_module USE cable_common_module, ONLY: CABLE_USER - USE casa_ncdf_module, ONLY: is_casa_time - USE cable_IO_vars_module, ONLY: logn, landpt, patch, output + USE casa_ncdf_module, ONLY: is_casa_time + USE cable_IO_vars_module, ONLY: landpt, output USE casadimension USE casaparm USE casavariable @@ -8361,7 +8301,7 @@ SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & USE POPLUC_Module, ONLY: POPLUCStep, POPLUC_weights_Transfer, WRITE_LUC_OUTPUT_NC, & POP_LUC_CASA_transfer, WRITE_LUC_RESTART_NC, READ_LUC_RESTART_NC, & POPLUC_set_patchfrac, WRITE_LUC_OUTPUT_GRID_NC -USE casa_offline_inout_module, ONLY : WRITE_CASA_RESTART_NC + USE casa_offline_inout_module, ONLY : WRITE_CASA_RESTART_NC @@ -8369,9 +8309,7 @@ SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & REAL, INTENT(IN) :: dels INTEGER, INTENT(IN) :: kstart INTEGER, INTENT(IN) :: kend - INTEGER, INTENT(IN) :: LALLOC 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 @@ -8386,46 +8324,15 @@ SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & !TYPE (casa_flux) , INTENT(INOUT) :: sum_casaflux ! communicator for error-messages INTEGER, INTENT(IN) :: icomm, ocomm - TYPE (casa_met) :: casaspin - - ! local variables - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cleaf2met, avg_cleaf2str, avg_croot2met, avg_croot2str, avg_cwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nleaf2met, avg_nleaf2str, avg_nroot2met, avg_nroot2str, avg_nwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_pleaf2met, avg_pleaf2str, avg_proot2met, avg_proot2str, avg_pwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cgpp, avg_cnpp, avg_nuptake, avg_puptake - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nsoilmin, avg_psoillab, avg_psoilsorb, avg_psoilocc - !chris 12/oct/2012 for spin up casa - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_ratioNCsoilmic, avg_ratioNCsoilslow, avg_ratioNCsoilpass - REAL(r_2), DIMENSION(:), ALLOCATABLE, SAVE :: avg_xnplimit, avg_xkNlimiting,avg_xklitter, avg_xksoil ! local variables INTEGER :: myearspin,nyear, yyyy, nyear_dump CHARACTER(LEN=99) :: ncfile CHARACTER(LEN=4) :: cyear - INTEGER :: ktau,ktauday,nday,idoy,ktaux,ktauy,nloop - INTEGER, SAVE :: ndays - REAL, DIMENSION(mp) :: cleaf2met, cleaf2str, croot2met, croot2str, cwood2cwd - REAL, DIMENSION(mp) :: nleaf2met, nleaf2str, nroot2met, nroot2str, nwood2cwd - REAL, DIMENSION(mp) :: pleaf2met, pleaf2str, proot2met, proot2str, pwood2cwd - REAL, DIMENSION(mp) :: xcgpp, xcnpp, xnuptake, xpuptake - REAL, DIMENSION(mp) :: xnsoilmin, xpsoillab, xpsoilsorb,xpsoilocc - REAL(r_2), DIMENSION(mp) :: xnplimit, xkNlimiting, xklitter, xksoil,xkleaf, xkleafcold, xkleafdry - - ! more variables to store the spinup pool size over the last 10 loops. Added by Yp Wang 30 Nov 2012 - REAL, DIMENSION(5,mvtype,mplant) :: bmcplant, bmnplant, bmpplant - REAL, DIMENSION(5,mvtype,mlitter) :: bmclitter, bmnlitter, bmplitter - REAL, DIMENSION(5,mvtype,msoil) :: bmcsoil, bmnsoil, bmpsoil - REAL, DIMENSION(5,mvtype) :: bmnsoilmin,bmpsoillab,bmpsoilsorb, bmpsoilocc - REAL, DIMENSION(mvtype) :: bmarea - INTEGER :: nptx,nvt,kloop, ctime, k, j, l - - REAL(dp) :: StemNPP(mp,2) - REAL(dp), ALLOCATABLE, SAVE :: LAImax(:) , Cleafmean(:), Crootmean(:) - REAL(dp), ALLOCATABLE :: NPPtoGPP(:) - INTEGER, ALLOCATABLE :: Iw(:) ! array of indices corresponding to woody (shrub or forest) tiles - INTEGER :: count_sum_casa ! number of time steps over which casa pools & - !and fluxes are aggregated (for output) - INTEGER :: rank, count, off, cnt, ierr + INTEGER :: ktau,ktauday,nday,idoy + + INTEGER :: k, j, l + INTEGER :: rank, off, cnt, ierr !$ if (.NOT.Allocated(LAIMax)) allocate(LAIMax(mp)) !$ if (.NOT.Allocated(Cleafmean)) allocate(Cleafmean(mp)) !$ if (.NOT.Allocated(Crootmean)) allocate(Crootmean(mp)) @@ -8650,9 +8557,9 @@ SUBROUTINE LUCdriver( casabiome,casapool, & USE cable_def_types_mod , ONLY: veg_parameter_type, mland USE cable_carbon_module - USE cable_common_module, ONLY: CABLE_USER, CurYear - USE casa_ncdf_module, ONLY: is_casa_time - USE cable_IO_vars_module, ONLY: logn, landpt, patch + USE cable_common_module, ONLY: CurYear + USE casa_ncdf_module, ONLY: is_casa_time + USE cable_IO_vars_module, ONLY: landpt USE casadimension USE casaparm USE casavariable diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index f240e557d..6c06f0dea 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -69,7 +69,7 @@ MODULE cable_mpiworker USE cable_common_module, ONLY: cable_user USE casa_inout_module USE casa_cable -USE bgcdriver_mod, ONLY : bgcdriver + USE bgcdriver_mod, ONLY : bgcdriver IMPLICIT NONE @@ -80,12 +80,6 @@ MODULE cable_mpiworker PRIVATE - ! MPI: MPI derived datatype for receiving parameters from the master - INTEGER :: param_t - - ! MPI: MPI derived datatype for receiving casa parameters from the master - INTEGER :: casaparam_t - ! MPI: MPI derived datatype for receiving input from the master INTEGER :: inp_t @@ -127,9 +121,9 @@ SUBROUTINE mpidrv_worker (comm) USE cable_IO_vars_module, ONLY: logn,gswpfile,ncciy,leaps, globalMetfile, & verbose, fixedCO2,output,check,patchout, & patch_type,soilparmnew,& - defaultLAI, NO_CHECK + NO_CHECK USE cable_common_module, ONLY: ktau_gl, kend_gl, knode_gl, cable_user, & - cable_runtime, filename, myhome, & + cable_runtime, filename, & redistrb, wiltParam, satuParam, CurYear, & IS_LEAPYEAR, calcsoilalbedo, & kwidth_gl, gw_params @@ -158,9 +152,9 @@ SUBROUTINE mpidrv_worker (comm) USE CABLE_PLUME_MIP, ONLY: PLUME_MIP_TYPE USE cable_namelist_util, ONLY : get_namelist_file_name,& - CABLE_NAMELIST,arg_not_namelist + CABLE_NAMELIST -USE cbl_soil_snow_init_special_module + USE cbl_soil_snow_init_special_module IMPLICIT NONE ! MPI: @@ -182,14 +176,9 @@ SUBROUTINE mpidrv_worker (comm) ktauday, & ! day counter for CASA-CNP idoy, & ! day of year (1:365) counter for CASA-CNP nyear, & ! year counter for CASA-CNP - casa_it, & ! number of calls to CASA-CNP - ctime, & ! day count for casacnp YYYY, & ! LOY, & ! Length of Year - count_sum_casa, & ! number of time steps over which casa pools & - !and fluxes are aggregated (for output) - rank, & ! Rank of this worker - maxdiff(2) ! location of maximum in convergence test + rank ! Rank of this worker REAL :: dels ! time step size in seconds CHARACTER :: cRank*4 ! for worker-logfiles @@ -219,9 +208,6 @@ SUBROUTINE mpidrv_worker (comm) TYPE (casa_balance) :: casabal TYPE (phen_variable) :: phen TYPE (POP_TYPE) :: POP - TYPE (PLUME_MIP_TYPE) :: PLUME - CHARACTER :: cyear*4 - CHARACTER :: ncfile*99 ! declare vars for switches (default .FALSE.) etc declared thru namelist LOGICAL, SAVE :: & @@ -240,18 +226,12 @@ SUBROUTINE mpidrv_worker (comm) delsoilM, & ! allowed variation in soil moisture for spin up delsoilT ! allowed variation in soil temperature for spin up - ! temporary storage for soil moisture/temp. in spin up mode - REAL, ALLOCATABLE, DIMENSION(:,:) :: & - soilMtemp, & - soilTtemp - ! MPI: LOGICAL :: loop_exit ! MPI: exit flag for bcast to workers INTEGER :: stat(MPI_STATUS_SIZE) INTEGER :: icomm ! separate dupes of MPI communicator for send and recv INTEGER :: ocomm ! separate dupes of MPI communicator for send and recv INTEGER :: ierr - CHARACTER(len=200):: Run ! switches etc defined thru namelist (by default cable.nml) NAMELIST/CABLE/ & @@ -284,12 +264,11 @@ SUBROUTINE mpidrv_worker (comm) cable_user, & ! additional USER switches gw_params - INTEGER :: i,x,kk - INTEGER :: LALLOC, iu -!For consistency w JAC - REAL,ALLOCATABLE, SAVE :: c1(:,:) - REAL,ALLOCATABLE, SAVE :: rhoch(:,:) - REAL,ALLOCATABLE, SAVE :: xk(:,:) + INTEGER :: LALLOC + !For consistency w JAC + REAL,ALLOCATABLE, SAVE :: c1(:,:) + REAL,ALLOCATABLE, SAVE :: rhoch(:,:) + REAL,ALLOCATABLE, SAVE :: xk(:,:) ! END header ! Maciej: make sure the variable does not go out of scope @@ -430,7 +409,7 @@ SUBROUTINE mpidrv_worker (comm) IF ( CALL1 ) THEN - IF (.NOT.spinup) spinConv=.TRUE. + IF (.NOT.spinup) spinConv=.TRUE. ! MPI: bcast to workers so that they don't need to open the met ! file themselves @@ -485,7 +464,7 @@ SUBROUTINE mpidrv_worker (comm) & casabal,phen) ! MPI: POP restart received only if pop module AND casa are active - IF ( CABLE_USER%CALL_POP ) CALL worker_pop_types (comm,veg,casamet,pop) + IF ( CABLE_USER%CALL_POP ) CALL worker_pop_types (comm,veg,pop) END IF @@ -506,7 +485,7 @@ SUBROUTINE mpidrv_worker (comm) casamet,casabal, phen) IF ( CABLE_USER%CASA_DUMP_READ .OR. CABLE_USER%CASA_DUMP_WRITE ) & - CALL worker_casa_dump_types(comm, casamet, casaflux, phen, climate) + CALL worker_casa_dump_types(comm, casamet, casaflux, phen) WRITE(logn,*) 'cable_mpiworker, POPLUC: ', CABLE_USER%POPLUC WRITE(*,*) 'cable_mpiworker, POPLUC: ', CABLE_USER%POPLUC CALL flush(logn) @@ -688,7 +667,7 @@ SUBROUTINE mpidrv_worker (comm) IF ( IS_CASA_TIME("write", yyyy, ktau, kstart, & koffset, kend, ktauday, logn) ) THEN - ! write(logn,*), 'IN IS_CASA', casapool%cplant(:,1) + ! write(logn,*) 'IN IS_CASA', casapool%cplant(:,1) ! CALL MPI_Send (MPI_BOTTOM,1, casa_t,0,ktau_gl,ocomm,ierr) ENDIF @@ -733,10 +712,10 @@ SUBROUTINE mpidrv_worker (comm) IF (CABLE_USER%POPLUC) THEN - WRITE(logn,*), 'before MPI_Send casa_LUC' + WRITE(logn,*) 'before MPI_Send casa_LUC' ! worker sends casa updates required for LUC calculations here CALL MPI_Send (MPI_BOTTOM, 1, casa_LUC_t, 0, 0, ocomm, ierr) - WRITE(logn,*), 'after MPI_Send casa_LUC' + WRITE(logn,*) 'after MPI_Send casa_LUC' ! master calls LUCDriver here ! worker receives casa and POP updates CALL MPI_Recv( POP%pop_grid(1), POP%np, pop_t, 0, 0, icomm, stat, ierr ) @@ -970,7 +949,7 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& INTEGER :: bidx ! block index INTEGER :: ntyp ! total number of blocks - INTEGER :: rank, off, ierr2, rcount, pos + INTEGER :: rank, ierr2, rcount, pos CHARACTER, DIMENSION(:), ALLOCATABLE :: rbuf @@ -2480,9 +2459,9 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& pos = 0 CALL MPI_Unpack (rbuf, tsize, pos, MPI_BOTTOM, rcount, param_t, & comm, ierr) - IF (ierr /= MPI_SUCCESS) WRITE(*,*),'cable param unpack error, rank: ',rank,ierr + IF (ierr /= MPI_SUCCESS) WRITE(*,*)'cable param unpack error, rank: ',rank,ierr ELSE - WRITE(*,*),'cable param recv rank err err2 rcount: ',rank, ierr, ierr2, rcount + WRITE(*,*)'cable param recv rank err err2 rcount: ',rank, ierr, ierr2, rcount END IF DEALLOCATE(rbuf) @@ -3493,9 +3472,9 @@ SUBROUTINE worker_casa_params (comm,casabiome,casapool,casaflux,casamet,& pos = 0 CALL MPI_Unpack (rbuf, tsize, pos, MPI_BOTTOM, rcount, casa_t, & comm, ierr) - IF (ierr /= MPI_SUCCESS) WRITE(*,*),'casa params unpack error, rank: ',rank,ierr + IF (ierr /= MPI_SUCCESS) WRITE(*,*)'casa params unpack error, rank: ',rank,ierr ELSE - WRITE(*,*),'casa params recv rank err err2 rcount: ',rank, ierr, ierr2, rcount + WRITE(*,*)'casa params recv rank err err2 rcount: ',rank, ierr, ierr2, rcount END IF DEALLOCATE(rbuf) @@ -3723,16 +3702,11 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) INTEGER :: r1len, r2len, I1LEN, llen INTEGER :: rank, off, cnt - INTEGER :: bidx, midx, vidx, ierr + INTEGER :: bidx, ierr INTEGER :: tsize INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb - ! base index to make types indexing easier - INTEGER :: istart - - INTEGER :: i - CALL MPI_Comm_rank (comm, rank, ierr) ! MPI: calculate the sizes/extents of Fortran types used by @@ -5653,199 +5627,6 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) END SUBROUTINE worker_outtype - SUBROUTINE worker_time_update (met, kend, dels) - - USE cable_common_module, ONLY: ktau_gl - USE cable_def_types_mod - USE cable_IO_vars_module - - IMPLICIT NONE - - TYPE(met_type), INTENT(INOUT) :: met - INTEGER, INTENT(IN) :: kend ! number of time steps in simulation - REAL, INTENT(IN) :: dels ! time step size - - INTEGER :: i - - DO i=1,mland ! over all land points/grid cells - ! First set timing variables: - ! All timing details below are initially written to the first patch - ! of each gridcell, then dumped to all patches for the gridcell. - IF(ktau_gl==1) THEN ! initialise... - SELECT CASE(time_coord) - CASE('LOC')! i.e. use local time by default - ! hour-of-day = starting hod - met%hod(landpt(i)%cstart) = shod - met%doy(landpt(i)%cstart) = sdoy - met%moy(landpt(i)%cstart) = smoy - met%year(landpt(i)%cstart) = syear - CASE('GMT')! use GMT - ! hour-of-day = starting hod + offset from GMT time: - met%hod(landpt(i)%cstart) = shod + (longitude(i)/180.0)*12.0 - ! Note above that all met%* vars have dim mp, - ! while longitude and latitude have dimension mland. - met%doy(landpt(i)%cstart) = sdoy - met%moy(landpt(i)%cstart) = smoy - met%year(landpt(i)%cstart) = syear - CASE DEFAULT - CALL abort('Unknown time coordinate! ' & - //' (SUBROUTINE get_met_data)') - END SELECT - ELSE - ! increment hour-of-day by time step size: - met%hod(landpt(i)%cstart) = met%hod(landpt(i)%cstart) + dels/3600.0 - END IF - ! - IF(met%hod(landpt(i)%cstart)<0.0) THEN ! may be -ve since longitude - ! has range [-180,180] - ! Reduce day-of-year by one and ammend hour-of-day: - met%doy(landpt(i)%cstart) = met%doy(landpt(i)%cstart) - 1 - met%hod(landpt(i)%cstart) = met%hod(landpt(i)%cstart) + 24.0 - ! If a leap year AND we're using leap year timing: - IF(((MOD(syear,4)==0.AND.MOD(syear,100)/=0).OR. & - (MOD(syear,4)==0.AND.MOD(syear,400)==0)).AND.leaps) THEN - SELECT CASE(INT(met%doy(landpt(i)%cstart))) - CASE(0) ! ie Dec previous year - met%moy(landpt(i)%cstart) = 12 - met%year(landpt(i)%cstart) = met%year(landpt(i)%cstart) - 1 - met%doy(landpt(i)%cstart) = 365 ! prev year not leap year as this is - CASE(31) ! Jan - met%moy(landpt(i)%cstart) = 1 - CASE(60) ! Feb - met%moy(landpt(i)%cstart) = 2 - CASE(91) ! Mar - met%moy(landpt(i)%cstart) = 3 - CASE(121) - met%moy(landpt(i)%cstart) = 4 - CASE(152) - met%moy(landpt(i)%cstart) = 5 - CASE(182) - met%moy(landpt(i)%cstart) = 6 - CASE(213) - met%moy(landpt(i)%cstart) = 7 - CASE(244) - met%moy(landpt(i)%cstart) = 8 - CASE(274) - met%moy(landpt(i)%cstart) = 9 - CASE(305) - met%moy(landpt(i)%cstart) = 10 - CASE(335) - met%moy(landpt(i)%cstart) = 11 - END SELECT - ELSE ! not a leap year or not using leap year timing - SELECT CASE(INT(met%doy(landpt(i)%cstart))) - CASE(0) ! ie Dec previous year - met%moy(landpt(i)%cstart) = 12 - met%year(landpt(i)%cstart) = met%year(landpt(i)%cstart) - 1 - ! If previous year is a leap year - IF((MOD(syear,4)==0.AND.MOD(syear,100)/=0).OR. & - (MOD(syear,4)==0.AND.MOD(syear,400)==0)) THEN - met%doy(landpt(i)%cstart) = 366 - ELSE - met%doy(landpt(i)%cstart) = 365 - END IF - CASE(31) ! Jan - met%moy(landpt(i)%cstart) = 1 - CASE(59) ! Feb - met%moy(landpt(i)%cstart) = 2 - CASE(90) - met%moy(landpt(i)%cstart) = 3 - CASE(120) - met%moy(landpt(i)%cstart) = 4 - CASE(151) - met%moy(landpt(i)%cstart) = 5 - CASE(181) - met%moy(landpt(i)%cstart) = 6 - CASE(212) - met%moy(landpt(i)%cstart) = 7 - CASE(243) - met%moy(landpt(i)%cstart) = 8 - CASE(273) - met%moy(landpt(i)%cstart) = 9 - CASE(304) - met%moy(landpt(i)%cstart) = 10 - CASE(334) - met%moy(landpt(i)%cstart) = 11 - END SELECT - END IF ! if leap year or not - ELSE IF(met%hod(landpt(i)%cstart)>=24.0) THEN - ! increment or GMT adj has shifted day - ! Adjust day-of-year and hour-of-day: - met%doy(landpt(i)%cstart) = met%doy(landpt(i)%cstart) + 1 - met%hod(landpt(i)%cstart) = met%hod(landpt(i)%cstart) - 24.0 - ! If a leap year AND we're using leap year timing: - IF(((MOD(syear,4)==0.AND.MOD(syear,100)/=0).OR. & - (MOD(syear,4)==0.AND.MOD(syear,400)==0)).AND.leaps) THEN - SELECT CASE(INT(met%doy(landpt(i)%cstart))) - CASE(32) ! Feb - met%moy(landpt(i)%cstart) = 2 - CASE(61) ! Mar - met%moy(landpt(i)%cstart) = 3 - CASE(92) - met%moy(landpt(i)%cstart) = 4 - CASE(122) - met%moy(landpt(i)%cstart) = 5 - CASE(153) - met%moy(landpt(i)%cstart) = 6 - CASE(183) - met%moy(landpt(i)%cstart) = 7 - CASE(214) - met%moy(landpt(i)%cstart) = 8 - CASE(245) - met%moy(landpt(i)%cstart) = 9 - CASE(275) - met%moy(landpt(i)%cstart) = 10 - CASE(306) - met%moy(landpt(i)%cstart) = 11 - CASE(336) - met%moy(landpt(i)%cstart) = 12 - CASE(367)! end of year; increment - met%year(landpt(i)%cstart) = met%year(landpt(i)%cstart) + 1 - met%moy(landpt(i)%cstart) = 1 - met%doy(landpt(i)%cstart) = 1 - END SELECT - ! ELSE IF not leap year and Dec 31st, increment year - ELSE - SELECT CASE(INT(met%doy(landpt(i)%cstart))) - CASE(32) ! Feb - met%moy(landpt(i)%cstart) = 2 - CASE(60) ! Mar - met%moy(landpt(i)%cstart) = 3 - CASE(91) - met%moy(landpt(i)%cstart) = 4 - CASE(121) - met%moy(landpt(i)%cstart) = 5 - CASE(152) - met%moy(landpt(i)%cstart) = 6 - CASE(182) - met%moy(landpt(i)%cstart) = 7 - CASE(213) - met%moy(landpt(i)%cstart) = 8 - CASE(244) - met%moy(landpt(i)%cstart) = 9 - CASE(274) - met%moy(landpt(i)%cstart) = 10 - CASE(305) - met%moy(landpt(i)%cstart) = 11 - CASE(335) - met%moy(landpt(i)%cstart) = 12 - CASE(366)! end of year; increment - met%year(landpt(i)%cstart) = met%year(landpt(i)%cstart) + 1 - met%moy(landpt(i)%cstart) = 1 - met%doy(landpt(i)%cstart) = 1 - END SELECT - END IF ! if leap year or not - END IF ! if increment has pushed hod to a different day - ! Now copy these values to all veg/soil patches in the current grid cell: - met%hod(landpt(i)%cstart:landpt(i)%cend) = met%hod(landpt(i)%cstart) - met%doy(landpt(i)%cstart:landpt(i)%cend) = met%doy(landpt(i)%cstart) - met%moy(landpt(i)%cstart:landpt(i)%cend) = met%moy(landpt(i)%cstart) - met%year(landpt(i)%cstart:landpt(i)%cend) = met%year(landpt(i)%cstart) - ENDDO - - RETURN - - END SUBROUTINE worker_time_update ! creates MPI types for sending casa results back to the master at ! the end of the simulation @@ -5890,8 +5671,8 @@ SUBROUTINE worker_casa_type (comm, casapool,casaflux, & ! MPI: block lengths and strides for hvector representing matrices INTEGER :: r1len, r2len, I1LEN, llen - INTEGER :: rank, off, cnt - INTEGER :: bidx, midx, vidx, ierr + INTEGER :: off, cnt + INTEGER :: bidx, ierr INTEGER :: tsize INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb @@ -6410,20 +6191,14 @@ SUBROUTINE worker_climate_types (comm, climate, ktauday ) INTEGER, ALLOCATABLE, DIMENSION(:) :: types INTEGER :: ntyp ! number of worker's types - INTEGER :: last2d, i - - ! MPI: block lenghts for hindexed representing all vectors - INTEGER, ALLOCATABLE, DIMENSION(:) :: blen - ! MPI: block lengths and strides for hvector representing matrices INTEGER :: r1len, r2len, I1LEN - INTEGER(KIND=MPI_ADDRESS_KIND) :: r1stride, r2stride - INTEGER :: tsize, totalrecv, totalsend + INTEGER :: tsize, totalrecv INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb - INTEGER :: rank, off, cnt - INTEGER :: bidx, midx, vidx, ierr, ny, nd, ndq + INTEGER :: rank, off + INTEGER :: bidx, ierr, ny, nd, ndq INTEGER :: stat(MPI_STATUS_SIZE), ierr2, rcount, pos @@ -6649,9 +6424,9 @@ SUBROUTINE worker_climate_types (comm, climate, ktauday ) pos = 0 CALL MPI_Unpack (rbuf, tsize, pos, MPI_BOTTOM, rcount, climate_t, & comm, ierr) - IF (ierr /= MPI_SUCCESS) WRITE(*,*),'climate unpack error, rank: ',rank,ierr + IF (ierr /= MPI_SUCCESS) WRITE(*,*)'climate unpack error, rank: ',rank,ierr ELSE - WRITE(*,*),'climate recv rank err err2 rcount: ',rank, ierr, ierr2, rcount + WRITE(*,*)'climate recv rank err err2 rcount: ',rank, ierr, ierr2, rcount END IF DEALLOCATE(rbuf) @@ -6690,7 +6465,7 @@ SUBROUTINE worker_restart_type (comm, canopy, air) INTEGER :: r1len, r2len, I1LEN, llen INTEGER :: rank, off, cnt - INTEGER :: bidx, midx, vidx, ierr, nd, ny + INTEGER :: bidx, ierr INTEGER :: tsize INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb @@ -6809,7 +6584,7 @@ SUBROUTINE worker_restart_type (comm, canopy, air) END SUBROUTINE worker_restart_type - SUBROUTINE worker_casa_dump_types(comm, casamet, casaflux, phen, climate) + SUBROUTINE worker_casa_dump_types(comm, casamet, casaflux, phen) USE mpi @@ -6824,7 +6599,6 @@ SUBROUTINE worker_casa_dump_types(comm, casamet, casaflux, phen, climate) TYPE (casa_flux) , INTENT(INOUT) :: casaflux TYPE (casa_met) , INTENT(INOUT) :: casamet TYPE (phen_variable), INTENT(INOUT) :: phen - TYPE (climate_type):: climate ! local vars @@ -6837,10 +6611,9 @@ SUBROUTINE worker_casa_dump_types(comm, casamet, casaflux, phen, climate) INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: tsize - INTEGER :: stat(MPI_STATUS_SIZE), ierr - INTEGER :: landp_t, patch_t, param_t + INTEGER :: ierr - INTEGER :: r1len, r2len, I1LEN, llen ! block lengths + INTEGER :: r1len, r2len, I1LEN ! block lengths INTEGER :: bidx ! block index INTEGER :: ntyp ! total number of blocks @@ -6976,10 +6749,9 @@ SUBROUTINE worker_casa_LUC_types(comm, casapool, casabal) INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: tsize - INTEGER :: stat(MPI_STATUS_SIZE), ierr - INTEGER :: landp_t, patch_t, param_t + INTEGER :: ierr - INTEGER :: r1len, r2len, I1LEN, llen ! block lengths + INTEGER :: r1len, r2len, I1LEN ! block lengths INTEGER :: bidx ! block index INTEGER :: ntyp ! total number of blocks @@ -7088,7 +6860,7 @@ SUBROUTINE worker_casa_LUC_types(comm, casapool, casabal) END SUBROUTINE worker_casa_LUC_types - SUBROUTINE worker_pop_types(comm, veg, casamet, pop) + SUBROUTINE worker_pop_types(comm, veg, pop) USE mpi USE POP_mpi @@ -7101,7 +6873,6 @@ SUBROUTINE worker_pop_types(comm, veg, casamet, pop) IMPLICIT NONE INTEGER, INTENT(IN) :: comm - TYPE (casa_met), INTENT(IN) :: casamet TYPE (pop_type), INTENT(INOUT) :: pop TYPE (veg_parameter_type),INTENT(IN) :: veg @@ -7114,31 +6885,31 @@ SUBROUTINE worker_pop_types(comm, veg, casamet, pop) ! Get POP relevant info from Master CALL MPI_Recv ( mp_pop, 1, MPI_INTEGER, 0, 0, comm, stat, ierr ) - WRITE(*,*),'worker iwood to allocate', rank, mp_pop, mp - !write(*,*),'worker mppop', rank, mp_pop + WRITE(*,*)'worker iwood to allocate', rank, mp_pop, mp + !write(*,*)'worker mppop', rank, mp_pop !ALLOCATE( POP%Iwood( mp_pop ) ) ALLOCATE( Iwood( mp_pop ) ) - WRITE(*,*),'worker iwood allocated', rank, mp_pop + WRITE(*,*)'worker iwood allocated', rank, mp_pop !CALL MPI_Recv ( POP%Iwood, mp_pop, MPI_INTEGER, 0, 0, comm, stat, ierr ) CALL MPI_Recv ( Iwood, mp_pop, MPI_INTEGER, 0, 0, comm, stat, ierr ) - !write(*,*),'worker Iwood', rank, POP%Iwood + !write(*,*)'worker Iwood', rank, POP%Iwood ! Maciej IF (ANY (Iwood < 1) .OR. ANY (Iwood > mp)) THEN - WRITE(*,*),'worker iwood values outside valid ranges', rank + WRITE(*,*) 'worker iwood values outside valid ranges', rank inv = COUNT(Iwood < 1) IF (inv .GT. 0) THEN - WRITE(*,*),'no of values below 1: ', inv + WRITE(*,*) 'no of values below 1: ', inv ALLOCATE (ainv(inv)) ainv = PACK (Iwood, Iwood .LT. 1) - WRITE (*,*),'values below 1: ', ainv + WRITE (*,*) 'values below 1: ', ainv DEALLOCATE (ainv) END IF inv = COUNT(Iwood > mp) IF (inv .GT. 0) THEN - WRITE(*,*),'no of values above mp ', mp, inv + WRITE(*,*) 'no of values above mp ', mp, inv ALLOCATE (ainv(inv)) ainv = PACK (Iwood, Iwood .GT. mp) - WRITE (*,*),'values above mp: ', ainv + WRITE (*,*) 'values above mp: ', ainv DEALLOCATE (ainv) END IF @@ -7155,7 +6926,7 @@ SUBROUTINE worker_pop_types(comm, veg, casamet, pop) CALL create_pop_gridcell_type (pop_t, comm) IF (.NOT. CABLE_USER%POP_fromZero ) THEN - WRITE(*,*),'rank receiving pop_grid from master', rank + WRITE(*,*) 'rank receiving pop_grid from master', rank CALL MPI_Recv( POP%pop_grid(1), mp_pop, pop_t, 0, 0, comm, stat, ierr ) END IF @@ -7229,7 +7000,7 @@ SUBROUTINE worker_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo USE POPMODULE, ONLY: POPStep USE TypeDef, ONLY: i4b, dp USE mpi - USE biogeochem_mod, ONLY : biogeochem + USE biogeochem_mod, ONLY : biogeochem !mrd561 debug USE cable_IO_vars_module, ONLY: logn @@ -7256,7 +7027,6 @@ SUBROUTINE worker_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo ! communicator for error-messages INTEGER, INTENT(IN) :: icomm, ocomm - TYPE (casa_met) :: casaspin ! local variables REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cleaf2met, avg_cleaf2str, avg_croot2met, avg_croot2str, avg_cwood2cwd @@ -7268,36 +7038,22 @@ SUBROUTINE worker_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_ratioNCsoilmic, avg_ratioNCsoilslow, avg_ratioNCsoilpass REAL(r_2), DIMENSION(:), ALLOCATABLE, SAVE :: avg_xnplimit, avg_xkNlimiting,avg_xklitter, avg_xksoil - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_af - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_aw - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_ar - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_lf - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_lw - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_lr - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_annual_cnpp + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_af + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_aw + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_ar + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_lf + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_lw + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_lr + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_annual_cnpp ! local variables INTEGER :: myearspin,nyear, nloop1, LOY - CHARACTER(LEN=99) :: ncfile - CHARACTER(LEN=4) :: cyear - INTEGER :: ktau,ktauday,nday,idoy,ktaux,ktauy,nloop - INTEGER, SAVE :: ndays + INTEGER :: ktau,ktauday,nday,idoy,ktauy,nloop REAL, DIMENSION(mp) :: cleaf2met, cleaf2str, croot2met, croot2str, cwood2cwd REAL, DIMENSION(mp) :: nleaf2met, nleaf2str, nroot2met, nroot2str, nwood2cwd REAL, DIMENSION(mp) :: pleaf2met, pleaf2str, proot2met, proot2str, pwood2cwd - REAL, DIMENSION(mp) :: xcgpp, xcnpp, xnuptake, xpuptake - REAL, DIMENSION(mp) :: xnsoilmin, xpsoillab, xpsoilsorb,xpsoilocc REAL(r_2), DIMENSION(mp) :: xnplimit, xkNlimiting, xklitter, xksoil,xkleaf, xkleafcold, xkleafdry - ! more variables to store the spinup pool size over the last 10 loops. Added by Yp Wang 30 Nov 2012 - REAL, DIMENSION(5,mvtype,mplant) :: bmcplant, bmnplant, bmpplant - REAL, DIMENSION(5,mvtype,mlitter) :: bmclitter, bmnlitter, bmplitter - REAL, DIMENSION(5,mvtype,msoil) :: bmcsoil, bmnsoil, bmpsoil - REAL, DIMENSION(5,mvtype) :: bmnsoilmin,bmpsoillab,bmpsoilsorb, bmpsoilocc - REAL, DIMENSION(mvtype) :: bmarea - INTEGER nptx,nvt,kloop - - REAL(dp) :: StemNPP(mp,2) INTEGER, ALLOCATABLE :: Iw(:) ! array of indices corresponding to woody (shrub or forest) tiles @@ -7452,57 +7208,57 @@ SUBROUTINE worker_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo ENDDO ENDDO - ! Average the plant allocation fraction - avg_af = avg_af / REAL(nday) - avg_aw = avg_aw / REAL(nday) - avg_ar = avg_ar / REAL(nday) + ! Average the plant allocation fraction + avg_af = avg_af / REAL(nday) + avg_aw = avg_aw / REAL(nday) + avg_ar = avg_ar / REAL(nday) - ! Average the plant turnover fraction - avg_lf = avg_lf / REAL(nday) - avg_lw = avg_lw / REAL(nday) - avg_lr = avg_lr / REAL(nday) + ! Average the plant turnover fraction + avg_lf = avg_lf / REAL(nday) + avg_lw = avg_lw / REAL(nday) + avg_lr = avg_lr / REAL(nday) - ! Need the annual NPP to solve plant pools g C m-2 y-1 - avg_annual_cnpp = avg_cnpp / REAL(myearspin) + ! Need the annual NPP to solve plant pools g C m-2 y-1 + avg_annual_cnpp = avg_cnpp / REAL(myearspin) - avg_cleaf2met = avg_cleaf2met/REAL(nday) - avg_cleaf2str = avg_cleaf2str/REAL(nday) - avg_croot2met = avg_croot2met/REAL(nday) - avg_croot2str = avg_croot2str/REAL(nday) - avg_cwood2cwd = avg_cwood2cwd/REAL(nday) + avg_cleaf2met = avg_cleaf2met/REAL(nday) + avg_cleaf2str = avg_cleaf2str/REAL(nday) + avg_croot2met = avg_croot2met/REAL(nday) + avg_croot2str = avg_croot2str/REAL(nday) + avg_cwood2cwd = avg_cwood2cwd/REAL(nday) - avg_nleaf2met = avg_nleaf2met/REAL(nday) - avg_nleaf2str = avg_nleaf2str/REAL(nday) - avg_nroot2met = avg_nroot2met/REAL(nday) - avg_nroot2str = avg_nroot2str/REAL(nday) - avg_nwood2cwd = avg_nwood2cwd/REAL(nday) + avg_nleaf2met = avg_nleaf2met/REAL(nday) + avg_nleaf2str = avg_nleaf2str/REAL(nday) + avg_nroot2met = avg_nroot2met/REAL(nday) + avg_nroot2str = avg_nroot2str/REAL(nday) + avg_nwood2cwd = avg_nwood2cwd/REAL(nday) - avg_pleaf2met = avg_pleaf2met/REAL(nday) - avg_pleaf2str = avg_pleaf2str/REAL(nday) - avg_proot2met = avg_proot2met/REAL(nday) - avg_proot2str = avg_proot2str/REAL(nday) - avg_pwood2cwd = avg_pwood2cwd/REAL(nday) + avg_pleaf2met = avg_pleaf2met/REAL(nday) + avg_pleaf2str = avg_pleaf2str/REAL(nday) + avg_proot2met = avg_proot2met/REAL(nday) + avg_proot2str = avg_proot2str/REAL(nday) + avg_pwood2cwd = avg_pwood2cwd/REAL(nday) - avg_cgpp = avg_cgpp/REAL(nday) - avg_cnpp = avg_cnpp/REAL(nday) + avg_cgpp = avg_cgpp/REAL(nday) + avg_cnpp = avg_cnpp/REAL(nday) - avg_nuptake = avg_nuptake/REAL(nday) - avg_puptake = avg_puptake/REAL(nday) + avg_nuptake = avg_nuptake/REAL(nday) + avg_puptake = avg_puptake/REAL(nday) - avg_xnplimit = avg_xnplimit/REAL(nday) - avg_xkNlimiting = avg_xkNlimiting/REAL(nday) - avg_xklitter = avg_xklitter/REAL(nday) + avg_xnplimit = avg_xnplimit/REAL(nday) + avg_xkNlimiting = avg_xkNlimiting/REAL(nday) + avg_xklitter = avg_xklitter/REAL(nday) - avg_xksoil = avg_xksoil/REAL(nday) + avg_xksoil = avg_xksoil/REAL(nday) - avg_nsoilmin = avg_nsoilmin/REAL(nday) - avg_psoillab = avg_psoillab/REAL(nday) - avg_psoilsorb = avg_psoilsorb/REAL(nday) - avg_psoilocc = avg_psoilocc/REAL(nday) + avg_nsoilmin = avg_nsoilmin/REAL(nday) + avg_psoillab = avg_psoillab/REAL(nday) + avg_psoilsorb = avg_psoilsorb/REAL(nday) + avg_psoilocc = avg_psoilocc/REAL(nday) - avg_rationcsoilmic = avg_rationcsoilmic /REAL(nday) - avg_rationcsoilslow = avg_rationcsoilslow /REAL(nday) - avg_rationcsoilpass = avg_rationcsoilpass /REAL(nday) + avg_rationcsoilmic = avg_rationcsoilmic /REAL(nday) + avg_rationcsoilslow = avg_rationcsoilslow /REAL(nday) + avg_rationcsoilpass = avg_rationcsoilpass /REAL(nday) CALL analyticpool(kend,veg,soil,casabiome,casapool, & casaflux,casamet,casabal,phen, & @@ -7599,7 +7355,7 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & USE POPMODULE, ONLY: POPStep USE TypeDef, ONLY: i4b, dp USE mpi - USE biogeochem_mod, ONLY : biogeochem + USE biogeochem_mod, ONLY : biogeochem !mrd561 debug USE cable_IO_vars_module, ONLY: logn @@ -7625,39 +7381,15 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & ! communicator for error-messages INTEGER, INTENT(IN) :: icomm, ocomm - TYPE (casa_met) :: casaspin ! local variables - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cleaf2met, avg_cleaf2str, avg_croot2met, avg_croot2str, avg_cwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nleaf2met, avg_nleaf2str, avg_nroot2met, avg_nroot2str, avg_nwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_pleaf2met, avg_pleaf2str, avg_proot2met, avg_proot2str, avg_pwood2cwd - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cgpp, avg_cnpp, avg_nuptake, avg_puptake - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nsoilmin, avg_psoillab, avg_psoilsorb, avg_psoilocc - !chris 12/oct/2012 for spin up casa - REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_ratioNCsoilmic, avg_ratioNCsoilslow, avg_ratioNCsoilpass - REAL(r_2), DIMENSION(:), ALLOCATABLE, SAVE :: avg_xnplimit, avg_xkNlimiting,avg_xklitter, avg_xksoil - - ! local variables - INTEGER :: myearspin,nyear, nloop1 - CHARACTER(LEN=99) :: ncfile - CHARACTER(LEN=4) :: cyear - INTEGER :: ktau,ktauday,nday,idoy,ktaux,ktauy,nloop - INTEGER, SAVE :: ndays + INTEGER :: myearspin,nyear + INTEGER :: ktau,ktauday,nday,idoy REAL, DIMENSION(mp) :: cleaf2met, cleaf2str, croot2met, croot2str, cwood2cwd REAL, DIMENSION(mp) :: nleaf2met, nleaf2str, nroot2met, nroot2str, nwood2cwd REAL, DIMENSION(mp) :: pleaf2met, pleaf2str, proot2met, proot2str, pwood2cwd - REAL, DIMENSION(mp) :: xcgpp, xcnpp, xnuptake, xpuptake - REAL, DIMENSION(mp) :: xnsoilmin, xpsoillab, xpsoilsorb,xpsoilocc REAL(r_2), DIMENSION(mp) :: xnplimit, xkNlimiting, xklitter, xksoil,xkleaf, xkleafcold, xkleafdry - ! more variables to store the spinup pool size over the last 10 loops. Added by Yp Wang 30 Nov 2012 - REAL, DIMENSION(5,mvtype,mplant) :: bmcplant, bmnplant, bmpplant - REAL, DIMENSION(5,mvtype,mlitter) :: bmclitter, bmnlitter, bmplitter - REAL, DIMENSION(5,mvtype,msoil) :: bmcsoil, bmnsoil, bmpsoil - REAL, DIMENSION(5,mvtype) :: bmnsoilmin,bmpsoillab,bmpsoilsorb, bmpsoilocc - REAL, DIMENSION(mvtype) :: bmarea - INTEGER nptx,nvt,kloop - REAL(dp) :: StemNPP(mp,2) @@ -7711,7 +7443,7 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & CALL MPI_Comm_rank (icomm, rank, ierr) WRITE(logn,*) - WRITE(logn,*),'rank receiving pop_grid from master', rank + WRITE(logn,*) 'rank receiving pop_grid from master', rank !$ write(logn,*) 'b4 MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum !$ write(logn,*) 'b4 MPI_Recv, pop_t LU: ', POP%pop_grid%LU CALL MPI_Recv( POP%pop_grid(1), POP%np, pop_t, 0, 0, icomm, stat, ierr ) @@ -7720,7 +7452,7 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & WRITE(logn,*) 'after MPI_Recv, pop_t ' CALL flush(logn) IF (cable_user%CALL_POP .AND. POP%np.GT.0) THEN ! CALL_POP - WRITE(logn,*), 'b4 POPdriver', POP%pop_grid%cmass_sum + WRITE(logn,*) 'b4 POPdriver', POP%pop_grid%cmass_sum CALL POPdriver(casaflux,casabal,veg, POP) ENDIF diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 index 04cb67a43..93a1f9798 100644 --- a/src/offline/cable_output.F90 +++ b/src/offline/cable_output.F90 @@ -1365,158 +1365,238 @@ SUBROUTINE open_output_file(dels, soil, veg, bgc, rough, met) !~ Patch out_settings%dimswitch = "real" - CALL check_and_write(output%patchfrac .AND. (patchout%patchfrac .OR. output%patch), opid%patchfrac, 'patchfrac', & - REAL(patch(:)%frac, 4), ranges%patchfrac, patchout%patchfrac, out_settings) + IF (output%patchfrac .AND. (patchout%patchfrac .OR. output%patch)) THEN + CALL check_and_write(opid%patchfrac, 'patchfrac', & + REAL(patch(:)%frac, 4), ranges%patchfrac, patchout%patchfrac, out_settings) + END IF !~ Soil out_settings%dimswitch = "integer" - CALL check_and_write(output%isoil, opid%isoil, & - 'isoil', REAL(soil%isoilm, 4), ranges%isoil, patchout%isoil, out_settings) + IF (output%isoil) THEN + CALL check_and_write(opid%isoil, & + 'isoil', REAL(soil%isoilm, 4), ranges%isoil, patchout%isoil, out_settings) + END IF out_settings%dimswitch = "real" - CALL check_and_write(output%bch, opid%bch, & - 'bch', REAL(soil%bch, 4), ranges%bch, patchout%bch, out_settings) - CALL check_and_write(output%clay, opid%clay, & - 'clay', REAL(soil%clay, 4), ranges%clay, patchout%clay, out_settings) - CALL check_and_write(output%sand, opid%sand, & - 'sand', REAL(soil%sand, 4), ranges%sand, patchout%sand, out_settings) - CALL check_and_write(output%silt, opid%silt, & - 'silt', REAL(soil%silt, 4), ranges%silt, patchout%silt, out_settings) - CALL check_and_write(output%css, opid%css, & - 'css', REAL(soil%css, 4), ranges%css, patchout%css, out_settings) - CALL check_and_write(output%rhosoil, & - opid%rhosoil, 'rhosoil',REAL(soil%rhosoil,4), & - ranges%rhosoil, patchout%rhosoil, out_settings) - CALL check_and_write(output%hyds, opid%hyds, & - 'hyds', REAL(soil%hyds, 4), ranges%hyds, patchout%hyds, out_settings) - CALL check_and_write(output%sucs, opid%sucs, & - 'sucs', REAL(soil%sucs, 4), ranges%sucs, patchout%sucs, out_settings) - CALL check_and_write(output%rs20, opid%rs20, & - 'rs20', REAL(veg%rs20, 4), ranges%rs20, patchout%rs20, out_settings) - ! 'rs20',REAL(soil%rs20,4),ranges%rs20,patchout%rs20,out_settings) - CALL check_and_write(output%ssat, opid%ssat, & - 'ssat', REAL(soil%ssat, 4), ranges%ssat, patchout%ssat, out_settings) - CALL check_and_write(output%sfc, opid%sfc, & - 'sfc', REAL(soil%sfc, 4), ranges%sfc, patchout%sfc, out_settings) - CALL check_and_write(output%swilt, opid%swilt, & - 'swilt', REAL(soil%swilt, 4), ranges%swilt, patchout%swilt, out_settings) - - ! CALL check_and_write(output%slope ,ncid_out, opid%slope, & - ! 'slope', REAL(soil%slope, 4), ranges%slope, patchout%slope, out_settings) - ! CALL check_and_write(output%slope_std, opid%slope_std, & - ! 'slope_std', REAL(soil%slope_std, 4), ranges%slope_std, patchout%slope_std, out_settings) - ! CALL check_and_write(output%GWdz, opid%GWdz, & - ! 'GWdz', REAL(soil%GWdz, 4), ranges%GWdz, patchout%GWdz, out_settings) - - out_settings%dimswitch = "radiation" - CALL check_and_write(output%albsoil, & - opid%albsoil, 'albsoil', REAL(soil%albsoil, 4), & - ranges%albsoil, patchout%albsoil, out_settings) - - out_settings%dimswitch = "soil" - CALL check_and_write(output%zse, opid%zse, & - 'zse', SPREAD(REAL(soil%zse, 4), 1, mp),ranges%zse, & - patchout%zse, out_settings)! no spatial dim at present + IF (output%bch) THEN + CALL check_and_write(opid%bch, & + 'bch', REAL(soil%bch, 4), ranges%bch, patchout%bch, out_settings) + END IF + IF (output%clay) THEN + CALL check_and_write(opid%clay, & + 'clay', REAL(soil%clay, 4), ranges%clay, patchout%clay, out_settings) + END IF + IF (output%sand) THEN + CALL check_and_write(opid%sand, & + 'sand', REAL(soil%sand, 4), ranges%sand, patchout%sand, out_settings) + END IF + IF (output%silt) THEN + CALL check_and_write(opid%silt, & + 'silt', REAL(soil%silt, 4), ranges%silt, patchout%silt, out_settings) + END IF + IF (output%css) THEN + CALL check_and_write(opid%css, & + 'css', REAL(soil%css, 4), ranges%css, patchout%css, out_settings) + END IF + IF (output%rhosoil) THEN + CALL check_and_write(opid%rhosoil, 'rhosoil',REAL(soil%rhosoil,4), & + ranges%rhosoil, patchout%rhosoil, out_settings) + END IF + IF (output%hyds) THEN + CALL check_and_write(opid%hyds, & + 'hyds', REAL(soil%hyds, 4), ranges%hyds, patchout%hyds, out_settings) + END IF + IF (output%sucs) THEN + CALL check_and_write(opid%sucs, & + 'sucs', REAL(soil%sucs, 4), ranges%sucs, patchout%sucs, out_settings) + END IF + IF (output%rs20) THEN + CALL check_and_write(opid%rs20, & + 'rs20', REAL(veg%rs20, 4), ranges%rs20, patchout%rs20, out_settings) + ! 'rs20',REAL(soil%rs20,4),ranges%rs20,patchout%rs20,out_settings) + END IF + IF (output%ssat) THEN + CALL check_and_write(opid%ssat, & + 'ssat', REAL(soil%ssat, 4), ranges%ssat, patchout%ssat, out_settings) + END IF + IF (output%sfc) THEN + CALL check_and_write(opid%sfc, & + 'sfc', REAL(soil%sfc, 4), ranges%sfc, patchout%sfc, out_settings) + END IF + IF (output%swilt) THEN + CALL check_and_write(opid%swilt, & + 'swilt', REAL(soil%swilt, 4), ranges%swilt, patchout%swilt, out_settings) + END IF + + ! IF (output%slope) THEN + ! CALL check_and_write(ncid_out, opid%slope, & + ! 'slope', REAL(soil%slope, 4), ranges%slope, patchout%slope, out_settings) + ! END IF + ! IF (output%slope_std) THEN + ! CALL check_and_write(opid%slope_std, & + ! 'slope_std', REAL(soil%slope_std, 4), ranges%slope_std, patchout%slope_std, out_settings) + ! END IF + ! IF (output%GWdz) THEN + ! CALL check_and_write(opid%GWdz, & + ! 'GWdz', REAL(soil%GWdz, 4), ranges%GWdz, patchout%GWdz, out_settings) + ! END IF + + IF (output%albsoil) THEN + out_settings%dimswitch = "radiation" + CALL check_and_write(opid%albsoil, 'albsoil', REAL(soil%albsoil, 4), & + ranges%albsoil, patchout%albsoil, out_settings) + END IF + + IF (output%zse) THEN + out_settings%dimswitch = "soil" + CALL check_and_write(opid%zse, & + 'zse', SPREAD(REAL(soil%zse, 4), 1, mp),ranges%zse, & + patchout%zse, out_settings)! no spatial dim at present + END IF !~ Veg out_settings%dimswitch = "integer" - CALL check_and_write(output%iveg, opid%iveg, & - 'iveg', REAL(veg%iveg, 4), ranges%iveg, patchout%iveg, out_settings) - CALL check_and_write(output%meth, opid%meth, & - 'meth', REAL(veg%meth, 4), ranges%meth, patchout%meth, out_settings) - - out_settings%dimswitch = "real" - CALL check_and_write(output%canst1, & - opid%canst1, 'canst1', REAL(veg%canst1, 4), & - ranges%canst1, patchout%canst1, out_settings) - CALL check_and_write(output%dleaf, opid%dleaf, & - 'dleaf', REAL(veg%dleaf, 4), ranges%dleaf, patchout%dleaf, out_settings) - CALL check_and_write(output%ejmax, opid%ejmax, & - 'ejmax', REAL(veg%ejmax, 4), ranges%ejmax, patchout%ejmax, out_settings) - CALL check_and_write(output%vcmax, opid%vcmax, & - 'vcmax', REAL(veg%vcmax, 4), ranges%vcmax, patchout%vcmax, out_settings) - CALL check_and_write(output%frac4, opid%frac4, & - 'frac4', REAL(veg%frac4, 4), ranges%frac4, patchout%frac4, out_settings) + IF (output%iveg) THEN + CALL check_and_write(opid%iveg, & + 'iveg', REAL(veg%iveg, 4), ranges%iveg, patchout%iveg, out_settings) + END IF + IF (output%meth) THEN + CALL check_and_write(opid%meth, & + 'meth', REAL(veg%meth, 4), ranges%meth, patchout%meth, out_settings) + END IF - IF (.NOT.cable_user%CALL_POP) THEN - CALL check_and_write(output%hc, opid%hc, & + out_settings%dimswitch = "real" + IF (output%canst1) THEN + CALL check_and_write(opid%canst1, 'canst1', REAL(veg%canst1, 4), & + ranges%canst1, patchout%canst1, out_settings) + END IF + IF (output%dleaf) THEN + CALL check_and_write(opid%dleaf, & + 'dleaf', REAL(veg%dleaf, 4), ranges%dleaf, patchout%dleaf, out_settings) + END IF + IF (output%ejmax) THEN + CALL check_and_write(opid%ejmax, & + 'ejmax', REAL(veg%ejmax, 4), ranges%ejmax, patchout%ejmax, out_settings) + END IF + IF (output%vcmax) THEN + CALL check_and_write(opid%vcmax, & + 'vcmax', REAL(veg%vcmax, 4), ranges%vcmax, patchout%vcmax, out_settings) + END IF + IF (output%frac4) THEN + CALL check_and_write(opid%frac4, & + 'frac4', REAL(veg%frac4, 4), ranges%frac4, patchout%frac4, out_settings) + END IF + IF (.NOT.cable_user%CALL_POP .and. output%hc) THEN + CALL check_and_write(opid%hc, & 'hc', REAL(veg%hc, 4), ranges%hc, patchout%hc, out_settings) - ENDIF - CALL check_and_write(output%rp20, opid%rp20, & - 'rp20', REAL(veg%rp20, 4),ranges%rp20, patchout%rp20, out_settings) + END IF + IF (output%rp20) THEN + CALL check_and_write(opid%rp20, & + 'rp20', REAL(veg%rp20, 4),ranges%rp20, patchout%rp20, out_settings) + END IF + ! Ticket #56 - CALL check_and_write(output%g0, opid%g0, & - 'g0', REAL(veg%g0, 4),ranges%g0, patchout%g0, out_settings) - CALL check_and_write(output%g1, opid%g1, & - 'g1', REAL(veg%g1, 4),ranges%g1, patchout%g1, out_settings) + IF (output%g0) THEN + CALL check_and_write(opid%g0, & + 'g0', REAL(veg%g0, 4),ranges%g0, patchout%g0, out_settings) + END IF + IF (output%g1) THEN + CALL check_and_write(opid%g1, & + 'g1', REAL(veg%g1, 4),ranges%g1, patchout%g1, out_settings) + END IF + ! End Ticket #56 - CALL check_and_write(output%rpcoef, & - opid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & - ranges%rpcoef, patchout%rpcoef, out_settings) - CALL check_and_write(output%shelrb, & - opid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & - ranges%shelrb, patchout%shelrb, out_settings) - CALL check_and_write(output%xfang, opid%xfang, & - 'xfang', REAL(veg%xfang, 4), ranges%xfang, patchout%xfang, out_settings) - CALL check_and_write(output%wai, opid%wai, & - 'wai', REAL(veg%wai, 4), ranges%wai, patchout%wai, out_settings) - CALL check_and_write(output%vegcf, opid%vegcf, & - 'vegcf', REAL(veg%vegcf, 4), ranges%vegcf, patchout%vegcf, out_settings) - CALL check_and_write(output%extkn, opid%extkn, & - 'extkn', REAL(veg%extkn, 4), ranges%extkn, patchout%extkn, out_settings) - CALL check_and_write(output%tminvj, & - opid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & - ranges%tminvj, patchout%tminvj, out_settings) - CALL check_and_write(output%tmaxvj, & - opid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & - ranges%tmaxvj, patchout%tmaxvj, out_settings) - CALL check_and_write(output%vbeta, opid%vbeta, & - 'vbeta', REAL(veg%vbeta, 4), ranges%vbeta, patchout%vbeta, out_settings) - CALL check_and_write(output%xalbnir, & - opid%xalbnir, 'xalbnir', REAL(veg%xalbnir, 4), & + IF (output%rpcoef) THEN + CALL check_and_write(opid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & + ranges%rpcoef, patchout%rpcoef, out_settings) + END IF + IF (output%shelrb) THEN + CALL check_and_write(opid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & + ranges%shelrb, patchout%shelrb, out_settings) + END IF + IF (output%xfang) THEN + CALL check_and_write(opid%xfang, & + 'xfang', REAL(veg%xfang, 4), ranges%xfang, patchout%xfang, out_settings) + END IF + IF (output%wai) THEN + CALL check_and_write(opid%wai, & + 'wai', REAL(veg%wai, 4), ranges%wai, patchout%wai, out_settings) + END IF + IF (output%vegcf) THEN + CALL check_and_write(opid%vegcf, & + 'vegcf', REAL(veg%vegcf, 4), ranges%vegcf, patchout%vegcf, out_settings) + END IF + IF (output%extkn) THEN + CALL check_and_write(opid%extkn, & + 'extkn', REAL(veg%extkn, 4), ranges%extkn, patchout%extkn, out_settings) + END IF + IF (output%tminvj) THEN + CALL check_and_write(opid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & + ranges%tminvj, patchout%tminvj, out_settings) + END IF + IF (output%tmaxvj) THEN + CALL check_and_write(opid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & + ranges%tmaxvj, patchout%tmaxvj, out_settings) + END IF + IF (output%vbeta) THEN + CALL check_and_write(opid%vbeta, & + 'vbeta', REAL(veg%vbeta, 4), ranges%vbeta, patchout%vbeta, out_settings) + END IF + IF (output%xalbnir) THEN + CALL check_and_write(opid%xalbnir, 'xalbnir', REAL(veg%xalbnir, 4), & ranges%xalbnir, patchout%xalbnir, out_settings) + END IF + IF (output%froot) THEN + out_settings%dimswitch = "soil" + CALL check_and_write(opid%froot, & + 'froot', REAL(veg%froot, 4), ranges%froot, patchout%froot, out_settings) + END IF - out_settings%dimswitch = "soil" - CALL check_and_write (output%froot, opid%froot, & - 'froot', REAL(veg%froot, 4), ranges%froot, patchout%froot, out_settings) - - !~ Rough - out_settings%dimswitch = "real" - CALL check_and_write(output%za, opid%za_uv, & - 'za_uv', REAL(rough%za_uv, 4), ranges%za, patchout%za, out_settings) - CALL check_and_write(output%za, opid%za_tq, & - 'za_tq', REAL(rough%za_tq, 4), ranges%za, patchout%za, out_settings) - !~ bgc - out_settings%dimswitch = "plantcarbon" - CALL check_and_write(output%ratecp, & - opid%ratecp, 'ratecp',SPREAD(REAL(bgc%ratecp,4),1,mp), ranges%ratecp, & - patchout%ratecp, out_settings)! no spatial dim at present - out_settings%dimswitch = "soilcarbon" - CALL check_and_write(output%ratecs, & - opid%ratecs, 'ratecs', SPREAD(REAL(bgc%ratecs, 4), 1, mp), ranges%ratecs, & - patchout%ratecs, out_settings)! no spatial dim at present - - !~ gwmodel - out_settings%dimswitch = "real" - CALL check_and_write(output%params .AND. cable_user%gw_model, opid%SatFracmax, & - 'SatFracmax', SPREAD(REAL(gw_params%MaxSatFraction,4),1,mp), & - ranges%gw_default, patchout%SatFracmax, out_settings) - - CALL check_and_write(output%params .AND. cable_user%gw_model, opid%Qhmax, & - 'Qhmax', SPREAD(REAL(gw_params%MaxHorzDrainRate, 4),1,mp), & - ranges%gw_default, patchout%Qhmax, out_settings) - - CALL check_and_write(output%params .AND. cable_user%gw_model, opid%QhmaxEfold, & - 'QhmaxEfold', SPREAD(REAL(gw_params%EfoldHorzDrainRate, 4),1,mp), & - ranges%gw_default, patchout%QhmaxEfold, out_settings) - - CALL check_and_write(output%params .AND. cable_user%gw_model, opid%HKefold, & - 'HKefold', SPREAD(REAL(gw_params%hkrz, 4),1,mp), & - ranges%gw_default, patchout%HKefold, out_settings) - - CALL check_and_write(output%params .AND. cable_user%gw_model, opid%HKdepth, & - 'HKdepth', SPREAD(REAL(gw_params%zdepth, 4),1,mp), & - ranges%gw_default, patchout%HKdepth, out_settings) + !~ Rough + out_settings%dimswitch = "real" + IF (output%za) THEN + CALL check_and_write(opid%za_uv, & + 'za_uv', REAL(rough%za_uv, 4), ranges%za, patchout%za, out_settings) + END IF + IF (output%za) THEN + CALL check_and_write(opid%za_tq, & + 'za_tq', REAL(rough%za_tq, 4), ranges%za, patchout%za, out_settings) + END IF + + !~ bgc + IF (output%ratecp) THEN + out_settings%dimswitch = "plantcarbon" + CALL check_and_write(opid%ratecp, 'ratecp',SPREAD(REAL(bgc%ratecp,4),1,mp), ranges%ratecp, & + patchout%ratecp, out_settings)! no spatial dim at present + END IF + IF (output%ratecs) THEN + out_settings%dimswitch = "soilcarbon" + CALL check_and_write(opid%ratecs, 'ratecs', SPREAD(REAL(bgc%ratecs, 4), 1, mp), ranges%ratecs, & + patchout%ratecs, out_settings)! no spatial dim at present + END IF + !~ gwmodel + out_settings%dimswitch = "real" + IF (output%params .AND. cable_user%gw_model) THEN + CALL check_and_write(opid%SatFracmax, & + 'SatFracmax', SPREAD(REAL(gw_params%MaxSatFraction,4),1,mp), & + ranges%gw_default, patchout%SatFracmax, out_settings) + + CALL check_and_write(opid%Qhmax, & + 'Qhmax', SPREAD(REAL(gw_params%MaxHorzDrainRate, 4),1,mp), & + ranges%gw_default, patchout%Qhmax, out_settings) + + CALL check_and_write(opid%QhmaxEfold, & + 'QhmaxEfold', SPREAD(REAL(gw_params%EfoldHorzDrainRate, 4),1,mp), & + ranges%gw_default, patchout%QhmaxEfold, out_settings) + + CALL check_and_write(opid%HKefold, & + 'HKefold', SPREAD(REAL(gw_params%hkrz, 4),1,mp), & + ranges%gw_default, patchout%HKefold, out_settings) + + CALL check_and_write(opid%HKdepth, & + 'HKdepth', SPREAD(REAL(gw_params%zdepth, 4),1,mp), & + ranges%gw_default, patchout%HKdepth, out_settings) + END IF END SUBROUTINE open_output_file @@ -1702,130 +1782,215 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss !-----------------------WRITE MET DATA------------------------------------- out_settings%dimswitch = 'default' - ! SWdown: downward short-wave radiation [W/m^2] - CALL generate_out_write_acc(output%SWdown, ovid%SWdown, 'SWdown', out%SWdown, REAL(met%fsd(:, 1) + met%fsd(:, 2)), ranges%SWdown, patchout%SWdown, out_settings) - ! LWdown: downward long-wave radiation [W/m^2] - CALL generate_out_write_acc(output%LWdown, ovid%LWdown, 'LWdown', out%LWdown, REAL(met%fld, 4), ranges%LWdown, patchout%LWdown, out_settings) - ! Rainf: rainfall [kg/m^2/s] - CALL generate_out_write_acc(output%Rainf, ovid%Rainf, 'Rainf', out%Rainf, REAL(met%precip/dels, 4), ranges%Rainf, patchout%Rainf, out_settings) - ! Snowf: snowfall [kg/m^2/s] - CALL generate_out_write_acc(output%Snowf, ovid%Snowf, 'Snowf', out%Snowf, REAL(met%precip_sn/dels, 4), ranges%Snowf, patchout%Snowf, out_settings) - ! PSurf: surface pressure [Pa] - CALL generate_out_write_acc(output%PSurf, ovid%PSurf, 'PSurf', out%PSurf, REAL(met%pmb, 4), ranges%PSurf, patchout%PSurf, out_settings) + IF (output%SWdown) THEN + ! SWdown: downward short-wave radiation [W/m^2] + CALL generate_out_write_acc(ovid%SWdown, 'SWdown', out%SWdown, REAL(met%fsd(:, 1) + met%fsd(:, 2)), ranges%SWdown, patchout%SWdown, out_settings) + END IF + IF (output%LWdown) THEN + ! LWdown: downward long-wave radiation [W/m^2] + CALL generate_out_write_acc(ovid%LWdown, 'LWdown', out%LWdown, REAL(met%fld, 4), ranges%LWdown, patchout%LWdown, out_settings) + END IF + IF (output%Rainf) THEN + ! Rainf: rainfall [kg/m^2/s] + CALL generate_out_write_acc(ovid%Rainf, 'Rainf', out%Rainf, REAL(met%precip/dels, 4), ranges%Rainf, patchout%Rainf, out_settings) + END IF + IF (output%Snowf) THEN + ! Snowf: snowfall [kg/m^2/s] + CALL generate_out_write_acc(ovid%Snowf, 'Snowf', out%Snowf, REAL(met%precip_sn/dels, 4), ranges%Snowf, patchout%Snowf, out_settings) + END IF + IF (output%PSurf) THEN + ! PSurf: surface pressure [Pa] + CALL generate_out_write_acc(ovid%PSurf, 'PSurf', out%PSurf, REAL(met%pmb, 4), ranges%PSurf, patchout%PSurf, out_settings) + END IF out_settings%dimswitch = 'ALMA' - ! Tair: surface air temperature [K] - CALL generate_out_write_acc(output%Tair, ovid%Tair, 'Tair', out%Tair, REAL(met%tk, 4), ranges%Tair, patchout%Tair, out_settings) - ! Qair: specific humidity [kg/kg] - CALL generate_out_write_acc(output%Qair, ovid%Qair, 'Qair', out%Qair, REAL(met%qv, 4), ranges%Qair, patchout%Qair, out_settings) - ! Wind: windspeed [m/s] - CALL generate_out_write_acc(output%Wind, ovid%Wind, 'Wind', out%Wind, REAL(met%ua, 4), ranges%Wind, patchout%Wind, out_settings) - ! CO2air: CO2 concentration [ppmv] - CALL generate_out_write_acc(output%CO2air, ovid%CO2air, 'CO2air', out%CO2air, REAL(met%ca*1000000.0, 4), ranges%CO2air, patchout%CO2air, out_settings) + IF (output%Tair) THEN + ! Tair: surface air temperature [K] + CALL generate_out_write_acc(ovid%Tair, 'Tair', out%Tair, REAL(met%tk, 4), ranges%Tair, patchout%Tair, out_settings) + END IF + IF (output%Qair) THEN + ! Qair: specific humidity [kg/kg] + CALL generate_out_write_acc(ovid%Qair, 'Qair', out%Qair, REAL(met%qv, 4), ranges%Qair, patchout%Qair, out_settings) + END IF + IF (output%Wind) THEN + ! Wind: windspeed [m/s] + CALL generate_out_write_acc(ovid%Wind, 'Wind', out%Wind, REAL(met%ua, 4), ranges%Wind, patchout%Wind, out_settings) + END IF + IF (output%CO2air) THEN + ! CO2air: CO2 concentration [ppmv] + CALL generate_out_write_acc(ovid%CO2air, 'CO2air', out%CO2air, REAL(met%ca*1000000.0, 4), ranges%CO2air, patchout%CO2air, out_settings) + END IF !-----------------------WRITE FLUX DATA------------------------------------- out_settings%dimswitch = 'default' ! Qmom: momentum flux [kg/m/s2] INH - CALL generate_out_write_acc(output%Qmom, ovid%Qmom, 'Qmom', out%Qmom, REAL(air%rho, 4)*(REAL(canopy%us, 4)**2.), ranges%Qmom, patchout%Qmom, out_settings) - ! Qle: latent heat flux [W/m^2] - CALL generate_out_write_acc(output%Qmom, ovid%Qle, 'Qle', out%Qle, REAL(canopy%fe, 4), ranges%Qle, patchout%Qle, out_settings) - ! Qh: sensible heat flux [W/m^2] - CALL generate_out_write_acc(output%Qh, ovid%Qh, 'Qh', out%Qh, REAL(canopy%fh, 4), ranges%Qh, patchout%Qh, out_settings) - ! Qg: ground heat flux [W/m^2] - CALL generate_out_write_acc(output%Qg, ovid%Qg, 'Qg', out%Qg, REAL(canopy%ga, 4), ranges%Qg, patchout%Qg, out_settings) - ! Qs: surface runoff [kg/m^2/s] - CALL generate_out_write_acc(output%Qs, ovid%Qs, 'Qs', out%Qs, REAL(ssnow%rnof1/dels, 4), ranges%Qs, patchout%Qs, out_settings) - ! Qsb: subsurface runoff [kg/m^2/s] - CALL generate_out_write_acc(output%Qsb, ovid%Qsb, 'Qsb', out%Qsb, REAL(ssnow%rnof2/dels, 4), ranges%Qsb, patchout%Qsb, out_settings) - ! Evap: total evapotranspiration [kg/m^2/s] - CALL generate_out_write_acc(output%Evap, ovid%Evap, 'Evap', out%Evap, REAL(canopy%fe/air%rlam, 4), ranges%Evap, patchout%Evap, out_settings) - ! PotEVap: potential evapotranspiration [kg/m^2/s] - CALL generate_out_write_acc(output%PotEvap, ovid%PotEvap, 'PotEvap', out%PotEvap, REAL(canopy%epot/dels, 4), ranges%PotEvap, patchout%PotEvap, out_settings) - ! ECanop: interception evaporation [kg/m^2/s] - CALL generate_out_write_acc(output%ECanop, ovid%ECanop, 'ECanop', out%ECanop, REAL(canopy%fevw/air%rlam, 4), ranges%ECanop, patchout%ECanop, out_settings) - ! TVeg: vegetation transpiration [kg/m^2/s] - CALL generate_out_write_acc(output%TVeg, ovid%TVeg, 'TVeg', out%TVeg, REAL(canopy%fevc/air%rlam, 4), ranges%TVeg, patchout%TVeg, out_settings) - - ! ESoil: bare soil evaporation [kg/m^2/s] - IF (cable_user%SOIL_STRUC == 'sli') THEN - temp_acc = ssnow%evap/dels !vh! - ELSE - temp_acc = canopy%fes/air%rlam + IF (output%Qmom) THEN + CALL generate_out_write_acc(ovid%Qmom, 'Qmom', out%Qmom, REAL(air%rho, 4)*(REAL(canopy%us, 4)**2.), ranges%Qmom, patchout%Qmom, out_settings) + END IF + IF (output%Qmom) THEN + ! Qle: latent heat flux [W/m^2] + CALL generate_out_write_acc(ovid%Qle, 'Qle', out%Qle, REAL(canopy%fe, 4), ranges%Qle, patchout%Qle, out_settings) + END IF + IF (output%Qh) THEN + ! Qh: sensible heat flux [W/m^2] + CALL generate_out_write_acc(ovid%Qh, 'Qh', out%Qh, REAL(canopy%fh, 4), ranges%Qh, patchout%Qh, out_settings) + END IF + IF (output%Qg) THEN + ! Qg: ground heat flux [W/m^2] + CALL generate_out_write_acc(ovid%Qg, 'Qg', out%Qg, REAL(canopy%ga, 4), ranges%Qg, patchout%Qg, out_settings) + END IF + IF (output%Qs) THEN + ! Qs: surface runoff [kg/m^2/s] + CALL generate_out_write_acc(ovid%Qs, 'Qs', out%Qs, REAL(ssnow%rnof1/dels, 4), ranges%Qs, patchout%Qs, out_settings) + END IF + IF (output%Qsb) THEN + ! Qsb: subsurface runoff [kg/m^2/s] + CALL generate_out_write_acc(ovid%Qsb, 'Qsb', out%Qsb, REAL(ssnow%rnof2/dels, 4), ranges%Qsb, patchout%Qsb, out_settings) + END IF + IF (output%Evap) THEN + ! Evap: total evapotranspiration [kg/m^2/s] + CALL generate_out_write_acc(ovid%Evap, 'Evap', out%Evap, REAL(canopy%fe/air%rlam, 4), ranges%Evap, patchout%Evap, out_settings) + END IF + IF (output%PotEvap) THEN + ! PotEVap: potential evapotranspiration [kg/m^2/s] + CALL generate_out_write_acc(ovid%PotEvap, 'PotEvap', out%PotEvap, REAL(canopy%epot/dels, 4), ranges%PotEvap, patchout%PotEvap, out_settings) + END IF + IF (output%ECanop) THEN + ! ECanop: interception evaporation [kg/m^2/s] + CALL generate_out_write_acc(ovid%ECanop, 'ECanop', out%ECanop, REAL(canopy%fevw/air%rlam, 4), ranges%ECanop, patchout%ECanop, out_settings) + END IF + IF (output%TVeg) THEN + ! TVeg: vegetation transpiration [kg/m^2/s] + CALL generate_out_write_acc(ovid%TVeg, 'TVeg', out%TVeg, REAL(canopy%fevc/air%rlam, 4), ranges%TVeg, patchout%TVeg, out_settings) END IF - CALL generate_out_write_acc(output%Esoil, ovid%Esoil, 'Esoil', out%Esoil, temp_acc, ranges%Esoil, patchout%Esoil, out_settings) - ! HVeg: sensible heat from vegetation [W/m^2] - CALL generate_out_write_acc(output%HVeg, ovid%HVeg, 'HVeg', out%HVeg, REAL(canopy%fhv, 4), ranges%HVeg, patchout%HVeg, out_settings) - ! HSoil: sensible heat from soil [W/m^2] - CALL generate_out_write_acc(output%HSoil, ovid%HSoil, 'HSoil', out%HSoil, REAL(canopy%fhs, 4), ranges%HSoil, patchout%HSoil, out_settings) - CALL generate_out_write_acc(output%RNetSoil, ovid%RNetSoil, 'RNetSoil', out%RNetSoil, REAL(canopy%fns, 4), ranges%HSoil, patchout%HSoil, out_settings) - ! NEE: net ecosystem exchange [umol/m^2/s] - CALL generate_out_write_acc(output%NEE, ovid%NEE, 'NEE', out%NEE, REAL(canopy%fnee/1.201E-5, 4), ranges%NEE, patchout%NEE, out_settings) + IF (output%Esoil) THEN + ! ESoil: bare soil evaporation [kg/m^2/s] + IF (cable_user%SOIL_STRUC == 'sli') THEN + temp_acc = ssnow%evap/dels !vh! + ELSE + temp_acc = canopy%fes/air%rlam + END IF + CALL generate_out_write_acc(ovid%Esoil, 'Esoil', out%Esoil, temp_acc, ranges%Esoil, patchout%Esoil, out_settings) + END IF + + IF (output%HVeg) THEN + ! HVeg: sensible heat from vegetation [W/m^2] + CALL generate_out_write_acc(ovid%HVeg, 'HVeg', out%HVeg, REAL(canopy%fhv, 4), ranges%HVeg, patchout%HVeg, out_settings) + END IF + IF (output%HSoil) THEN + ! HSoil: sensible heat from soil [W/m^2] + CALL generate_out_write_acc(ovid%HSoil, 'HSoil', out%HSoil, REAL(canopy%fhs, 4), ranges%HSoil, patchout%HSoil, out_settings) + END IF + IF (output%RNetSoil) THEN + CALL generate_out_write_acc(ovid%RNetSoil, 'RNetSoil', out%RNetSoil, REAL(canopy%fns, 4), ranges%HSoil, patchout%HSoil, out_settings) + END IF + IF (output%NEE) THEN + ! NEE: net ecosystem exchange [umol/m^2/s] + CALL generate_out_write_acc(ovid%NEE, 'NEE', out%NEE, REAL(canopy%fnee/1.201E-5, 4), ranges%NEE, patchout%NEE, out_settings) + END IF !-----------------------WRITE SOIL STATE DATA------------------------------- out_settings%dimswitch = 'soil' - ! SoilMoist: av.layer soil moisture [kg/m^2] - CALL generate_out_write_acc(output%SoilMoist, ovid%SoilMoist, 'SoilMoist', out%SoilMoist, REAL(ssnow%wb, 4), ranges%SoilMoist, patchout%SoilMoistIce, out_settings) - CALL generate_out_write_acc(output%SoilMoist, ovid%SoilMoistIce, 'SoilMoistIce', out%SoilMoistIce, REAL(ssnow%wbice, 4), ranges%SoilMoist, patchout%SoilMoistIce, out_settings) - ! SoilTemp: av.layer soil temperature [K] - CALL generate_out_write_acc(output%SoilTemp, ovid%SoilTemp, 'SoilTemp', out%SoilTemp, REAL(ssnow%tgg, 4), ranges%SoilTemp, patchout%SoilTemp, out_settings) + IF (output%SoilMoist) THEN + ! SoilMoist: av.layer soil moisture [kg/m^2] + CALL generate_out_write_acc(ovid%SoilMoist, 'SoilMoist', out%SoilMoist, REAL(ssnow%wb, 4), ranges%SoilMoist, patchout%SoilMoistIce, out_settings) + CALL generate_out_write_acc(ovid%SoilMoistIce, 'SoilMoistIce', out%SoilMoistIce, REAL(ssnow%wbice, 4), ranges%SoilMoist, patchout%SoilMoistIce, out_settings) + END IF + IF (output%SoilTemp) THEN + ! SoilTemp: av.layer soil temperature [K] + CALL generate_out_write_acc(ovid%SoilTemp, 'SoilTemp', out%SoilTemp, REAL(ssnow%tgg, 4), ranges%SoilTemp, patchout%SoilTemp, out_settings) + END IF out_settings%dimswitch = 'default' - ! BaresoilT: surface bare soil temp [K] - CALL generate_out_write_acc(output%BaresoilT, ovid%BaresoilT, 'BaresoilT', out%BaresoilT, REAL(ssnow%tgg(:, 1), 4), ranges%BaresoilT, patchout%BaresoilT, out_settings) + IF (output%BaresoilT) THEN + ! BaresoilT: surface bare soil temp [K] + CALL generate_out_write_acc(ovid%BaresoilT, 'BaresoilT', out%BaresoilT, REAL(ssnow%tgg(:, 1), 4), ranges%BaresoilT, patchout%BaresoilT, out_settings) + END IF !MD Write the hydrology output data from the groundwater module calculations - !water table depth - CALL generate_out_write_acc(output%WatTable .AND. cable_user%GW_MODEL, ovid%WatTable, 'WatTable', out%WatTable, REAL(ssnow%wtd/1000.0, 4), ranges%WatTable, patchout%WatTable, out_settings) - !aquifer water content - CALL generate_out_write_acc(output%GWMoist .AND. cable_user%GW_MODEL, ovid%GWMoist, 'GWMoist', out%GWMoist, REAL(ssnow%GWwb, 4), ranges%GWwb, patchout%GWMoist, out_settings) - !write(*,*) 'Qinfl' !MDeck - CALL generate_out_write_acc(output%SatFrac .AND. cable_user%GW_MODEL, ovid%SatFrac, 'SatFrac', out%SatFrac, REAL(ssnow%satfrac, 4), ranges%SatFrac, patchout%SatFrac, out_settings) + IF (cable_user%GW_MODEL) THEN + IF (output%WatTable) THEN + !water table depth + CALL generate_out_write_acc(ovid%WatTable, 'WatTable', out%WatTable, REAL(ssnow%wtd/1000.0, 4), ranges%WatTable, patchout%WatTable, out_settings) + END IF + IF (output%GWMoist) THEN + !aquifer water content + CALL generate_out_write_acc(ovid%GWMoist, 'GWMoist', out%GWMoist, REAL(ssnow%GWwb, 4), ranges%GWwb, patchout%GWMoist, out_settings) + END IF + IF (output%SatFrac) THEN + !write(*,*) 'Qinfl' !MDeck + CALL generate_out_write_acc(ovid%SatFrac, 'SatFrac', out%SatFrac, REAL(ssnow%satfrac, 4), ranges%SatFrac, patchout%SatFrac, out_settings) + END IF + END IF - ! recharge rate - CALL generate_out_write_acc(output%Qrecharge, ovid%Qrecharge, 'Qrecharge', out%Qrecharge, REAL(ssnow%Qrecharge, 4), ranges%Qrecharge, patchout%Qrecharge, out_settings) + IF (output%Qrecharge) THEN + ! recharge rate + CALL generate_out_write_acc(ovid%Qrecharge, 'Qrecharge', out%Qrecharge, REAL(ssnow%Qrecharge, 4), ranges%Qrecharge, patchout%Qrecharge, out_settings) + END IF !----------------------WRITE SNOW STATE DATA-------------------------------- - ! SWE: snow water equivalent [kg/m^2] - CALL generate_out_write_acc(output%SWE, ovid%SWE, 'SWE', out%SWE, REAL(ssnow%snowd, 4), ranges%SWE, patchout%SWE, out_settings) - CALL generate_out_write_acc(output%SWE, ovid%SnowMelt, 'SnowMelt', out%SnowMelt, REAL(ssnow%smelt/dels, 4), ranges%SnowMelt, patchout%SnowMelt, out_settings) + IF (output%SWE) THEN + ! SWE: snow water equivalent [kg/m^2] + CALL generate_out_write_acc(ovid%SWE, 'SWE', out%SWE, REAL(ssnow%snowd, 4), ranges%SWE, patchout%SWE, out_settings) + CALL generate_out_write_acc(ovid%SnowMelt, 'SnowMelt', out%SnowMelt, REAL(ssnow%smelt/dels, 4), ranges%SnowMelt, patchout%SnowMelt, out_settings) + END IF - ! SnowT: snow surface temp [K] - CALL generate_out_write_acc(output%SnowT, ovid%SnowT, 'SnowT', out%SnowT, REAL(ssnow%tggsn(:, 1), 4), ranges%SnowT, patchout%SnowT, out_settings) - ! SnowDepth: actual depth of snow in [m] - CALL generate_out_write_acc(output%SnowDepth, ovid%SnowDepth, 'SnowDepth', out%SnowDepth, REAL(SUM(ssnow%sdepth, 2), 4), ranges%SnowDepth, patchout%SnowDepth, out_settings) + IF (output%SnowT) THEN + ! SnowT: snow surface temp [K] + CALL generate_out_write_acc(ovid%SnowT, 'SnowT', out%SnowT, REAL(ssnow%tggsn(:, 1), 4), ranges%SnowT, patchout%SnowT, out_settings) + END IF + IF (output%SnowDepth) THEN + ! SnowDepth: actual depth of snow in [m] + CALL generate_out_write_acc(ovid%SnowDepth, 'SnowDepth', out%SnowDepth, REAL(SUM(ssnow%sdepth, 2), 4), ranges%SnowDepth, patchout%SnowDepth, out_settings) + END IF !-------------------------WRITE RADIATION DATA------------------------------ - ! SWnet: net shortwave [W/m^2] - temp_acc = SUM(rad%qcan(:, :, 1), 2) + SUM(rad%qcan(:, :, 2), 2) + rad%qssabs - CALL generate_out_write_acc(output%Swnet, ovid%Swnet, 'Swnet', out%Swnet, temp_acc, ranges%Swnet, patchout%Swnet, out_settings) - ! LWnet: net longwave [W/m^2] - temp_acc = met%fld - sboltz*emleaf*canopy%tv**4*(1 - rad%transd) - & - rad%flws*rad%transd - CALL generate_out_write_acc(output%Lwnet, ovid%Lwnet, 'Lwnet', out%Lwnet, temp_acc, ranges%Lwnet, patchout%Lwnet, out_settings) - ! Rnet: net absorbed radiation [W/m^2] - temp_acc = met%fld - sboltz*emleaf*canopy%tv**4* & - (1 - rad%transd) - rad%flws*rad%transd + & - SUM(rad%qcan(:, :, 1), 2) + & - SUM(rad%qcan(:, :, 2), 2) + rad%qssabs - CALL generate_out_write_acc(output%Rnet, ovid%Rnet, 'Rnet', out%Rnet, temp_acc, ranges%Rnet, patchout%Rnet, out_settings) - - ! Albedo: - CALL generate_out_write_acc(output%Albedo, ovid%Albedo, 'Albedo', out%Albedo, REAL((rad%albedo(:, 1) + rad%albedo(:, 2)) & + IF (output%Swnet) THEN + ! SWnet: net shortwave [W/m^2] + temp_acc = SUM(rad%qcan(:, :, 1), 2) + SUM(rad%qcan(:, :, 2), 2) + rad%qssabs + CALL generate_out_write_acc(ovid%Swnet, 'Swnet', out%Swnet, temp_acc, ranges%Swnet, patchout%Swnet, out_settings) + END IF + IF (output%Lwnet) THEN + ! LWnet: net longwave [W/m^2] + temp_acc = met%fld - sboltz*emleaf*canopy%tv**4*(1 - rad%transd) - & + rad%flws*rad%transd + CALL generate_out_write_acc(ovid%Lwnet, 'Lwnet', out%Lwnet, temp_acc, ranges%Lwnet, patchout%Lwnet, out_settings) + END IF + IF (output%Rnet) THEN + ! Rnet: net absorbed radiation [W/m^2] + temp_acc = met%fld - sboltz*emleaf*canopy%tv**4* & + (1 - rad%transd) - rad%flws*rad%transd + & + SUM(rad%qcan(:, :, 1), 2) + & + SUM(rad%qcan(:, :, 2), 2) + rad%qssabs + CALL generate_out_write_acc(ovid%Rnet, 'Rnet', out%Rnet, temp_acc, ranges%Rnet, patchout%Rnet, out_settings) + END IF + + IF (output%Albedo) THEN + ! Albedo: + CALL generate_out_write_acc(ovid%Albedo, 'Albedo', out%Albedo, REAL((rad%albedo(:, 1) + rad%albedo(:, 2)) & *0.5, 4), ranges%Albedo, patchout%Albedo, out_settings) - CALL generate_out_write_acc(output%Albedo .AND. calcsoilalbedo, ovid%visAlbedo, 'visAlbedo', out%visAlbedo, REAL(rad%albedo(:, 1), 4), ranges%visAlbedo, patchout%visAlbedo, out_settings) - CALL generate_out_write_acc(output%Albedo .AND. calcsoilalbedo, ovid%nirAlbedo, 'nirAlbedo', out%nirAlbedo, REAL(rad%albedo(:, 2), 4), ranges%nirAlbedo, patchout%nirAlbedo, out_settings) + IF (calcsoilalbedo) THEN + CALL generate_out_write_acc(ovid%visAlbedo, 'visAlbedo', out%visAlbedo, REAL(rad%albedo(:, 1), 4), ranges%visAlbedo, patchout%visAlbedo, out_settings) + CALL generate_out_write_acc(ovid%nirAlbedo, 'nirAlbedo', out%nirAlbedo, REAL(rad%albedo(:, 2), 4), ranges%nirAlbedo, patchout%nirAlbedo, out_settings) + END IF + END IF + ! RadT: Radiative surface temperature [K] - temp_acc = (((1.0 - rad%transd)*emleaf*sboltz* & - canopy%tv**4 + rad%transd*emsoil*sboltz*(ssnow%tss)**4)/sboltz)**0.25 - CALL generate_out_write_acc(output%RadT, ovid%RadT, 'RadT', out%RadT, temp_acc, ranges%RadT, patchout%RadT, out_settings) + IF (output%RadT) THEN + temp_acc = (((1.0 - rad%transd)*emleaf*sboltz* & + canopy%tv**4 + rad%transd*emsoil*sboltz*(ssnow%tss)**4)/sboltz)**0.25 + CALL generate_out_write_acc(ovid%RadT, 'RadT', out%RadT, temp_acc, ranges%RadT, patchout%RadT, out_settings) + END IF !------------------------WRITE VEGETATION DATA------------------------------ out_settings%dimswitch = 'ALMA' - ! Tscrn: screen level air temperature [oC] - CALL generate_out_write_acc(output%Tscrn, ovid%Tscrn, 'Tscrn', out%Tscrn, REAL(canopy%tscrn, 4), ranges%Tscrn, patchout%Tscrn, out_settings) + IF (output%Tscrn) THEN + ! Tscrn: screen level air temperature [oC] + CALL generate_out_write_acc(ovid%Tscrn, 'Tscrn', out%Tscrn, REAL(canopy%tscrn, 4), ranges%Tscrn, patchout%Tscrn, out_settings) + END IF !INH - extremes in screen level air temperature [oC] IF (output%Tex) THEN @@ -1836,9 +2001,9 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss out%Tnn(iy) = MIN(out%Tnn(iy), REAL(canopy%tscrn(iy), 4)) END DO IF (out_settings%writenow) THEN - CALL check_and_write(.TRUE., ovid%Txx, 'Txx', & + CALL check_and_write(ovid%Txx, 'Txx', & out%Txx, out%Txx, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(.TRUE., ovid%Tnn, 'Tnn', & + CALL check_and_write(ovid%Tnn, 'Tnn', & out%Tnn, out%Tnn, ranges%Tscrn, patchout%Tex, out_settings) !Reset temporary output variables: out%Txx = -1.0E6 @@ -1866,13 +2031,13 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss out%Tmx = REAL(86400, 4)*out%Tmx/REAL(output%interval*INT(dels), 4) out%Tmn = REAL(86400, 4)*out%Tmn/REAL(output%interval*INT(dels), 4) !write to file - CALL check_and_write(.TRUE., ovid%Txx, 'Txx', & + CALL check_and_write(ovid%Txx, 'Txx', & out%Txx, out%Txx, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(.TRUE., ovid%Tnn, 'Tnn', & + CALL check_and_write(ovid%Tnn, 'Tnn', & out%Tnn, out%Tnn, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(.TRUE., ovid%Tmx, 'Tmx', & + CALL check_and_write(ovid%Tmx, 'Tmx', & out%Tmx, out%Tmx, ranges%Tscrn, patchout%Tex, out_settings) - CALL check_and_write(.TRUE., ovid%Tmn, 'Tmn', & + CALL check_and_write(ovid%Tmn, 'Tmn', & out%Tmn, out%Tmn, ranges%Tscrn, patchout%Tex, out_settings) !Reset temporary output variables: out%Txx = -1.0E6 @@ -1882,32 +2047,51 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss END IF END IF END IF - ! Qscrn: screen level specific humdity [kg/kg] - CALL generate_out_write_acc(output%Qscrn, ovid%qscrn, 'Qscrn', out%qscrn, REAL(canopy%qscrn, 4), ranges%Qscrn, patchout%Qscrn, out_settings) + + IF (output%Qscrn) THEN + ! Qscrn: screen level specific humdity [kg/kg] + CALL generate_out_write_acc(ovid%qscrn, 'Qscrn', out%qscrn, REAL(canopy%qscrn, 4), ranges%Qscrn, patchout%Qscrn, out_settings) + END IF out_settings%dimswitch = 'default' - ! VegT: vegetation temperature [K] - CALL generate_out_write_acc(output%VegT, ovid%VegT, 'VegT', out%VegT, REAL(canopy%tv, 4), ranges%VegT, patchout%VegT, out_settings) - ! CanT: within-canopy temperature [K] - CALL generate_out_write_acc(output%CanT, ovid%CanT, 'CanT', out%CanT, REAL(met%tvair, 4), ranges%CanT, patchout%CanT, out_settings) - ! Fwsoil - CALL generate_out_write_acc(output%Fwsoil, ovid%Fwsoil, 'Fwsoil', out%Fwsoil, REAL(canopy%fwsoil, 4), ranges%Fwsoil, patchout%Fwsoil, out_settings) - ! CanopInt: total canopy water storage [kg/m^2] - CALL generate_out_write_acc(output%CanopInt, ovid%CanopInt, 'CanopInt', out%CanopInt, REAL(canopy%cansto, 4), ranges%CanopInt, patchout%CanopInt, out_settings) - ! LAI: - CALL generate_out_write_acc(output%LAI, ovid%LAI, 'LAI', out%LAI, REAL(veg%vlai, 4), ranges%LAI, patchout%LAI, out_settings) + IF (output%VegT) THEN + ! VegT: vegetation temperature [K] + CALL generate_out_write_acc(ovid%VegT, 'VegT', out%VegT, REAL(canopy%tv, 4), ranges%VegT, patchout%VegT, out_settings) + END IF + IF (output%CanT) THEN + ! CanT: within-canopy temperature [K] + CALL generate_out_write_acc(ovid%CanT, 'CanT', out%CanT, REAL(met%tvair, 4), ranges%CanT, patchout%CanT, out_settings) + END IF + IF (output%Fwsoil) THEN + ! Fwsoil + CALL generate_out_write_acc(ovid%Fwsoil, 'Fwsoil', out%Fwsoil, REAL(canopy%fwsoil, 4), ranges%Fwsoil, patchout%Fwsoil, out_settings) + END IF + IF (output%CanopInt) THEN + ! CanopInt: total canopy water storage [kg/m^2] + CALL generate_out_write_acc(ovid%CanopInt, 'CanopInt', out%CanopInt, REAL(canopy%cansto, 4), ranges%CanopInt, patchout%CanopInt, out_settings) + END IF + IF (output%LAI) THEN + ! LAI: + CALL generate_out_write_acc(ovid%LAI, 'LAI', out%LAI, REAL(veg%vlai, 4), ranges%LAI, patchout%LAI, out_settings) + END IF !------------------------WRITE BALANCES DATA-------------------------------- - ! Ebal: cumulative energy balance [W/m^2] - CALL generate_out_write_acc(output%Ebal, ovid%Ebal, 'Ebal', out%Ebal, REAL(bal%ebal_tot, 4), ranges%Ebal, patchout%Ebal, out_settings) - ! Wbal: cumulative water balance [kg/m^2/s] - CALL generate_out_write_acc(output%Wbal, ovid%Wbal, 'Wbal', out%Wbal, REAL(bal%wbal_tot, 4), ranges%Wbal, patchout%Wbal, out_settings) + IF (output%Ebal) THEN + ! Ebal: cumulative energy balance [W/m^2] + CALL generate_out_write_acc(ovid%Ebal, 'Ebal', out%Ebal, REAL(bal%ebal_tot, 4), ranges%Ebal, patchout%Ebal, out_settings) + END IF + IF (output%Wbal) THEN + ! Wbal: cumulative water balance [kg/m^2/s] + CALL generate_out_write_acc(ovid%Wbal, 'Wbal', out%Wbal, REAL(bal%wbal_tot, 4), ranges%Wbal, patchout%Wbal, out_settings) + END IF !------------------------WRITE CARBON DATA---------------------------------- ! GPP: gross primary production C by veg [umol/m^2/s] ! added frday in the calculation of GPP (BP may08) ! temp_acc = REAL((-1.0 * canopy%fpn) / 1.201E-5, 4) - CALL generate_out_write_acc(output%GPP, ovid%GPP, 'GPP', out%GPP, REAL((-1.0*canopy%fpn + canopy%frday) & - /1.201E-5, 4), ranges%GPP, patchout%GPP, out_settings) + IF (output%GPP) THEN + CALL generate_out_write_acc(ovid%GPP, 'GPP', out%GPP, REAL((-1.0*canopy%fpn + canopy%frday) & + /1.201E-5, 4), ranges%GPP, patchout%GPP, out_settings) + END IF ! NPP: net primary production of C by veg [umol/m^2/s] IF (output%NPP) THEN @@ -1923,8 +2107,8 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss ELSE temp_acc = (-1.0*canopy%fpn - canopy%frp)/1.201E-5 ! & END IF + CALL generate_out_write_acc(ovid%NPP, 'NPP', out%NPP, temp_acc, ranges%NPP, patchout%NPP, out_settings) END IF - CALL generate_out_write_acc(output%NPP, ovid%NPP, 'NPP', out%NPP, temp_acc, ranges%NPP, patchout%NPP, out_settings) ! AutoResp: autotrophic respiration [umol/m^2/s] IF (output%AutoResp) THEN @@ -1943,134 +2127,115 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss ELSE temp_acc = (canopy%frp + canopy%frday)/1.201E-5 END IF + CALL generate_out_write_acc(ovid%AutoResp, 'AutoResp', out%AutoResp, temp_acc, ranges%AutoResp, patchout%AutoResp, out_settings) + IF (output%casa) THEN + ! rootresp alt: REAL(0.3*casaflux%crmplant(:,2)/86400.0/ 1.201E-5, 4) + CALL generate_out_write_acc(ovid%RootResp, 'RootResp', out%RootResp, & + REAL(casaflux%crmplant(:, 3)/86400.0/1.201E-5, 4), ranges%AutoResp, patchout%AutoResp, out_settings) + CALL generate_out_write_acc(ovid%StemResp, 'StemResp', out%StemResp, & + REAL(casaflux%crmplant(:, 2)/86400.0/1.201E-5, 4), ranges%AutoResp, patchout%AutoResp, out_settings) + END IF END IF - CALL generate_out_write_acc(output%AutoResp, ovid%AutoResp, 'AutoResp', out%AutoResp, temp_acc, ranges%AutoResp, patchout%AutoResp, out_settings) - ! rootresp alt: REAL(0.3*casaflux%crmplant(:,2)/86400.0/ 1.201E-5, 4) - CALL generate_out_write_acc(output%AutoResp .AND. output%casa, ovid%RootResp, 'RootResp', out%RootResp, & - REAL(casaflux%crmplant(:, 3)/86400.0/1.201E-5, 4), ranges%AutoResp, patchout%AutoResp, out_settings) - CALL generate_out_write_acc(output%AutoResp .AND. output%casa, ovid%StemResp, 'StemResp', out%StemResp, & - REAL(casaflux%crmplant(:, 2)/86400.0/1.201E-5, 4), ranges%AutoResp, patchout%AutoResp, out_settings) - ! LeafResp: Leaf respiration [umol/m^2/s] - CALL generate_out_write_acc(output%LeafResp, ovid%LeafResp, 'LeafResp', out%LeafResp, REAL(canopy%frday/1.201E-5, 4), ranges%LeafResp, patchout%LeafResp, out_settings) - ! HeteroResp: heterotrophic respiration [umol/m^2/s] - CALL generate_out_write_acc(output%HeteroResp, ovid%HeteroResp, 'HeteroResp', out%HeteroResp, REAL(canopy%frs/1.201E-5, 4), ranges%HeteroResp, patchout%HeteroResp, out_settings) + IF (output%LeafResp) THEN + ! LeafResp: Leaf respiration [umol/m^2/s] + CALL generate_out_write_acc(ovid%LeafResp, 'LeafResp', out%LeafResp, REAL(canopy%frday/1.201E-5, 4), ranges%LeafResp, patchout%LeafResp, out_settings) + END IF + IF (output%HeteroResp) THEN + ! HeteroResp: heterotrophic respiration [umol/m^2/s] + CALL generate_out_write_acc(ovid%HeteroResp, 'HeteroResp', out%HeteroResp, REAL(canopy%frs/1.201E-5, 4), ranges%HeteroResp, patchout%HeteroResp, out_settings) + END IF ! output patch area IF (output%casa) THEN out%Area = casamet%areacell/1e6 ! km2 - END IF - CALL check_and_write(output%casa, ovid%Area, 'Area', out%Area, out%Area, ranges%Area, patchout%Area, out_settings) - CALL check_and_write(output%casa .AND. cable_user%POPLUC, ovid%patchfrac, 'patchfrac', REAL(patch(:)%frac, 4), REAL(patch(:)%frac, 4), ranges%Area, patchout%Area, out_settings) - CALL check_and_write(output%casa .AND. cable_user%CALL_POP, ovid%hc, 'hc', REAL(veg%hc, 4), REAL(veg%hc, 4), ranges%hc, patchout%hc, out_settings) - ! NBP and turnover fluxes [umol/m^2/s] - IF (output%NBP .AND. output%casa) THEN + CALL check_and_write(ovid%Area, 'Area', out%Area, out%Area, ranges%Area, patchout%Area, out_settings) IF (cable_user%POPLUC) THEN - temp_acc = -(casaflux%Crsoil - casaflux%cnpp & - - casapool%dClabiledt)/86400.0 & - /1.201E-5 !- & - !REAL((casaflux%FluxCtohwp + casaflux%FluxCtoclear )/86400.0 & - !/ 1.201E-5, 4) - ELSE - temp_acc = -(casaflux%Crsoil - casaflux%cnpp & - - casapool%dClabiledt)/86400.0 & - /1.201E-5 + CALL check_and_write(ovid%patchfrac, 'patchfrac', REAL(patch(:)%frac, 4), REAL(patch(:)%frac, 4), ranges%Area, patchout%Area, out_settings) END IF - END IF - CALL generate_out_write_acc(output%NBP .AND. output%casa, ovid%NBP, 'NBP', out%NBP, temp_acc, ranges%NEE, patchout%NBP, out_settings) - - !------------------------WRITE REMAINING CASA DATA---------------------------------- - CALL generate_out_write_acc(output%casa, ovid%dCdt, 'dCdt', out%dCdt, & - REAL((casapool%ctot - casapool%ctot_0)/86400.0/1.201E-5, 4), ranges%NEE, patchout%dCdt, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantTurnover, 'PlantTurnover', out%PlantTurnover, & - REAL((SUM(casaflux%Cplant_turnover, 2))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnover, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantTurnoverLeaf, 'PlantTurnoverLeaf', out%PlantTurnoverLeaf, & - REAL((casaflux%Cplant_turnover(:, 1))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverLeaf, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantTurnoverFineRoot, 'PlantTurnoverFineRoot', out%PlantTurnoverFineRoot, & - REAL((casaflux%Cplant_turnover(:, 3))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverFineRoot, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantTurnoverWood, 'PlantTurnoverWood', out%PlantTurnoverWood, & - REAL((casaflux%Cplant_turnover(:, 2))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWood, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantTurnoverWoodDist, 'PlantTurnoverWoodDist', out%PlantTurnoverWoodDist, & - REAL(casaflux%Cplant_turnover_disturbance/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWoodDist, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantTurnoverWoodCrowding, 'PlantTurnoverWoodCrowding', out%PlantTurnoverWoodCrowding, & - REAL(casaflux%Cplant_turnover_crowding/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWoodCrowding, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantTurnoverWoodResourceLim, 'PlantTurnoverWoodResourceLim', out%PlantTurnoverWoodResourceLim, & - REAL((casaflux%Cplant_turnover_resource_limitation)/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWoodResourceLim, out_settings) - CALL generate_out_write_acc(output%casa .AND. cable_user%POPLUC, ovid%LandUseFlux, 'LandUseFlux', out%LandUseFlux, & - REAL((casaflux%FluxCtohwp + casaflux%FluxCtoclear)/86400.0/1.201E-5, 4), ranges%NEE, patchout%LandUseFlux, out_settings) - - ! plant carbon [kg C m-2] - CALL generate_out_write_acc(output%casa, ovid%TotSoilCarb, 'TotSoilCarb', out%TotSoilCarb, REAL((SUM(casapool%csoil, 2) + SUM(casapool%clitter, 2)) & - /1000.0, 4), ranges%TotSoilCarb, patchout%TotSoilCarb, out_settings) - CALL generate_out_write_acc(output%casa, ovid%TotLittCarb, 'TotLittCarb', out%TotLittCarb, REAL(SUM(casapool%clitter, 2)/1000.0, 4) & - , ranges%TotLittCarb, patchout%TotLittCarb, out_settings) - - ! csoil - CALL generate_out_write_acc(output%casa, ovid%SoilCarbFast, 'SoilCarbFast', out%SoilCarbFast, REAL(casapool%csoil(:, 1)/1000.0, 4) & - , ranges%TotLittCarb, patchout%SoilCarbFast, out_settings) - CALL generate_out_write_acc(output%casa, ovid%SoilCarbSlow, 'SoilCarbSlow', out%SoilCarbSlow, REAL(casapool%csoil(:, 2)/1000.0, 4) & - , ranges%TotSoilCarb, patchout%SoilCarbSlow, out_settings) - CALL generate_out_write_acc(output%casa, ovid%SoilCarbPassive, 'SoilCarbPassive', out%SoilCarbPassive, REAL(casapool%csoil(:, 3)/1000.0, 4) & - , ranges%TotSoilCarb, patchout%SoilCarbPassive, out_settings) - - ! clitter - CALL generate_out_write_acc(output%casa, ovid%LittCarbMetabolic, 'LittCarbMetabolic', out%LittCarbMetabolic, REAL(casapool%clitter(:, 1)/1000.0, 4) & - , ranges%TotLittCarb, patchout%LittCarbMetabolic, out_settings) - CALL generate_out_write_acc(output%casa, ovid%LittCarbStructural, 'LittCarbStructural', out%LittCarbStructural, REAL(casapool%clitter(:, 2)/1000.0, 4) & - , ranges%TotLittCarb, patchout%LittCarbStructural, out_settings) - CALL generate_out_write_acc(output%casa, ovid%LittCarbCWD, 'LittCarbCWD', out%LittCarbCWD, REAL(casapool%clitter(:, 3)/1000.0, 4) & - , ranges%TotLittCarb, patchout%LittCarbCWD, out_settings) - - ! cplant - CALL generate_out_write_acc(output%casa, ovid%PlantCarbLeaf, 'PlantCarbLeaf', out%PlantCarbLeaf, REAL(casapool%cplant(:, 1)/1000.0, 4) & - , ranges%TotLittCarb, patchout%PlantCarbLeaf, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantCarbWood, 'PlantCarbWood', out%PlantCarbWood, REAL(casapool%cplant(:, 2)/1000.0, 4) & - , ranges%TotLittCarb, patchout%PlantCarbWood, out_settings) - CALL generate_out_write_acc(output%casa, ovid%PlantCarbFineRoot, 'PlantCarbFineRoot', out%PlantCarbFineRoot, REAL(casapool%cplant(:, 3)/1000.0, 4) & - , ranges%TotLittCarb, patchout%PlantCarbFineRoot, out_settings) - - CALL generate_out_write_acc(output%casa, ovid%TotLivBiomass, 'TotLivBiomass', out%TotLivBiomass, REAL((SUM(casapool%cplant, 2)) & - /1000.0, 4), ranges%TotLivBiomass, patchout%TotLivBiomass, out_settings) - - IF (cable_user%sync_nc_file) & - ok = NF90_SYNC(ncid_out) - - END SUBROUTINE write_output - - PURE ELEMENTAL REAL(4) FUNCTION acc_out_var(output_var, out_var, acc_val, writenow) RESULT(res) - LOGICAL, INTENT(IN) :: output_var ! Whether to write the current variable - REAL(4), INTENT(IN) :: out_var - REAL(4), INTENT(IN) :: acc_val - LOGICAL, INTENT(IN) :: writenow - - IF (output_var) THEN - ! Accumulate out_var until interval timesteps - res = out_var + acc_val - IF (writenow) THEN - res = res/REAL(output%interval, 4) + IF (cable_user%CALL_POP) THEN + CALL check_and_write(ovid%hc, 'hc', REAL(veg%hc, 4), REAL(veg%hc, 4), ranges%hc, patchout%hc, out_settings) END IF - ELSE - res = out_var - END IF - END FUNCTION acc_out_var - PURE ELEMENTAL REAL(4) FUNCTION reset_on_write(output_var, out_var, writenow) RESULT(res) - LOGICAL, INTENT(IN) :: output_var ! Whether to write the current variable - REAL(4), INTENT(IN) :: out_var - LOGICAL, INTENT(IN) :: writenow + ! NBP and turnover fluxes [umol/m^2/s] + IF (output%NBP) THEN + IF (cable_user%POPLUC) THEN + temp_acc = -(casaflux%Crsoil - casaflux%cnpp & + - casapool%dClabiledt)/86400.0 & + /1.201E-5 !- & + !REAL((casaflux%FluxCtohwp + casaflux%FluxCtoclear )/86400.0 & + !/ 1.201E-5, 4) + ELSE + temp_acc = -(casaflux%Crsoil - casaflux%cnpp & + - casapool%dClabiledt)/86400.0 & + /1.201E-5 + END IF + CALL generate_out_write_acc(ovid%NBP, 'NBP', out%NBP, temp_acc, ranges%NEE, patchout%NBP, out_settings) + END IF - res = out_var + !------------------------WRITE REMAINING CASA DATA---------------------------------- + CALL generate_out_write_acc(ovid%dCdt, 'dCdt', out%dCdt, & + REAL((casapool%ctot - casapool%ctot_0)/86400.0/1.201E-5, 4), ranges%NEE, patchout%dCdt, out_settings) + CALL generate_out_write_acc(ovid%PlantTurnover, 'PlantTurnover', out%PlantTurnover, & + REAL((SUM(casaflux%Cplant_turnover, 2))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnover, out_settings) + CALL generate_out_write_acc(ovid%PlantTurnoverLeaf, 'PlantTurnoverLeaf', out%PlantTurnoverLeaf, & + REAL((casaflux%Cplant_turnover(:, 1))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverLeaf, out_settings) + CALL generate_out_write_acc(ovid%PlantTurnoverFineRoot, 'PlantTurnoverFineRoot', out%PlantTurnoverFineRoot, & + REAL((casaflux%Cplant_turnover(:, 3))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverFineRoot, out_settings) + CALL generate_out_write_acc(ovid%PlantTurnoverWood, 'PlantTurnoverWood', out%PlantTurnoverWood, & + REAL((casaflux%Cplant_turnover(:, 2))/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWood, out_settings) + CALL generate_out_write_acc(ovid%PlantTurnoverWoodDist, 'PlantTurnoverWoodDist', out%PlantTurnoverWoodDist, & + REAL(casaflux%Cplant_turnover_disturbance/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWoodDist, out_settings) + CALL generate_out_write_acc(ovid%PlantTurnoverWoodCrowding, 'PlantTurnoverWoodCrowding', out%PlantTurnoverWoodCrowding, & + REAL(casaflux%Cplant_turnover_crowding/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWoodCrowding, out_settings) + CALL generate_out_write_acc(ovid%PlantTurnoverWoodResourceLim, 'PlantTurnoverWoodResourceLim', out%PlantTurnoverWoodResourceLim, & + REAL((casaflux%Cplant_turnover_resource_limitation)/86400.0/1.201E-5, 4), ranges%NEE, patchout%PlantTurnoverWoodResourceLim, out_settings) + IF (cable_user%POPLUC) THEN + CALL generate_out_write_acc(ovid%LandUseFlux, 'LandUseFlux', out%LandUseFlux, & + REAL((casaflux%FluxCtohwp + casaflux%FluxCtoclear)/86400.0/1.201E-5, 4), ranges%NEE, patchout%LandUseFlux, out_settings) + END IF - ! Reset the value if it has been written to file - IF (output_var .AND. writenow) THEN - res = 0.0 + ! plant carbon [kg C m-2] + CALL generate_out_write_acc(ovid%TotSoilCarb, 'TotSoilCarb', out%TotSoilCarb, REAL((SUM(casapool%csoil, 2) + SUM(casapool%clitter, 2)) & + /1000.0, 4), ranges%TotSoilCarb, patchout%TotSoilCarb, out_settings) + CALL generate_out_write_acc(ovid%TotLittCarb, 'TotLittCarb', out%TotLittCarb, REAL(SUM(casapool%clitter, 2)/1000.0, 4), & + ranges%TotLittCarb, patchout%TotLittCarb, out_settings) + + ! csoil + CALL generate_out_write_acc(ovid%SoilCarbFast, 'SoilCarbFast', out%SoilCarbFast, REAL(casapool%csoil(:, 1)/1000.0, 4), & + ranges%TotLittCarb, patchout%SoilCarbFast, out_settings) + CALL generate_out_write_acc(ovid%SoilCarbSlow, 'SoilCarbSlow', out%SoilCarbSlow, REAL(casapool%csoil(:, 2)/1000.0, 4), & + ranges%TotSoilCarb, patchout%SoilCarbSlow, out_settings) + CALL generate_out_write_acc(ovid%SoilCarbPassive, 'SoilCarbPassive', out%SoilCarbPassive, REAL(casapool%csoil(:, 3)/1000.0, 4), & + ranges%TotSoilCarb, patchout%SoilCarbPassive, out_settings) + + ! clitter + CALL generate_out_write_acc(ovid%LittCarbMetabolic, 'LittCarbMetabolic', out%LittCarbMetabolic, REAL(casapool%clitter(:, 1)/1000.0, 4), & + ranges%TotLittCarb, patchout%LittCarbMetabolic, out_settings) + CALL generate_out_write_acc(ovid%LittCarbStructural, 'LittCarbStructural', out%LittCarbStructural, REAL(casapool%clitter(:, 2)/1000.0, 4), & + ranges%TotLittCarb, patchout%LittCarbStructural, out_settings) + CALL generate_out_write_acc(ovid%LittCarbCWD, 'LittCarbCWD', out%LittCarbCWD, REAL(casapool%clitter(:, 3)/1000.0, 4), & + ranges%TotLittCarb, patchout%LittCarbCWD, out_settings) + + ! cplant + CALL generate_out_write_acc(ovid%PlantCarbLeaf, 'PlantCarbLeaf', out%PlantCarbLeaf, REAL(casapool%cplant(:, 1)/1000.0, 4), & + ranges%TotLittCarb, patchout%PlantCarbLeaf, out_settings) + CALL generate_out_write_acc(ovid%PlantCarbWood, 'PlantCarbWood', out%PlantCarbWood, REAL(casapool%cplant(:, 2)/1000.0, 4), & + ranges%TotLittCarb, patchout%PlantCarbWood, out_settings) + CALL generate_out_write_acc(ovid%PlantCarbFineRoot, 'PlantCarbFineRoot', out%PlantCarbFineRoot, REAL(casapool%cplant(:, 3)/1000.0, 4), & + ranges%TotLittCarb, patchout%PlantCarbFineRoot, out_settings) + + CALL generate_out_write_acc(ovid%TotLivBiomass, 'TotLivBiomass', out%TotLivBiomass, REAL((SUM(casapool%cplant, 2)) & + /1000.0, 4), ranges%TotLivBiomass, patchout%TotLivBiomass, out_settings) END IF - END FUNCTION reset_on_write + IF (cable_user%sync_nc_file) & + ok = NF90_SYNC(ncid_out) + + END SUBROUTINE write_output - SUBROUTINE check_and_write_d1(output_var, varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - LOGICAL, INTENT(IN) :: output_var ! Whether to write the current variable + SUBROUTINE check_and_write_d1(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) INTEGER, INTENT(IN) :: varID ! variable's netcdf ID CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable REAL(4), INTENT(IN) :: out_var(:) @@ -2083,15 +2248,14 @@ SUBROUTINE check_and_write_d1(output_var, varID, vname, out_var, acc_val, vrange CALL check_range(vname, acc_val, vrange, out_timestep, out_settings%met) END IF - IF (output_var .AND. out_settings%writenow) THEN + IF (out_settings%writenow) THEN ! Write value to file: CALL write_ovar(out_timestep, ncid_out, varID, vname, & out_var, writepatch, out_settings%dimswitch, out_settings%met) END IF END SUBROUTINE check_and_write_d1 - SUBROUTINE check_and_write_d2(output_var, varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - LOGICAL, INTENT(IN) :: output_var ! Whether to write the current variable + SUBROUTINE check_and_write_d2(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) INTEGER, INTENT(IN) :: varID ! variable's netcdf ID CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable REAL(4), INTENT(IN) :: out_var(:, :) @@ -2104,16 +2268,14 @@ SUBROUTINE check_and_write_d2(output_var, varID, vname, out_var, acc_val, vrange CALL check_range(vname, acc_val, vrange, out_timestep, out_settings%met) END IF - IF (output_var .AND. out_settings%writenow) THEN + IF (out_settings%writenow) THEN ! Write value to file: CALL write_ovar(out_timestep, ncid_out, varID, vname, & out_var, writepatch, out_settings%dimswitch, out_settings%met) END IF END SUBROUTINE check_and_write_d2 - SUBROUTINE check_and_write_d1_p(output_par, parID, pname, out_par, prange, writepatch, out_settings) - - LOGICAL, INTENT(IN) :: output_par ! Whether to write the current parameter + SUBROUTINE check_and_write_d1_p(parID, pname, out_par, prange, writepatch, out_settings) INTEGER, INTENT(IN) :: parID ! parameter netcdf ID CHARACTER(LEN=*), INTENT(IN) :: pname ! name of parameter REAL(4), INTENT(IN) :: out_par(:) @@ -2125,22 +2287,18 @@ SUBROUTINE check_and_write_d1_p(output_par, parID, pname, out_par, prange, write CALL check_range(pname, out_par, prange, out_timestep, out_settings%met) - IF (output_par) THEN - IF (out_settings%restart) THEN - ncid_file = ncid_restart - ELSE - ncid_file = ncid_out - END IF - ! Write value to file: - CALL write_ovar(ncid_file, parID, pname, out_par, & - writepatch, out_settings%dimswitch, out_settings%restart) + IF (out_settings%restart) THEN + ncid_file = ncid_restart + ELSE + ncid_file = ncid_out END IF + ! Write value to file: + CALL write_ovar(ncid_file, parID, pname, out_par, & + writepatch, out_settings%dimswitch, out_settings%restart) END SUBROUTINE check_and_write_d1_p - SUBROUTINE check_and_write_d2_p(output_par, parID, pname, out_par, prange, writepatch, out_settings) - - LOGICAL, INTENT(IN) :: output_par ! Whether to write the current parameter + SUBROUTINE check_and_write_d2_p(parID, pname, out_par, prange, writepatch, out_settings) INTEGER, INTENT(IN) :: parID ! parameter netcdf ID CHARACTER(LEN=*), INTENT(IN) :: pname ! name of parameter REAL(4), INTENT(IN) :: out_par(:, :) @@ -2152,21 +2310,18 @@ SUBROUTINE check_and_write_d2_p(output_par, parID, pname, out_par, prange, write CALL check_range(pname, out_par, prange, out_timestep, out_settings%met) - IF (output_par) THEN - IF (out_settings%restart) THEN - ncid_file = ncid_restart - ELSE - ncid_file = ncid_out - END IF - ! Write value to file: - CALL write_ovar(ncid_file, parID, pname, out_par, & - writepatch, out_settings%dimswitch, out_settings%restart) + IF (out_settings%restart) THEN + ncid_file = ncid_restart + ELSE + ncid_file = ncid_out END IF + ! Write value to file: + CALL write_ovar(ncid_file, parID, pname, out_par, & + writepatch, out_settings%dimswitch, out_settings%restart) END SUBROUTINE check_and_write_d2_p - SUBROUTINE generate_out_write_acc_d1(output_var, varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - LOGICAL, INTENT(IN) :: output_var ! Whether to write the current variable + SUBROUTINE generate_out_write_acc_d1(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) INTEGER, INTENT(IN) :: varID ! variable's netcdf ID CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable REAL(4), INTENT(INOUT) :: out_var(:) @@ -2175,14 +2330,22 @@ SUBROUTINE generate_out_write_acc_d1(output_var, varID, vname, out_var, acc_val, LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? TYPE(output_var_settings_type), INTENT(IN) :: out_settings ! met data - out_var = acc_out_var(output_var, out_var, acc_val, out_settings%writenow) - CALL check_and_write(output_var, varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - out_var = reset_on_write(output_var, out_var, out_settings%writenow) + ! Accumulate out_var until interval timesteps + out_var = out_var + acc_val + IF (out_settings%writenow) THEN + out_var = out_var/REAL(output%interval, 4) + END IF + + CALL check_and_write(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) + + ! Reset the value if it has been written to file + IF (out_settings%writenow) THEN + out_var = 0.0 + END IF END SUBROUTINE generate_out_write_acc_d1 - SUBROUTINE generate_out_write_acc_d2(output_var, varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - LOGICAL, INTENT(IN) :: output_var ! Whether to write the current variable + SUBROUTINE generate_out_write_acc_d2(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) INTEGER, INTENT(IN) :: varID ! variable's netcdf ID CHARACTER(LEN=*), INTENT(IN) :: vname ! name of variable REAL(4), INTENT(INOUT) :: out_var(:, :) @@ -2191,9 +2354,18 @@ SUBROUTINE generate_out_write_acc_d2(output_var, varID, vname, out_var, acc_val, LOGICAL, INTENT(IN) :: writepatch ! write patch-specific info for this var? TYPE(output_var_settings_type), INTENT(IN) :: out_settings ! met data - out_var = acc_out_var(output_var, out_var, acc_val, out_settings%writenow) - CALL check_and_write(output_var, varID, vname, out_var, acc_val, vrange, writepatch, out_settings) - out_var = reset_on_write(output_var, out_var, out_settings%writenow) + ! Accumulate out_var until interval timesteps + out_var = out_var + acc_val + IF (out_settings%writenow) THEN + out_var = out_var/REAL(output%interval, 4) + END IF + + CALL check_and_write(varID, vname, out_var, acc_val, vrange, writepatch, out_settings) + + ! Reset the value if it has been written to file + IF (out_settings%writenow) THEN + out_var = 0.0 + END IF END SUBROUTINE generate_out_write_acc_d2 @@ -2272,7 +2444,7 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, TYPE(output_par_settings_type) :: out_settings - LOGICAL, PARAMETER :: output_var = .TRUE., patchout_var = .TRUE. + LOGICAL, PARAMETER :: patchout_var = .TRUE. ! REAL, POINTER, :: surffrac(:, :) ! fraction of each surf type INTEGER :: dummy ! dummy argument in subroutine call @@ -2765,196 +2937,196 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, ! Write parameters: !~ veg and soil out_settings%dimswitch = "integer" - CALL check_and_write(output_var, rpid%iveg, & + CALL check_and_write(rpid%iveg, & 'iveg', REAL(veg%iveg, 4), ranges%iveg, patchout_var, out_settings) - CALL check_and_write(output_var, rpid%isoil, 'isoil', REAL(soil%isoilm, 4), & + CALL check_and_write(rpid%isoil, 'isoil', REAL(soil%isoilm, 4), & ranges%isoil, patchout_var, out_settings) out_settings%dimswitch = "real" -!$ CALL check_and_write(output_var, rpid%bch, 'bch', REAL(soil%bch, 4), & +!$ CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & !$ ranges%bch, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%bch, 'bch', REAL(soil%bch, 4), & +!$ CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & !$ ranges%bch, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%clay, 'clay', REAL(soil%clay, 4), & +!$ CALL check_and_write(rpid%clay, 'clay', REAL(soil%clay, 4), & !$ ranges%clay, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%sand, 'sand', REAL(soil%sand, 4), & +!$ CALL check_and_write(rpid%sand, 'sand', REAL(soil%sand, 4), & !$ ranges%sand, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%silt, 'silt', REAL(soil%silt, 4), & +!$ CALL check_and_write(rpid%silt, 'silt', REAL(soil%silt, 4), & !$ ranges%silt, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%css, 'css', REAL(soil%css, 4), & +!$ CALL check_and_write(rpid%css, 'css', REAL(soil%css, 4), & !$ ranges%css, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%rhosoil, 'rhosoil', & +!$ CALL check_and_write(rpid%rhosoil, 'rhosoil', & !$ REAL(soil%rhosoil, 4), ranges%rhosoil, patchout_var, & !$ out_settings) -!$ CALL check_and_write(output_var, rpid%hyds, 'hyds', REAL(soil%hyds, 4), & +!$ CALL check_and_write(rpid%hyds, 'hyds', REAL(soil%hyds, 4), & !$ ranges%hyds, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%sucs, 'sucs', REAL(soil%sucs, 4), & +!$ CALL check_and_write(rpid%sucs, 'sucs', REAL(soil%sucs, 4), & !$ ranges%sucs, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%rs20, 'rs20', REAL(veg%rs20, 4), & +!$ CALL check_and_write(rpid%rs20, 'rs20', REAL(veg%rs20, 4), & !$ ranges%rs20, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%ssat, 'ssat', REAL(soil%ssat, 4), & +!$ CALL check_and_write(rpid%ssat, 'ssat', REAL(soil%ssat, 4), & !$ ranges%ssat, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%sfc, 'sfc', REAL(soil%sfc, 4), & +!$ CALL check_and_write(rpid%sfc, 'sfc', REAL(soil%sfc, 4), & !$ ranges%sfc, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%swilt, 'swilt', REAL(soil%swilt, 4), & +!$ CALL check_and_write(rpid%swilt, 'swilt', REAL(soil%swilt, 4), & !$ ranges%swilt, patchout_var, out_settings) ! Soil dimensioned variables/parameters: out_settings%dimswitch = "soil" -!$ CALL check_and_write(output_var, rpid%froot, 'froot', REAL(veg%froot, 4), & +!$ CALL check_and_write(rpid%froot, 'froot', REAL(veg%froot, 4), & !$ ranges%froot, patchout_var, out_settings) !~ ssnow !~~ Soil dimensioned variables/parameters: out_settings%dimswitch = "soil" - CALL check_and_write(output_var, tggID, 'tgg', REAL(ssnow%tgg, 4), & + CALL check_and_write(tggID, 'tgg', REAL(ssnow%tgg, 4), & ranges%SoilTemp, patchout_var, out_settings) - CALL check_and_write(output_var, wbID, 'wb', REAL(ssnow%wb, 4), ranges%SoilMoist, & + CALL check_and_write(wbID, 'wb', REAL(ssnow%wb, 4), ranges%SoilMoist, & patchout_var, out_settings) - CALL check_and_write(output_var, wbiceID, 'wbice', REAL(ssnow%wbice, 4), & + CALL check_and_write(wbiceID, 'wbice', REAL(ssnow%wbice, 4), & ranges%SoilMoist, patchout_var, out_settings) - CALL check_and_write(output_var, gammzzID, 'gammzz', REAL(ssnow%gammzz, 4), & + CALL check_and_write(gammzzID, 'gammzz', REAL(ssnow%gammzz, 4), & ranges%default_l, patchout_var, out_settings) !~~ Snow dimensioned variables/parameters: out_settings%dimswitch = "snow" - CALL check_and_write(output_var, ssdnID, 'ssdn', REAL(ssnow%ssdn, 4), & + CALL check_and_write(ssdnID, 'ssdn', REAL(ssnow%ssdn, 4), & ranges%ssdn, patchout_var, out_settings) - CALL check_and_write(output_var, smassID, 'smass', REAL(ssnow%smass, 4), & + CALL check_and_write(smassID, 'smass', REAL(ssnow%smass, 4), & ranges%smass, patchout_var, out_settings) - CALL check_and_write(output_var, sdepthID, 'sdepth', REAL(ssnow%sdepth, 4), & + CALL check_and_write(sdepthID, 'sdepth', REAL(ssnow%sdepth, 4), & ranges%sdepth, patchout_var, out_settings) - CALL check_and_write(output_var, tggsnID, 'tggsn', REAL(ssnow%tggsn, 4), & + CALL check_and_write(tggsnID, 'tggsn', REAL(ssnow%tggsn, 4), & ranges%tggsn, patchout_var, out_settings) !~~ Other dims out_settings%dimswitch = "radiation" - CALL check_and_write(output_var, albsoilsnID, 'albsoilsn', & + CALL check_and_write(albsoilsnID, 'albsoilsn', & REAL(ssnow%albsoilsn, 4), ranges%albsoiln, patchout_var, out_settings) out_settings%dimswitch = "plantcarbon" - CALL check_and_write(output_var, cplantID, 'cplant', REAL(bgc%cplant, 4), & + CALL check_and_write(cplantID, 'cplant', REAL(bgc%cplant, 4), & ranges%default_l, patchout_var, out_settings) out_settings%dimswitch = "soilcarbon" - CALL check_and_write(output_var, csoilID, 'csoil', REAL(bgc%csoil, 4), & + CALL check_and_write(csoilID, 'csoil', REAL(bgc%csoil, 4), & ranges%default_l, patchout_var, out_settings) ok = NF90_PUT_VAR(ncid_restart, rpid%zse, REAL(soil%zse, 4)) IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing zse parameter to ' & //TRIM(frst_out)//'(SUBROUTINE create_restart)') ! Single dim: out_settings%dimswitch = "radiation" - CALL check_and_write(output_var, rpid%albsoil, 'albsoil', & + CALL check_and_write(rpid%albsoil, 'albsoil', & REAL(soil%albsoil, 4), ranges%albsoil, patchout_var, out_settings) !$ out_settings%dimswitch = "real" -!$ CALL check_and_write(output_var, rpid%canst1, 'canst1', REAL(veg%canst1, 4), & +!$ CALL check_and_write(rpid%canst1, 'canst1', REAL(veg%canst1, 4), & !$ ranges%canst1, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%dleaf, 'dleaf', REAL(veg%dleaf, 4), & +!$ CALL check_and_write(rpid%dleaf, 'dleaf', REAL(veg%dleaf, 4), & !$ ranges%dleaf, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%ejmax, 'ejmax', REAL(veg%ejmax, 4), & +!$ CALL check_and_write(rpid%ejmax, 'ejmax', REAL(veg%ejmax, 4), & !$ ranges%ejmax, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%vcmax, 'vcmax', REAL(veg%vcmax, 4), & +!$ CALL check_and_write(rpid%vcmax, 'vcmax', REAL(veg%vcmax, 4), & !$ ranges%vcmax, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%frac4, 'frac4', REAL(veg%frac4, 4), & +!$ CALL check_and_write(rpid%frac4, 'frac4', REAL(veg%frac4, 4), & !$ ranges%frac4, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%hc, 'hc', REAL(veg%hc, 4), & +!$ CALL check_and_write(rpid%hc, 'hc', REAL(veg%hc, 4), & !$ ranges%hc, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%rp20, 'rp20', REAL(veg%rp20, 4), & +!$ CALL check_and_write(rpid%rp20, 'rp20', REAL(veg%rp20, 4), & !$ ranges%rp20, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%g0, 'g0', REAL(veg%g0, 4), & +!$ CALL check_and_write(rpid%g0, 'g0', REAL(veg%g0, 4), & !$ ranges%g0, patchout_var, out_settings) ! Ticket #56 -!$ CALL check_and_write(output_var, rpid%g1, 'g1', REAL(veg%g1, 4), & +!$ CALL check_and_write(rpid%g1, 'g1', REAL(veg%g1, 4), & !$ ranges%g1, patchout_var, out_settings) ! Ticket #56 -!$ CALL check_and_write(output_var, rpid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & +!$ CALL check_and_write(rpid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & !$ ranges%rpcoef, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & +!$ CALL check_and_write(rpid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & !$ ranges%shelrb, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%xfang, 'xfang', REAL(veg%xfang, 4), & +!$ CALL check_and_write(rpid%xfang, 'xfang', REAL(veg%xfang, 4), & !$ ranges%xfang, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%wai, 'wai', REAL(veg%wai, 4), & +!$ CALL check_and_write(rpid%wai, 'wai', REAL(veg%wai, 4), & !$ ranges%wai, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%vegcf, 'vegcf', REAL(veg%vegcf, 4), & +!$ CALL check_and_write(rpid%vegcf, 'vegcf', REAL(veg%vegcf, 4), & !$ ranges%vegcf, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%extkn, 'extkn', REAL(veg%extkn, 4), & +!$ CALL check_and_write(rpid%extkn, 'extkn', REAL(veg%extkn, 4), & !$ ranges%extkn, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & +!$ CALL check_and_write(rpid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & !$ ranges%tminvj, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & +!$ CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & !$ ranges%tmaxvj, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%vbeta, 'vbeta', REAL(veg%vbeta, 4), & +!$ CALL check_and_write(rpid%vbeta, 'vbeta', REAL(veg%vbeta, 4), & !$ ranges%vbeta, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%xalbnir, 'xalbnir', & +!$ CALL check_and_write(rpid%xalbnir, 'xalbnir', & !$ REAL(veg%xalbnir, 4), ranges%xalbnir, patchout_var, & !$ out_settings) -!$ CALL check_and_write(output_var, rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & +!$ CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & !$ ranges%tmaxvj, patchout_var, out_settings) -!$ ok = NF90_PUT_VAR(output_var, rpid%ratecp, REAL(bgc%ratecp, 4)) +!$ ok = NF90_PUT_VAR(rpid%ratecp, REAL(bgc%ratecp, 4)) !$ IF (ok /= NF90_NOERR) CALL nc_abort(ok, & !$ 'Error writing ratecp parameter to ' & !$ //TRIM(frst_out)//'(SUBROUTINE create_restart)') -!$ ok = NF90_PUT_VAR(output_var, rpid%ratecs, REAL(bgc%ratecs, 4)) +!$ ok = NF90_PUT_VAR(rpid%ratecs, REAL(bgc%ratecs, 4)) !$ IF (ok /= NF90_NOERR) CALL nc_abort(ok, & !$ 'Error writing ratecs parameter to ' & !$ //TRIM(frst_out)//'(SUBROUTINE create_restart)') !$ out_settings%dimswitch = "integer" -!$ CALL check_and_write(output_var, rpid%meth, 'meth', REAL(veg%meth, 4), & +!$ CALL check_and_write(rpid%meth, 'meth', REAL(veg%meth, 4), & !$ ranges%meth, patchout_var, out_settings) !$ out_settings%dimswitch = "real" -!$ CALL check_and_write(output_var, rpid%za_uv, 'za_uv', REAL(rough%za_uv, 4), & +!$ CALL check_and_write(rpid%za_uv, 'za_uv', REAL(rough%za_uv, 4), & !$ ranges%za, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%za_tq, 'za_tq', REAL(rough%za_tq, 4), & +!$ CALL check_and_write(rpid%za_tq, 'za_tq', REAL(rough%za_tq, 4), & !$ ranges%za, patchout_var, out_settings) out_settings%dimswitch = "r2" - CALL check_and_write(output_var, dgdtgID, 'dgdtg', REAL(canopy%dgdtg, 4), & + CALL check_and_write(dgdtgID, 'dgdtg', REAL(canopy%dgdtg, 4), & ranges%default_l, patchout_var, out_settings) out_settings%dimswitch = "integer" - CALL check_and_write(output_var, isflagID, 'isflag', REAL(ssnow%isflag, 4), & + CALL check_and_write(isflagID, 'isflag', REAL(ssnow%isflag, 4), & ranges%default_l, patchout_var, out_settings) out_settings%dimswitch = "real" - CALL check_and_write(output_var, gwID, 'GWwb', REAL(ssnow%GWwb, 4), & + CALL check_and_write(gwID, 'GWwb', REAL(ssnow%GWwb, 4), & ranges%GWwb, patchout_var, out_settings) - CALL check_and_write(output_var, tssID, 'tss', REAL(ssnow%tss, 4), & + CALL check_and_write(tssID, 'tss', REAL(ssnow%tss, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, ssdnnID, 'ssdnn', REAL(ssnow%ssdnn, 4), & + CALL check_and_write(ssdnnID, 'ssdnn', REAL(ssnow%ssdnn, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, osnowdID, 'osnowd', REAL(ssnow%osnowd, 4), & + CALL check_and_write(osnowdID, 'osnowd', REAL(ssnow%osnowd, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, snageID, 'snage', REAL(ssnow%snage, 4), & + CALL check_and_write(snageID, 'snage', REAL(ssnow%snage, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, snowdID, 'snowd', REAL(ssnow%snowd, 4), & + CALL check_and_write(snowdID, 'snowd', REAL(ssnow%snowd, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, rtsoilID, 'rtsoil', REAL(ssnow%rtsoil, 4), & + CALL check_and_write(rtsoilID, 'rtsoil', REAL(ssnow%rtsoil, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, canstoID, 'cansto', REAL(canopy%cansto, 4), & + CALL check_and_write(canstoID, 'cansto', REAL(canopy%cansto, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, sghfluxID, 'sghflux', & + CALL check_and_write(sghfluxID, 'sghflux', & REAL(canopy%sghflux, 4), ranges%default_l, & patchout_var, out_settings) - CALL check_and_write(output_var, ghfluxID, 'ghflux', REAL(canopy%ghflux, 4), & + CALL check_and_write(ghfluxID, 'ghflux', REAL(canopy%ghflux, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, runoffID, 'runoff', REAL(ssnow%runoff, 4), & + CALL check_and_write(runoffID, 'runoff', REAL(ssnow%runoff, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, rnof1ID, 'rnof1', REAL(ssnow%rnof1, 4), & + CALL check_and_write(rnof1ID, 'rnof1', REAL(ssnow%rnof1, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, rnof2ID, 'rnof2', REAL(ssnow%rnof2, 4), & + CALL check_and_write(rnof2ID, 'rnof2', REAL(ssnow%rnof2, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, gaID, 'ga', REAL(canopy%ga, 4), & + CALL check_and_write(gaID, 'ga', REAL(canopy%ga, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, fevID, 'fev', REAL(canopy%fev, 4), & + CALL check_and_write(fevID, 'fev', REAL(canopy%fev, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, fesID, 'fes', REAL(canopy%fes, 4), & + CALL check_and_write(fesID, 'fes', REAL(canopy%fes, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, fhsID, 'fhs', REAL(canopy%fhs, 4), & + CALL check_and_write(fhsID, 'fhs', REAL(canopy%fhs, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, wbtot0ID, 'wbtot0', REAL(bal%wbtot0, 4), & + CALL check_and_write(wbtot0ID, 'wbtot0', REAL(bal%wbtot0, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, osnowd0ID, 'osnowd0', REAL(bal%osnowd0, 4), & + CALL check_and_write(osnowd0ID, 'osnowd0', REAL(bal%osnowd0, 4), & ranges%default_l, patchout_var, out_settings) !~ Radiation out_settings%dimswitch = "radiation" - CALL check_and_write(output_var, albedoID, 'albedo', REAL(rad%albedo, 4), & + CALL check_and_write(albedoID, 'albedo', REAL(rad%albedo, 4), & ranges%Albedo, patchout_var, out_settings) out_settings%dimswitch = "real" - CALL check_and_write(output_var, tradID, 'trad', & + CALL check_and_write(tradID, 'trad', & REAL(rad%trad, 4), ranges%RadT, patchout_var, out_settings) !$ IF (cable_user%SOIL_STRUC == 'sli' .OR. cable_user%FWSOIL_SWITCH == 'Haverd2013') THEN -!$ CALL check_and_write(output_var, rpid%gamma, 'gamma', & +!$ CALL check_and_write(rpid%gamma, 'gamma', & !$ REAL(veg%gamma, 4), ranges%default_s, patchout_var, out_settings) !$ END IF !$ @@ -2962,32 +3134,32 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, IF (cable_user%SOIL_STRUC == 'sli') THEN ! Write SLI parameters: out_settings%dimswitch = "integer" -!$ CALL check_and_write(output_var, rpid%nhorizons, 'nhorizons', & +!$ CALL check_and_write(rpid%nhorizons, 'nhorizons', & !$ REAL(soil%nhorizons, 4), ranges%default_s, patchout_var, out_settings) - CALL check_and_write(output_var, nsnowID, 'nsnow', REAL(ssnow%nsnow, 4), & + CALL check_and_write(nsnowID, 'nsnow', REAL(ssnow%nsnow, 4), & ranges%default_s, patchout_var, out_settings) out_settings%dimswitch = "soil" -!$ CALL check_and_write(output_var, rpid%ishorizon, 'ishorizon', & +!$ CALL check_and_write(rpid%ishorizon, 'ishorizon', & !$ REAL(soil%ishorizon, 4), ranges%default_s, patchout_var, out_settings) - CALL check_and_write(output_var, SID, 'S', REAL(ssnow%S, 4), & + CALL check_and_write(SID, 'S', REAL(ssnow%S, 4), & ranges%S, patchout_var, out_settings) - CALL check_and_write(output_var, TsoilID, 'Tsoil', REAL(ssnow%Tsoil, 4), & + CALL check_and_write(TsoilID, 'Tsoil', REAL(ssnow%Tsoil, 4), & ranges%Tsoil, patchout_var, out_settings) out_settings%dimswitch = "real" -!$ CALL check_and_write(output_var, rpid%clitt, 'clitt', & +!$ CALL check_and_write(rpid%clitt, 'clitt', & !$ REAL(veg%clitt, 4), ranges%default_s, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%ZR, 'ZR', & +!$ CALL check_and_write(rpid%ZR, 'ZR', & !$ REAL(veg%ZR, 4), ranges%default_s, patchout_var, out_settings) -!$ CALL check_and_write(output_var, rpid%F10, 'F10', & +!$ CALL check_and_write(rpid%F10, 'F10', & !$ REAL(veg%F10, 4), ranges%default_s, patchout_var, out_settings) - CALL check_and_write(output_var, TsurfaceID, 'Tsurface', REAL(ssnow%Tsurface, 4), & + CALL check_and_write(TsurfaceID, 'Tsurface', REAL(ssnow%Tsurface, 4), & ranges%default_s, patchout_var, out_settings) - CALL check_and_write(output_var, h0ID, 'h0', REAL(ssnow%h0, 4), & + CALL check_and_write(h0ID, 'h0', REAL(ssnow%h0, 4), & ranges%default_s, patchout_var, out_settings) out_settings%dimswitch = "snow" - CALL check_and_write(output_var, snowliqID, 'snowliq', REAL(ssnow%snowliq, 4), & + CALL check_and_write(snowliqID, 'snowliq', REAL(ssnow%snowliq, 4), & ranges%default_s, patchout_var, out_settings) - CALL check_and_write(output_var, scondsID, 'sconds', REAL(ssnow%sconds, 4), & + CALL check_and_write(scondsID, 'sconds', REAL(ssnow%sconds, 4), & ranges%default_s, patchout_var, out_settings) END IF diff --git a/src/offline/cable_write.F90 b/src/offline/cable_write.F90 index 49badaa9a..56a1fb4e8 100644 --- a/src/offline/cable_write.F90 +++ b/src/offline/cable_write.F90 @@ -45,7 +45,7 @@ MODULE cable_write_module - USE cable_abort_module, ONLY: nc_abort + USE cable_abort_module, ONLY: nc_abort, abort USE cable_def_types_mod USE cable_IO_vars_module, ONLY: landpt, patch, max_vegpatches, parID_type, & metGrid, land_x, land_y, logn, output, & diff --git a/src/offline/landuse_inout.F90 b/src/offline/landuse_inout.F90 index 3e0fa8202..0a80b0954 100644 --- a/src/offline/landuse_inout.F90 +++ b/src/offline/landuse_inout.F90 @@ -1182,7 +1182,7 @@ SUBROUTINE create_landuse_cable_restart(logn,dels,ktau,soil,mpx,lucmp,cstart,cen TYPE(output_par_settings_type) :: out_settings - LOGICAL, PARAMETER :: output_var = .TRUE., patchout_var = .TRUE. + LOGICAL, PARAMETER :: patchout_var = .TRUE. out_settings = output_par_settings_type(met=met, restart=.TRUE.) @@ -1544,101 +1544,101 @@ SUBROUTINE create_landuse_cable_restart(logn,dels,ktau,soil,mpx,lucmp,cstart,cen ! Write parameters: out_settings%dimswitch = "integer" - CALL check_and_write(output_var, iveg_id, 'iveg', REAL(lucmp%iveg, 4), ranges%iveg, & + CALL check_and_write(iveg_id, 'iveg', REAL(lucmp%iveg, 4), ranges%iveg, & patchout_var, out_settings) - CALL check_and_write(output_var, isoil_id, 'isoil', REAL(lucmp%tgg, 4), ranges%isoil, & + CALL check_and_write(isoil_id, 'isoil', REAL(lucmp%tgg, 4), ranges%isoil, & patchout_var, out_settings) - CALL check_and_write(output_var, isflagID, 'isflag', REAL(lucmp%isflag, 4), & + CALL check_and_write(isflagID, 'isflag', REAL(lucmp%isflag, 4), & ranges%default_l, patchout_var, out_settings) out_settings%dimswitch = "soil" - CALL check_and_write(output_var, tggID, 'tgg', REAL(lucmp%tgg, 4), & + CALL check_and_write(tggID, 'tgg', REAL(lucmp%tgg, 4), & ranges%SoilTemp, patchout_var, out_settings) - CALL check_and_write(output_var, wbID, 'wb', REAL(lucmp%wb, 4), ranges%SoilMoist, & + CALL check_and_write(wbID, 'wb', REAL(lucmp%wb, 4), ranges%SoilMoist, & patchout_var, out_settings) - CALL check_and_write(output_var, wbiceID, 'wbice', REAL(lucmp%wbice, 4), & + CALL check_and_write(wbiceID, 'wbice', REAL(lucmp%wbice, 4), & ranges%SoilMoist, patchout_var, out_settings) - CALL check_and_write(output_var, gammzzID, 'gammzz', REAL(lucmp%gammzz, 4), & + CALL check_and_write(gammzzID, 'gammzz', REAL(lucmp%gammzz, 4), & ranges%default_l, patchout_var, out_settings) ! Snow dimensioned variables/parameters: out_settings%dimswitch = "snow" - CALL check_and_write(output_var, ssdnID, 'ssdn', REAL(lucmp%ssdn, 4), & + CALL check_and_write(ssdnID, 'ssdn', REAL(lucmp%ssdn, 4), & ranges%ssdn, patchout_var, out_settings) - CALL check_and_write(output_var, smassID, 'smass', REAL(lucmp%smass, 4), & + CALL check_and_write(smassID, 'smass', REAL(lucmp%smass, 4), & ranges%smass, patchout_var, out_settings) - CALL check_and_write(output_var, sdepthID, 'sdepth', REAL(lucmp%sdepth, 4), & + CALL check_and_write(sdepthID, 'sdepth', REAL(lucmp%sdepth, 4), & ranges%sdepth, patchout_var, out_settings) - CALL check_and_write(output_var, tggsnID, 'tggsn', REAL(lucmp%tggsn, 4), & + CALL check_and_write(tggsnID, 'tggsn', REAL(lucmp%tggsn, 4), & ranges%tggsn, patchout_var, out_settings) ! Other dims out_settings%dimswitch = "radiation" - CALL check_and_write(output_var, albsoilsnID, 'albsoilsn', & + CALL check_and_write(albsoilsnID, 'albsoilsn', & REAL(lucmp%albsoilsn, 4), ranges%albsoiln, patchout_var, out_settings) out_settings%dimswitch = "plantcarbon" - CALL check_and_write(output_var, cplantID, 'cplant', REAL(lucmp%cplantx, 4), & + CALL check_and_write(cplantID, 'cplant', REAL(lucmp%cplantx, 4), & ranges%default_l, patchout_var, out_settings) out_settings%dimswitch = "soilcarbon" - CALL check_and_write(output_var, csoilID, 'csoil', REAL(lucmp%csoilx, 4), & + CALL check_and_write(csoilID, 'csoil', REAL(lucmp%csoilx, 4), & ranges%default_l, patchout_var, out_settings) ok = NF90_PUT_VAR(ncid_restart, zse_id, REAL(soil%zse, 4)) IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error writing zse parameter to ' & //TRIM(frst_out)//'(SUBROUTINE create_restart)') ! Single dim: out_settings%dimswitch = "radiation" - CALL check_and_write(output_var, albsoil_id, 'albsoil', & + CALL check_and_write(albsoil_id, 'albsoil', & REAL(lucmp%albsoil, 4), ranges%albsoil, patchout_var, & out_settings) out_settings%dimswitch = "real" - CALL check_and_write(output_var, tssID, 'tss', REAL(lucmp%tss, 4), & + CALL check_and_write(tssID, 'tss', REAL(lucmp%tss, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, ssdnnID, 'ssdnn', REAL(lucmp%ssdnn, 4), & + CALL check_and_write(ssdnnID, 'ssdnn', REAL(lucmp%ssdnn, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, osnowdID, 'osnowd', REAL(lucmp%osnowd, 4), & + CALL check_and_write(osnowdID, 'osnowd', REAL(lucmp%osnowd, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, snageID, 'snage', REAL(lucmp%snage, 4), & + CALL check_and_write(snageID, 'snage', REAL(lucmp%snage, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, snowdID, 'snowd', REAL(lucmp%snowd, 4), & + CALL check_and_write(snowdID, 'snowd', REAL(lucmp%snowd, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, rtsoilID, 'rtsoil', REAL(lucmp%rtsoil, 4), & + CALL check_and_write(rtsoilID, 'rtsoil', REAL(lucmp%rtsoil, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, canstoID, 'cansto', REAL(lucmp%cansto, 4), & + CALL check_and_write(canstoID, 'cansto', REAL(lucmp%cansto, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, sghfluxID, 'sghflux', & + CALL check_and_write(sghfluxID, 'sghflux', & REAL(lucmp%sghflux, 4), ranges%default_l, & patchout_var, out_settings) - CALL check_and_write(output_var, ghfluxID, 'ghflux', REAL(lucmp%ghflux, 4), & + CALL check_and_write(ghfluxID, 'ghflux', REAL(lucmp%ghflux, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, runoffID, 'runoff', REAL(lucmp%runoff, 4), & + CALL check_and_write(runoffID, 'runoff', REAL(lucmp%runoff, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, rnof1ID, 'rnof1', REAL(lucmp%rnof1, 4), & + CALL check_and_write(rnof1ID, 'rnof1', REAL(lucmp%rnof1, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, rnof2ID, 'rnof2', REAL(lucmp%rnof2, 4), & + CALL check_and_write(rnof2ID, 'rnof2', REAL(lucmp%rnof2, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, gaID, 'ga', REAL(lucmp%ga, 4), & + CALL check_and_write(gaID, 'ga', REAL(lucmp%ga, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, fevID, 'fev', REAL(lucmp%fev, 4), & + CALL check_and_write(fevID, 'fev', REAL(lucmp%fev, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, fesID, 'fes', REAL(lucmp%fes, 4), & + CALL check_and_write(fesID, 'fes', REAL(lucmp%fes, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, fhsID, 'fhs', REAL(lucmp%fhs, 4), & + CALL check_and_write(fhsID, 'fhs', REAL(lucmp%fhs, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, wbtot0ID, 'wbtot0', REAL(lucmp%wbtot0, 4), & + CALL check_and_write(wbtot0ID, 'wbtot0', REAL(lucmp%wbtot0, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, osnowd0ID, 'osnowd0', REAL(lucmp%osnowd0, 4), & + CALL check_and_write(osnowd0ID, 'osnowd0', REAL(lucmp%osnowd0, 4), & ranges%default_l, patchout_var, out_settings) - CALL check_and_write(output_var, tradID, 'trad', & + CALL check_and_write(tradID, 'trad', & REAL(lucmp%trad, 4), ranges%RadT, patchout_var, out_settings) - CALL check_and_write(output_var, gwID, 'GWwb', REAL(lucmp%GWwb, 4), & + CALL check_and_write(gwID, 'GWwb', REAL(lucmp%GWwb, 4), & ranges%GWwb, patchout_var, out_settings) out_settings%dimswitch = "r2" - CALL check_and_write(output_var, dgdtgID, 'dgdtg', REAL(lucmp%dgdtg, 4), & + CALL check_and_write(dgdtgID, 'dgdtg', REAL(lucmp%dgdtg, 4), & ranges%default_l, patchout_var, out_settings) out_settings%dimswitch = "radiation" - CALL check_and_write(output_var, albedoID, 'albedo', REAL(lucmp%albedo, 4), & + CALL check_and_write(albedoID, 'albedo', REAL(lucmp%albedo, 4), & ranges%Albedo, patchout_var, out_settings) ! Close restart file diff --git a/src/params/cable_other_constants_mod.F90 b/src/params/cable_other_constants_mod.F90 index b91797355..904106397 100644 --- a/src/params/cable_other_constants_mod.F90 +++ b/src/params/cable_other_constants_mod.F90 @@ -44,4 +44,6 @@ MODULE cable_other_constants_mod REAL, PARAMETER :: z0surf_min = 1.0e-7 ! min. roughness of bare soil surface !H!REAL, PARAMETER :: z0snow_min = 1.e-7 ! min. roughness of bare snow surface +REAL, PARAMETER :: wilt_limitfactor = 2.0 ! Used in lower limit of soil moisture + END MODULE cable_other_constants_mod diff --git a/src/params/grid_constants_cbl.F90 b/src/params/grid_constants_cbl.F90 index b1925aa63..53d7b8346 100644 --- a/src/params/grid_constants_cbl.F90 +++ b/src/params/grid_constants_cbl.F90 @@ -54,9 +54,6 @@ MODULE grid_constants_mod_cbl INTEGER, PARAMETER :: mf = 2 ! # leaves (sunlit, shaded) INTEGER, PARAMETER :: niter = 4 ! number of iterations for za/L INTEGER, PARAMETER :: swb = 2 ! # SW bands (VIS+NIR) - CM3 alloc TYPEs -INTEGER, PARAMETER :: nCpool_casa = 10 -INTEGER, PARAMETER :: nNpool_casa = 10 -INTEGER, PARAMETER :: nPPool_casa = 12 ! Strictly NOT a constant. # of active tiles, length of CABLE working vectors INTEGER :: mp diff --git a/src/science/canopy/cbl_SurfaceWetness.F90 b/src/science/canopy/cbl_SurfaceWetness.F90 index f42961e15..ab54cd1f1 100644 --- a/src/science/canopy/cbl_SurfaceWetness.F90 +++ b/src/science/canopy/cbl_SurfaceWetness.F90 @@ -16,6 +16,9 @@ SUBROUTINE Surf_wetness_fact( cansat, canopy, ssnow,veg, met, soil, dels ) USE cable_phys_constants_mod, ONLY : CTFRZ => TFRZ !H!USE cable_gw_hydro_module, ONLY : calc_srf_wet_fraction + + use cable_init_wetfac_mod, ONLY: initialize_wetfac + TYPE (veg_parameter_type), INTENT(INOUT) :: veg TYPE (soil_snow_type), INTENT(inout):: ssnow TYPE (soil_parameter_type), INTENT(inout) :: soil @@ -63,32 +66,16 @@ SUBROUTINE Surf_wetness_fact( cansat, canopy, ssnow,veg, met, soil, dels ) ssnow%satfrac(:) = 1.0e-8 ssnow%rh_srf(:) = 1.0 - ssnow%wetfac = MAX( 1.e-6, MIN( 1.0,& - ( REAL (ssnow%wb(:,1) ) - soil%swilt/ 2.0 ) & - / ( soil%sfc - soil%swilt/2.0 ) ) ) - - DO i=1,mp - - IF( ssnow%wbice(i,1) > 0. )& - ssnow%wetfac(i) = ssnow%wetfac(i) * & - real(MAX( 0.5_r_2, 1._r_2 - MIN( 0.2_r_2, & - ( ssnow%wbice(i,1) / ssnow%wb(i,1) )**2 ) ) ) - - IF( ssnow%snowd(i) > 0.1) ssnow%wetfac(i) = 0.9 - - IF ( veg%iveg(i) == lakes_cable .and. met%tk(i) >= Ctfrz + 5. ) & - ssnow%wetfac(i) = 1.0 - - IF( veg%iveg(i) == lakes_cable .and. met%tk(i) < Ctfrz + 5. ) & - ssnow%wetfac(i) = 0.7 - - ENDDO + CALL initialize_wetfac(mp, ssnow%wetfac, soil%swilt, soil%sfc, ssnow%wb, ssnow%wbice, ssnow%snowd, veg%iveg, met%tk, Ctfrz) + ! owetfac introduced to reduce sharp changes in dry regions, ! especially in offline runs in which there may be discrepancies b/n ! timing of precip and temperature change (EAK apr2009) ssnow%wetfac = 0.5*(ssnow%wetfac + ssnow%owetfac) + + END SUBROUTINE Surf_wetness_fact diff --git a/src/science/canopy/cbl_init_wetfac_mod.f90 b/src/science/canopy/cbl_init_wetfac_mod.f90 new file mode 100644 index 000000000..4dd331940 --- /dev/null +++ b/src/science/canopy/cbl_init_wetfac_mod.f90 @@ -0,0 +1,118 @@ +MODULE cable_init_wetfac_mod + !! Module containing subroutine to initialise the surface wetness factor + !! of the soil/snow (ssnow_wetfac) array + + IMPLICIT NONE + + CONTAINS + + SUBROUTINE initialize_wetfac( & + mp, & + ssnow_wetfac, & + soil_swilt, & + soil_sfc, & + ssnow_wb, & + ssnow_wbice, & + ssnow_snowd, & + veg_iveg, & + met_tk, & + Ctfrz & + ) + !! ## Purpose + !! + !! Initialize the surface wetness factor of the soil/snow + !! (ssnow_wetfac) array + !! + !! ## Method + !! + !! **Warning**: The original subroutine from which this was ported + !! lacks any documented methodolody. + !! + !! ## References + !! + !! **Warning**: The original subroutine from which this was ported + !! lacks any literature reference. + + + + ! Imports + USE grid_constants_mod_cbl, ONLY: lakes_cable + USE cable_def_types_mod, ONLY : r_2 + USE cable_other_constants_mod, ONLY : wilt_limitfactor + + IMPLICIT NONE + + ! Arguments (See soil params file for units?) + INTEGER, INTENT(IN) :: mp !! Number of active land points + REAL, INTENT(INOUT) :: ssnow_wetfac(mp) !! Surface wetness factor at current time step + REAL, INTENT(IN) :: soil_swilt(mp) !! Wilting factor, point at which plants in soil start to wilt + REAL, INTENT(IN) :: soil_sfc(mp) !! Volumetric H20 @ field capacity + REAL(r_2), INTENT(IN) :: ssnow_wb(mp) !! Volumetric soil moisture (solid+liquid) + REAL(r_2), INTENT(IN) :: ssnow_wbice(mp) !! Soil ice + REAL, INTENT(IN) :: ssnow_snowd(mp) !! Soil/snow snow depth (mm of water) + REAL, INTENT(IN) :: met_tk(mp) !! Air temperature (Kelvin) + REAL, INTENT(IN) :: Ctfrz !! Freezing temperature (Kelvin) + INTEGER, INTENT(IN) :: veg_iveg(mp) !! Surface types + + ! Local variables + REAL :: wilting_pt(mp) ! Wilting point + REAL :: wetfac_num(mp) ! Wetness factor numerator + REAL :: wetfac_den(mp) ! Wetness factor denominator + REAL :: ice_ratio ! Ice ratio + REAL :: ice_factor ! Ice factor + INTEGER :: i ! Index to iterate through + + ! Work out the numerator / denominator + wilting_pt(:) = soil_swilt(:) / wilt_limitfactor + wetfac_num(:) = REAL(ssnow_wb(:)) - wilting_pt(:) + wetfac_den(:) = REAL(soil_sfc(:) - wilting_pt(:)) + wetfac_den(:) = MAX(0.0830, wetfac_den(:)) ! WARNING: CABLE#457 + + ! Set some "meaningful" defaults + ssnow_wetfac(:) = wetfac_num(:) / wetfac_den(:) + ssnow_wetfac(:) = MIN(1.0, ssnow_wetfac(:)) + ssnow_wetfac(:) = MAX(0.0, ssnow_wetfac(:)) + + ! Loop through the number of land points + DO i=1,mp + + ! Ultimately reduces surface wetness considering wetness locked up in ice + IF (ssnow_wbice(i) > 0.0) THEN + + ! ice_ratio = ice moisture / total moisture (** ?) + ice_ratio = (ssnow_wbice(i) / ssnow_wb(i))**2 + + !~ 1-Ice_ratio^2 + ice_factor = 1._r_2 - MIN(0.2_r_2, ice_ratio) + ice_factor = REAL(MAX(0.5_r_2, ice_factor)) + ssnow_wetfac(i) = ssnow_wetfac(i) * ice_factor + + END IF + + ! If snow depth is greater than 0.1m then soil is at 90% of the total available water + IF (ssnow_snowd(i) > 0.1) THEN + ssnow_wetfac(i) = 0.9 + END IF + + ! If we are on a lake + IF (veg_iveg(i) == lakes_cable) THEN + + ! When the air temperature is >= +5 deg above freezing it at 100% of the total available water + IF ( met_tk(i) >= Ctfrz + 5. ) THEN + ssnow_wetfac(i) = 1.0 + END IF + + ! When the air temperature is < +5 deg above freezing it is at 70% of the total available water + IF( met_tk(i) < Ctfrz + 5. ) THEN + ssnow_wetfac(i) = 0.7 + END IF + + END IF + + ENDDO + + RETURN + + END SUBROUTINE initialize_wetfac + +END MODULE cable_init_wetfac_mod \ No newline at end of file diff --git a/src/science/casa-cnp/casa_cnp.F90 b/src/science/casa-cnp/casa_cnp.F90 index 5f1a08511..55726a4e5 100644 --- a/src/science/casa-cnp/casa_cnp.F90 +++ b/src/science/casa-cnp/casa_cnp.F90 @@ -1,4 +1,3 @@ -!#define ESM15 YES !============================================================================== ! This source code is part of the ! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model. @@ -1027,14 +1026,15 @@ SUBROUTINE casa_delplant(veg,casabiome,casapool,casaflux,casamet, & * casabiome%ftransNPtoL(veg%iveg(npt),leaf) ENDIF - casapool%dNplantdt(npt,wood) = 0.0 -#ifndef ESM15 - ! offline/trunk uses this condition - IF (casamet%lnonwood(npt)==0) & -#endif - casapool%dNplantdt(npt,wood) = - casaflux%kplant(npt,wood) & + !R. Law 25/10/24 removed ESM15 case as no need to exclude the condition + !that is in offline/trunk. Also re-write as IF / THEN + IF (casamet%lnonwood(npt)==0) THEN + casapool%dNplantdt(npt,wood) = - casaflux%kplant(npt,wood) & * casapool%Nplant(npt,wood) & * casabiome%ftransNPtoL(veg%iveg(npt),wood) + ELSE + casapool%dNplantdt(npt,wood) = 0.0 + ENDIF casapool%dNplantdt(npt,froot) = - casaflux%kplant(npt,froot) & * casapool%Nplant(npt,froot) & @@ -1066,9 +1066,14 @@ SUBROUTINE casa_delplant(veg,casabiome,casapool,casaflux,casamet, & * casabiome%ftransPPtoL(veg%iveg(npt),leaf) ENDIF - casapool%dPplantdt(npt,wood) = - casaflux%kplant(npt,wood) & + !R. Law 25/10/24 Add similar lnonwood condition as used in nitrogen case + IF (casamet%lnonwood(npt)==0) THEN + casapool%dPplantdt(npt,wood) = - casaflux%kplant(npt,wood) & * casapool%Pplant(npt,wood) & * casabiome%ftransPPtoL(veg%iveg(npt),wood) + ELSE + casapool%dPplantdt(npt,wood) = 0.0 + ENDIF casapool%dPplantdt(npt,froot) = - casaflux%kplant(npt,froot) & * casapool%Pplant(npt,froot) & @@ -1341,13 +1346,11 @@ SUBROUTINE casa_delsoil(veg,casapool,casaflux,casamet,casabiome) +casaflux%Psimm(nland) ! net mineralization -# ifdef ESM15 - casaflux%Pleach(nland) = (1.0e-4) & - * max(0.0,casapool%Psoillab(nland)) -# else + !rml 14/10/24 #278 remove ESM15 specific version as can be + !accommodated by setting appropriate parameter in pftlookup casaflux%Pleach(nland) = casaflux%fPleach(nland) & * MAX(0.0,casapool%Psoillab(nland)) -# endif + DO k=1,msoil DO j=1,mlitter casaflux%FluxPtosoil(nland,k) = casaflux%FluxPtosoil(nland,k) & @@ -1451,23 +1454,16 @@ SUBROUTINE casa_delsoil(veg,casapool,casaflux,casamet,casabiome) casapool%dPsoillabdt(nland)= casaflux%Psnet(nland) + fluxptase(nland) & + casaflux%Pdep(nland) + casaflux%Pwea(nland) & - casaflux%Pleach(nland)-casaflux%pupland(nland) & -!jhan: ESM15 is effectively using xkpsorb**2 - inadvertently?!?!?!?! -# ifdef ESM15 - - casabiome%xkpsorb(casamet%isorder(nland))*casaflux%kpsorb(nland)*casapool%Psoilsorb(nland) & -# else + !R. Law 23/08/2024 Removed ESM15 case as inconsistent with how xkpsorb now input (#283) - casaflux%kpsorb(nland)*casapool%Psoilsorb(nland) & -# endif + casaflux%kpocc(nland) * casapool%Psoilocc(nland) ! here the dPsoillabdt =(dPsoillabdt+dPsoilsorbdt) ! dPsoilsorbdt = xdplabsorb casapool%dPsoillabdt(nland) = casapool%dPsoillabdt(nland)/xdplabsorb(nland) casapool%dPsoilsorbdt(nland) = 0.0 -# ifdef ESM15 - casapool%dPsoiloccdt(nland) = casabiome%xkpsorb(casamet%isorder(nland))*casaflux%kpsorb(nland)* casapool%Psoilsorb(nland) & -# else + !R. Law 23/08/2024 Removed ESM15 case as inconsistent with how xkpsorb now input (#283) casapool%dPsoiloccdt(nland) = casaflux%kpsorb(nland)* casapool%Psoilsorb(nland) & -# endif - casaflux%kpocc(nland) * casapool%Psoilocc(nland) ! P loss to non-available P pools ! casaflux%Ploss(nland) = casaflux%kpocc(nland) * casapool%Psoilocc(nland) diff --git a/src/science/misc/cable_carbon.F90 b/src/science/misc/cable_carbon.F90 index f066862b8..3148a01c2 100644 --- a/src/science/misc/cable_carbon.F90 +++ b/src/science/misc/cable_carbon.F90 @@ -161,10 +161,10 @@ SUBROUTINE carbon_pl(dels, soil, ssnow, veg, canopy, bgc) EffStressIndexWilting = soil%swilt**( CampbellExp ) - 1.0 - RelativeStress = EffStressIndexWater / EffStressIndexWilting + RelativeStress = EffStressIndexWater / EffStressIndexWilting - 1.0 RelativeStress = MIN( 1.0, RelativeStress ) - coef_drght = EXP( 5.0 * ( RelativeStress - 1.0 ) ) + coef_drght = EXP( 5.0 * RelativeStress ) coef_cd = ( coef_cold + coef_drght ) * 2.0e-7