Commit 116b1c1f authored by Sebastian Müller's avatar Sebastian Müller 🎸

EDK_driver: use new edk_dist class; reformat for readability

parent 9fcedbf7
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
! UPDATES ! UPDATES
! Created Sa 21.03.2006 ! Created Sa 21.03.2006
! Last Update Sa 11.06.2010 ! blocks, whole Germany ! Last Update Sa 11.06.2010 ! blocks, whole Germany
! Last Update Zi 04.02.2012 ! changed to general edk version ! Last Update Zi 04.02.2012 ! changed to general edk version
! ! (excluded block seperation) ! ! (excluded block seperation)
!**************************************************************************** !****************************************************************************
program ED_Kriging program ED_Kriging
...@@ -23,13 +23,13 @@ program ED_Kriging ...@@ -23,13 +23,13 @@ program ED_Kriging
use mo_print_message , only: print_start_message, print_end_message use mo_print_message , only: print_start_message, print_end_message
use mo_julian , only: NDAYS, NDYIN, dec2date, julday use mo_julian , only: NDAYS, NDYIN, dec2date, julday
use runControl , only: flagEDK, interMth, & ! flag for activate kriging, flag for 'OK' or 'EDK' use runControl , only: flagEDK, interMth, & ! flag for activate kriging, flag for 'OK' or 'EDK'
correctNeg, & ! pre or temp correctNeg, & ! pre or temp
flagVario ! flag for activate variogram estimation flagVario ! flag for activate variogram estimation
use mainVar , only: yStart, yEnd, jStart, jEnd, tBuffer, nSta, DEMNcFlag, & ! interpolation time periods use mainVar , only: yStart, yEnd, jStart, jEnd, tBuffer, nSta, DEMNcFlag, & ! interpolation time periods
grid, gridMeteo, & ! grid properties of input and output grid grid, gridMeteo, & ! grid properties of input and output grid
nCell, MetSta, & nCell, MetSta, &
noDataValue noDataValue
use kriging , only: dCS, dS, cell use kriging , only: edk_dist, cell
use mo_setVario , only: setVario, dMatrix use mo_setVario , only: setVario, dMatrix
use mo_netcdf , only: NcDataset, NcVariable use mo_netcdf , only: NcDataset, NcVariable
use mo_write , only: open_netcdf use mo_write , only: open_netcdf
...@@ -38,7 +38,7 @@ program ED_Kriging ...@@ -38,7 +38,7 @@ program ED_Kriging
use mo_ReadData , only: readData use mo_ReadData , only: readData
use NetCDFVar , only: invert_y use NetCDFVar , only: invert_y
USE mo_timer, ONLY : & USE mo_timer, ONLY : &
timers_init, timer_start, timer_stop, timer_get ! Timing of processes timers_init, timer_start, timer_stop, timer_get ! Timing of processes
use mo_string_utils, ONLY : num2str use mo_string_utils, ONLY : num2str
!$ use omp_lib, ONLY : OMP_GET_NUM_THREADS ! OpenMP routines !$ use omp_lib, ONLY : OMP_GET_NUM_THREADS ! OpenMP routines
implicit none implicit none
...@@ -65,15 +65,15 @@ program ED_Kriging ...@@ -65,15 +65,15 @@ program ED_Kriging
type(NcVariable) :: nc_data, nc_time type(NcVariable) :: nc_data, nc_time
integer(i4), allocatable :: Nk_old(:) integer(i4), allocatable :: Nk_old(:)
real(dp), allocatable :: X(:) real(dp), allocatable :: X(:)
call print_start_message() call print_start_message()
loop_factor = 10 ! factor for setting openMP loop size loop_factor = 10 ! factor for setting openMP loop size
n_threads = 1 n_threads = 1
!$OMP PARALLEL !$omp PARALLEL
!$ n_threads = OMP_GET_NUM_THREADS() !$ n_threads = OMP_GET_NUM_THREADS()
!$OMP END PARALLEL !$omp END PARALLEL
!$ print *, 'Run with OpenMP with ', trim(num2str(n_threads)), ' threads.' !$ print *, 'Run with OpenMP with ', trim(num2str(n_threads)), ' threads.'
! initialize timers ! initialize timers
...@@ -83,7 +83,7 @@ program ED_Kriging ...@@ -83,7 +83,7 @@ program ED_Kriging
itimer = 1 itimer = 1
call timer_start(itimer) call timer_start(itimer)
call message('') call message('')
call message(' >>> Reading data') call message(' >>> Reading data')
call message('') call message('')
call ReadData call ReadData
...@@ -96,11 +96,11 @@ program ED_Kriging ...@@ -96,11 +96,11 @@ program ED_Kriging
!print *, 'nCell: ', nCell !print *, 'nCell: ', nCell
!print *, "ncell_thread: ", ncell_thread !print *, "ncell_thread: ", ncell_thread
!print *, 'n_threads: ', n_threads !print *, 'n_threads: ', n_threads
! print *, 'DEMNcFlag', DEMNcFlag ! print *, 'DEMNcFlag', DEMNcFlag
itimer = 2 itimer = 2
call timer_start(itimer) call timer_start(itimer)
call message(' >>> Calculating distance matrix') call message(' >>> Calculating distance matrix')
call message('') call message('')
! call distance matrix ! call distance matrix
call dMatrix call dMatrix
...@@ -109,21 +109,20 @@ program ED_Kriging ...@@ -109,21 +109,20 @@ program ED_Kriging
call message(' in ', trim(num2str(timer_get(itimer), '(F9.3)')), ' seconds.') call message(' in ', trim(num2str(timer_get(itimer), '(F9.3)')), ' seconds.')
call message('') call message('')
itimer = 3 itimer = 3
call timer_start(itimer) call timer_start(itimer)
call message(' >>> Estimate variogram') call message(' >>> Estimate variogram')
call message('') call message('')
! estimate variogram ! estimate variogram
call setVario(param) call setVario(param)
! write variogram ! write variogram
if (flagVario) call WriteDataMeteo(0,0,2) if (flagVario) call WriteDataMeteo(0,0,2)
call timer_stop(itimer) call timer_stop(itimer)
call message('') call message('')
call message(' in ', trim(num2str(timer_get(itimer), '(F9.3)')), ' seconds.') call message(' in ', trim(num2str(timer_get(itimer), '(F9.3)')), ' seconds.')
call message('') call message('')
!write(*,*), "jStart = ",jStart !write(*,*), "jStart = ",jStart
if (interMth .gt. 0) then if (interMth .gt. 0) then
itimer = 4 itimer = 4
...@@ -133,165 +132,154 @@ program ED_Kriging ...@@ -133,165 +132,154 @@ program ED_Kriging
! open netcdf if necessary ! open netcdf if necessary
call open_netcdf(nc_out, nc_data, nc_time) call open_netcdf(nc_out, nc_data, nc_time)
do iCell = 1, nCell do iCell = 1, nCell
! initialize cell ! initialize cell
allocate(cell(iCell)%Nk_old(nSta)) allocate(cell(iCell)%Nk_old(nSta))
cell(iCell)%Nk_old = nint(noDataValue) cell(iCell)%Nk_old = nint(noDataValue)
end do end do
if (mod((jEnd - jStart + 1),tBuffer) .eq. 0) then ! just use mod if (mod((jEnd - jStart + 1),tBuffer) .eq. 0) then ! just use mod
iTime = ((jEnd - jStart + 1)/tBuffer) iTime = ((jEnd - jStart + 1)/tBuffer)
else else
iTime = ((jEnd - jStart + 1)/tBuffer) + 1 iTime = ((jEnd - jStart + 1)/tBuffer) + 1
end if end if
write(*,*),"Total Number of Time Buffers = ",iTime write(*,*),"Total Number of Time Buffers = ",iTime
t = 0 t = 0
bufferloop: do iTemp = 1, iTime bufferloop: do iTemp = 1, iTime
write(*,*)," >>> Started buffer #", iTemp
jStartTmp = jStart + (iTemp - 1) * tBuffer jStartTmp = jStart + (iTemp - 1) * tBuffer
if (iTemp .lt. iTime) then if (iTemp .lt. iTime) then
jEndTmp = jStartTmp + tBuffer - 1 jEndTmp = jStartTmp + tBuffer - 1
else else
jEndTmp = jStartTmp + (jEnd-jStartTmp+1) jEndTmp = jStartTmp + (jEnd-jStartTmp+1)
end if ! use minimum to never exceed jEnd end if ! use minimum to never exceed jEnd
jEndTmp = min(jEndTmp, jEnd) jEndTmp = min(jEndTmp, jEnd)
do iCell = 1, nCell do iCell = 1, nCell
! initialize cell ! deallocate similarly ! initialize cell ! deallocate similarly
allocate(cell(iCell)%z(jStartTmp:jEndTmp)) allocate(cell(iCell)%z(jStartTmp:jEndTmp))
cell(iCell)%z = noDataValue cell(iCell)%z = noDataValue
end do
!print *, iTemp, iTime
!$omp parallel default(shared) &
!$omp private(iThread, iCell, X, Nk_old)
!$omp do SCHEDULE(dynamic)
do iThread = 1, loop_factor * n_threads
! print *, 'thread: ', iThread, " start"
ncellsloop: do iCell = (iThread - 1) * ncell_thread + 1, min(iThread * ncell_thread, ncell)
! check DEM
if (nint(cell(iCell)%h) == grid%nodata_value ) then
cell(iCell)%z = gridMeteo%nodata_value
cycle
end if
! interploation
call EDK(iCell, jStartTmp, jEndTmp, edk_dist, MetSta, cell, cell(iCell)%W, cell(iCell)%Nk_old, doOK=(interMth==1))
end do ncellsloop
! print *, 'thread: ', iThread, " end"
end do
!$omp end do
!$omp end parallel
if (DEMNcFlag == 1) then
! write output
allocate(tmp_array(gridMeteo%nrows, gridMeteo%ncols, jEndTmp - jStartTmp + 1))
allocate(tmp_time(jEndTmp - jStartTmp + 1))
k = 0
if (invert_y) then
do i = 1, gridMeteo%ncols
do j = 1, gridMeteo%nrows
k = k + 1
tmp_array(j,gridMeteo%ncols - i + 1,:) = cell(k)%z
end do
end do
else
do i = 1, gridMeteo%ncols
do j = 1, gridMeteo%nrows
k = k + 1
tmp_array(j,i,:) = cell(k)%z
end do
end do
end if
do i = 1, jEndTmp - jStartTmp + 1
tmp_time(i) = t
t = t + 1
end do end do
!print *, iTemp, iTime sttemp = nint(tmp_time(1)+1)
cnttemp = nint((tmp_time(size(tmp_time)) - sttemp))+2
!$OMP parallel default(shared) &
!$OMP private(iThread, iCell, X, Nk_old) !write(*,*),"Final Output ",shape(tmp_array)
!$OMP do SCHEDULE(dynamic)
do iThread = 1, loop_factor * n_threads call nc_time%setData(values=tmp_time,start=(/sttemp/),cnt=(/cnttemp/))
! print *, 'thread: ', iThread, " start" !call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
ncellsloop: do iCell = (iThread - 1) * ncell_thread + 1, min(iThread * ncell_thread, ncell)
else
! check DEM ! write output
if (nint(cell(iCell)%h) == grid%nodata_value ) then allocate(tmp_array(gridMeteo%ncols, gridMeteo%nrows, jEndTmp - jStartTmp + 1))
cell(iCell)%z = gridMeteo%nodata_value allocate(tmp_time(jEndTmp - jStartTmp + 1))
cycle
end if k = 0
! interploation do i = 1, gridMeteo%ncols
select case (interMth) ! do j = 1, gridMeteo%nrows
case (1) ! k = k + 1
call EDK(iCell, jStartTmp, jEndTmp, dCS, MetSta, dS, cell, cell(iCell)%W, cell(iCell)%Nk_old, doOK=.True.) ! tmp_array(i, gridMeteo%nrows - j + 1, :) = cell(k)%z
case (2) ! end do
call EDK(iCell, jStartTmp, jEndTmp, dCS, MetSta, dS, cell, cell(iCell)%W, cell(iCell)%Nk_old) ! end do
end select if (invert_y) then
end do ncellsloop do j = gridMeteo%nrows, 1, -1
k = k + 1
! print *, 'thread: ', iThread, " end" tmp_array(i, gridMeteo%nrows - j + 1, :) = cell(k)%z
end do
else
do j = 1, gridMeteo%nrows
k = k + 1
tmp_array(i, gridMeteo%nrows - j + 1, :) = cell(k)%z
end do
end if
end do
!t = 0
!do i = 1, jEnd - jStart + 1
! tmp_time(i) = t
! t = t + 1
!end do
do i = 1, jEndTmp - jStartTmp + 1
tmp_time(i) = t
t = t + 1
end do end do
!$OMP end do
!$OMP end parallel
if (DEMNcFlag == 1) then
! write output
allocate(tmp_array(gridMeteo%nrows, gridMeteo%ncols, jEndTmp - jStartTmp + 1))
allocate(tmp_time(jEndTmp - jStartTmp + 1))
k = 0
if (invert_y) then
do i = 1, gridMeteo%ncols
do j = 1, gridMeteo%nrows
k = k + 1
tmp_array(j,gridMeteo%ncols - i + 1,:) = cell(k)%z
end do
end do
else
do i = 1, gridMeteo%ncols
do j = 1, gridMeteo%nrows
k = k + 1
tmp_array(j,i,:) = cell(k)%z
end do
end do
end if
do i = 1, jEndTmp - jStartTmp + 1
tmp_time(i) = t
t = t + 1
end do
sttemp = nint(tmp_time(1)+1)
cnttemp = nint((tmp_time(size(tmp_time)) - sttemp))+2
!write(*,*),"Final Output ",shape(tmp_array)
call nc_time%setData(values=tmp_time,start=(/sttemp/),cnt=(/cnttemp/))
!call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
else
! write output
allocate(tmp_array(gridMeteo%ncols, gridMeteo%nrows, jEndTmp - jStartTmp + 1))
allocate(tmp_time(jEndTmp - jStartTmp + 1))
k = 0
do i = 1, gridMeteo%ncols
! do j = 1, gridMeteo%nrows
! k = k + 1
! tmp_array(i, gridMeteo%nrows - j + 1, :) = cell(k)%z
! end do
! end do
if (invert_y) then
do j = gridMeteo%nrows, 1, -1
k = k + 1
tmp_array(i, gridMeteo%nrows - j + 1, :) = cell(k)%z
end do
else
do j = 1, gridMeteo%nrows
k = k + 1
tmp_array(i, gridMeteo%nrows - j + 1, :) = cell(k)%z
end do
end if
end do
!t = 0
!do i = 1, jEnd - jStart + 1
! tmp_time(i) = t
! t = t + 1
!end do
do i = 1, jEndTmp - jStartTmp + 1
tmp_time(i) = t
t = t + 1
end do
!write(*,*),tmp_time !write(*,*),tmp_time
sttemp = nint(tmp_time(1)+1) sttemp = nint(tmp_time(1)+1)
cnttemp = nint((tmp_time(size(tmp_time)) - sttemp))+2 cnttemp = nint((tmp_time(size(tmp_time)) - sttemp))+2
!write(*,*),"Final Output ",shape(tmp_array)
call nc_time%setData(values=tmp_time,start=(/sttemp/),cnt=(/cnttemp/))
!call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
end if
!write(*,*),"Final Output ",shape(tmp_array)
deallocate(tmp_array, tmp_time) call nc_time%setData(values=tmp_time,start=(/sttemp/),cnt=(/cnttemp/))
!deallocate(cell) !call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
call nc_data%setData(values=tmp_array,start=(/1,1,sttemp/),cnt=(/size(tmp_array,1),size(tmp_array,2),cnttemp/))
do iCell = 1, nCell end if
! initialize cell
deallocate(cell(iCell)%z)
!cell(iCell)%z = noDataValue
end do
deallocate(tmp_array, tmp_time)
!deallocate(cell)
! close netcdf if necessary do iCell = 1, nCell
!call nc_out%close() ! outside ! initialize cell
deallocate(cell(iCell)%z)
!cell(iCell)%z = noDataValue
end do
! close netcdf if necessary
!call nc_out%close() ! outside
end do bufferloop end do bufferloop
! close netcdf if necessary ! close netcdf if necessary
call nc_out%close() call nc_out%close()
...@@ -307,4 +295,3 @@ program ED_Kriging ...@@ -307,4 +295,3 @@ program ED_Kriging
call print_end_message() call print_end_message()
! !
end program ED_Kriging end program ED_Kriging
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment