diff --git a/include/define.h b/include/define.h index 2913f9e8..8207ce3e 100755 --- a/include/define.h +++ b/include/define.h @@ -56,8 +56,10 @@ ! Conflicts : only used when LULC_IGBP_PFT is defined. #ifndef LULC_IGBP_PFT +#ifndef LULC_IGBP_PC #undef BGC #endif +#endif ! 7.1 If defined, CROP model is used #define CROP ! Conflicts : only used when BGC is defined diff --git a/main/BGC/MOD_BGC_Vars_TimeVariables.F90 b/main/BGC/MOD_BGC_Vars_TimeVariables.F90 index e0ef625f..70a8ef54 100644 --- a/main/BGC/MOD_BGC_Vars_TimeVariables.F90 +++ b/main/BGC/MOD_BGC_Vars_TimeVariables.F90 @@ -970,6 +970,7 @@ SUBROUTINE WRITE_BGCTimeVariables (file_restart) CALL ncio_write_vector (file_restart, 'sminn_vr ', 'soil' , nl_soil, 'patch', landpatch, sminn_vr ) CALL ncio_write_vector (file_restart, 'smin_no3_vr ', 'soil' , nl_soil, 'patch', landpatch, smin_no3_vr ) CALL ncio_write_vector (file_restart, 'smin_nh4_vr ', 'soil' , nl_soil, 'patch', landpatch, smin_nh4_vr ) + CALL ncio_write_vector (file_restart, 'lag_npp ', 'patch', landpatch, lag_npp ) IF(DEF_USE_NITRIF)THEN CALL ncio_write_vector (file_restart, 'tCONC_O2_UNSAT ', 'soil' , nl_soil, 'patch', landpatch, tconc_o2_unsat) @@ -1132,6 +1133,7 @@ SUBROUTINE READ_BGCTimeVariables (file_restart) CALL ncio_read_vector (file_restart, 'sminn_vr ', nl_soil, landpatch, sminn_vr ) CALL ncio_read_vector (file_restart, 'smin_no3_vr ', nl_soil, landpatch, smin_no3_vr) CALL ncio_read_vector (file_restart, 'smin_nh4_vr ', nl_soil, landpatch, smin_nh4_vr) + CALL ncio_read_vector (file_restart, 'lag_npp ', landpatch, lag_npp, defval =1.0 ) IF(DEF_USE_NITRIF)THEN CALL ncio_read_vector (file_restart, 'tCONC_O2_UNSAT ', nl_soil, landpatch, tconc_o2_unsat ) diff --git a/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 b/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 index 51f34e44..8dd5bf75 100644 --- a/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 +++ b/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 @@ -149,8 +149,9 @@ SUBROUTINE calc_plant_nutrient_competition_CLM45_default(i,ps,pe,npcropmin) IF (gpp_p(m) > 0.0_r8) THEN downreg_p(m) = excess_cflux_p(m)/gpp_p(m) psn_to_cpool_p(m) = psn_to_cpool_p(m) * (1._r8 - downreg_p(m)) - - ENDIF + ELSE + downreg_p(m) = 0._r8 + ENDIF ! calculate the amount of new leaf C dictated by these allocation ! decisions, and calculate the daily fluxes of C and N to current diff --git a/main/CoLM.F90 b/main/CoLM.F90 index 473f3a0f..7884cbc4 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -125,10 +125,10 @@ PROGRAM CoLM integer :: e_year, e_month, e_day, e_seconds, e_julian integer :: p_year, p_month, p_day, p_seconds, p_julian integer :: lc_year, lai_year - integer :: month, mday, year_p, month_p, mday_p + integer :: month, mday, year_p, month_p, mday_p, month_prev, mday_prev integer :: spinup_repeat, istep - type(timestamp) :: ststamp, itstamp, etstamp, ptstamp + type(timestamp) :: ststamp, itstamp, etstamp, ptstamp, time_prev integer*8 :: start_time, end_time, c_per_sec, time_used !----------------------------------------------------------------------- @@ -326,7 +326,7 @@ PROGRAM CoLM #ifdef BGC IF (DEF_USE_NITRIF) THEN - CALL init_nitrif_data (sdate) + CALL init_nitrif_data (ststamp) ENDIF IF (DEF_NDEP_FREQUENCY==1)THEN ! Initial annual ndep data readin @@ -386,7 +386,15 @@ PROGRAM CoLM IF(DEF_USE_OZONEDATA)THEN CALL update_Ozone_data(itstamp, deltim) ENDIF + #ifdef BGC + IF(DEF_USE_NITRIF) THEN + time_prev = itstamp + int(-deltim) + CALL julian2monthday(time_prev%year,time_prev%day,month_prev,mday_prev) + if(month_p /= month_prev)then + CALL update_nitrif_data (month_p) + end if + ENDIF IF(DEF_USE_FIRE)THEN CALL update_lightning_data (itstamp, deltim) ENDIF @@ -407,11 +415,6 @@ PROGRAM CoLM CALL julian2monthday (jdate(1), jdate(2), month, mday) #ifdef BGC - IF(DEF_USE_NITRIF) THEN - IF (month /= month_p) THEN - CALL update_nitrif_data (month) - ENDIF - ENDIF IF (DEF_NDEP_FREQUENCY==1)THEN ! Read Annual Ndep data IF (jdate(1) /= year_p) THEN diff --git a/main/MOD_NitrifData.F90 b/main/MOD_NitrifData.F90 index b28e49c9..55831c98 100644 --- a/main/MOD_NitrifData.F90 +++ b/main/MOD_NitrifData.F90 @@ -20,7 +20,7 @@ MODULE MOD_NitrifData CONTAINS - SUBROUTINE init_nitrif_data (idate) + SUBROUTINE init_nitrif_data (time) !----------------------------------------------------------------------- ! !DESCRIPTION: @@ -35,7 +35,7 @@ SUBROUTINE init_nitrif_data (idate) USE MOD_LandPatch IMPLICIT NONE - integer, intent(in) :: idate(3) + type(timestamp), intent(in) :: time ! Local Variables character(len=256) :: file_nitrif @@ -54,7 +54,7 @@ SUBROUTINE init_nitrif_data (idate) IF (allocated(lon)) deallocate(lon) IF (allocated(lat)) deallocate(lat) - CALL julian2monthday (idate(1), idate(2), month, mday) + CALL julian2monthday (time%year, time%day, month, mday) CALL update_nitrif_data (month) diff --git a/run/scripts/SummaryTest.bash b/run/scripts/SummaryTest.bash index 8067bc90..fd69aa70 100755 --- a/run/scripts/SummaryTest.bash +++ b/run/scripts/SummaryTest.bash @@ -8,6 +8,7 @@ Help() echo "!----------------------------------------------------------------------------!" echo 'Syntax: ./SummaryTest.bash -n $TestPath/$TestName [-f $TestLists][-i $Varlist]' + echo ' [-t $TestType]' echo "!----------------------------------------------------------------------------!" echo options: echo "-n The Path and Name of the test working folder" @@ -15,7 +16,7 @@ Help() echo ' is absent, use $ROOT/run/script/TestLists as the default test list. ' echo '-i Specify the summary item of the test restuls:' echo ' 1)CreateCase; 2)Compile; 3)Submit_Mksrfdata;' - echo ' 4)Submit_Mkinidata; 5)Submit_Case' + echo ' 4)Submit_Mkinidata; 5)Submit_Case; 6)Sugmit_Restart; 7)RestartMatch' echo '-h display command information' } @@ -30,7 +31,7 @@ SummaryTest() exit fi if [ "$3" == "All" ];then - Varlist="CreateCase Compile Submit_Mksrfdata Submit_Mkinidata Submit_Case" + Varlist="CreateCase Compile Submit_Mksrfdata Submit_Mkinidata Submit_Case Submit_Restart RestartMatch" fi TestCaseLists=$2 diff --git a/run/scripts/create_test b/run/scripts/create_test index 7aa9bf52..5587f983 100755 --- a/run/scripts/create_test +++ b/run/scripts/create_test @@ -8,6 +8,7 @@ Help() echo "!-----------------------------------------------------------------------!" echo 'Syntax: ./create_test -n $TestPath/$TestName [-f $TestLists][-m $Mode]' + echo ' [-t $TestType]' echo "!-----------------------------------------------------------------------!" echo options: echo "-n The Path and Name of the test working folder" @@ -22,6 +23,9 @@ Help() echo ' $TestPath/$TestName ' echo ' 4) RunNoMkSrf: create_test will follow $TestLists to run without make' echo ' surface data for all test cases under $TestPath/$TestName ' + echo '-t (Optional) Type of the test: ' + echo ' 1) SMS: Smoke test, normally run model under different configuration' + echo ' 2) RES: Restart test, run model from restart file to check their consistency' echo '-h display command information' } diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 58300a22..ba862c44 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -727,13 +727,13 @@ MODULE MOD_Namelist logical :: sum_irrig_count = .true. logical :: ndep_to_sminn = .true. - logical :: CONC_O2_UNSAT = .true. - logical :: O2_DECOMP_DEPTH_UNSAT = .true. - logical :: abm = .true. - logical :: gdp = .true. - logical :: peatf = .true. - logical :: hdm = .true. - logical :: lnfm = .true. + logical :: CONC_O2_UNSAT = .false. + logical :: O2_DECOMP_DEPTH_UNSAT = .false. + logical :: abm = .false. + logical :: gdp = .false. + logical :: peatf = .false. + logical :: hdm = .false. + logical :: lnfm = .false. logical :: leafcCap = .false. logical :: leafc_storageCap = .false. @@ -1928,6 +1928,10 @@ SUBROUTINE sync_hist_vars (set_defaults) ENDIF #endif CALL sync_hist_vars_one (DEF_hist_vars%ndep_to_sminn , set_defaults) + IF(DEF_USE_NITRIF)THEN + CALL sync_hist_vars_one (DEF_hist_vars%CONC_O2_UNSAT , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%O2_DECOMP_DEPTH_UNSAT , set_defaults) + ENDIF IF(DEF_USE_FIRE)THEN CALL sync_hist_vars_one (DEF_hist_vars%abm , set_defaults) CALL sync_hist_vars_one (DEF_hist_vars%gdp , set_defaults) diff --git a/share/MOD_TimeManager.F90 b/share/MOD_TimeManager.F90 index e5e18a5f..c63e0d67 100644 --- a/share/MOD_TimeManager.F90 +++ b/share/MOD_TimeManager.F90 @@ -114,7 +114,7 @@ FUNCTION addsec(tstamp, sec) addsec = tstamp addsec%sec = addsec%sec + sec - IF (addsec%sec > 86400) THEN + DO WHILE (addsec%sec > 86400) addsec%sec = addsec%sec - 86400 IF( isleapyear(addsec%year) ) THEN maxday = 366 @@ -126,7 +126,20 @@ FUNCTION addsec(tstamp, sec) addsec%year = addsec%year + 1 addsec%day = 1 ENDIF - ENDIF + ENDDO + DO WHILE (addsec%sec <= 0) + addsec%sec = addsec%sec + 86400 + IF( isleapyear(addsec%year-1) )THEN + maxday = 366 + ELSE + maxday = 365 + ENDIF + addsec%day = addsec%day - 1 + IF(addsec%day <= 0) THEN + addsec%year = addsec%year - 1 + addsec%day = maxday + ENDIF + ENDDO RETURN END FUNCTION addsec