Skip to content

Commit

Permalink
Replaced pointers with associate block in multi_driver.f90
Browse files Browse the repository at this point in the history
Also changes nSnow, nSoil, and nLayer to integers rather than pointers.
  • Loading branch information
bartnijssen committed May 1, 2015
1 parent 54e617c commit 16ea435
Showing 1 changed file with 27 additions and 28 deletions.
55 changes: 27 additions & 28 deletions build/source/driver/multi_driver.f90
Original file line number Diff line number Diff line change
Expand Up @@ -128,17 +128,10 @@ program multi_driver
character(len=256) :: fuseFileManager='' ! path/name of file defining directories and files
character(len=256) :: fileout='' ! output filename
! define pointers for model indices
integer(i4b),pointer :: nSnow=>null() ! number of snow layers
integer(i4b),pointer :: nSoil=>null() ! number of soil layers
integer(i4b),pointer :: nLayers=>null() ! total number of layers
integer(i4b),pointer :: midSnowStartIndex=>null() ! start index of the midSnow vector for a given timestep
integer(i4b),pointer :: midSoilStartIndex=>null() ! start index of the midSoil vector for a given timestep
integer(i4b),pointer :: midTotoStartIndex=>null() ! start index of the midToto vector for a given timestep
integer(i4b),pointer :: ifcSnowStartIndex=>null() ! start index of the ifcSnow vector for a given timestep
integer(i4b),pointer :: ifcSoilStartIndex=>null() ! start index of the ifcSoil vector for a given timestep
integer(i4b),pointer :: ifcTotoStartIndex=>null() ! start index of the ifcToto vector for a given timestep
integer(i4b) :: nSnow ! number of snow layers
integer(i4b) :: nSoil ! number of soil layers
integer(i4b) :: nLayers ! total number of layers
real(dp),allocatable :: dt_init(:) ! used to initialize the length of the sub-step for each HRU
real(dp),pointer :: totalArea=>null() ! total basin area (m2)
! exfiltration
real(dp) :: totalStorage ! total water in the soil column (m)
real(dp) :: availStorage ! water required to bring the entire soil column to saturation (m)
Expand All @@ -165,6 +158,21 @@ program multi_driver
integer(i4b) :: err=0 ! error code
character(len=1024) :: message='' ! error message

! ----------------------------------------------------------------------------------
! associate variables in data structure
associate(&
! associate the model index structures
midSnowStartIndex => indx_data%var(iLookINDEX%midSnowStartIndex)%dat(1), &
midSoilStartIndex => indx_data%var(iLookINDEX%midSoilStartIndex)%dat(1), &
midTotoStartIndex => indx_data%var(iLookINDEX%midTotoStartIndex)%dat(1), &
ifcSnowStartIndex => indx_data%var(iLookINDEX%ifcSnowStartIndex)%dat(1), &
ifcSoilStartIndex => indx_data%var(iLookINDEX%ifcSoilStartIndex)%dat(1), &
ifcTotoStartIndex => indx_data%var(iLookINDEX%ifcTotoStartIndex)%dat(1), &
! associate the model variables
totalArea => bvar_data%var(iLookBVAR%basin__totalArea)%dat(1) &
) ! end associate
! ----------------------------------------------------------------------------------

! *****************************************************************************
! (1) inital priming -- get command line arguments, identify files, etc.
! *****************************************************************************
Expand Down Expand Up @@ -329,7 +337,6 @@ program multi_driver
exfilMin = -supersatScale*log(1._dp/fSmall - 1._dp) + supersatThresh

! identify the total basin area (m2)
totalArea => bvar_data%var(iLookBVAR%basin__totalArea)%dat(1)
totalArea = 0._dp
do iHRU=1,nHRU
totalArea = totalArea + attr_hru(iHRU)%var(iLookATTR%HRUarea)
Expand Down Expand Up @@ -475,24 +482,12 @@ program multi_driver
fracHRU = attr_data%var(iLookATTR%HRUarea) / bvar_data%var(iLookBVAR%basin__totalArea)%dat(1)

! get height at bottom of each soil layer, negative downwards (used in Noah MP)
nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1)
nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1)
nSnow = indx_data%var(iLookINDEX%nSnow)%dat(1)
nSoil = indx_data%var(iLookINDEX%nSoil)%dat(1)
nLayers = indx_data%var(iLookINDEX%nLayers)%dat(1)
allocate(zSoilReverseSign(nSoil),stat=err); call handle_err(err,'problem allocating space for zSoilReverseSign')
zSoilReverseSign(1:nSoil) = -mvar_data%var(iLookMVAR%iLayerHeight)%dat(nSnow+1:nSnow+nSoil)

! assign pointers to model layers
nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1)
nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1)
nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1)

! assign pointers to model indices
midSnowStartIndex => indx_data%var(iLookINDEX%midSnowStartIndex)%dat(1)
midSoilStartIndex => indx_data%var(iLookINDEX%midSoilStartIndex)%dat(1)
midTotoStartIndex => indx_data%var(iLookINDEX%midTotoStartIndex)%dat(1)
ifcSnowStartIndex => indx_data%var(iLookINDEX%ifcSnowStartIndex)%dat(1)
ifcSoilStartIndex => indx_data%var(iLookINDEX%ifcSoilStartIndex)%dat(1)
ifcTotoStartIndex => indx_data%var(iLookINDEX%ifcTotoStartIndex)%dat(1)

! get NOAH-MP parameters
call REDPRM(type_data%var(iLookTYPE%vegTypeIndex), & ! vegetation type index
type_data%var(iLookTYPE%soilTypeIndex), & ! soil type
Expand Down Expand Up @@ -714,10 +709,13 @@ program multi_driver

call stop_program('finished simulation')

end associate

contains


! **************************************************************************************************
! private subroutine handle_err: error handler
! internal subroutine handle_err: error handler
! **************************************************************************************************
subroutine handle_err(err,message)
! used to handle error codes
Expand Down Expand Up @@ -776,8 +774,9 @@ subroutine handle_err(err,message)
stop
end subroutine handle_err


! **************************************************************************************************
! private subroutine stop_program: stop program execution
! internal subroutine stop_program: stop program execution
! **************************************************************************************************
subroutine stop_program(message)
! used to stop program execution
Expand Down

0 comments on commit 16ea435

Please sign in to comment.