247 lines
9.0 KiB
Fortran
247 lines
9.0 KiB
Fortran
module parameterkeys
|
|
use io_parameters, only: llen,klen,
|
|
> key,maxpar_keys,parkeynum,parkeylen,ec_read,ec_dim
|
|
use dim_parameter,only: pst,max_par
|
|
use keys_mod, only: init_keys
|
|
implicit none
|
|
|
|
|
|
contains
|
|
! < Subroutine reading the user defined Parameter keys from keys.incl
|
|
! <returns: the parameter arrays p, p_act, p_spread and their length npar
|
|
! <needs: internalized file (infile) it's length (linenum), the keylist from keys.incl (key) and the counted number of keys (parkeynum)
|
|
subroutine parameterkey_read
|
|
> (infile,linenum,p,p_act,p_spread,npar,gspread,facspread)
|
|
use strings_mod,only:write_oneline
|
|
use long_keyread_mod,only:long_intkey,long_realkey,long_strkey
|
|
! dir$ optimize:1
|
|
! IN: variables
|
|
integer linenum !< number of lines in internalized input file (infile)
|
|
character(len=llen) :: infile(linenum) !< internalized input file
|
|
double precision gspread !< general parameterspread used to initialize p_spread
|
|
double precision facspread !< multiplicative factor for spreads
|
|
|
|
! OUT: read parameters and their lenght,spread and active state
|
|
integer npar !< lenght oo parameter vector
|
|
double precision, allocatable :: p(:) !< vector for the values of read parameters
|
|
double precision, allocatable :: p_spread(:) !< vector for the spread values for each parameter
|
|
integer, allocatable :: p_act(:) !< vector containing 0 or 1 defining if corresponding parameters are activ in Fit ! Nicole: added flexible value for nonlinear terms
|
|
|
|
! Private: variables
|
|
integer i,j !< running indicies
|
|
integer ktype,key_end !< dummys for keytype and keylength
|
|
integer pcount !< dummy for number of read values
|
|
logical dbg !< logical for debugging state
|
|
|
|
! Fabian
|
|
character(len=llen) fmt
|
|
integer,parameter :: std_out = 6
|
|
|
|
dbg =.false.
|
|
|
|
!Fabian: No need that these are within keys.incl since these are generic statements
|
|
parkeynum=0
|
|
parkeylen=0
|
|
key = ' '
|
|
|
|
!Fabian: Include user specific keys
|
|
call init_keys
|
|
! include 'keys.incl'
|
|
|
|
!Fabian: No need that this is within keys.incl since it is generic
|
|
do j=1,maxpar_keys
|
|
if (key(1,j)(1:1).eq.' ') then
|
|
parkeynum=j-1
|
|
write(fmt,'("Number of accepted parameter keys: ",I3)')
|
|
> parkeynum
|
|
call write_oneline(fmt,std_out)
|
|
exit
|
|
endif
|
|
enddo
|
|
|
|
do i=1,4
|
|
do j=1,maxpar_keys
|
|
if(parkeylen.lt.len_trim(key(i,j))) then
|
|
parkeylen = len_trim(key(i,j))
|
|
endif
|
|
enddo
|
|
enddo
|
|
if(parkeylen.ge.klen) then
|
|
write(fmt,*)
|
|
> 'WARNING: Lenght of Parameterkey >= Maximum Keylenght'
|
|
call write_oneline(fmt,std_out)
|
|
endif
|
|
|
|
|
|
|
|
! reading cards for the number of parameters'
|
|
npar =0
|
|
ktype = 1 !reading number of parameters per key
|
|
do i=1,linenum
|
|
do j=1, parkeynum
|
|
|
|
! get string length of key
|
|
key_end=len_trim(key(ktype,j))
|
|
|
|
! check if key is present and read values if present
|
|
if (infile(i)(1:key_end).eq.key(ktype,j)) then
|
|
if(dbg) write(6,*) key(ktype,j),' read'
|
|
read (infile(i)(key_end+1:llen),*) pst(2,j)
|
|
endif
|
|
enddo
|
|
enddo
|
|
|
|
!.. compute total number of parameters:
|
|
do i=1, parkeynum
|
|
npar=npar + pst(2,i)
|
|
enddo
|
|
if(npar.gt.max_par) call signal_maxparameter_error(npar,max_par)
|
|
if(npar.le.0) call signal_noparameters_error(npar)
|
|
|
|
write(fmt,'("Number of Expected Parameters: ",I9)') npar
|
|
call write_oneline(fmt,std_out)
|
|
|
|
!.. determine start and end points of parameter blocks:
|
|
pst(1,1)=1 ! 1 = start of block
|
|
do i=2,parkeynum
|
|
pst(1,i)= pst(1,i-1)+pst(2,i-1)
|
|
if(dbg) write(6,'("pst(1:2,i): ",2i9)') pst(1:2,i)
|
|
enddo
|
|
|
|
|
|
! allocate parameter arrays
|
|
allocate(p(npar),p_act(npar),p_spread(npar))
|
|
! initialize parameter arrays
|
|
p=0.d0
|
|
! DW: UNDOCUMENTED BEHAVIOR: What does act=2 do???
|
|
p_act=10
|
|
p_spread=gspread
|
|
|
|
! read parameter values
|
|
ktype = 2 !reading value of parameters per key
|
|
do i=1,linenum
|
|
do j=1, parkeynum
|
|
|
|
! get string length of key
|
|
key_end=len_trim(key(ktype,j))
|
|
|
|
! check if key is present and read values if present
|
|
if (infile(i)(1:key_end).eq.key(ktype,j)) then
|
|
if(dbg) write(6,*) key(ktype,j),' read'
|
|
call long_realkey(infile,i,key_end,
|
|
> p,pst(1,j),pcount,llen,npar,linenum)
|
|
! check if number of parameters consistent
|
|
if(pcount.ne.pst(2,j)) then
|
|
call signal_parameter_error
|
|
> (key(ktype,j),pcount,pst(2,j))
|
|
endif
|
|
|
|
endif
|
|
|
|
enddo
|
|
enddo
|
|
|
|
! read if parameters are activ
|
|
ktype = 3 !reading activity of parameter per key
|
|
do i=1,linenum
|
|
do j=1, parkeynum
|
|
|
|
! get string length of key
|
|
key_end=len_trim(key(ktype,j))
|
|
|
|
! check if key is present and read values if present
|
|
if (infile(i)(1:key_end).eq.key(ktype,j)) then
|
|
if(dbg) write(6,*) key(ktype,j),' read'
|
|
call long_intkey(infile,i,key_end,
|
|
> p_act,pst(1,j),pcount,llen,npar,linenum)
|
|
! check if number of parameters consistent
|
|
if(pcount.ne.pst(2,j)) then
|
|
call signal_parameter_error
|
|
> (key(ktype,j),pcount,pst(2,j))
|
|
endif
|
|
|
|
endif
|
|
|
|
enddo
|
|
enddo
|
|
|
|
! check if all values for p_act are in valid range
|
|
do i=1,npar
|
|
! Nicole: added flexible p_act values
|
|
! in my case now up tp 6
|
|
if((abs(p_act(i)).gt.6)) then
|
|
write(fmt,*) 'Invalid value for p_act: ', p_act(i), i
|
|
call write_oneline(fmt,std_out)
|
|
endif
|
|
enddo
|
|
|
|
! read spread for parameters
|
|
ktype = 4 !reading spread of parameters per key
|
|
do i=1,linenum
|
|
do j=1, parkeynum
|
|
|
|
! get string length of key
|
|
key_end=len_trim(key(ktype,j))
|
|
|
|
! check if key is present and read values if present
|
|
if (infile(i)(1:key_end).eq.key(ktype,j)) then
|
|
if(dbg) write(6,*) key(ktype,j),' read'
|
|
call long_realkey(infile,i,key_end,
|
|
> p_spread,pst(1,j),pcount,llen,npar,linenum)
|
|
|
|
! check if number of parameters consistent
|
|
if(pcount.ne.pst(2,j)) then
|
|
call signal_parameter_error
|
|
> (key(ktype,j),pcount,pst(2,j))
|
|
endif
|
|
|
|
endif
|
|
|
|
enddo
|
|
enddo
|
|
|
|
!Multiply p_spread by facspread
|
|
!(default facspread=1, unless it is explicitly declared)
|
|
p_spread=p_spread*facspread
|
|
|
|
end subroutine
|
|
!----------------------------------------------------------------------------------------------------
|
|
! <Subroutine returns error message for inconsistent number of Parameters
|
|
! <needs: the corresponding key as string (keystr) the number of values read (val) and the expected number (expval)
|
|
subroutine signal_parameter_error(keystr,val,expval)
|
|
use strings_mod,only:int2string
|
|
character(len=klen) :: keystr !< string containing the Card (EXAMPLE:)
|
|
integer :: val, expval !< number of read and expected number of Parametervalues
|
|
write(6,'(A)')'ERROR: Reading ' // trim(keystr) // ' counted: '
|
|
> // trim(int2string(val)) // ' Parameters, but expected: '
|
|
> // trim(int2string(expval))
|
|
stop ec_read
|
|
end subroutine
|
|
|
|
!----------------------------------------------------------------------------------------------------
|
|
! <Subroutine returns error message for inconsistent number of Parameters
|
|
! <needs: the corresponding key as string (keystr) the number of values read (val) and the expected number (expval)
|
|
subroutine signal_maxparameter_error(val,maxval)
|
|
use strings_mod,only:int2string
|
|
integer :: val, maxval !< number of read and expected number of Parametervalues
|
|
|
|
write(6,'(A)')'ERROR: More Parameters then given maximum counted:'
|
|
> // trim(int2string(val)) // ' Parameters, but maximum: '
|
|
> // trim(int2string(maxval))
|
|
stop ec_dim
|
|
end subroutine
|
|
|
|
!----------------------------------------------------------------------------------------------------
|
|
! <Subroutine returns error message for inconsistent number of Parameters
|
|
! <needs: the corresponding key as string (keystr) the number of values read (val) and the expected number (expval)
|
|
subroutine signal_noparameters_error(val)
|
|
use strings_mod,only:int2string
|
|
integer :: val !< number of read and expected number of Parametervalues
|
|
write(6,'(A)')'ERROR: No. of counted parameters is <= 0:'
|
|
> // trim(int2string(val))
|
|
stop ec_dim
|
|
end subroutine
|
|
|
|
|
|
end module
|