ReadControlPars.f90

Go to the documentation of this file.

!==============================================================================
!
!  File   :  ReadControlPars
!
!  Remarks:  contains the module WriteLineMod
!            and the subroutine  ReadControlPars
!
!
!==============================================================================
!==============================================================================
!
!  Module   :  WriteLineMod
!
!  CONTAINS  subroutines:
!            RWLine            
!            RWInteger       
!            RWReal      
!            RWLogical 
!            RWChar
!            CheckWriteError
!            CheckReadError
!            ReadSeveralValuesSameTypeFromLine
!            ReadWriteSeveralValuesSameTypeFromLine
!            AssignReportIntervals
!==============================================================================
module writelinemod    
    use loggermodule
    use filelistmodule
  contains
  
!==============================================================================
!==============================================================================
    SUBROUTINE rwinteger(outInt)
        IMPLICIT NONE
        
        INTEGER, INTENT(out) :: outInt
        character(len=:), allocatable :: word
        character(len=:), allocatable:: comment
        INTEGER :: err      
        
        call extractword(controlpars_file,1,word, comment, err) ! reads in 1st characterstring and rest (comment) from actual line in controlpars
        call checkreaderror(err)
        
        read(word, "("//format_integer//")",   iostat=err) outint ! converts it into integer
        if(err /= 0) then
          call logerror("Could not cast to TYPE INTEGER in controlParsFile: ->"//word//"<-"//comment)
          error stop
        end if
        
        write(controlparsout_file%unit,"("//format_integer//",A)",    iostat=err) outint, comment
        call checkwriteerror(err)
        
    end SUBROUTINE rwinteger
 
!==============================================================================
!============================================================================== 
    SUBROUTINE rwreal(outReal)
        IMPLICIT NONE
        
        REAL, INTENT(out) :: outReal
        character(len=:), allocatable :: word
        character(len=:), allocatable:: comment
        INTEGER :: err      
        
        call extractword(controlpars_file,1,word, comment, err) ! reads in 1st characterstring and rest (comment) from actual line in controlpars
        call checkreaderror(err)
        
        read(word, "("//format_real//")",   iostat=err) outreal
        if(err /= 0) then
          call logerror("Could not cast to TYPE REAL in controlParsFile: ->"//word//"<-"//comment)
          error stop
        end if
        
        write(controlparsout_file%unit,"("//format_real//",A)",    iostat=err) outreal, comment
        call checkwriteerror(err)
        
    end SUBROUTINE rwreal
 
!==============================================================================
!==============================================================================     
    SUBROUTINE rwchar(outChar)
        IMPLICIT NONE       
        
        character(len=:), allocatable, INTENT(out) :: outChar
        character(len=:), allocatable :: word
        character(len=:), allocatable:: comment
        INTEGER :: err
                
        call extractword(controlpars_file,1,word, comment, err) ! reads in 1st characterstring and rest (comment) from actual line in controlpars
        call checkreaderror(err)
        outchar = word
        if(err /= 0) then
          call logerror("Could not cast to TYPE CHARCATER in controlParsFile: ->"//word//"<-"//comment)
          error stop
        end if
        
        write(controlparsout_file%unit,"("//format_character//",A)",    iostat=err) outchar, comment
        call checkwriteerror(err)
        
    end SUBROUTINE rwchar
 
!==============================================================================
! @brief RWLogical  
! ***************************************** 
!==============================================================================     
    SUBROUTINE rwlogical(outLogical)
        IMPLICIT NONE       
        
        LOGICAL, INTENT(out) :: outLogical      
        character(len=:), allocatable :: word
        character(len=:), allocatable:: comment
        INTEGER :: err
        
        call extractword(controlpars_file,1,word, comment, err) ! reads in 1st characterstring and rest (comment) from actual line in controlpars
        call checkreaderror(err)
        
        read(word, "("//format_logical//")",   iostat=err) outlogical
        if(err /= 0) then
          call logerror("Could not cast to TYPE LOGICAL in controlParsFile: ->"//word//"<-"//comment)
          error stop
        end if
        
        write(controlparsout_file%unit,"("//format_logical//",A)",    iostat=err) outlogical, comment
        call checkwriteerror(err)
        
    end SUBROUTINE rwlogical
 
!==============================================================================
!==============================================================================     
    SUBROUTINE checkwriteerror(err)
        IMPLICIT NONE
        INTEGER, INTENT(in) :: err
        if(err /= 0) then
          call logerror("Could not write line in output controlParsFile: "//controlparsout_file%path)
          error stop
        end if
    end SUBROUTINE checkwriteerror
    
!==============================================================================
!==============================================================================     
    SUBROUTINE checkreaderror(err)
        IMPLICIT NONE
        INTEGER, INTENT(in) :: err
        if(err /= 0) then
            call logerror("Could not read line in controlParsFile: "//controlpars_file%path)
            error stop
        end if
    end SUBROUTINE checkreaderror
 
!==============================================================================
!==============================================================================     
    SUBROUTINE readseveralvaluessametypefromline(nvals,  rest, err, vec_INTEGER, vec_REAL, vec_CHAR,  vec_LOGICAL)
        use filelistmodule
        use loggermodule
        IMPLICIT NONE
        character(len=:), allocatable,  INTENT(out) :: rest
        INTEGER,                        INTENT(out) :: err
        INTEGER,                        INTENT(out) :: nvals
  
        INTEGER, dimension(10),         INTENT(out), optional :: vec_INTEGER
        REAL, dimension(10),            INTENT(out), optional :: vec_REAL
        character(len=30),              INTENT(out), optional :: vec_CHAR (10)
        LOGICAL,  dimension(10),        INTENT(out), optional :: vec_LOGICAL  
        
        character(len=30), dimension(50)  :: wordsvec
        INTEGER:: iword  
 !---- get a vector of strings for values and the rest (e.g. comment) from the buffer
        call extractandcountwords(controlpars_file, nvals, wordsvec, rest, err) 
        
        if(err /= 0) then
            call logerror("Could not read line in controlParsFile: "//controlpars_file%path)
            error stop
        end if
 !---- convert each of these strings to a value and store it in the corresponding vector
        do iword = 1, nvals 
            if(present(vec_integer))then
                read(wordsvec(iword), "("//format_integer//")",   iostat=err) vec_integer(iword)
            else if (present(vec_real)) then
                read(wordsvec(iword), "("//format_real//")",      iostat=err) vec_real(iword)
            else if (present(vec_char)) then
                vec_char(iword) = wordsvec(iword )
            else if (present(vec_logical)) then
                read(wordsvec(iword), "("//format_logical//")",   iostat=err) vec_logical(iword)
            end if
        end do ! iword 
 
    end SUBROUTINE readseveralvaluessametypefromline
 
!=============================================================================
!==============================================================================     
     SUBROUTINE readwriteseveralvaluessametypefromline( nvals,  err, vec_INTEGER, vec_REAL, vec_CHAR,  vec_LOGICAL)
  
        use filelistmodule
        use loggermodule
        IMPLICIT NONE
        character(len=:), allocatable  :: rest
        INTEGER,                        INTENT(out) :: err
        INTEGER,                        INTENT(out) :: nvals
  
        INTEGER, dimension(10),         INTENT(out), optional :: vec_INTEGER
        REAL, dimension(10),            INTENT(out), optional :: vec_REAL
        character(len=30),              INTENT(out), optional :: vec_char (10)
        LOGICAL,  dimension(10),        INTENT(out), optional :: vec_LOGICAL  
        INTEGER:: i
        character (len=3)             :: nvalschar
        character(len=3), parameter :: FORMAT_INTEGER_narrow = "I5"
 !--- get the vector to be read in and its number of elements (nvals)
        call readseveralvaluessametypefromline( nvals, rest, err, vec_integer, vec_real, vec_char,  vec_logical)
 !--- write out to the copy of the control pars file        
        call inttochar(3,nvals,nvalschar)
        if(present(vec_integer))then
            if(nvals == 0) then
                write(controlparsout_file%unit,"(A)", iostat=err) &
                    rest
            else 
                write(controlparsout_file%unit,"("// nvalschar// "("//format_integer_narrow//") ,A)", iostat=err) &
                     ( vec_integer(i), i= 1,nvals), rest
            end if
        else if (present(vec_real)) then
          write(controlparsout_file%unit,"("// nvalschar// "("//format_real//") ,A)",           iostat=err) &
                         ( vec_real(i), i= 1,nvals),    rest
        else if (present(vec_char)) then
          write(controlparsout_file%unit,"("// nvalschar// "("//format_character//") ,A)",      iostat=err) &
                         ( vec_char(i), i= 1,nvals),    rest
        else if (present(vec_logical)) then
          write(controlparsout_file%unit,"("// nvalschar// "("//format_logical//") ,A)",        iostat=err) &
                         ( vec_logical(i), i= 1,nvals), rest
 
        end if
 
    end SUBROUTINE readwriteseveralvaluessametypefromline
!==============================================================================
!============================================================================== 
 SUBROUTINE assignreportintervals(nvals, repInts) 
 
    use all_par, only: simustartyear,numyrs , reportintervals,   nreportintervals  
    use loggermodule
    IMPLICIT NONE
    INTEGER, INTENT(in ):: nvals   
    INTEGER, INTENT(in ):: repInts(30)
    INTEGER:: i, irepInts, simuendyear
    character (len=3)             :: charvar
 !--- write the report invervals, their starts and ends to an array 
    simuendyear = simustartyear + numyrs
    reportintervals = simuendyear + 1 
    if (nvals == 1) then  ! only one interval for entire simulation
        reportintervals(1,1) = repints(1)
        reportintervals(1,2) = simustartyear
        reportintervals(1,3) = simuendyear
        nreportintervals = 1
    else if (mod(nvals,3) == 0 ) then ! correct intervals, store the interval, start and end for all ReportIntervals
        nreportintervals = nvals/3
        do irepints = 1, nreportintervals
           reportintervals(irepints,1) = repints((irepints-1)*3 +1)
           reportintervals(irepints,2) = repints((irepints-1)*3 +2)
           reportintervals(irepints,3) = repints((irepints-1)*3 +3)
        end do
    else
        call inttochar(3,nvals,charvar)
        call logerror("Number of values for report interval must be 1 or multiple of 3"// charvar)
        error stop
    end if
 !---  write the infos 
    call loginfo("Output will be written")
    do i =1,nreportintervals
        if(reportintervals(i,1) == 1) then
            write(logmessage, "(A,I5,A,I5)") "    every year       from ",&
                reportintervals(i,2)," to ",reportintervals(i,3)
        else 
            write(logmessage, "(A,I4,A,I5,A,I5)") "    every ", reportintervals(i,1), " years from ",&
                reportintervals(i,2)," to ", reportintervals(i,3)
        end if        
        call loginfo(logmessage)
    end do    
    call loginfo("    every year for all other years")
end SUBROUTINE assignreportintervals     
end module writelinemod
!==============================================================================
!============================================================================== 
SUBROUTINE readcontrolpars()
 
    
    use all_par, only: numyrs,     & 
                       stateoutputyears, stateoutputdist,  &
                       maxlat, maxlon,& 
                       latrealstart, latrealend, lonrealstart, lonrealend,         &
                       startlatstart, startlatend, startlonstart, startlonend, & 
                       inoculationtime, readstatefile,                &                       
                       includeenv, envfromfile, bioclimfilename,   &
                       kerneltype, alpha_all, epskernel, cellsidelength, active, pltsiz, &
                       dostochseeddisp, seedsdifferent, mathgtdifferent, dofft, &
                       dispersaldifferent, mastseeding, calcseedbank, seedlcrowndiamincm,              &
                       disturbances, disturbprob, disturbintensity,                                &
                       withseedantagonists, seedantagraz, seedantamort, seedantaeff, seedantarain, &
                       withseedcarrcap, seedcarrcap,                                               &
                       boundaries, fcvarinit, fcvardyn, estabeqhc0, contlightdepgerm,              &
                       specfilename ,immifilename, immigration, simustartyear,                     &
                       experimentid, tabsepoutput, outerseeds,           &
                       writeoutput, unitofspatialdata,                      &
                       driverdefault            ! Use control and species parameters
    use writelinemod 
    use loggermodule  
    use filelistmodule, only: controlpars_file  
    IMPLICIT NONE
       ! Local variables ---------------------------------------------------------------------------------
    INTEGER      :: err,   nvals 
    INTEGER      :: repInts(30)
   
    character(len=:), allocatable :: dummy
    character(len=:), allocatable :: rest 
 
    !Here the SUBROUTINE starts **********************************************************************
    !---- opens the control pars file
    call loginfo("Reading control-pars file: "//controlpars_file%path)
    call openfiler(controlpars_file, err) ! closed (this l. 271)
    if(err /= 0) then 
        call logerror("Cannot open control-pars file:"//controlpars_file%path)
        error stop
    end if
        
    !---- Experiment ID ----
    call extractword(controlpars_file,1,dummy, rest, err)
    call checkreaderror(err)
    call extractword(controlpars_file,1,experimentid, rest, err)
    call checkreaderror(err)
    ! we got experimentID, so we can define the resultPath for the output files    
        resultpath     = relativepathletter//"R"//pathletter//experimentid//pathletter
        resultpath_h   = resultpath // "HCL/"
        statepath      =  relativepathletter//"S"//pathletter//experimentid//pathletter
       ! CREATE DIR FOR RESULTS
        call execute_command_line ('mkdir '//'"'//resultpath//'"', exitstat=err)
        call execute_command_line ('mkdir '//'"'//resultpath_h//'"' , exitstat=err)
        call execute_command_line ('mkdir '//'"'//statepath//'"' , exitstat=err)
 
 
        controlparsout_file%path = resultpath//experimentid//"_"//"control.pars"
        call openfilew(controlparsout_file, err) ! closed (this l. 272)
        if (err /= 0) then
            call logerror("Could not create output control-pars file:"//controlparsout_file%path)
            error stop
        end if
    ! 
 
    write(controlparsout_file%unit,"("//format_character//",A)",    iostat=err) dummy, "  Simulation  ====="
    call checkwriteerror(err)
    write(controlparsout_file%unit,"("//format_character//",A)",    iostat=err) experimentid, rest
    call checkwriteerror(err)
 
!---- Time
    call rwchar(dummy) !  The dummy reading is for the empty lines in the control file  
    call rwinteger(numyrs)
    call rwinteger(simustartyear)
    
    call readwriteseveralvaluessametypefromline(nvals, err,  vec_integer=repints)
    call assignreportintervals(nvals, repints) 
    call rwinteger(inoculationtime)
    call rwinteger(stateoutputdist)
 
    call readwriteseveralvaluessametypefromline(nvals, err,  vec_integer=stateoutputyears)
    stateoutputyears(nvals+1 : size(stateoutputyears)) = simustartyear+numyrs
 
    call rwlogical(readstatefile)
    if (readstatefile) then 
        if (inoculationtime /=0) then
          inoculationtime=0
          call loginfo("inoculation time set to 0, because simulation starts from initial values")
        end if 
    else 
        if(inoculationtime == 0) then
          call logerror("inoculation time is zero and no initial values =>  no trees. Set it to >=1");
          error stop
        end if
    end if 
!----  Space
    call rwchar(dummy) ! 
    call rwreal(pltsiz)
    call rwinteger(maxlat)
    call rwinteger(maxlon)
    call rwreal(cellsidelength)
    call rwreal(unitofspatialdata)
    call rwreal(lonrealstart)
    call rwreal(lonrealend)
    call rwreal(latrealstart)
    call rwreal(latrealend)
 
    call rwinteger(startlatstart)
    call rwinteger(startlatend)
    call rwinteger(startlonstart)
    call rwinteger(startlonend)
    call rwchar(boundaries)
!---- Environment 
    call rwchar(dummy) 
    call rwlogical(includeenv)
    call rwlogical(envfromfile)
    call rwchar(bioclimfilename)
!---- Defaults for other drivers    
    call rwchar(dummy)  
    call rwreal(driverdefault(7))
    call rwreal(driverdefault(8))
    call rwreal(driverdefault(9))
    call rwreal(driverdefault(10))
!---- Dispersal   
    call rwchar(dummy)  
    call rwlogical(dofft)
    call rwlogical(dispersaldifferent)
    call rwinteger(kerneltype)
    call rwreal(epskernel)
    epskernel = epskernel * 1.e-5 
    call rwreal(alpha_all)
    call rwlogical(active)
    call rwlogical(dostochseeddisp)
    call rwinteger(outerseeds)
!---- Seeds
    call rwchar(dummy)  
    call rwlogical(seedsdifferent)
    call rwlogical(mathgtdifferent)
    call rwlogical(mastseeding)
    call rwlogical(calcseedbank)
!---- Density regulation
    call rwchar(dummy)  
    call rwreal(seedlcrowndiamincm)
    call rwlogical(withseedantagonists)
    call rwreal(seedantagraz)
    call rwreal(seedantaeff)
    call rwreal(seedantamort)
    call rwreal(seedantarain)
    call rwlogical(withseedcarrcap)
    call rwreal(seedcarrcap)
    seedcarrcap = seedcarrcap * pltsiz / 833.0 ! scale from 833 to the chosen plot size
!--- Immigration    
    call rwchar(dummy) 
    call rwlogical(immigration)
    call rwchar(immifilename)
!---- Disturbances
    call rwchar(dummy) 
    call rwlogical(disturbances)
    call rwreal(disturbprob)
    call rwreal(disturbintensity)
!---- Light
    call rwchar(dummy) 
    call rwreal(fcvarinit)
    call rwreal(fcvardyn)
!---- Clump (but actually these parameters refer to the establishment)
    call rwchar(dummy) 
    call rwlogical(estabeqhc0)
    call rwlogical(contlightdepgerm)
!---- Species File
    call rwchar(dummy) 
    call rwchar(specfilename)
!---- Output
    call rwchar(dummy) 
    call rwlogical(writeoutput%netcdf)
    call rwlogical(writeoutput%biomass)
    call rwlogical(writeoutput%number)
    call rwlogical(writeoutput%hstruct)
    call rwlogical(writeoutput%seeds)
    call rwlogical(writeoutput%antagonists)
    call rwlogical(writeoutput%pollen)
    call rwlogical(writeoutput%lai)
    call rwlogical(writeoutput%basalArea)
    call rwlogical(writeoutput%NPP)
    call rwlogical(writeoutput%ingrowth)
    call rwlogical(writeoutput%biodiv)
    call rwlogical(writeoutput%light)
    call rwlogical(tabsepoutput)
!---- Check and close the file       
    if(err /= 0) then
        call logerror("Error reading control pars file:"//controlpars_file%path);
        error stop
    end if
    
    call closefile(controlpars_file)
    call closefile(controlparsout_file)
    end SUBROUTINE readcontrolpars
    ! ****<Here the SUBROUTINE ends>******************************************************************