From 4dfb0f703247a6056941934f600aa3db5752362e Mon Sep 17 00:00:00 2001 From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr> Date: Fri, 25 Nov 2022 13:39:01 +0100 Subject: [PATCH] Philippe 25/11/2022: add tools fo find rank and model number corresponding to a given position --- src/MNH/position_tools.f90 | 230 +++++++++++++++++++++++++++++++++++++ 1 file changed, 230 insertions(+) create mode 100644 src/MNH/position_tools.f90 diff --git a/src/MNH/position_tools.f90 b/src/MNH/position_tools.f90 new file mode 100644 index 000000000..2fb03e7d5 --- /dev/null +++ b/src/MNH/position_tools.f90 @@ -0,0 +1,230 @@ +!MNH_LIC Copyright 2022-2022 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- +! Author: +! P. Wautelet 25/11/2022 +! Modifications: +!----------------------------------------------------------------- +! ################### +MODULE MODE_POSITION_TOOLS +! ################### + +USE MODE_MSG + +IMPLICIT NONE + +PRIVATE + +PUBLIC :: FIND_PROCESS_AND_MODEL_FROM_XY_POS + +CONTAINS + +!---------------------------------------------------------------------------- +SUBROUTINE FIND_PROCESS_FROM_XY_POS( PX, PY, TPMODEL, KRANK, GINSIDE ) + ! Find the rank of the process with the given position + USE MODD_FIELD, ONLY: TFIELDLIST + USE MODD_IO, ONLY: ISNPROC + USE MODD_PARAMETERS, ONLY: NNEGUNDEF + USE MODD_STRUCTURE_ll, ONLY: PROCONF_ll + + USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME + + IMPLICIT NONE + + REAL, INTENT(IN) :: PX + REAL, INTENT(IN) :: PY + TYPE(PROCONF_ll), INTENT(IN) :: TPMODEL + INTEGER, INTENT(OUT) :: KRANK + LOGICAL, INTENT(OUT) :: GINSIDE + + INTEGER :: IID + INTEGER :: IRESP + INTEGER :: IXPOS + INTEGER :: IYPOS + INTEGER :: JP + REAL, DIMENSION(:), POINTER :: ZXHAT_ll + REAL, DIMENSION(:), POINTER :: ZYHAT_ll + + GINSIDE = .FALSE. + KRANK = NNEGUNDEF + + ZXHAT_ll => NULL() + ZYHAT_ll => NULL() + + call Find_field_id_from_mnhname( 'XHAT_ll', iid, iresp ) + ZXHAT_ll => tfieldlist(iid)%tfield_x1d(TPMODEL%NUMBER)%data + call Find_field_id_from_mnhname( 'YHAT_ll', iid, iresp ) + ZYHAT_ll => tfieldlist(iid)%tfield_x1d(TPMODEL%NUMBER)%data + + IXPOS = COUNT( ZXHAT_ll(:) <= PX ) + IYPOS = COUNT( ZYHAT_ll(:) <= PY ) + + DO JP = 1, ISNPROC + IF ( IXPOS >= TPMODEL%TSPLITS_B(JP)%NXORP .AND. IXPOS <= TPMODEL%TSPLITS_B(JP)%NXENDP & + .AND. IYPOS >= TPMODEL%TSPLITS_B(JP)%NYORP .AND. IYPOS <= TPMODEL%TSPLITS_B(JP)%NYENDP ) THEN + GINSIDE = .TRUE. + KRANK = JP + EXIT + END IF + END DO + +END SUBROUTINE FIND_PROCESS_FROM_XY_POS +!---------------------------------------------------------------------------- + +!---------------------------------------------------------------------------- +SUBROUTINE FIND_PROCESS_AND_MODEL_FROM_XY_POS( PX, PY, KRANK, KMODEL ) + ! Find the rank of the process with the given position + ! on the most refined model (except if model number is forced) + + USE MODD_IO, ONLY: ISNPROC + USE MODD_PARAMETERS, ONLY: NNEGUNDEF + USE MODD_STRUCTURE_ll, ONLY: PROCONF_ll + USE MODD_VAR_ll, ONLY: TCRRT_PROCONF + + IMPLICIT NONE + + REAL, INTENT(IN) :: PX + REAL, INTENT(IN) :: PY + INTEGER, INTENT(OUT) :: KRANK ! If < 1, position is outside domain(s) + INTEGER, INTENT(INOUT) :: KMODEL ! If > 0 at entry, model is fixed, else it is set by subroutine + + CHARACTER(LEN=3) :: YMODEL + LOGICAL :: GFOUND + LOGICAL :: OINSIDE + TYPE(PROCONF_ll), POINTER :: TZMODEL + + KRANK = NNEGUNDEF + + TZMODEL => TCRRT_PROCONF + + ! Go back to the root model + DO WHILE( ASSOCIATED( TZMODEL%TPARENT ) ) + TZMODEL => TZMODEL%TPARENT + END DO + + IF ( KMODEL > 0 ) THEN + ! Find the configuration corresponding to KMODEL + ! based on GO_TOMODEL_ll + + ! Find the model configuration + CALL FIND_MODEL( TZMODEL, KMODEL, GFOUND ) + + IF ( .NOT. GFOUND ) THEN + WRITE( YMODEL, '( I3 )' ) KMODEL + CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'FIND_PROCESS_AND_MODEL_FROM_XY_POS', 'model ' // YMODEL // ' not found' ) + END IF + + ! Find the rank of the process where the position is + CALL FIND_PROCESS_FROM_XY_POS( PX, PY, TZMODEL, KRANK, OINSIDE ) + ELSE + ! Model number is not fixed => find the finer model corresponding to the position + CALL FIND_FINER_MODEL_WITH_XY_POS( PX, PY, TZMODEL, KMODEL, KRANK, OINSIDE ) + END IF + +END SUBROUTINE FIND_PROCESS_AND_MODEL_FROM_XY_POS +!---------------------------------------------------------------------------- + + +!---------------------------------------------------------------------------- +RECURSIVE SUBROUTINE FIND_FINER_MODEL_WITH_XY_POS( PX, PY, TPMODEL, KMODEL, KRANK, OINSIDE ) + USE MODD_PARAMETERS, ONLY: NNEGUNDEF + USE MODD_STRUCTURE_ll, ONLY: LPROCONF_ll, PROCONF_ll + + IMPLICIT NONE + + REAL, INTENT(IN) :: PX + REAL, INTENT(IN) :: PY + TYPE(PROCONF_ll), POINTER, INTENT(INOUT) :: TPMODEL + INTEGER, INTENT(INOUT) :: KMODEL + INTEGER, INTENT(OUT) :: KRANK + LOGICAL, INTENT(OUT) :: OINSIDE + + INTEGER :: IRANK + LOGICAL :: GINSIDE + TYPE(PROCONF_ll), POINTER :: TZCHILD + TYPE(LPROCONF_ll), POINTER :: TZMODELS + + IRANK = NNEGUNDEF + GINSIDE = .FALSE. + + CALL FIND_PROCESS_FROM_XY_POS( PX, PY, TPMODEL, IRANK, GINSIDE ) + IF ( GINSIDE ) THEN + KMODEL = TPMODEL%NUMBER + KRANK = IRANK + END IF + OINSIDE = GINSIDE + + IF ( .NOT. GINSIDE ) RETURN + + !If the coordinates are inside the current model, look at its children + TZMODELS => TPMODEL%TCHILDREN + DO WHILE(ASSOCIATED(TZMODELS)) + TZCHILD => TZMODELS%TELT + + CALL FIND_FINER_MODEL_WITH_XY_POS( PX, PY, TZCHILD, KMODEL, IRANK, GINSIDE ) + + IF ( .NOT. GINSIDE ) THEN + TZMODELS => TZMODELS%TNEXT + ELSE + TPMODEL => TZCHILD + KMODEL = TPMODEL%NUMBER + KRANK = IRANK + OINSIDE = GINSIDE + RETURN + END IF + END DO + +END SUBROUTINE FIND_FINER_MODEL_WITH_XY_POS +!---------------------------------------------------------------------------- + + +!---------------------------------------------------------------------------- +RECURSIVE SUBROUTINE FIND_MODEL( TPMODEL, KMODEL, OFOUND ) + USE MODD_STRUCTURE_ll, ONLY: LPROCONF_ll, PROCONF_ll + + IMPLICIT NONE + + TYPE(PROCONF_ll), POINTER, INTENT(INOUT) :: TPMODEL + INTEGER, INTENT(IN) :: KMODEL + LOGICAL, INTENT(OUT) :: OFOUND + + TYPE(PROCONF_ll), POINTER :: TZCHILD + TYPE(LPROCONF_ll), POINTER :: TZMODELS + + OFOUND = .FALSE. + + ! Is the current model the searched one? + IF (TPMODEL%NUMBER == KMODEL) THEN + OFOUND = .TRUE. + RETURN + ENDIF + + ! no => explore all the children model of the current model + TZMODELS => TPMODEL%TCHILDREN + DO WHILE(ASSOCIATED(TZMODELS)) + + IF (TZMODELS%TELT%NUMBER == KMODEL) THEN + OFOUND = .TRUE. + TPMODEL => TZMODELS%TELT + RETURN + END IF + + TZCHILD => TZMODELS%TELT + + CALL FIND_MODEL( TZCHILD, KMODEL, OFOUND ) + + IF ( .NOT. OFOUND ) THEN + TZMODELS => TZMODELS%TNEXT + ELSE + TPMODEL => TZCHILD + RETURN + END IF + + END DO + +END SUBROUTINE FIND_MODEL +!---------------------------------------------------------------------------- + +END MODULE MODE_POSITION_TOOLS -- GitLab