manipulator_support_procedures.f90 Source File


Source Code

!-----------------------------------------------------------------------------------------------------------------------------------
! This file is part of ReMKiT1D.
!
! ReMKiT1D is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as 
! published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
!
! ReMKiT1D is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of 
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License along with ReMKiT1D. If not, see <https://www.gnu.org/licenses/>. 
!
! Copyright 2023 United Kingdom Atomic Energy Authority (stefan.mijin@ukaea.uk)
!-----------------------------------------------------------------------------------------------------------------------------------
submodule (manipulator_support) manipulator_support_procedures
!! author: Stefan Mijin 
!! 
!! Contains implementation of manipulator initialization support procedures

implicit none

!-----------------------------------------------------------------------------------------------------------------------------------
contains
!-----------------------------------------------------------------------------------------------------------------------------------
module subroutine initCompositeManipulatorFromJSON(manip,envObj,normObj)
    !! Initialize modelbound data and add to corresponding model object

    type(CompositeManipulator) ,allocatable ,intent(inout) :: manip
    type(EnvironmentWrapper)                ,intent(inout) :: envObj
    class(Normalization)                    ,intent(in)    :: normObj

    type(NamedStringArray)     ,dimension(1) :: manipulatorTags
    type(NamedString)          ,dimension(1) :: manipulatorType

    integer(ik) :: i

    if (assertions .or. assertionLvl >= 0) then 
        call assert(envObj%isDefined(),"Undefined environment wrapper passed to initCompositeManipulatorFromJSON")
        call assert(normObj%isDefined(),"Undefined normalization object passed to initCompositeManipulatorFromJSON")
    end if
    
    manipulatorTags(1)%name = keyManipulators//"."//keyTags
    allocate(manipulatorTags(1)%values(0))

    call envObj%jsonCont%load(manipulatorTags)

    if (size(manipulatorTags(1)%values) > 0) then 
        allocate(manip)
        call manip%init(size(manipulatorTags(1)%values))
    end if

    do i = 1,size(manipulatorTags(1)%values)
        manipulatorType(1) = NamedString(keyManipulators//"."//manipulatorTags(1)%values(i)%string//"."//keyType,"")

        call envObj%jsonCont%load(manipulatorType)

        select case(manipulatorType(1)%value)
        case (keyGroupEvaluator)
            call addGroupEvaluatorToCompositeManipulator(manip,envObj,normObj,&
                                                         keyManipulators//"."//manipulatorTags(1)%values(i)%string)
        case (keyTermEvaluator)
            call addTermEvaluatorToCompositeManipulator(manip,envObj,normObj,&
                                                            keyManipulators//"."//manipulatorTags(1)%values(i)%string)
        case (keyExtractor)
            call addMBDataExtractorToCompositeManipulator(manip,envObj,normObj,&
                                                          keyManipulators//"."//manipulatorTags(1)%values(i)%string)
        case default 
            error stop "Unsupported manipulator type detected by initCompositeManipulatorFromJSON"
        end select
    end do

end subroutine initCompositeManipulatorFromJSON
!-----------------------------------------------------------------------------------------------------------------------------------
module subroutine addGroupEvaluatorToCompositeManipulator(manip,envObj,normObj,jsonPrefix)
    !! Add GroupEvaluator type manipulator based json file

    type(CompositeManipulator)              ,intent(inout) :: manip
    type(EnvironmentWrapper)                ,intent(inout) :: envObj
    class(Normalization)                    ,intent(in)    :: normObj
    character(*)                            ,intent(in)    :: jsonPrefix

    type(GroupEvaluator) :: evalManip 

    type(NamedInteger) ,dimension(2) :: namedIntParams 
    type(NamedString)  ,dimension(2) :: namedStringParams 
    type(NamedStringArray) ,dimension(1) :: modelTags

    integer(ik) :: i ,modelIndex ,varIndex

    logical :: modelFound

    namedStringParams(1) = NamedString(jsonPrefix//"."//keyResultVarName,"")

    namedStringParams(2) = NamedString(jsonPrefix//"."//keyModelTag,"")

    namedIntParams(1) = NamedInteger(jsonPrefix//"."//keyEvaluatedGroup,1)
    namedIntParams(2) = NamedInteger(jsonPrefix//"."//keyPriority,0)

    modelTags(1)%name = keyModels//"."//keyTags
    allocate(modelTags(1)%values(0))

    call envObj%jsonCont%load(modelTags)
    call envObj%jsonCont%load(namedStringParams)
    call envObj%jsonCont%load(namedIntParams)

    call envObj%jsonCont%output(namedStringParams)
    call envObj%jsonCont%output(namedIntParams)

    modelFound = .false. 
    do i = 1, size(modelTags(1)%values)
        if (modelTags(1)%values(i)%string == namedStringParams(2)%value) then 
            modelIndex = i 
            modelFound = .true. 
            exit 
        end if
    end do

    if (.not. modelFound) error stop "model requested by GroupEvaluator not found"

    if (assertions .or. assertionLvl >= 0) call assert(envObj%externalVars%isVarNameRegistered(namedStringParams(1)%value),&
    namedStringParams(1)%value//&
    " variable requested by GroupEvaluator not found in environment wrapper")

    varIndex = envObj%externalVars%getVarIndex(namedStringParams(1)%value)

    call evalManip%init(varIndex,modelIndex,namedIntParams(1)%value)

    call manip%addManipulator(evalManip,namedIntParams(2)%value)
    
end subroutine addGroupEvaluatorToCompositeManipulator
!-----------------------------------------------------------------------------------------------------------------------------------
module subroutine addTermEvaluatorToCompositeManipulator(manip,envObj,normObj,jsonPrefix)
    !! Add TermEvaluator type manipulator based json file

    type(CompositeManipulator)              ,intent(inout) :: manip
    type(EnvironmentWrapper)                ,intent(inout) :: envObj
    class(Normalization)                    ,intent(in)    :: normObj
    character(*)                            ,intent(in)    :: jsonPrefix

    type(TermEvaluator) :: evalManip 

    type(NamedInteger) ,dimension(1) :: manipPriority 
    type(NamedString)  ,dimension(1) :: resultVarName 
    type(NamedStringArray) ,dimension(1) :: modelEvalTags, termNames 
    type(NamedStringArray) ,dimension(1) :: modelTags

    integer(ik) :: i ,j ,varIndex

    integer(ik) ,allocatable ,dimension(:) :: modelIndices
    type(StringArray) ,allocatable ,dimension(:) :: termNameStrings

    logical :: modelFound

    modelTags(1)%name = keyModels//"."//keyTags
    allocate(modelTags(1)%values(0))

    resultVarName(1) = NamedString(jsonPrefix//"."//keyResultVarName,"")
    modelEvalTags(1)%name = jsonPrefix//"."//keyEvaluatedModelNames
    allocate(modelEvalTags(1)%values(0))
    termNames(1)%name = jsonPrefix//"."//keyEvaluatedTermNames
    allocate(termNames(1)%values(0))
    
    manipPriority(1) = NamedInteger(jsonPrefix//"."//keyPriority,0)

    call envObj%jsonCont%load(modelTags)
    call envObj%jsonCont%load(modelEvalTags)
    call envObj%jsonCont%load(termNames)
    call envObj%jsonCont%load(resultVarName)
    call envObj%jsonCont%load(manipPriority)

    call envObj%jsonCont%output(modelEvalTags)
    call envObj%jsonCont%output(termNames)
    call envObj%jsonCont%output(resultVarName)
    call envObj%jsonCont%output(manipPriority)

    if (assertions .or. assertionLvl >= 0) call assert(size(termNames(1)%values) == size(modelEvalTags(1)%values),&
                                     modelEvalTags(1)%name//" and "//termNames(1)%name//" must be of the same size")
    
    allocate(modelIndices(size(modelEvalTags(1)%values)))
    allocate(termNameStrings(size(modelEvalTags(1)%values)))
    do i = 1,size(modelEvalTags(1)%values)
        modelFound = .false.
        do j = 1, size(modelTags(1)%values)
            if (modelTags(1)%values(j)%string == modelEvalTags(1)%values(i)%string) then 
                modelIndices(i) = j 
                modelFound = .true. 
                exit 
            end if
        end do
        if (.not. modelFound) error stop "model requested by TermEvaluator not found"

        termNameStrings(i)%string = termNames(1)%values(i)%string
    end do

    if (assertions .or. assertionLvl >= 0) call assert(envObj%externalVars%isVarNameRegistered(resultVarName(1)%value),&
    resultVarName(1)%value//&
    " variable requested by TermEvaluator not found in environment wrapper")

    varIndex = envObj%externalVars%getVarIndex(resultVarName(1)%value)

    call evalManip%init(varIndex,modelIndices,termNameStrings)

    call manip%addManipulator(evalManip,manipPriority(1)%value)
    
end subroutine addTermEvaluatorToCompositeManipulator
!-----------------------------------------------------------------------------------------------------------------------------------
module subroutine addMBDataExtractorToCompositeManipulator(manip,envObj,normObj,jsonPrefix)
    !! Add ModelboundDataExtractor type manipulator based json file

    type(CompositeManipulator)              ,intent(inout) :: manip
    type(EnvironmentWrapper)                ,intent(inout) :: envObj
    class(Normalization)                    ,intent(in)    :: normObj
    character(*)                            ,intent(in)    :: jsonPrefix

    type(ModelboundDataExtractor) :: extrManip 

    type(NamedInteger) ,dimension(1) :: namedIntParams 
    type(NamedString)  ,dimension(3) :: namedStringParams 
    type(NamedStringArray) ,dimension(1) :: modelTags

    integer(ik) :: i ,modelIndex ,varIndex

    logical :: modelFound

    namedStringParams(1) = NamedString(jsonPrefix//"."//keyResultVarName,"")

    namedStringParams(2) = NamedString(jsonPrefix//"."//keyModelTag,"")

    namedStringParams(3) = NamedString(jsonPrefix//"."//keyModelboundDataName,"")

    namedIntParams(1) = NamedInteger(jsonPrefix//"."//keyPriority,0)

    modelTags(1)%name = keyModels//"."//keyTags
    allocate(modelTags(1)%values(0))

    call envObj%jsonCont%load(modelTags)
    call envObj%jsonCont%load(namedStringParams)
    call envObj%jsonCont%load(namedIntParams)

    call envObj%jsonCont%output(namedStringParams)
    call envObj%jsonCont%output(namedIntParams)

    modelFound = .false. 
    do i = 1, size(modelTags(1)%values)
        if (modelTags(1)%values(i)%string == namedStringParams(2)%value) then 
            modelIndex = i 
            modelFound = .true. 
            exit 
        end if
    end do

    if (.not. modelFound) error stop "model requested by ModelboundDataExtractor not found"

    if (assertions .or. assertionLvl >= 0) call assert(envObj%externalVars%isVarNameRegistered(namedStringParams(1)%value),&
    namedStringParams(1)%value//&
    " variable requested by ModelboundDataExtractor not found in environment wrapper")

    varIndex = envObj%externalVars%getVarIndex(namedStringParams(1)%value)

    call extrManip%init(varIndex,modelIndex,namedStringParams(3)%value)

    call manip%addManipulator(extrManip,namedIntParams(1)%value)
    
end subroutine addMBDataExtractorToCompositeManipulator
!-----------------------------------------------------------------------------------------------------------------------------------
!-----------------------------------------------------------------------------------------------------------------------------------
end submodule manipulator_support_procedures
!-----------------------------------------------------------------------------------------------------------------------------------