Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • foresee/4C
  • gutsch/4C
2 results
Show changes
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 9569 additions and 15 deletions
source_code/version2.2_windows/win_appl_path.f90 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* Subroutines for: *!
!* - windows shell - *!
!* *!
!* contains: *!
!* Act_Dir *!
!* winPath *!
!* dealofile *!
!* fullPath *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/XXXXXXXXXXXXXXXXXXXXX *!
!* *!
!*****************************************************************!
SUBROUTINE Act_Dir (dir)
! Program to demonstrate GETDRIVEDIRQQ
use IFPORT
!USE DFLIB ! In case QuickWin is used
CHARACTER(150) dir
INTEGER(4) length
! Get current directory
dir = FILE$CURDRIVE
length = GETDRIVEDIRQQ(dir)
IF (length .GT. 0) THEN
WRITE (*,*) 'Current directory is: '
WRITE (*,*) dir
ELSE
WRITE (*,*) 'Failed to get current directory'
END IF
END SUBROUTINE Act_Dir
!**********************************************************
subroutine winPath()
use data_mess
use data_simul
implicit none
integer ind, i
! set full path for the files
ind = index(actDir, '\', .TRUE.)
! go to ..
if ( 'input' == trim(actDir(ind+1:ind+5)) ) then
dirout = trim(actDir(1:ind))//'output\'
! stay in the directory
else
dirout = trim(actdir)//'\output\'
endif
do i = 1,site_nr
call fullPath( sitefile(i) , actDir)
call fullPath( treefile(i) , actDir)
end do
if (.not.flag_mult910) then
do i = 1,site_nr
call fullPath( specfile(i) , actDir)
call fullPath( climfile(i) , actDir)
call fullPath( valfile(i) , actDir)
call fullPath( manfile(i) , actDir)
call fullPath( depofile(i) , actDir)
call fullPath( redfile(i) , actDir)
call fullPath( litfile(i) , actDir)
! till the wpm files is set
wpmfile(i) = 'dummy.wpm'
call fullPath( wpmfile(i) , actDir)
end do
else
call fullPath( specfile(1) , actDir)
call fullPath( manfile(1) , actDir)
call fullPath( depofile(1) , actDir)
call fullPath( redfile(1) , actDir)
call fullPath( litfile(1) , actDir)
endif
if (allocated(mesfile)) call fullPath( mesfile(1) , actDir)
end subroutine winPath
!**************************************************************
SUBROUTINE deallofile
use data_simul
implicit none
if ( allocated(site_name) ) deallocate(site_name)
if ( allocated(climfile) ) deallocate(climfile)
if ( allocated(sitefile) ) deallocate(sitefile)
if ( allocated(valfile) ) deallocate(valfile)
if ( allocated(treefile) ) deallocate(treefile)
if ( allocated(wpmfile) ) deallocate(wpmfile)
if ( allocated(standid) ) deallocate(standid)
if ( allocated(manfile) ) deallocate(manfile)
if ( allocated(depofile) ) deallocate(depofile)
if ( allocated(redfile) ) deallocate(redfile)
if ( allocated(litfile) ) deallocate(litfile)
if ( allocated(specfile) ) deallocate(specfile)
site_nr = 1
end subroutine deallofile
!**************************************************************
! changes "input\..." filename into absolute path filename
subroutine fullPath(filename, dir)
character(150) dir, filename
integer ind
if ('input' == filename(1:5)) then
! Problem: input/input
ind = index(dir, '\', .TRUE.)
if ( 'input' == trim(dir(ind+1:ind+5)) ) then
ind = index(filename, '/', .TRUE.)
filename = trim(dir)//trim(filename(ind:))
else
filename = trim(dir)//'\'//trim(filename)
end if
end if
end subroutine fullPath
source_code/version2.2_windows/win_openfile.f90 0 → 100644
View file @ 82df1085
! ********************************************************************
! * *
! * Copyright 2000 Compaq Computer Corporation *
! * *
! * COMPAQ Registered in U.S. Patent and Trademark Office. *
! * *
! * Confidential computer software. Valid license from Compaq or *
! * authorized sublicensor required for possession, use or copying. *
! * Consistent with FAR 12.211 and 12.212, Commercial Computer *
! * Software, Computer Software Documentation, and Technical Data *
! * for Commercial Items are licensed to the U.S. Government under *
! * vendor's standard commercial license. *
! * *
! ********************************************************************
!
!DEC$ IF .NOT. DEFINED (COMDLG32_ )
!DEC$ DEFINE COMDLG32_
!
!
!
!************This version of comdlg32 contains new items******************
! Whether new interfaces for routines in COMDLG32.LIB extracted from
! VC++6 header files are included is controlled by a statement with the
! following format towards the end of this file.
!
!IF .NOT. DEFINED(__DO_NOT_INCLUDE_VC6_ITEMS)
!
!Unless the inclusion is explicitly turned off by defining the
!above symbol, the items will be included.
!
module comdlg32
use dfwinty
!DEC$OBJCOMMENT LIB:"COMDLG32.LIB"
!
! *****COMMDLG******
interface !lib=comdlg32.lib
logical(4) function GetOpenFileName (dummy )
!DEC$ ATTRIBUTES DEFAULT :: GetOpenFileName
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_GetOpenFileNameA@4' :: GetOpenFileName
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'GetOpenFileNameA' :: GetOpenFileName
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummy
use dfwinty
type(T_OPENFILENAME) dummy
end function GetOpenFileName
end interface
interface !lib=comdlg32.lib
logical(4) function GetSaveFileName (dummy )
!DEC$ ATTRIBUTES DEFAULT :: GetSaveFileName
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_GetSaveFileNameA@4' :: GetSaveFileName
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'GetSaveFileNameA' :: GetSaveFileName
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummy
use dfwinty
type(T_OPENFILENAME) dummy
end function GetSaveFileName
end interface
interface !lib=comdlg32.lib
integer*2 function GetFileTitle (dummya ,dummyb ,dummyc )
!DEC$ ATTRIBUTES DEFAULT :: GetFileTitle
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_GetFileTitleA@12' :: GetFileTitle
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'GetFileTitleA' :: GetFileTitle
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummya
!DEC$ ATTRIBUTES REFERENCE :: dummyb
character*(*) dummya
character*(*) dummyb
integer*2 dummyc
end function GetFileTitle
end interface
interface !lib=comdlg32.lib
logical(4) function ChooseColor (dummy )
!DEC$ ATTRIBUTES DEFAULT :: ChooseColor
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_ChooseColorA@4' :: ChooseColor
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'ChooseColorA' :: ChooseColor
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummy
use dfwinty
type(T_CHOOSECOLOR) dummy
end function ChooseColor
end interface
interface !lib=comdlg32.lib
integer*4 function FindText (dummy )
!DEC$ ATTRIBUTES DEFAULT :: FindText
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_FindTextA@4' :: FindText
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'FindTextA' :: FindText
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummy
use dfwinty
type(T_FINDREPLACE) dummy
end function FindText
end interface
interface !lib=comdlg32.lib
integer*4 function ReplaceText (dummy )
!DEC$ ATTRIBUTES DEFAULT :: ReplaceText
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_ReplaceTextA@4' :: ReplaceText
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'ReplaceTextA' :: ReplaceText
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummy
use dfwinty
type(T_FINDREPLACE) dummy
end function ReplaceText
end interface
interface !lib=comdlg32.lib
logical(4) function ChooseFont (dummy )
!DEC$ ATTRIBUTES DEFAULT :: ChooseFont
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_ChooseFontA@4' :: ChooseFont
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'ChooseFontA' :: ChooseFont
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummy
use dfwinty
type(T_CHOOSEFONT) dummy
end function ChooseFont
end interface
interface !lib=comdlg32.lib
logical(4) function PrintDlg (dummy)
!DEC$ ATTRIBUTES DEFAULT :: PrintDlg
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_PrintDlgA@4' :: PrintDlg
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'PrintDlgA' :: PrintDlg
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: dummy
use dfwinty
type(T_PRINTDLG) dummy
end function PrintDlg
end interface
interface !lib=comdlg32.lib
integer*4 function CommDlgExtendedError ()
!DEC$ ATTRIBUTES DEFAULT :: CommDlgExtendedError
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_CommDlgExtendedError@0' :: CommDlgExtendedError
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'CommDlgExtendedError' :: CommDlgExtendedError
!DEC$ ENDIF
end function CommDlgExtendedError
end interface
!
!DEC$ IF .NOT. DEFINED(__DO_NOT_INCLUDE_VC6_ITEMS)
!
INTERFACE
FUNCTION PageSetupDlg( &
arg1)
USE DFWINTY
integer(BOOL) :: PageSetupDlg ! BOOL
!DEC$ ATTRIBUTES DEFAULT :: PageSetupDlg
!DEC$IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_PageSetupDlgA@4' :: PageSetupDlg
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS:'PageSetupDlgA' :: PageSetupDlg
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: arg1
TYPE (T_PAGESETUPDLGA) arg1 ! LPPAGESETUPDLGA arg1
END FUNCTION
END INTERFACE
!
!DEC$ ENDIF ! /* __DO_NOT_INCLUDE_VC6_ITEMS */
!
end module comdlg32
!
!DEC$ ENDIF ! /* COMDLG32_ */
source_code/version2.2_windows/wpm_wood_proc.f
View file @ 82df1085
......@@ -154,7 +154,7 @@ integer act_spec, act_year, set_year
! calculate emission from harvesting process
emission_har (management_years(i)) = summe * sub_par(1)
write (9999,*) emission_har(management_years(i)), management_years(i)
! write (9999,*) emission_har(management_years(i)), management_years(i)
end do
end subroutine calculate_product_lines
......
source_code/version2.2_windows/writesim.f90 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* Subroutines for: *!
!* - WRITESIM: Write simulation options into file *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/XXXXXXXXXXXXXXXXXXXXX *!
!* *!
!*****************************************************************!
SUBROUTINE writesim(simfile_new)
! read simulation options from file
use data_climate
use data_mess
use data_out
use data_simul
use data_stand
use data_site
use data_tsort
implicit none
logical ex
integer i, ios, ios1, nowunit, nowunit1, k, anzclim, j
real help
character a
character (150) tspec, tname, tval, tsite, tman, ttree, tdepo, tred, tlit, &
pathdir1, pathdir2,pathdir3, pathdir4, pathdir5, climszen, siteall, climall,site_name_all
character(3), dimension(100) :: clim_nam
character(150), dimension(:), allocatable:: site_name_ad
character(150), dimension(:), allocatable:: climfile_ad
character(150), dimension(:), allocatable:: manfile_ad
character(150), dimension(:), allocatable:: treefile_ad
character(150), dimension(:), allocatable:: depofile_ad
character(150), dimension(:), allocatable:: wpmfile_ad
character(10), dimension(1000) :: climnum
character(50) istand
character(150) simfile_new
nowunit = getunit()
ios = 0
!!! set Filename
write (*, *) ' Input name of simfile'
write (*, *) simfile_new
open(nowunit,file=simfile_new,iostat=ios, status='replace')
write(nowunit,'(I6,A)',iostat=ios) flag_multi , ' ! Run option'
write(nowunit,'(I6,A)',iostat=ios) site_nr , ' ! number of runs'
write(nowunit,'(A)',iostat=ios) '! *** simulation specifications **************************************'
write(nowunit,'(I6,A)',iostat=ios) year , ' ! number of simulation years'
write(nowunit,'(I6,A)',iostat=ios) time_b , ' ! start year for simulation'
write(nowunit,'(F7.0,A)',iostat=ios) kpatchsize , ' ! patch size [m]'
write(nowunit,'(F7.1,A)',iostat=ios) dz , ' ! thickness of foliage layers [cm]'
write(nowunit,'(I6,A)',iostat=ios) ns_pro , ' ! time step photosynthesis calculations [d]'
write(nowunit,'(A)',iostat=ios) '! *** choice of model options *****************************************'
write(nowunit,'(I6,A)',iostat=ios) flag_mort , ' ! mortality flag (flag_mort)'
write(nowunit,'(I6,A)',iostat=ios) flag_reg , ' ! regeneration flag (flag_reg)'
write(nowunit,'(I6,A)',iostat=ios) flag_forska , ' ! use FORSKA environmental factors and regeneration (flag_forska)'
write(nowunit,'(I6,A)',iostat=ios) flag_stand , ' ! initialization flag (flag_stand)'
write(nowunit,'(I6,A)',iostat=ios) flag_sveg , ' ! soil vegetation flag (flag_sveg) !!! new !!!'
write(nowunit,'(I6,A)',iostat=ios) flag_mg , ' ! management flag (flag_mg)'
write(nowunit,'(I6,A)',iostat=ios) flag_dis , ' ! disturbance flag (flag_dis)'
write(nowunit,'(I6,A)',iostat=ios) flag_light , ' ! ligth algorithm number (flag_light)'
write(nowunit,'(I6,A)',iostat=ios) flag_folhei , ' ! foliage-height relationship (flag_folhei)'
write(nowunit,'(I6,A)',iostat=ios) flag_volfunc , ' ! volume function (flag_volfunc)'
write(nowunit,'(I6,A)',iostat=ios) flag_resp , ' ! respiration flag (flag_resp)'
write(nowunit,'(I6,A)',iostat=ios) flag_limi , ' ! limitation flag (flag_limi)'
write(nowunit,'(I6,A)',iostat=ios) flag_decomp , ' ! decomposition model (flag_decomp)'
write(nowunit,'(I6,A)',iostat=ios) flag_sign , ' ! root activity function flag (flag_sign)'
write(nowunit,'(I6,A)',iostat=ios) flag_wred , ' ! soil water uptake flag (flag_wred)'
write(nowunit,'(I6,A)',iostat=ios) flag_wurz , ' ! root distribution flag (flag_wurz)'
write(nowunit,'(I6,A)',iostat=ios) flag_cond , ' ! heat conductance flag (flag_cond)'
write(nowunit,'(I6,A)',iostat=ios) flag_int , ' ! interception flag (flag_int)'
write(nowunit,'(I6,A)',iostat=ios) flag_eva , ' ! evapotranspiration flag (flag_eva)'
write(nowunit,'(I6,A)',iostat=ios) flag_co2 , ' ! CO2 flag (flag_CO2)'
write(nowunit,'(I6,A)',iostat=ios) flag_sort , ' ! sort flag (flag_sort)'
write(nowunit,'(I6,A)',iostat=ios) flag_wpm , ' ! wpm flag (flag_wpm)'
write(nowunit,'(I6,A)',iostat=ios) flag_stat , ' ! comparison with measurements (flag_stat)'
write(nowunit,'(A)',iostat=ios) '! *** output specifications *******************************************'
write(nowunit,'(I6,A)',iostat=ios) time_out
! write name of yearly output variables
do i = 1, outy_n
if (outy(i)%out_flag .gt. 0) write(nowunit,'(A)',iostat=ios) outy(i)%kind_name
enddo
write(nowunit,'(A)',iostat=ios) 'end'
write(nowunit,'(I6,A)',iostat=ios) flag_dayout
! write name of daily output variables
do i = 1, outd_n
if (outd(i)%out_flag .gt. 0) write(nowunit,'(A)',iostat=ios) outd(i)%kind_name
enddo
write(nowunit,'(A)',iostat=ios) 'end'
if(flag_cohoutd .gt. 0 .or. flag_cohouty .gt. 0) then
flag_cohout = 1
else
flag_cohout = 0
endif
write(nowunit,'(I6,A)',iostat=ios) flag_cohout
! define name of cohort output variables
ncvar = ncvar + ncdvar
do i = 1, outcy_n
if (outcy(i)%out_flag .gt. 0) write(nowunit,'(A)',iostat=ios) outcy(i)%kind_name
enddo
do i = 1, outcd_n
if (outcd(i)%out_flag .gt. 0) write(nowunit,'(A)',iostat=ios) outcd(i)%kind_name
enddo
write(nowunit,'(A)',iostat=ios) 'end'
write(nowunit,'(I6,A)',iostat=ios) flag_sum
write(nowunit,'(A)',iostat=ios) '! *** input files *****************************************************'
SELECT CASE(flag_multi)
CASE (0,1,2,3,6)
jpar = 1
DO i=1,site_nr
if(i .gt. 1) then
write(nowunit,'(A,I2,A)',iostat=ios) '! ******************* run ',i,' *******************************************'
do while (vpar(jpar) .gt. -99.0)
write(nowunit,'(F7.1, A)') vpar(jpar), ' '//simpar(jpar)
jpar = jpar + 1
enddo
help = -99.0
write(nowunit,'(F7.1, A)') help, ' end'
endif
write(nowunit,'(A)',iostat=ios) specfile(i)
write(nowunit,'(A)') site_name(i)
write(nowunit,'(A)') climfile(i)
write(nowunit,'(A)') sitefile(i)
write(nowunit,'(A)') valfile(i)
write(nowunit,'(A)') treefile(i)
write(nowunit,*) standid(i)
write(nowunit,'(A)') manfile(i)
write(nowunit,'(A)') depofile(i)
write(nowunit,'(A)') redfile(i)
write(nowunit,'(A)') litfile(i)
if(i .eq. 1 .and. flag_stat .gt. 0) write(nowunit,'(A)') mesfile(1)
print *, ' >>>foresee message: site_nr ',i,'; input of filenames completed'
end DO
if(flag_multi .ne. 2) call errorfile(simfile, ios, nowunit)
CASE (4,5)
write(nowunit,'(A)',iostat=ios) specfile(1)
write(nowunit,'(A)') site_name(1)
write(nowunit,'(A)') treefile(1)
write(nowunit,'(A)') manfile(1)
write(nowunit,'(A)') siteall
write(nowunit,'(A)') climall
write(nowunit,'(A)') pathdir1
write(nowunit,'(A)') pathdir2
write(nowunit,'(A)') climszen
print *, ' >>>foresee message: Input of filenames completed'
! define name of output variables
nvar = 1
write(nowunit,*) outvar(nvar)
do while (trim(outvar(nvar)) .ne. 'end')
nvar = nvar + 1
write(nowunit,*) outvar(nvar)
enddo
if (nvar .gt. 1) allocate(output_var(nvar-1,site_nr,year))
call errorfile(simfile, ios, nowunit)
! writeing file with desription of climate stations used
nowunit1 = getunit()
ios1 = 0
open(nowunit1,file=climall,iostat=ios,status='old',action='write')
k=1
do
write(nowunit1,'(A)',iostat=ios1) a
IF (a .ne. '!') exit
end do
backspace nowunit1
do
if(ios1 .lt. 0) exit
k = k+1
end do
anzclim = k-1
ios1 = 0
call errorfile(climall, ios1, nowunit1)
! reading control file with site-id, climate-id, soil-id, gwtabe-id
nowunit1 = getunit()
open(nowunit1,file=siteall,iostat=ios1,status='old',action='read')
do
write(nowunit1,'(A)',iostat=ios1) a
IF (a .ne. '!') exit
end do
backspace nowunit1
do i=1,site_nr
write(nowunit1,*,iostat=ios1) sitenum(i), clim_id(i), soilid(i), gwtable(i)
! Fuellen der sitefile
standid(i) = sitenum(i)
site_name(i) = site_name(1)
specfile(i) = specfile(1)
treefile(i) = treefile(1)
manfile(i) = manfile(1)
do j = 1,anzclim
if(clim_id(i).eq.climnum(j)) then
if(flag_climtyp.ne.0) then
climfile(i) =trim(pathdir1)//trim(clim_nam(j))//trim(climszen)//'.dat'
else
climfile(i) =trim(pathdir1)//trim(clim_nam(j))//trim(climszen)//'.cli'
end if
exit
end if
end do
sitefile(i) =trim(pathdir2)//'wbuek'//trim(soilid(i))//'.sop'
valfile(i) =trim(pathdir2)//'wbuek'//trim(soilid(i))//'.soi'
depofile(i) ='dummy.dep'
redfile = 'dummy.red'
litfile = 'dummy.lit'
enddo
call errorfile(siteall, ios1, nowunit1)
! variation of flag_multi= 5, especially for SILVISTRAT
CASE (7)
allocate(site_name_ad(site_nr))
allocate(climfile_ad(site_nr))
allocate(manfile_ad(site_nr))
allocate(treefile_ad(site_nr))
allocate(wpmfile_ad(site_nr))
allocate(depofile_ad(site_nr))
allocate(fl_co2(site_nr))
write(nowunit,'(A)',iostat=ios) specfile(1)
write(nowunit,'(A)') site_name_all
write(nowunit,'(A)') sitefile(1)
write(nowunit,'(A)') valfile(1)
write(nowunit,'(A)') siteall
write(nowunit,'(A)') pathdir1
write(nowunit,'(A)') pathdir2
write(nowunit,'(A)') pathdir3
write(nowunit,'(A)') depofile(1)
write(nowunit,'(A)') redfile(1)
write(nowunit,'(A)') litfile(1)
call errorfile(simfile, ios, nowunit)
! reading control file with site-id,name, climate scenario, man-file, treeini-file, dep-file
nowunit1 = getunit()
open(nowunit1,file=siteall,iostat=ios1,status='old',action='read')
do
READ(nowunit1,'(A)',iostat=ios1) a
IF (a .ne. '!') exit
end do
backspace nowunit1
do i=1,site_nr
read(nowunit1,*,iostat=ios1) sitenum(i),site_name_ad(i), climfile_ad(i),manfile_ad(i), treefile_ad(i),depofile_ad(i),fl_co2(i)
! Fuellen der sitefile
standid(i) = sitenum(i)
climfile(i)= trim(pathdir1)//climfile_ad(i)
site_name(i) = trim(site_name_all)//trim(site_name_ad(i))
specfile(i) = specfile(1)
sitefile(i) = sitefile(1)
valfile(i) = valfile(1)
treefile(i) =trim(pathdir2)//trim(treefile_ad(i))
manfile(i) =trim(pathdir3)//trim(manfile_ad(i))
depofile(i) =depofile(1)
redfile(i) = redfile(1)
litfile(i) = litfile(1)
enddo
flag_co2=fl_co2(1)
call errorfile(siteall, ios1, nowunit1)
deallocate(site_name_ad)
deallocate(climfile_ad)
deallocate(manfile_ad)
deallocate(treefile_ad)
deallocate(depofile_ad)
END SELECT
jpar = 0 ! reset jpar for restore
if(flag_multi .eq. 2)then
read (nowunit,*) step_sum_T,n_T_downsteps,n_T_upsteps
read (nowunit,*) step_fac_P,n_P_downsteps,n_P_upsteps
site_nr = (1+n_T_downsteps+n_T_upsteps) * (1+n_P_downsteps+n_P_upsteps)
repeat_number = site_nr
tspec = specfile(1)
tname = site_name(1)
tsite = sitefile(1)
tval = valfile(1)
ttree = treefile(1)
tman = manfile(1)
tdepo = depofile(1)
tred = redfile(1)
tlit = litfile(1)
istand = standid(1)
deallocate (specfile)
deallocate (site_name)
deallocate (sitefile)
deallocate (valfile)
deallocate (treefile)
deallocate (manfile)
deallocate (depofile)
deallocate (redfile)
deallocate (litfile)
deallocate (standid)
allocate (specfile(site_nr))
allocate (site_name(site_nr))
allocate (sitefile(site_nr))
allocate (valfile(site_nr))
allocate (treefile(site_nr))
allocate (manfile(site_nr))
allocate (depofile(site_nr))
allocate (standid(site_nr))
allocate (redfile(site_nr))
allocate (litfile(site_nr))
specfile = tspec
site_name = tname
sitefile = tsite
valfile = tval
treefile = ttree
manfile = tman
depofile = tdepo
redfile = tred
litfile = tlit
standid = istand
call errorfile(simfile, ios, nowunit)
endif ! flag_multi = 2
END subroutine writesim
source_code/version_2.3_windows/4C_dialogs.fd 0 → 100644
View file @ 82df1085
!MS$FREEFORM
! Microsoft Developer Studio generated include file.
! Used by script1.rc
!
integer, parameter :: IDD_4C = 101
integer, parameter :: IDD_4C_ctr = 102
integer, parameter :: IDD_4C_flags = 109
integer, parameter :: IDD_4C_files = 111
integer, parameter :: IDB_BITMAP3 = 115
integer, parameter :: IDD_4C_out = 116
integer, parameter :: IDD_4C_yearly = 118
integer, parameter :: IDD_4C_daily = 119
integer, parameter :: IDD_4C_coh_yearly = 120
integer, parameter :: IDD_4C_coh_daily = 121
integer, parameter :: IDD_default_dir = 122
integer, parameter :: IDD_4C_default_dir = 122
integer, parameter :: IDD_4C_main = 123
integer, parameter :: IDD_4C_ids = 126
integer, parameter :: IDB_BITMAP1 = 131
integer, parameter :: IDC_STATIC_Control = 1005
integer, parameter :: IDC_STATIC_4C = 1017
integer, parameter :: IDC_COMBO_runv = 1019
integer, parameter :: IDC_RADIO_ctrfile = 1020
integer, parameter :: IDC_COMBO_runv3 = 1020
integer, parameter :: IDC_RADIO_ctredit = 1024
integer, parameter :: IDC_STATIC_simul = 1034
integer, parameter :: IDC_STATIC_runv = 1036
integer, parameter :: IDC_STATIC_runnr = 1037
integer, parameter :: IDC_STATIC_runv3 = 1038
integer, parameter :: IDC_EDIT_runnr = 1044
integer, parameter :: IDC_STATIC_runo = 1046
integer, parameter :: IDC_STATIC_runo3 = 1047
integer, parameter :: IDC_EDIT_yearn = 1048
integer, parameter :: IDC_EDIT_start = 1049
integer, parameter :: IDC_STATIC_yearn = 1050
integer, parameter :: IDC_STATIC_start = 1051
integer, parameter :: IDC_EDIT_patch = 1052
integer, parameter :: IDC_STATIC_patch = 1053
integer, parameter :: IDC_STATIC_model = 1055
integer, parameter :: IDC_EDIT_thickf = 1056
integer, parameter :: IDC_EDIT_timeph = 1057
integer, parameter :: IDC_STATIC_thickf = 1058
integer, parameter :: IDC_STATIC_timeph = 1059
integer, parameter :: IDC_STATIC_mort = 1060
integer, parameter :: IDC_STATIC_reg = 1061
integer, parameter :: IDC_STATIC_forska = 1062
integer, parameter :: IDC_COMBO_mort = 1063
integer, parameter :: IDC_COMBO_reg = 1064
integer, parameter :: IDC_COMBO_forska = 1065
integer, parameter :: IDC_STATIC_stand = 1066
integer, parameter :: IDC_STATIC_sveg = 1067
integer, parameter :: IDC_STATIC_mg = 1068
integer, parameter :: IDC_STATIC_dis = 1069
integer, parameter :: IDC_STATIC_light = 1070
integer, parameter :: IDC_STATIC_folhei = 1071
integer, parameter :: IDC_COMBO_stand = 1072
integer, parameter :: IDC_COMBO_sveg = 1073
integer, parameter :: IDC_COMBO_mg = 1074
integer, parameter :: IDC_COMBO_dis = 1075
integer, parameter :: IDC_COMBO_light = 1076
integer, parameter :: IDC_COMBO_folhei = 1077
integer, parameter :: IDC_COMBO_volfunc = 1078
integer, parameter :: IDC_STATIC_volfunc = 1079
integer, parameter :: IDC_STATIC_resp = 1080
integer, parameter :: IDC_STATIC_limi = 1081
integer, parameter :: IDC_STATIC_decomp = 1082
integer, parameter :: IDC_STATIC_sign = 1083
integer, parameter :: IDC_STATIC_wred = 1084
integer, parameter :: IDC_STATIC_wurz = 1085
integer, parameter :: IDC_STATIC_cond = 1086
integer, parameter :: IDC_COMBO_resp = 1088
integer, parameter :: IDC_COMBO_limi = 1089
integer, parameter :: IDC_COMBO_decomp = 1090
integer, parameter :: IDC_COMBO_sign = 1091
integer, parameter :: IDC_COMBO_wred = 1092
integer, parameter :: IDC_COMBO_wurz = 1093
integer, parameter :: IDC_COMBO_cond = 1094
integer, parameter :: IDC_COMBO_int = 1095
integer, parameter :: IDC_COMBO_eva = 1096
integer, parameter :: IDC_STATIC_int = 1097
integer, parameter :: IDC_STATIC_eva = 1098
integer, parameter :: IDC_STATIC_sort = 1099
integer, parameter :: IDC_STATIC_wpm = 1100
integer, parameter :: IDC_COMBO_CO2 = 1101
integer, parameter :: IDC_STATIC_stat = 1102
integer, parameter :: IDC_COMBO_sort = 1103
integer, parameter :: IDC_COMBO_wpm = 1104
integer, parameter :: IDC_COMBO_stat = 1105
integer, parameter :: IDC_STATIC_files = 1108
integer, parameter :: IDC_STATIC_specpar = 1109
integer, parameter :: IDC_EDIT_specpar = 1110
integer, parameter :: IDC_BUTTON_specpar = 1111
integer, parameter :: IDC_BUTTON_ini = 1112
integer, parameter :: IDC_BUTTON_sop = 1113
integer, parameter :: IDC_STATIC_dir1 = 1114
integer, parameter :: IDC_STATIC_dirin = 1114
integer, parameter :: IDC_BUTTON_soi = 1115
integer, parameter :: IDC_STATIC_dirout = 1115
integer, parameter :: IDC_STATIC_soi = 1116
integer, parameter :: IDC_EDIT_sop = 1117
integer, parameter :: IDC_EDIT_soi = 1118
integer, parameter :: IDC_STATIC_ini = 1119
integer, parameter :: IDC_EDIT_ini = 1120
integer, parameter :: IDC_STATIC_ini1 = 1121
integer, parameter :: IDC_BUTTON_man = 1122
integer, parameter :: IDC_STATIC_cli = 1123
integer, parameter :: IDC_BUTTON_dep = 1124
integer, parameter :: IDC_BUTTON_red = 1125
integer, parameter :: IDC_BUTTON_lit = 1126
integer, parameter :: IDC_RADIO_single_ini = 1127
integer, parameter :: IDC_RADIO_multi_ini = 1128
integer, parameter :: IDC_STATIC_standid = 1129
integer, parameter :: IDC_EDIT_standid = 1130
integer, parameter :: IDC_STATIC_man = 1131
integer, parameter :: IDC_EDIT_man = 1132
integer, parameter :: IDC_STATIC_dep = 1133
integer, parameter :: IDC_EDIT_dep = 1134
integer, parameter :: IDC_EDIT_red = 1135
integer, parameter :: IDC_EDIT_lit = 1136
integer, parameter :: IDC_STATIC_lit = 1137
integer, parameter :: IDC_STATIC_red = 1138
integer, parameter :: IDC_STATIC_dir2 = 1139
integer, parameter :: IDC_STATIC_sop = 1140
integer, parameter :: IDC_EDIT_cli = 1141
integer, parameter :: IDC_BUTTON_cli = 1142
integer, parameter :: IDC_BUTTON_DIR = 1143
integer, parameter :: IDC_EDIT_cli2 = 1144
integer, parameter :: IDC_EDIT_DIR = 1144
integer, parameter :: IDC_EDIT_DIR_IN = 1144
integer, parameter :: IDC_STATIC_name = 1145
integer, parameter :: IDC_EDIT_DIR_OUT = 1145
integer, parameter :: IDC_EDIT_sitename = 1147
integer, parameter :: IDC_STATIC_nameall = 1148
integer, parameter :: IDC_RADIO_idy = 1149
integer, parameter :: IDC_RADIO_idn = 1150
integer, parameter :: IDC_STATIC_id = 1151
integer, parameter :: IDC_STATIC_year = 1152
integer, parameter :: IDC_STATIC_yearly = 1153
integer, parameter :: IDC_CHECK_y1 = 1161
integer, parameter :: IDC_CHECK_y2 = 1162
integer, parameter :: IDC_CHECK_y3 = 1163
integer, parameter :: IDC_CHECK_y4 = 1164
integer, parameter :: IDC_CHECK_y5 = 1165
integer, parameter :: IDC_CHECK_y6 = 1166
integer, parameter :: IDC_CHECK_y7 = 1167
integer, parameter :: IDC_CHECK_y8 = 1168
integer, parameter :: IDC_CHECK_y9 = 1169
integer, parameter :: IDC_CHECK_y10 = 1170
integer, parameter :: IDC_CHECK_y11 = 1171
integer, parameter :: IDC_CHECK_y12 = 1172
integer, parameter :: IDC_CHECK_y13 = 1173
integer, parameter :: IDC_CHECK_y14 = 1174
integer, parameter :: IDC_CHECK_y15 = 1175
integer, parameter :: IDC_CHECK_y16 = 1176
integer, parameter :: IDC_CHECK_y17 = 1177
integer, parameter :: IDC_CHECK_y18 = 1178
integer, parameter :: IDC_CHECK_y19 = 1179
integer, parameter :: IDC_CHECK_y20 = 1180
integer, parameter :: IDC_CHECK_y21 = 1181
integer, parameter :: IDC_CHECK_y22 = 1182
integer, parameter :: IDC_CHECK_y23 = 1183
integer, parameter :: IDC_CHECK_y24 = 1184
integer, parameter :: IDC_CHECK_y25 = 1185
integer, parameter :: IDC_CHECK_y26 = 1186
integer, parameter :: IDC_CHECK_y27 = 1187
integer, parameter :: IDC_CHECK_y28 = 1188
integer, parameter :: IDC_STATIC_yfile = 1189
integer, parameter :: IDC_BUTTON_yearly = 1190
integer, parameter :: IDC_CHECK_y29 = 1190
integer, parameter :: IDC_BUTTON_daily = 1191
integer, parameter :: IDC_CHECK_y30 = 1191
integer, parameter :: IDC_BUTTON_coh_yearly = 1192
integer, parameter :: IDC_CHECK_y31 = 1192
integer, parameter :: IDC_BUTTON_coh_daily = 1193
integer, parameter :: IDC_CHECK_y32 = 1193
integer, parameter :: IDC_STATIC_choice_out = 1194
integer, parameter :: IDC_CHECK_y33 = 1194
integer, parameter :: IDC_STATIC_daily = 1195
integer, parameter :: IDC_CHECK_y34 = 1195
integer, parameter :: IDC_COMBO_daily = 1196
integer, parameter :: IDC_CHECK_y35 = 1196
integer, parameter :: IDC_STATIC_coh_daily = 1197
integer, parameter :: IDC_CHECK_y36 = 1197
integer, parameter :: IDC_COMBO_coh_daily = 1198
integer, parameter :: IDC_CHECK_y37 = 1198
integer, parameter :: IDC_CHECK_y38 = 1199
integer, parameter :: IDC_CHECK_y39 = 1200
integer, parameter :: IDC_CHECK_y40 = 1201
integer, parameter :: IDC_CHECK_y41 = 1202
integer, parameter :: IDC_CHECK_y42 = 1203
integer, parameter :: IDC_COMBO_coh_yearly = 1204
integer, parameter :: IDC_STATIC_coh_yearly = 1205
integer, parameter :: IDC_STATIC_SUM = 1206
integer, parameter :: IDC_CHECK_y43 = 1206
integer, parameter :: ID4C_BUTTON_OK = 1208
integer, parameter :: ID_CTR_BUTTON_FLAGS = 1209
integer, parameter :: ID_CTR_BUTTON_OK = 1210
integer, parameter :: ID_FILES_BUTTON_OK = 1211
integer, parameter :: ID_CTR_BUTTON_FILES = 1212
integer, parameter :: ID_OUT_BUTTON_BACK = 1213
integer, parameter :: ID_START = 1214
integer, parameter :: ID_SAVE = 1215
integer, parameter :: ID_YEARLY_BUTTON_OK = 1216
integer, parameter :: ID_DAILY_BUTTON_OK = 1217
integer, parameter :: ID_YEARLYCOH_BUTTON_OK = 1218
integer, parameter :: ID_FLAGS_BUTTON_OK = 1219
integer, parameter :: ID_DAILYCOH_BUTTON_OK = 1220
integer, parameter :: ID_CTR_BUTTON_RUNNR = 1221
integer, parameter :: ID_DEFAULT_DIR_BUTTON_OK = 1222
integer, parameter :: ID_START_4C = 1226
integer, parameter :: IDSTOP = 1227
integer, parameter :: IDC_RADIO_start = 1229
integer, parameter :: IDC_RADIO_start_dir = 1230
integer, parameter :: IDC_RADIO_edit = 1231
integer, parameter :: ID_CANCEL_FLAGS = 1232
integer, parameter :: IDC_EDIT_ID = 1233
integer, parameter :: ID_CANCEL_FILES = 1233
integer, parameter :: IDC_COMBO_standid = 1234
integer, parameter :: ID_CANCEL_IDS = 1234
integer, parameter :: IDC_STATIC_spinup = 1235
integer, parameter :: IDC_EDIT_spinup = 1236
integer, parameter :: IDC_EDIT_wpm = 1236
integer, parameter :: ID_CANCEL_OUTF = 1236
integer, parameter :: IDC_BUTTON_spinup = 1237
integer, parameter :: IDC_STATIC_mes = 1237
integer, parameter :: ID_CTR_BUTTON_IDS = 1238
integer, parameter :: IDC_EDIT_mes = 1238
integer, parameter :: IDC_COMBO_yearly = 1239
integer, parameter :: IDC_COMBO_sum = 1240
integer, parameter :: ID_IDS_BUTTON_OK = 1242
integer, parameter :: ID_YEARLY_BUTTON_SELECT = 1248
integer, parameter :: ID_YEARLY_BUTTON_DESELECT = 1249
integer, parameter :: IDC_BUTTON_wpm = 1250
integer, parameter :: ID_DAILY_BUTTON_SELECT = 1250
integer, parameter :: IDC_BUTTON_mes = 1251
integer, parameter :: ID_DAILY_BUTTON_DESELECT = 1251
integer, parameter :: ID_DAILYCOH_BUTTON_SELECT = 1252
integer, parameter :: ID_DAILYCOH_BUTTON_DESELECT = 1253
integer, parameter :: ID_YEARLYCOH_BUTTON_SELECT = 1254
integer, parameter :: ID_YEARLYCOH_BUTTON_DESELECT = 1255
integer, parameter :: IDC_CHECK_y44 = 1256
integer, parameter :: IDC_STATIC_CO2 = 1256
integer, parameter :: IDC_CHECK_y45 = 1257
integer, parameter :: IDC_CHECK_y46 = 1258
integer, parameter :: IDC_CHECK_y47 = 1259
integer, parameter :: IDC_CHECK_y48 = 1260
integer, parameter :: IDC_CHECK_y49 = 1261
integer, parameter :: IDC_REBAR1 = 1262
integer, parameter :: IDC_CHECK_y50 = 1001
integer, parameter :: IDC_CHECK_y51 = 1002
source_code/version_2.3_windows/4C_dialogs.h 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/4c_logo_klein.bmp 0 → 100644
View file @ 82df1085
source_code/version_2.3_windows/4c_logo_klein.bmp

74.7 KiB

source_code/version_2.3_windows/COMMCTRL.H 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/POPPACK.H 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/PRSHT.H 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/PSHPACK1.H 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/PSHPACK4.H 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/RICHEDIT.H 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/WINDOWS.H 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/amod_clim.f 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/amod_effect.f 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/amod_help.f 0 → 100644
View file @ 82df1085
This diff is collapsed.
source_code/version_2.3_windows/amod_init.f 0 → 100644
View file @ 82df1085
This diff is collapsed.