diff --git a/build/CMakeLists.txt b/build/CMakeLists.txt
index fce75751284dfe875a6bcb26076f7ea9b687d593..0f87e6afdc099825a39812bcba459d3c95b265dd 100644
--- a/build/CMakeLists.txt
+++ b/build/CMakeLists.txt
@@ -219,8 +219,7 @@ set(FILE_ACCESS_INTERFACE
${FILE_ACCESS_DIR}/fortran_code/cppwrap_fileAccess.f90
${FILE_ACCESS_DIR}/fortran_code/output_structure.f90
${FILE_ACCESS_DIR}/fortran_code/read_force.f90
- ${FILE_ACCESS_DIR}/fortran_code/write_to_netcdf.f90
- ${FILE_ACCESS_DIR}/fortran_code/writeOutputFromOutputStructure.f90)
+ ${FILE_ACCESS_DIR}/fortran_code/fileAccess_writeOutput.f90)
set(JOB_INTERFACE
${JOB_ACTOR_DIR}/job_actor.f90)
set(HRU_INTERFACE
diff --git a/build/includes/file_access_actor/file_access_actor.hpp b/build/includes/file_access_actor/file_access_actor.hpp
index 7a4e21cfc46599cf9c5a8df87ab3c22dee24a377..ff064c3c07ff09814da3add536050bc6e58c6658 100644
--- a/build/includes/file_access_actor/file_access_actor.hpp
+++ b/build/includes/file_access_actor/file_access_actor.hpp
@@ -27,8 +27,6 @@ struct netcdf_gru_actor_info {
namespace caf {
-
-
struct file_access_state {
// Variables set on Spwan
caf::actor parent;
diff --git a/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp b/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
index 002e4c97cb8de6ea6f787fd6d0ea2364866c29ff..817fb92b4fb01292e2c29d8d0310b58a35f9683f 100644
--- a/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
+++ b/build/includes/file_access_actor/file_access_actor_subroutine_wrappers.hpp
@@ -16,7 +16,7 @@ extern "C" {
// OutputStructure and Output functions
void deallocateOutputStructure(int* err);
- void writeOutput_fortran(void* handle_ncid, int* num_steps, int* start_gru, int* max_gru, int* err);
+ void writeOutput_fortran(void* handle_ncid, int* num_steps, int* start_gru, int* max_gru, bool* writeParamFlag, int* err);
void updateFailed(int* indxHRU);
diff --git a/build/includes/file_access_actor/output_container.hpp b/build/includes/file_access_actor/output_container.hpp
index ee6419118a747e499753940695029370facbf787..5c2247f1e0cb8039a3204ced77f12acd8a2b0efa 100644
--- a/build/includes/file_access_actor/output_container.hpp
+++ b/build/includes/file_access_actor/output_container.hpp
@@ -16,12 +16,13 @@
*/
class Output_Partition {
private:
- int start_local_gru_index; // The index of the first GRU in the partition
- int end_local_gru_index; // The index of the last GRU in the partition
- int num_local_grus; // The number of GRUs in the partition
- int num_active_grus; // The number of GRUs that have not failed
+ int start_local_gru_index; // The index of the first GRU in the partition
+ int end_local_gru_index; // The index of the last GRU in the partition
+ int num_local_grus; // The number of GRUs in the partition
+ int num_active_grus; // The number of GRUs that have not failed
int num_timesteps_simulation; // The number of timesteps in the simulation
- int num_stored_timesteps; // The number of timesteps held within the partition
+ int num_stored_timesteps; // The number of timesteps held within the partition
+ bool write_params = true; // Flag to write the parameters to the output file (only performed once)
std::vector<caf::actor> ready_to_write_list;
std::vector<int> failed_gru_index_list; // The list of GRUs that have failed
@@ -58,13 +59,14 @@ class Output_Partition {
std::vector<int> getFailedGRUIndexList();
-
int getNumActiveGRUs();
int getNumLocalGRUs();
int getRemainingTimesteps();
+ bool isWriteParams();
+
};
diff --git a/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp b/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp
index fea12f36ca86ca5abef28803a3a4b6bccc94ccd7..0c07df6b24b0e65aee0cd6459af60f60160fd5ad 100644
--- a/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp
+++ b/build/includes/hru_actor/hru_actor_subroutine_wrappers.hpp
@@ -12,7 +12,7 @@ extern "C" {
// Run the model for one timestep
void RunPhysics(int* id, int* stepIndex, void* hru_data, double* dt, int* dt_int_factor, int* err);
- void hru_writeOutput(int* index_hru, int* index_gru, int* output_step, void* hru_data, int* err);
+ void hru_writeOutput(int* index_hru, int* index_gru, int* timestep, int* output_step, void* hru_data, int* err);
void setTimeZoneOffset(int* iFile, void* hru_data, int* err);
diff --git a/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp b/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
index a94ad676750dc6eb82566decd6db9fa3419fe079..6a645d510fcd3e4591cb8d2bb1b72e89555ef38f 100644
--- a/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
+++ b/build/source/actors/file_access_actor/cpp_code/file_access_actor.cpp
@@ -76,33 +76,8 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
self->state.num_steps);
return {
- [=](write_param, int index_gru, int index_hru, std::vector<double> attr_struct,
- std::vector<int> type_struct, std::vector<std::vector<double>> mpar_struct,
- std::vector<double> bpar_struct) {
- int err = 0;
-
- std::shared_ptr<hru_output_handles> params = std::make_shared<hru_output_handles>();
-
- self->state.file_access_timing.updateStartPoint("write_duration");
-
- // populate the newly created Fortran structures
- set_var_d(attr_struct, params->handle_attr_struct);
- set_var_i(type_struct, params->handle_type_struct);
- set_var_dlength(mpar_struct, params->handle_mpar_struct);
- set_var_d(bpar_struct, params->handle_bpar_struct);
- // write the populated data to netCDF
- writeParamToNetCDF(self->state.handle_ncid, &index_gru, &index_hru,
- params->handle_attr_struct,
- params->handle_type_struct,
- params->handle_mpar_struct,
- params->handle_bpar_struct,
- &err);
-
-
- self->state.file_access_timing.updateEndPoint("write_duration");
-
- },
+ // Message from the HRU actor to get the forcing file that is loaded
[=](access_forcing, int currentFile, caf::actor refToRespondTo) {
if (currentFile <= self->state.numFiles) {
if(self->state.forcing_file_list[currentFile - 1].isFileLoaded()) { // C++ starts at 0 Fortran starts at 1
@@ -140,9 +115,9 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
} else {
aout(self) << currentFile << " is larger than expected for a forcing file request from an HRU" << std::endl;
}
-
},
-
+
+ // Internal Message to load all forcing files, calling this message allows other messages to be processed
[=](access_forcing_internal, int currentFile) {
if (self->state.filesLoaded <= self->state.numFiles &&
currentFile <= self->state.numFiles) {
@@ -167,27 +142,8 @@ behavior file_access_actor(stateful_actor<file_access_state>* self, int start_gr
aout(self) << "All Forcing Files Loaded \n";
}
},
-
- [=] (get_attributes_params, int index_gru) {
- // From Attributes File
-
- std::vector<double> attr_struct_to_send = self->state.attr_structs_for_hrus[index_gru-1];
- std::vector<int> type_struct_to_send = self->state.type_structs_for_hrus[index_gru-1];
- std::vector<long int> id_struct_to_send = self->state.id_structs_for_hrus[index_gru-1];
-
- // From Parameters File
- std::vector<double> bpar_struct_to_send = self->state.bpar_structs_for_hrus[index_gru-1];
- std::vector<double> dpar_struct_to_send = self->state.dpar_structs_for_hrus[index_gru-1];
- std::vector<std::vector<double>> mpar_struct_to_send = self->state.mpar_structs_for_hrus[index_gru-1];
-
- return std::make_tuple(attr_struct_to_send,
- type_struct_to_send,
- id_struct_to_send,
- bpar_struct_to_send,
- dpar_struct_to_send,
- mpar_struct_to_send);
- },
-
+
+ // Message from HRU Actor so it knows how many timesteps it can write before waiting
[=] (get_num_output_steps) { return self->state.num_output_steps; },
[=](write_output, int index_gru, int index_hru, caf::actor hru_actor) {
@@ -256,9 +212,10 @@ void writeOutput(stateful_actor<file_access_state>* self, Output_Partition* part
int num_timesteps_to_write = partition->getNumStoredTimesteps();
int start_gru = partition->getStartGRUIndex();
int max_gru = partition->getMaxGRUIndex();
+ bool write_param_flag = partition->isWriteParams();
writeOutput_fortran(self->state.handle_ncid, &num_timesteps_to_write,
- &start_gru, &max_gru, &self->state.err);
+ &start_gru, &max_gru, &write_param_flag, &self->state.err);
partition->updateTimeSteps();
diff --git a/build/source/actors/file_access_actor/cpp_code/output_container.cpp b/build/source/actors/file_access_actor/cpp_code/output_container.cpp
index 0417b370a8edf9e2c0307af2a164bfa8b5d7b24d..65a900410c1c866c604407cc405893fb63b07e60 100644
--- a/build/source/actors/file_access_actor/cpp_code/output_container.cpp
+++ b/build/source/actors/file_access_actor/cpp_code/output_container.cpp
@@ -89,6 +89,14 @@ std::vector<int> Output_Partition::getFailedGRUIndexList() {
return this->failed_gru_index_list;
}
+bool Output_Partition::isWriteParams() {
+ if (this->write_params) {
+ this->write_params = false;
+ return true;
+ }
+ return this->write_params;
+}
+
//###################################################################
// Output_Container
diff --git a/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90 b/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
index d37946d44dd709022c1e478ab45b7a1f8cd06267..af42ee82dba09ca0cd40a4305ed59ba711ee112a 100644
--- a/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
+++ b/build/source/actors/file_access_actor/fortran_code/cppwrap_fileAccess.f90
@@ -15,6 +15,7 @@ module cppwrap_fileAccess
implicit none
public::fileAccessActor_init_fortran
public::FileAccessActor_DeallocateStructures
+ public::SOIL_VEG_GEN_PARM
contains
@@ -34,7 +35,6 @@ subroutine fileAccessActor_init_fortran(& ! Variables for forcing
USE ffile_info_actors_module,only:ffile_info
USE mDecisions_module,only:mDecisions ! module to read model decisions
USE read_pinit_module,only:read_pinit ! module to read initial model parameter values
- USE INIT_HRU_ACTOR,only:SOIL_VEG_GEN_PARM
USE module_sf_noahmplsm,only:read_mp_veg_parameters ! module to read NOAH vegetation tables
USE def_output_actors_module,only:def_output ! module to define output variables
USE output_structure_module,only:initOutputStructure ! module to initialize output structure
@@ -67,7 +67,7 @@ subroutine fileAccessActor_init_fortran(& ! Variables for forcing
USE var_lookup,only:iLookATTR ! look-up values for model attributes
USE var_lookup,only:iLookBVAR ! look-up values for basin-average variables
USE output_structure_module,only:outputStructure ! output structure
- USE globalData,only:failedHRUs ! Flag for file access actor to know which GRUs have failed
+ USE output_structure_module,only:failedHRUs ! Flag for file access actor to know which GRUs have failed
USE globalData,only:iRunModeFull,iRunModeGRU,iRunModeHRU
USE globalData,only:iRunMode ! define the current running mode
@@ -373,7 +373,7 @@ end subroutine fileAccessActor_init_fortran
subroutine updateFailed(indxHRU) bind(C, name="updateFailed")
- USE globalData,only:failedHRUs
+ USE output_structure_module,only:failedHRUs
implicit none
integer(c_int), intent(in) :: indxHRU
@@ -381,7 +381,7 @@ subroutine updateFailed(indxHRU) bind(C, name="updateFailed")
end subroutine
subroutine resetFailedArray() bind(C, name="resetFailedArray")
- USE globalData,only:failedHRUs
+ USE output_structure_module,only:failedHRUs
implicit none
failedHRUs(:) = .false.
@@ -392,9 +392,9 @@ end subroutine
subroutine FileAccessActor_DeallocateStructures(handle_forcFileInfo, handle_ncid) bind(C,name="FileAccessActor_DeallocateStructures")
USE netcdf_util_module,only:nc_file_close
USE globalData,only:structInfo ! information on the data structures
- USE globalData,only:failedHRUs
- USE globalData,only:forcingDataStruct
- USE globalData,only:vectime
+ USE access_forcing_module,only:forcingDataStruct
+ USE access_forcing_module,only:vectime
+ USE output_structure_module,only:failedHRUs
USE output_structure_module,only:outputTimeStep
implicit none
type(c_ptr),intent(in), value :: handle_forcFileInfo
@@ -425,8 +425,268 @@ subroutine FileAccessActor_DeallocateStructures(handle_forcFileInfo, handle_ncid
deallocate(outputTimeStep)
end subroutine FileAccessActor_DeallocateStructures
+! **************************************************************************************************
+! private subroutine SOIL_VEG_GEN_PARM: Read soil, vegetation and other model parameters (from NOAH)
+! **************************************************************************************************
+SUBROUTINE SOIL_VEG_GEN_PARM(FILENAME_VEGTABLE, FILENAME_SOILTABLE, FILENAME_GENERAL, MMINLU, MMINSL)
+ !-----------------------------------------------------------------
+ use module_sf_noahlsm, only : shdtbl, nrotbl, rstbl, rgltbl, &
+ & hstbl, snuptbl, maxalb, laimintbl, &
+ & bb, drysmc, f11, maxsmc, laimaxtbl, &
+ & emissmintbl, emissmaxtbl, albedomintbl, &
+ & albedomaxtbl, wltsmc, qtz, refsmc, &
+ & z0mintbl, z0maxtbl, &
+ & satpsi, satdk, satdw, &
+ & theta_res, theta_sat, vGn_alpha, vGn_n, k_soil, & ! MPC add van Genutchen parameters
+ & fxexp_data, lvcoef_data, &
+ & lutype, maxalb, &
+ & slope_data, frzk_data, bare, cmcmax_data, &
+ & cfactr_data, csoil_data, czil_data, &
+ & refkdt_data, natural, refdk_data, &
+ & rsmax_data, salp_data, sbeta_data, &
+ & zbot_data, smhigh_data, smlow_data, &
+ & lucats, topt_data, slcats, slpcats, sltype
+
+ IMPLICIT NONE
+
+ CHARACTER(LEN=*), INTENT(IN) :: FILENAME_VEGTABLE, FILENAME_SOILTABLE, FILENAME_GENERAL
+ CHARACTER(LEN=*), INTENT(IN) :: MMINLU, MMINSL
+ integer :: LUMATCH, IINDEX, LC, NUM_SLOPE
+ integer :: ierr
+ INTEGER , PARAMETER :: OPEN_OK = 0
+
+ character*128 :: mess , message
+
+ !-----SPECIFY VEGETATION RELATED CHARACTERISTICS :
+ ! ALBBCK: SFC albedo (in percentage)
+ ! Z0: Roughness length (m)
+ ! SHDFAC: Green vegetation fraction (in percentage)
+ ! Note: The ALBEDO, Z0, and SHDFAC values read from the following table
+ ! ALBEDO, amd Z0 are specified in LAND-USE TABLE; and SHDFAC is
+ ! the monthly green vegetation data
+ ! CMXTBL: MAX CNPY Capacity (m)
+ ! NROTBL: Rooting depth (layer)
+ ! RSMIN: Mimimum stomatal resistance (s m-1)
+ ! RSMAX: Max. stomatal resistance (s m-1)
+ ! RGL: Parameters used in radiation stress function
+ ! HS: Parameter used in vapor pressure deficit functio
+ ! TOPT: Optimum transpiration air temperature. (K)
+ ! CMCMAX: Maximum canopy water capacity
+ ! CFACTR: Parameter used in the canopy inteception calculati
+ ! SNUP: Threshold snow depth (in water equivalent m) that
+ ! implies 100% snow cover
+ ! LAI: Leaf area index (dimensionless)
+ ! MAXALB: Upper bound on maximum albedo over deep snow
+ !
+ !-----READ IN VEGETAION PROPERTIES FROM VEGPARM.TBL
+ !
+
+ OPEN(19, FILE=trim(FILENAME_VEGTABLE),FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
+ IF(ierr .NE. OPEN_OK ) THEN
+ WRITE(message,FMT='(A)') &
+ 'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening VEGPARM.TBL'
+ CALL wrf_error_fatal ( message )
+ END IF
+
+ LUMATCH=0
+
+ FIND_LUTYPE : DO WHILE (LUMATCH == 0)
+ READ (19,*,END=2002)
+ READ (19,*,END=2002)LUTYPE
+ READ (19,*)LUCATS,IINDEX
+
+ IF(LUTYPE.EQ.MMINLU)THEN
+ WRITE( mess , * ) 'LANDUSE TYPE = ' // TRIM ( LUTYPE ) // ' FOUND', LUCATS,' CATEGORIES'
+ ! CALL wrf_message( mess )
+ LUMATCH=1
+ ELSE
+ ! call wrf_message ( "Skipping over LUTYPE = " // TRIM ( LUTYPE ) )
+ DO LC = 1, LUCATS+12
+ read(19,*)
+ ENDDO
+ ENDIF
+ ENDDO FIND_LUTYPE
+ ! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
+ IF ( SIZE(SHDTBL) < LUCATS .OR. &
+ SIZE(NROTBL) < LUCATS .OR. &
+ SIZE(RSTBL) < LUCATS .OR. &
+ SIZE(RGLTBL) < LUCATS .OR. &
+ SIZE(HSTBL) < LUCATS .OR. &
+ SIZE(SNUPTBL) < LUCATS .OR. &
+ SIZE(MAXALB) < LUCATS .OR. &
+ SIZE(LAIMINTBL) < LUCATS .OR. &
+ SIZE(LAIMAXTBL) < LUCATS .OR. &
+ SIZE(Z0MINTBL) < LUCATS .OR. &
+ SIZE(Z0MAXTBL) < LUCATS .OR. &
+ SIZE(ALBEDOMINTBL) < LUCATS .OR. &
+ SIZE(ALBEDOMAXTBL) < LUCATS .OR. &
+ SIZE(EMISSMINTBL ) < LUCATS .OR. &
+ SIZE(EMISSMAXTBL ) < LUCATS ) THEN
+ CALL wrf_error_fatal('Table sizes too small for value of LUCATS in module_sf_noahdrv.F')
+ ENDIF
+
+ IF(LUTYPE.EQ.MMINLU)THEN
+ DO LC=1,LUCATS
+ READ (19,*)IINDEX,SHDTBL(LC), &
+ NROTBL(LC),RSTBL(LC),RGLTBL(LC),HSTBL(LC), &
+ SNUPTBL(LC),MAXALB(LC), LAIMINTBL(LC), &
+ LAIMAXTBL(LC),EMISSMINTBL(LC), &
+ EMISSMAXTBL(LC), ALBEDOMINTBL(LC), &
+ ALBEDOMAXTBL(LC), Z0MINTBL(LC), Z0MAXTBL(LC)
+ ENDDO
+
+ READ (19,*)
+ READ (19,*)TOPT_DATA
+ READ (19,*)
+ READ (19,*)CMCMAX_DATA
+ READ (19,*)
+ READ (19,*)CFACTR_DATA
+ READ (19,*)
+ READ (19,*)RSMAX_DATA
+ READ (19,*)
+ READ (19,*)BARE
+ READ (19,*)
+ READ (19,*)NATURAL
+ ENDIF
+
+ 2002 CONTINUE
+
+ CLOSE (19)
+ IF (LUMATCH == 0) then
+ CALL wrf_error_fatal ("Land Use Dataset '"//MMINLU//"' not found in VEGPARM.TBL.")
+ ENDIF
+
+ !
+ !-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL
+ !
+ OPEN(19, FILE=trim(FILENAME_SOILTABLE),FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
+ IF(ierr .NE. OPEN_OK ) THEN
+ WRITE(message,FMT='(A)') &
+ 'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening SOILPARM.TBL'
+ CALL wrf_error_fatal ( message )
+ END IF
+
+ WRITE(mess,*) 'INPUT SOIL TEXTURE CLASSIFICATION = ', TRIM ( MMINSL )
+ ! CALL wrf_message( mess )
+
+ LUMATCH=0
+
+ ! MPC add a new soil table
+ FIND_soilTYPE : DO WHILE (LUMATCH == 0)
+ READ (19,*)
+ READ (19,*,END=2003)SLTYPE
+ READ (19,*)SLCATS,IINDEX
+ IF(SLTYPE.EQ.MMINSL)THEN
+ WRITE( mess , * ) 'SOIL TEXTURE CLASSIFICATION = ', TRIM ( SLTYPE ) , ' FOUND', &
+ SLCATS,' CATEGORIES'
+ ! CALL wrf_message ( mess )
+ LUMATCH=1
+ ELSE
+ ! call wrf_message ( "Skipping over SLTYPE = " // TRIM ( SLTYPE ) )
+ DO LC = 1, SLCATS
+ read(19,*)
+ ENDDO
+ ENDIF
+ ENDDO FIND_soilTYPE
+ ! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
+ IF ( SIZE(BB ) < SLCATS .OR. &
+ SIZE(DRYSMC) < SLCATS .OR. &
+ SIZE(F11 ) < SLCATS .OR. &
+ SIZE(MAXSMC) < SLCATS .OR. &
+ SIZE(REFSMC) < SLCATS .OR. &
+ SIZE(SATPSI) < SLCATS .OR. &
+ SIZE(SATDK ) < SLCATS .OR. &
+ SIZE(SATDW ) < SLCATS .OR. &
+ SIZE(WLTSMC) < SLCATS .OR. &
+ SIZE(QTZ ) < SLCATS ) THEN
+ CALL wrf_error_fatal('Table sizes too small for value of SLCATS in module_sf_noahdrv.F')
+ ENDIF
+
+ ! MPC add new soil table
+ select case(trim(SLTYPE))
+ case('STAS','STAS-RUC') ! original soil tables
+ DO LC=1,SLCATS
+ READ (19,*) IINDEX,BB(LC),DRYSMC(LC),F11(LC),MAXSMC(LC),&
+ REFSMC(LC),SATPSI(LC),SATDK(LC), SATDW(LC), &
+ WLTSMC(LC), QTZ(LC)
+ ENDDO
+ case('ROSETTA') ! new soil table
+ DO LC=1,SLCATS
+ READ (19,*) IINDEX,&
+ ! new soil parameters (from Rosetta)
+ theta_res(LC), theta_sat(LC), &
+ vGn_alpha(LC), vGn_n(LC), k_soil(LC), &
+ ! original soil parameters
+ BB(LC),DRYSMC(LC),F11(LC),MAXSMC(LC),&
+ REFSMC(LC),SATPSI(LC),SATDK(LC), SATDW(LC), &
+ WLTSMC(LC), QTZ(LC)
+ ENDDO
+ case default
+ CALL wrf_message( 'SOIL TEXTURE IN INPUT FILE DOES NOT ' )
+ CALL wrf_message( 'MATCH SOILPARM TABLE' )
+ CALL wrf_error_fatal ( 'INCONSISTENT OR MISSING SOILPARM FILE' )
+ end select
-end module cppwrap_fileAccess
-
-
+ 2003 CONTINUE
+
+ CLOSE (19)
+
+ IF(LUMATCH.EQ.0)THEN
+ CALL wrf_message( 'SOIL TEXTURE IN INPUT FILE DOES NOT ' )
+ CALL wrf_message( 'MATCH SOILPARM TABLE' )
+ CALL wrf_error_fatal ( 'INCONSISTENT OR MISSING SOILPARM FILE' )
+ ENDIF
+
+ !
+ !-----READ IN GENERAL PARAMETERS FROM GENPARM.TBL
+ !
+ OPEN(19, FILE=trim(FILENAME_GENERAL),FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
+ IF(ierr .NE. OPEN_OK ) THEN
+ WRITE(message,FMT='(A)') &
+ 'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening GENPARM.TBL'
+ CALL wrf_error_fatal ( message )
+ END IF
+
+ READ (19,*)
+ READ (19,*)
+ READ (19,*) NUM_SLOPE
+
+ SLPCATS=NUM_SLOPE
+ ! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
+ IF ( SIZE(slope_data) < NUM_SLOPE ) THEN
+ CALL wrf_error_fatal('NUM_SLOPE too large for slope_data array in module_sf_noahdrv')
+ ENDIF
+
+ DO LC=1,SLPCATS
+ READ (19,*)SLOPE_DATA(LC)
+ ENDDO
+
+ READ (19,*)
+ READ (19,*)SBETA_DATA
+ READ (19,*)
+ READ (19,*)FXEXP_DATA
+ READ (19,*)
+ READ (19,*)CSOIL_DATA
+ READ (19,*)
+ READ (19,*)SALP_DATA
+ READ (19,*)
+ READ (19,*)REFDK_DATA
+ READ (19,*)
+ READ (19,*)REFKDT_DATA
+ READ (19,*)
+ READ (19,*)FRZK_DATA
+ READ (19,*)
+ READ (19,*)ZBOT_DATA
+ READ (19,*)
+ READ (19,*)CZIL_DATA
+ READ (19,*)
+ READ (19,*)SMLOW_DATA
+ READ (19,*)
+ READ (19,*)SMHIGH_DATA
+ READ (19,*)
+ READ (19,*)LVCOEF_DATA
+ CLOSE (19)
+
+END SUBROUTINE SOIL_VEG_GEN_PARM
+end module cppwrap_fileAccess
diff --git a/build/source/actors/file_access_actor/fortran_code/writeOutputFromOutputStructure.f90 b/build/source/actors/file_access_actor/fortran_code/fileAccess_writeOutput.f90
similarity index 86%
rename from build/source/actors/file_access_actor/fortran_code/writeOutputFromOutputStructure.f90
rename to build/source/actors/file_access_actor/fortran_code/fileAccess_writeOutput.f90
index f5a3ed7ffba02fbaa06b387b2033ad8862ea04e8..0eec6b43136856be20057695285bd4dcf47457c2 100644
--- a/build/source/actors/file_access_actor/fortran_code/writeOutputFromOutputStructure.f90
+++ b/build/source/actors/file_access_actor/fortran_code/fileAccess_writeOutput.f90
@@ -18,7 +18,7 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>.
-module writeOutputFromOutputStructure_module
+module fileAccess_writeOutput
USE, intrinsic :: iso_c_binding
! NetCDF types
@@ -83,6 +83,7 @@ public::writeBasin
public::writeTime
private::writeScalar
private::writeVector
+public::writeGRUStatistics
! define dimension lengths
integer(i4b),parameter :: maxSpectral=2 ! maximum number of spectral bands
contains
@@ -90,18 +91,19 @@ contains
! **********************************************************************************************************
! public subroutine writeParm: write model parameters
! **********************************************************************************************************
-subroutine writeOutput_fortran(handle_ncid, num_steps, start_gru, max_gru, err) bind(C, name="writeOutput_fortran")
+subroutine writeOutput_fortran(handle_ncid, num_steps, start_gru, max_gru, write_parm_flag, err) bind(C, name="writeOutput_fortran")
USE var_lookup,only:maxVarFreq ! # of available output frequencies
USE globalData,only:structInfo
USE globalData,only:bvarChild_map,forcChild_map,progChild_map,diagChild_map,fluxChild_map,indxChild_map ! index of the child data structure: stats bvar
- USE globalData,only:bvar_meta,time_meta,forc_meta,prog_meta,diag_meta,flux_meta,indx_meta
+ USE globalData,only:attr_meta,bvar_meta,type_meta,time_meta,forc_meta,prog_meta,diag_meta,flux_meta,indx_meta,bpar_meta,mpar_meta
USE globalData,only:maxLayers
implicit none
! dummy variables
type(c_ptr),intent(in), value :: handle_ncid ! ncid of the output file
- integer(c_int),intent(in) :: num_steps ! number of steps to write
- integer(c_int),intent(in) :: start_gru ! index of GRU we are currently writing for
- integer(c_int),intent(in) :: max_gru ! index of HRU we are currently writing for
+ integer(c_int),intent(in) :: num_steps ! number of steps to write
+ integer(c_int),intent(in) :: start_gru ! index of GRU we are currently writing for
+ integer(c_int),intent(in) :: max_gru ! index of HRU we are currently writing for
+ logical(c_bool),intent(in) :: write_parm_flag ! flag to write parameters
integer(c_int),intent(out) :: err ! Error code
! local variables
type(var_i),pointer :: ncid
@@ -116,9 +118,31 @@ subroutine writeOutput_fortran(handle_ncid, num_steps, start_gru, max_gru, err)
integer(i4b) :: iStruct
integer(i4b) :: numGRU
-
! Change the C pointer to a fortran pointer
call c_f_pointer(handle_ncid, ncid)
+
+ ! Write the Parameters if first write
+ if (write_parm_flag)then
+ do iStruct=1,size(structInfo)
+ do iGRU=start_gru, max_gru
+ select case(trim(structInfo(iStruct)%structName))
+ case('attr'); call writeParm(ncid,gru_struc(iGRU)%hruInfo(indxHRU)%hru_ix, &
+ outputStructure(1)%attrStruct%gru(iGRU)%hru(indxHRU),attr_meta,err,cmessage)
+ case('type'); call writeParm(ncid,gru_struc(iGRU)%hruInfo(indxHRU)%hru_ix, &
+ outputStructure(1)%typeStruct%gru(iGRU)%hru(indxHRU),type_meta,err,cmessage)
+ case('mpar'); call writeParm(ncid,gru_struc(iGRU)%hruInfo(indxHRU)%hru_ix, &
+ outputStructure(1)%mparStruct%gru(iGRU)%hru(indxHRU),mpar_meta,err,cmessage)
+ end select
+ if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
+ call writeParm(ncid,iGRU,outputStructure(1)%bparStruct%gru(iGRU),bpar_meta,err,cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
+ end do ! GRU
+ end do ! structInfo
+ end if
+
+
+
+
! ****************************************************************************
! *** write basin data
! ****************************************************************************
@@ -259,7 +283,7 @@ subroutine writeData(ncid,outputTimestep,outputTimestepUpdate,maxLayers,nSteps,
USE var_lookup,only:iLookIndex ! index into index structure
USE var_lookup,only:iLookStat ! index into stat structure
USE globalData,only:outFreq ! output file information
- USE globalData,only:failedHRUs
+ USE output_structure_module,only:failedHRUs
USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
USE get_ixName_module,only:get_statName ! to access type strings for error messages
@@ -656,5 +680,67 @@ subroutine writeTime(ncid,outputTimestep,iStep,meta,dat,err,message)
end subroutine writeTime
+subroutine writeGRUStatistics(handle_ncid, &
+ gru_var_ids, &
+ gru_stats_vector, &
+ num_gru, &
+ err) bind(C, name="WriteGRUStatistics")
+ USE data_types,only:var_i,netcdf_gru_actor_info,serializable_netcdf_gru_actor_info
+ USE var_lookup, only: maxvarFreq ! number of output frequencies
+ USE netcdf
+ implicit none
+ ! Dummy Variables
+ type(c_ptr), intent(in), value :: handle_ncid
+ type(netcdf_gru_actor_info),intent(in) :: gru_var_ids
+ type(serializable_netcdf_gru_actor_info),intent(in) :: gru_stats_vector(num_gru)
+ integer(c_int), intent(in) :: num_gru
+ integer(c_int), intent(out) :: err
+
+ ! Local Variables
+ type(var_i), pointer :: ncid
+ real(c_double), dimension(num_gru) :: run_time_array
+ real(c_double), dimension(num_gru) :: init_time_array
+ real(c_double), dimension(num_gru) :: forcing_time_array
+ real(c_double), dimension(num_gru) :: run_physics_time_array
+ real(c_double), dimension(num_gru) :: write_output_time_array
+ real(c_double), dimension(num_gru) :: rel_tol_array
+ real(c_double), dimension(num_gru) :: abs_tol_array
+ integer(c_int), dimension(num_gru) :: successful_array
+ integer(c_int), dimension(num_gru) :: num_attempts_array
+
+ integer(c_int) :: i
+ integer(c_int) :: iFreq
+ ! ---------------------------------------------------------------------------------------
+ ! * Convert From C++ to Fortran
+ call c_f_pointer(handle_ncid, ncid)
+
+ ! Assemble fortran arrays
+ do i=1,num_gru
+ run_time_array(i) = gru_stats_vector(i)%run_time
+ init_time_array(i) = gru_stats_vector(i)%init_duration
+ forcing_time_array(i) = gru_stats_vector(i)%forcing_duration
+ run_physics_time_array(i) = gru_stats_vector(i)%run_physics_duration
+ write_output_time_array(i) = gru_stats_vector(i)%write_output_duration
+ rel_tol_array(i) = gru_stats_vector(i)%rel_tol
+ abs_tol_array(i) = gru_stats_vector(i)%abs_tol
+ successful_array(i) = gru_stats_vector(i)%successful
+ num_attempts_array(i) = gru_stats_vector(i)%num_attempts
+ end do
+
+ ! Write to NetCDF
+ do iFreq=1, maxvarFreq
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%run_time_var_id, run_time_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%init_duration_var_id, init_time_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%forcing_duration_var_id, forcing_time_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%run_physics_duration_var_id, run_physics_time_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%write_output_duration_var_id, write_output_time_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%state_var_id, successful_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%num_attempts_var_id, num_attempts_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%rel_tol_var_id, rel_tol_array)
+ err = nf90_put_var(ncid%var(iFreq), gru_var_ids%abs_tol_var_id, abs_tol_array)
+ end do
+
+end subroutine writeGRUStatistics
+
-end module writeOutputFromOutputStructure_module
\ No newline at end of file
+end module fileAccess_writeOutput
\ No newline at end of file
diff --git a/build/source/actors/file_access_actor/fortran_code/output_structure.f90 b/build/source/actors/file_access_actor/fortran_code/output_structure.f90
index 719993917817093b45a23656d5b87e6cdcb4ea89..05b031733190094f83d5d23b48e15c30ab4fa33a 100644
--- a/build/source/actors/file_access_actor/fortran_code/output_structure.f90
+++ b/build/source/actors/file_access_actor/fortran_code/output_structure.f90
@@ -102,8 +102,9 @@ module output_structure_module
end type summa_output_type
- type(summa_output_type),allocatable,save,public :: outputStructure(:) ! summa_OutputStructure(1)%struc%var(:)%dat(nTimeSteps)
- type(ilength),allocatable,save,public :: outputTimeStep(:) ! timestep in output files
+ type(summa_output_type),allocatable,save,public :: outputStructure(:) ! summa_OutputStructure(1)%struc%var(:)%dat(nTimeSteps)
+ type(ilength),allocatable,save,public :: outputTimeStep(:) ! timestep in output files
+ logical(lgt),allocatable,save,public :: failedHRUs(:) ! list of true and false values to indicate if an HRU has failed
contains
diff --git a/build/source/actors/file_access_actor/fortran_code/read_force.f90 b/build/source/actors/file_access_actor/fortran_code/read_force.f90
index 751dc8feabe1606b01f18cc5d153718a681b1e78..f75525073157bda8e7cdad332eb67287bb327c4f 100644
--- a/build/source/actors/file_access_actor/fortran_code/read_force.f90
+++ b/build/source/actors/file_access_actor/fortran_code/read_force.f90
@@ -9,25 +9,26 @@ USE nrtype
USE data_types,only:file_info
USE data_types,only:file_info_array
+USE data_types,only:var_forc ! global data structure for forcing data
+USE data_types,only:dlength ! global data structure for forcing data
+USE data_types,only:ilength ! global data structure for forcing data
USE globalData,only:gru_struc
-USE globalData,only:forcingDataStruct
-USE globalData,only:vecTime
USE globalData,only:time_meta,forc_meta ! metadata structures
USE globalData,only:integerMissing ! integer missing value
-
-
USE var_lookup,only:iLookTIME,iLookFORCE ! named variables to define structure elements
-
-
USE summaFileManager,only:FORCING_PATH ! path of the forcing data file
USE netcdf_util_module,only:nc_file_close ! close netcdf file
+
implicit none
private
public::read_forcingFile
+type(var_forc),allocatable,save,public :: forcingDataStruct(:) ! forcingDataStruct(:)%var(:)%dataFromFile(:,:)
+type(dlength),allocatable,save,public :: vecTime(:)
+
contains
subroutine read_forcingFile(handle_forcFileInfo, iFile, stepsInFile, startGRU, numGRU, err) bind(C,name="read_forcingFile")
USE netcdf ! netcdf capability
diff --git a/build/source/actors/file_access_actor/fortran_code/write_to_netcdf.f90 b/build/source/actors/file_access_actor/fortran_code/write_to_netcdf.f90
deleted file mode 100644
index 18c8909ff75d4050205e5791f61f52f6eef33f1d..0000000000000000000000000000000000000000
--- a/build/source/actors/file_access_actor/fortran_code/write_to_netcdf.f90
+++ /dev/null
@@ -1,148 +0,0 @@
-module write_to_netcdf_module
-USE, intrinsic :: iso_c_binding
-USE nrtype
-USE data_types
-
-!TODO: This module is only used for writeParamToNetCDF the others are not.
-
-
-implicit none
-public::writeParamToNetCDF
-public::writeGRUStatistics
-
-contains
-
-! Subroutine that writes data from the HRU actor to be written to netcdf
-subroutine writeParamToNetCDF(handle_ncid, &
- index_gru, &
- index_hru, &
- handle_attr_struct, &
- handle_type_struct, &
- handle_mpar_struct, &
- handle_bpar_struct, &
- err) bind(C, name="writeParamToNetCDF")
- USE globalData,only:attr_meta,type_meta,mpar_meta,bpar_meta ! meta structures
- USE globalData,only:gru_struc
- USE modelwrite_module,only:writeParm
- USE globalData,only:structInfo ! information on the data structures
- implicit none
- ! dummy variables
- type(c_ptr), intent(in), value :: handle_ncid ! ncid of the output file
- integer(c_int),intent(in) :: index_gru ! index of GRU in gru_struc
- integer(c_int),intent(in) :: index_hru ! index of HRU in gru_struc
- type(c_ptr), intent(in), value :: handle_attr_struct
- type(c_ptr), intent(in), value :: handle_type_struct
- type(c_ptr), intent(in), value :: handle_mpar_struct
- type(c_ptr), intent(in), value :: handle_bpar_struct
- integer(c_int),intent(out) :: err
- ! local variables pointers
- type(var_i), pointer :: ncid
- type(var_d), pointer :: attr_struct
- type(var_i), pointer :: type_struct
- type(var_dlength), pointer :: mpar_struct
- type(var_d),pointer :: bpar_struct
- ! local variables
- integer(i4b) :: iStruct
- character(LEN=256) :: cmessage
- character(LEN=256) :: message
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- ! ---------------------------------------------------------------------------------------
- message="file_access_actor.f90 - writeParamToNetCDF"
- call c_f_pointer(handle_ncid, ncid)
- call c_f_pointer(handle_attr_struct, attr_struct)
- call c_f_pointer(handle_type_struct, type_struct)
- call c_f_pointer(handle_mpar_struct, mpar_struct)
- call c_f_pointer(handle_bpar_struct, bpar_struct)
-
- do iStruct=1,size(structInfo)
- select case(trim(structInfo(iStruct)%structName))
- case('attr'); call writeParm(ncid,gru_struc(index_gru)%hruInfo(index_hru)%hru_ix, &
- attr_struct,attr_meta,err,cmessage)
- case('type'); call writeParm(ncid,gru_struc(index_gru)%hruInfo(index_hru)%hru_ix, &
- type_struct,type_meta,err,cmessage)
- case('mpar'); call writeParm(ncid,gru_struc(index_gru)%hruInfo(index_hru)%hru_ix, &
- mpar_struct,mpar_meta,err,cmessage)
- end select
- if(err/=0)then
- message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'
- print*, message
- return
- endif
- end do
-
- ! write GRU parameters
- call writeParm(ncid,index_gru,bpar_struct,bpar_meta,err,cmessage)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-end subroutine writeParamToNetCDF
-
-
-
-subroutine writeGRUStatistics(handle_ncid, &
- gru_var_ids, &
- gru_stats_vector, &
- num_gru, &
- err) bind(C, name="WriteGRUStatistics")
- USE data_types,only:var_i,netcdf_gru_actor_info,serializable_netcdf_gru_actor_info
- USE var_lookup, only: maxvarFreq ! number of output frequencies
- USE netcdf
- implicit none
- ! Dummy Variables
- type(c_ptr), intent(in), value :: handle_ncid
- type(netcdf_gru_actor_info),intent(in) :: gru_var_ids
- type(serializable_netcdf_gru_actor_info),intent(in) :: gru_stats_vector(num_gru)
- integer(c_int), intent(in) :: num_gru
- integer(c_int), intent(out) :: err
-
- ! Local Variables
- type(var_i), pointer :: ncid
- real(c_double), dimension(num_gru) :: run_time_array
- real(c_double), dimension(num_gru) :: init_time_array
- real(c_double), dimension(num_gru) :: forcing_time_array
- real(c_double), dimension(num_gru) :: run_physics_time_array
- real(c_double), dimension(num_gru) :: write_output_time_array
- real(c_double), dimension(num_gru) :: rel_tol_array
- real(c_double), dimension(num_gru) :: abs_tol_array
- integer(c_int), dimension(num_gru) :: successful_array
- integer(c_int), dimension(num_gru) :: num_attempts_array
-
- integer(c_int) :: i
- integer(c_int) :: iFreq
- ! ---------------------------------------------------------------------------------------
- ! * Convert From C++ to Fortran
- call c_f_pointer(handle_ncid, ncid)
-
- ! Assemble fortran arrays
- do i=1,num_gru
- run_time_array(i) = gru_stats_vector(i)%run_time
- init_time_array(i) = gru_stats_vector(i)%init_duration
- forcing_time_array(i) = gru_stats_vector(i)%forcing_duration
- run_physics_time_array(i) = gru_stats_vector(i)%run_physics_duration
- write_output_time_array(i) = gru_stats_vector(i)%write_output_duration
- rel_tol_array(i) = gru_stats_vector(i)%rel_tol
- abs_tol_array(i) = gru_stats_vector(i)%abs_tol
- successful_array(i) = gru_stats_vector(i)%successful
- num_attempts_array(i) = gru_stats_vector(i)%num_attempts
- end do
-
- ! Write to NetCDF
- do iFreq=1, maxvarFreq
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%run_time_var_id, run_time_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%init_duration_var_id, init_time_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%forcing_duration_var_id, forcing_time_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%run_physics_duration_var_id, run_physics_time_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%write_output_duration_var_id, write_output_time_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%state_var_id, successful_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%num_attempts_var_id, num_attempts_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%rel_tol_var_id, rel_tol_array)
- err = nf90_put_var(ncid%var(iFreq), gru_var_ids%abs_tol_var_id, abs_tol_array)
- end do
-
-end subroutine writeGRUStatistics
-
-
-end module write_to_netcdf_module
\ No newline at end of file
diff --git a/build/source/actors/hru_actor/cpp_code/hru_actor.cpp b/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
index 61b493db9fee4a33edf50d95eaa60b189c416e1b..13eeb6ef853e9704bb2f4bfc7f6dce3eb364f388 100644
--- a/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
+++ b/build/source/actors/hru_actor/cpp_code/hru_actor.cpp
@@ -45,38 +45,13 @@ behavior hru_actor(stateful_actor<hru_state>* self, int refGRU, int indxGRU,
caf::infinite,
get_num_output_steps_v)
.await([=](int num_steps){
- self->state.num_steps_until_write = num_steps;
- Initialize_HRU(self);
- self->send(self, start_hru_v);
+ self->state.num_steps_until_write = num_steps;
+ Initialize_HRU(self);
+ // Get Forcing information from the File Access Actor to start the simulation
+ self->send(self->state.file_access_actor, access_forcing_v, self->state.iFile, self);
});
return {
-
- // First method called after initialization, starts the HRU and the HRU asks
- // for parameters and forcing data from the file_access_actor
- [=](start_hru) {
- int err = 0;
- std::vector<double> attr_struct_array = get_attr_struct(self->state.hru_data);
- std::vector<int> type_struct_array = get_type_struct(self->state.hru_data);
- std::vector<std::vector<double>> mpar_struct_array = get_mpar_struct_array(self->state.hru_data);
- std::vector<double> bpar_struct_array = get_bpar_struct(self->state.hru_data);
-
- // ask file_access_actor to write parameters
- self->send(self->state.file_access_actor,
- write_param_v,
- self->state.indxGRU,
- self->state.indxHRU,
- attr_struct_array,
- type_struct_array,
- mpar_struct_array,
- bpar_struct_array);
-
- // ask file_access_actor for forcing data
- self->send(self->state.file_access_actor,
- access_forcing_v,
- self->state.iFile,
- self);
- },
[=](num_steps_before_write, int num_steps) {
self->state.num_steps_until_write = num_steps;
self->state.output_structure_step_index = 1;
@@ -240,10 +215,11 @@ int Run_HRU(stateful_actor<hru_state>* self) {
}
hru_writeOutput(&self->state.indxHRU,
- &self->state.indxGRU,
- &self->state.output_structure_step_index,
- self->state.hru_data,
- &self->state.err);
+ &self->state.indxGRU,
+ &self->state.timestep,
+ &self->state.output_structure_step_index,
+ self->state.hru_data,
+ &self->state.err);
if (self->state.err != 0) {
aout(self) << "Error: HRU_Actor - writeHRUToOutputStructure - HRU = " << self->state.indxHRU
<< " - indxGRU = " << self->state.indxGRU << " - refGRU = " << self->state.refGRU
diff --git a/build/source/actors/hru_actor/fortran_code/hru_init.f90 b/build/source/actors/hru_actor/fortran_code/hru_init.f90
index c1050a8b4896dffd8fca7134d7ff4b4ac88c3add..9817da9d12fd6c884b6b264d42c6a0fe3d9582dc 100755
--- a/build/source/actors/hru_actor/fortran_code/hru_init.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_init.f90
@@ -58,7 +58,6 @@ implicit none
private
public::initHRU
public::setupHRUParam
-public::SOIL_VEG_GEN_PARM
public::summa_readRestart
public::setIDATolerances
contains
@@ -345,273 +344,6 @@ subroutine setupHRUParam(indxGRU, & ! ID of hru
end subroutine setupHRUParam
-
-! **************************************************************************************************
-! private subroutine SOIL_VEG_GEN_PARM: Read soil, vegetation and other model parameters (from NOAH)
-! **************************************************************************************************
-SUBROUTINE SOIL_VEG_GEN_PARM(FILENAME_VEGTABLE, FILENAME_SOILTABLE, FILENAME_GENERAL, MMINLU, MMINSL)
- !-----------------------------------------------------------------
- use module_sf_noahlsm, only : shdtbl, nrotbl, rstbl, rgltbl, &
- & hstbl, snuptbl, maxalb, laimintbl, &
- & bb, drysmc, f11, maxsmc, laimaxtbl, &
- & emissmintbl, emissmaxtbl, albedomintbl, &
- & albedomaxtbl, wltsmc, qtz, refsmc, &
- & z0mintbl, z0maxtbl, &
- & satpsi, satdk, satdw, &
- & theta_res, theta_sat, vGn_alpha, vGn_n, k_soil, & ! MPC add van Genutchen parameters
- & fxexp_data, lvcoef_data, &
- & lutype, maxalb, &
- & slope_data, frzk_data, bare, cmcmax_data, &
- & cfactr_data, csoil_data, czil_data, &
- & refkdt_data, natural, refdk_data, &
- & rsmax_data, salp_data, sbeta_data, &
- & zbot_data, smhigh_data, smlow_data, &
- & lucats, topt_data, slcats, slpcats, sltype
-
- IMPLICIT NONE
-
- CHARACTER(LEN=*), INTENT(IN) :: FILENAME_VEGTABLE, FILENAME_SOILTABLE, FILENAME_GENERAL
- CHARACTER(LEN=*), INTENT(IN) :: MMINLU, MMINSL
- integer :: LUMATCH, IINDEX, LC, NUM_SLOPE
- integer :: ierr
- INTEGER , PARAMETER :: OPEN_OK = 0
-
- character*128 :: mess , message
-
- !-----SPECIFY VEGETATION RELATED CHARACTERISTICS :
- ! ALBBCK: SFC albedo (in percentage)
- ! Z0: Roughness length (m)
- ! SHDFAC: Green vegetation fraction (in percentage)
- ! Note: The ALBEDO, Z0, and SHDFAC values read from the following table
- ! ALBEDO, amd Z0 are specified in LAND-USE TABLE; and SHDFAC is
- ! the monthly green vegetation data
- ! CMXTBL: MAX CNPY Capacity (m)
- ! NROTBL: Rooting depth (layer)
- ! RSMIN: Mimimum stomatal resistance (s m-1)
- ! RSMAX: Max. stomatal resistance (s m-1)
- ! RGL: Parameters used in radiation stress function
- ! HS: Parameter used in vapor pressure deficit functio
- ! TOPT: Optimum transpiration air temperature. (K)
- ! CMCMAX: Maximum canopy water capacity
- ! CFACTR: Parameter used in the canopy inteception calculati
- ! SNUP: Threshold snow depth (in water equivalent m) that
- ! implies 100% snow cover
- ! LAI: Leaf area index (dimensionless)
- ! MAXALB: Upper bound on maximum albedo over deep snow
- !
- !-----READ IN VEGETAION PROPERTIES FROM VEGPARM.TBL
- !
-
- OPEN(19, FILE=trim(FILENAME_VEGTABLE),FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
- IF(ierr .NE. OPEN_OK ) THEN
- WRITE(message,FMT='(A)') &
- 'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening VEGPARM.TBL'
- CALL wrf_error_fatal ( message )
- END IF
-
- LUMATCH=0
-
- FIND_LUTYPE : DO WHILE (LUMATCH == 0)
- READ (19,*,END=2002)
- READ (19,*,END=2002)LUTYPE
- READ (19,*)LUCATS,IINDEX
-
- IF(LUTYPE.EQ.MMINLU)THEN
- WRITE( mess , * ) 'LANDUSE TYPE = ' // TRIM ( LUTYPE ) // ' FOUND', LUCATS,' CATEGORIES'
- ! CALL wrf_message( mess )
- LUMATCH=1
- ELSE
- ! call wrf_message ( "Skipping over LUTYPE = " // TRIM ( LUTYPE ) )
- DO LC = 1, LUCATS+12
- read(19,*)
- ENDDO
- ENDIF
- ENDDO FIND_LUTYPE
- ! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
- IF ( SIZE(SHDTBL) < LUCATS .OR. &
- SIZE(NROTBL) < LUCATS .OR. &
- SIZE(RSTBL) < LUCATS .OR. &
- SIZE(RGLTBL) < LUCATS .OR. &
- SIZE(HSTBL) < LUCATS .OR. &
- SIZE(SNUPTBL) < LUCATS .OR. &
- SIZE(MAXALB) < LUCATS .OR. &
- SIZE(LAIMINTBL) < LUCATS .OR. &
- SIZE(LAIMAXTBL) < LUCATS .OR. &
- SIZE(Z0MINTBL) < LUCATS .OR. &
- SIZE(Z0MAXTBL) < LUCATS .OR. &
- SIZE(ALBEDOMINTBL) < LUCATS .OR. &
- SIZE(ALBEDOMAXTBL) < LUCATS .OR. &
- SIZE(EMISSMINTBL ) < LUCATS .OR. &
- SIZE(EMISSMAXTBL ) < LUCATS ) THEN
- CALL wrf_error_fatal('Table sizes too small for value of LUCATS in module_sf_noahdrv.F')
- ENDIF
-
- IF(LUTYPE.EQ.MMINLU)THEN
- DO LC=1,LUCATS
- READ (19,*)IINDEX,SHDTBL(LC), &
- NROTBL(LC),RSTBL(LC),RGLTBL(LC),HSTBL(LC), &
- SNUPTBL(LC),MAXALB(LC), LAIMINTBL(LC), &
- LAIMAXTBL(LC),EMISSMINTBL(LC), &
- EMISSMAXTBL(LC), ALBEDOMINTBL(LC), &
- ALBEDOMAXTBL(LC), Z0MINTBL(LC), Z0MAXTBL(LC)
- ENDDO
-
- READ (19,*)
- READ (19,*)TOPT_DATA
- READ (19,*)
- READ (19,*)CMCMAX_DATA
- READ (19,*)
- READ (19,*)CFACTR_DATA
- READ (19,*)
- READ (19,*)RSMAX_DATA
- READ (19,*)
- READ (19,*)BARE
- READ (19,*)
- READ (19,*)NATURAL
- ENDIF
-
- 2002 CONTINUE
-
- CLOSE (19)
- IF (LUMATCH == 0) then
- CALL wrf_error_fatal ("Land Use Dataset '"//MMINLU//"' not found in VEGPARM.TBL.")
- ENDIF
-
- !
- !-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL
- !
- OPEN(19, FILE=trim(FILENAME_SOILTABLE),FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
- IF(ierr .NE. OPEN_OK ) THEN
- WRITE(message,FMT='(A)') &
- 'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening SOILPARM.TBL'
- CALL wrf_error_fatal ( message )
- END IF
-
- WRITE(mess,*) 'INPUT SOIL TEXTURE CLASSIFICATION = ', TRIM ( MMINSL )
- ! CALL wrf_message( mess )
-
- LUMATCH=0
-
- ! MPC add a new soil table
- FIND_soilTYPE : DO WHILE (LUMATCH == 0)
- READ (19,*)
- READ (19,*,END=2003)SLTYPE
- READ (19,*)SLCATS,IINDEX
- IF(SLTYPE.EQ.MMINSL)THEN
- WRITE( mess , * ) 'SOIL TEXTURE CLASSIFICATION = ', TRIM ( SLTYPE ) , ' FOUND', &
- SLCATS,' CATEGORIES'
- ! CALL wrf_message ( mess )
- LUMATCH=1
- ELSE
- ! call wrf_message ( "Skipping over SLTYPE = " // TRIM ( SLTYPE ) )
- DO LC = 1, SLCATS
- read(19,*)
- ENDDO
- ENDIF
- ENDDO FIND_soilTYPE
- ! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
- IF ( SIZE(BB ) < SLCATS .OR. &
- SIZE(DRYSMC) < SLCATS .OR. &
- SIZE(F11 ) < SLCATS .OR. &
- SIZE(MAXSMC) < SLCATS .OR. &
- SIZE(REFSMC) < SLCATS .OR. &
- SIZE(SATPSI) < SLCATS .OR. &
- SIZE(SATDK ) < SLCATS .OR. &
- SIZE(SATDW ) < SLCATS .OR. &
- SIZE(WLTSMC) < SLCATS .OR. &
- SIZE(QTZ ) < SLCATS ) THEN
- CALL wrf_error_fatal('Table sizes too small for value of SLCATS in module_sf_noahdrv.F')
- ENDIF
-
- ! MPC add new soil table
- select case(trim(SLTYPE))
- case('STAS','STAS-RUC') ! original soil tables
- DO LC=1,SLCATS
- READ (19,*) IINDEX,BB(LC),DRYSMC(LC),F11(LC),MAXSMC(LC),&
- REFSMC(LC),SATPSI(LC),SATDK(LC), SATDW(LC), &
- WLTSMC(LC), QTZ(LC)
- ENDDO
- case('ROSETTA') ! new soil table
- DO LC=1,SLCATS
- READ (19,*) IINDEX,&
- ! new soil parameters (from Rosetta)
- theta_res(LC), theta_sat(LC), &
- vGn_alpha(LC), vGn_n(LC), k_soil(LC), &
- ! original soil parameters
- BB(LC),DRYSMC(LC),F11(LC),MAXSMC(LC),&
- REFSMC(LC),SATPSI(LC),SATDK(LC), SATDW(LC), &
- WLTSMC(LC), QTZ(LC)
- ENDDO
- case default
- CALL wrf_message( 'SOIL TEXTURE IN INPUT FILE DOES NOT ' )
- CALL wrf_message( 'MATCH SOILPARM TABLE' )
- CALL wrf_error_fatal ( 'INCONSISTENT OR MISSING SOILPARM FILE' )
- end select
-
- 2003 CONTINUE
-
- CLOSE (19)
-
- IF(LUMATCH.EQ.0)THEN
- CALL wrf_message( 'SOIL TEXTURE IN INPUT FILE DOES NOT ' )
- CALL wrf_message( 'MATCH SOILPARM TABLE' )
- CALL wrf_error_fatal ( 'INCONSISTENT OR MISSING SOILPARM FILE' )
- ENDIF
-
- !
- !-----READ IN GENERAL PARAMETERS FROM GENPARM.TBL
- !
- OPEN(19, FILE=trim(FILENAME_GENERAL),FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
- IF(ierr .NE. OPEN_OK ) THEN
- WRITE(message,FMT='(A)') &
- 'module_sf_noahlsm.F: soil_veg_gen_parm: failure opening GENPARM.TBL'
- CALL wrf_error_fatal ( message )
- END IF
-
- READ (19,*)
- READ (19,*)
- READ (19,*) NUM_SLOPE
-
- SLPCATS=NUM_SLOPE
- ! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
- IF ( SIZE(slope_data) < NUM_SLOPE ) THEN
- CALL wrf_error_fatal('NUM_SLOPE too large for slope_data array in module_sf_noahdrv')
- ENDIF
-
- DO LC=1,SLPCATS
- READ (19,*)SLOPE_DATA(LC)
- ENDDO
-
- READ (19,*)
- READ (19,*)SBETA_DATA
- READ (19,*)
- READ (19,*)FXEXP_DATA
- READ (19,*)
- READ (19,*)CSOIL_DATA
- READ (19,*)
- READ (19,*)SALP_DATA
- READ (19,*)
- READ (19,*)REFDK_DATA
- READ (19,*)
- READ (19,*)REFKDT_DATA
- READ (19,*)
- READ (19,*)FRZK_DATA
- READ (19,*)
- READ (19,*)ZBOT_DATA
- READ (19,*)
- READ (19,*)CZIL_DATA
- READ (19,*)
- READ (19,*)SMLOW_DATA
- READ (19,*)
- READ (19,*)SMHIGH_DATA
- READ (19,*)
- READ (19,*)LVCOEF_DATA
- CLOSE (19)
-
-END SUBROUTINE SOIL_VEG_GEN_PARM
-
-
-
! **************************************************************************************************
! public subroutine summa_readRestart: read restart data and reset the model state
! **************************************************************************************************
@@ -655,14 +387,15 @@ subroutine summa_readRestart(indxGRU, & ! index of GRU in gru_struc
! ---------------------------------------------------------------------------------------
! Fortran Pointers
! ---------------------------------------------------------------------------------------
- type(hru_type),pointer :: hru_data
+ type(hru_type),pointer :: hru_data
! ---------------------------------------------------------------------------------------
! local variables
! ---------------------------------------------------------------------------------------
- character(len=256) :: message ! error message
- character(LEN=256) :: cmessage ! error message of downwind routine
- character(LEN=256) :: restartFile ! restart file name
- integer(i4b) :: nGRU
+ integer(i4b) :: ivar ! index of variable
+ character(len=256) :: message ! error message
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ character(LEN=256) :: restartFile ! restart file name
+ integer(i4b) :: nGRU
! ---------------------------------------------------------------------------------------
call c_f_pointer(handle_hru_data, hru_data)
@@ -748,11 +481,6 @@ subroutine summa_readRestart(indxGRU, & ! index of GRU in gru_struc
! initialize time step length
dt_init = hru_data%progStruct%var(iLookPROG%dt_init)%dat(1) ! seconds
-
- ! *****************************************************************************
- ! *** finalize
- ! *****************************************************************************
-
end subroutine summa_readRestart
! Set the HRU's relative and absolute tolerances
diff --git a/build/source/actors/hru_actor/fortran_code/hru_read.f90 b/build/source/actors/hru_actor/fortran_code/hru_read.f90
index 8d75099c82b0de51a1d8ce8d7e8457c2f3982a2d..86a4e84e8ae946c592de30141eedb8af7df67924 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_read.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_read.f90
@@ -24,7 +24,7 @@ contains
! set the refTimeString and extract the time to set the tmZonOffsetFracDay
subroutine setTimeZoneOffset(iFile, handle_hru_data, err) bind(C, name="setTimeZoneOffset")
- USE globalData,only:forcingDataStruct ! forcing structure
+ USE access_forcing_module,only:forcingDataStruct ! forcing structure
USE time_utils_module,only:extractTime ! extract time info from units string
USE time_utils_module,only:fracDay ! compute fractional day
USE summafilemanager,only:NC_TIME_ZONE
@@ -72,8 +72,8 @@ subroutine HRU_readForcing(indxGRU, iStep, iRead, iFile, handle_hru_data, err) b
USE globalData,only:dJulianStart ! julian day of start time of simulation
USE globalData,only:refJulDay_data ! reference time for data files (fractional julian days)
USE globalData,only:integerMissing ! integer missing value
- USE globalData,only:vecTime
- USE globalData,only:forcingDataStruct
+ USE access_forcing_module,only:vecTime
+ USE access_forcing_module,only:forcingDataStruct
USE globalData,only:time_meta,forc_meta
USE var_lookup,only:iLookTIME,iLookFORCE
USE data_types,only:var_i,var_d
@@ -234,8 +234,8 @@ end subroutine HRU_readForcing
! Find the first timestep within the forcing file
subroutine getFirstTimestep(iFile, iRead, err)
- USE globalData,only:forcingDataStruct ! forcing structure
- USE globalData,only:vecTime ! time structure for forcing
+ USE access_forcing_module,only:forcingDataStruct ! forcing structure
+ USE access_forcing_module,only:vecTime ! time structure for forcing
USE globalData,only:dJulianStart ! julian day of start time of simulation
USE globalData,only:data_step ! length of the data step (s)
USE globalData,only:refJulDay_data ! reference time for data files (fractional julian days)
diff --git a/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90 b/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90
index 8d0e33effd1762d5df9ee0646153fc8638d75939..37a65c027810566e937231f058e5a1f76165ec06 100644
--- a/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90
+++ b/build/source/actors/hru_actor/fortran_code/hru_writeOutput.f90
@@ -73,6 +73,7 @@ contains
subroutine hru_writeOutput(&
indxHRU, &
indxGRU, &
+ timestep, & ! model timestep
outputStep, & ! index into the output Struc
handle_hru_data, & ! local HRU data
err) bind(C, name="hru_writeOutput")
@@ -101,6 +102,7 @@ subroutine hru_writeOutput(&
implicit none
integer(c_int),intent(in) :: indxHRU ! index of hru in GRU
integer(c_int),intent(in) :: indxGRU ! index of the GRU
+ integer(c_int),intent(in) :: timestep ! model timestep
integer(c_int),intent(in) :: outputStep ! index into the output Struc
type(c_ptr),intent(in),value :: handle_hru_data ! local HRU data
integer(c_int),intent(out) :: err
@@ -132,6 +134,22 @@ subroutine hru_writeOutput(&
err, cmessage) ! error control
if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ ! Write Parameters to output structure if this is the first
+ if (timestep == 1)then
+ do iStruct=1,size(structInfo)
+ select case(trim(structInfo(iStruct)%structName))
+ case('attr'); call writeParm(indxGRU,indxHRU,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix,hru_data%attrStruct,attr_meta,structInfo(iStruct)%structName,err,cmessage)
+ case('type'); call writeParm(indxGRU,indxHRU,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix,hru_data%typeStruct,type_meta,structInfo(iStruct)%structName,err,cmessage)
+ case('mpar'); call writeParm(indxGRU,indxHRU,gru_struc(indxGRU)%hruInfo(indxHRU)%hru_ix,hru_data%mparStruct,mpar_meta,structInfo(iStruct)%structName,err,cmessage)
+ end select
+ if(err/=0)then; message=trim(message)//trim(cmessage)//'['//trim(structInfo(iStruct)%structName)//']'; return; endif
+ end do ! (looping through structures)
+ call writeParm(indxGRU,indxHRU,indxGRU,hru_data%bparStruct,bpar_meta,'bpar',err,cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage)//'[bpar]'; return; endif
+ endif
+
+
+
! If we do not do this looping we segfault - I am not sure why
outputStructure(1)%finalizeStats%gru(indxGRU)%hru(indxHRU)%tim(outputStep)%dat(:) = hru_data%finalizeStats%dat(:)