diff --git a/src/MNH/modd_mnh_surfexn.f90 b/src/MNH/modd_mnh_surfexn.f90 new file mode 100644 index 0000000000000000000000000000000000000000..5863841a2e60edefea80eac670e1d60e63ffaaa7 --- /dev/null +++ b/src/MNH/modd_mnh_surfexn.f90 @@ -0,0 +1,71 @@ +MODULE MODD_MNH_SURFEX_n +! +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK +USE PARKIND1 ,ONLY : JPRB +! +USE MODD_SURFEX_n, ONLY : SURFEX_t +! +USE MODE_MODELN_SURFEX_HANDLER +! +TYPE(SURFEX_t), ALLOCATABLE, TARGET, SAVE :: YSURF_LIST(:) +TYPE(SURFEX_t), POINTER :: YSURF_CUR => NULL() +!$OMP THREADPRIVATE(YSURF_CUR) +! +CONTAINS +! +SUBROUTINE GOTO_SURFEX(KMODEL) + +INTEGER, INTENT(IN) :: KMODEL +REAL(KIND=JPRB) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:GOTO_MODEL",0,ZHOOK_HANDLE) +! +YSURF_CUR => YSURF_LIST(KMODEL) +ICURRENT_MODEL = KMODEL +! +IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:GOTO_MODEL",1,ZHOOK_HANDLE) +! +END SUBROUTINE GOTO_SURFEX +! +SUBROUTINE SURFEX_ALLOC_LIST(KMODEL) +! +USE MODI_SURFEX_ALLOC +! +IMPLICIT NONE +! +INTEGER, INTENT(IN) :: KMODEL +INTEGER :: J +REAL(KIND=JPRB) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:SURFEX_ALLOC_LIST",0,ZHOOK_HANDLE) +! +CALL INIT_CURRENT_MODEL_INDEX_SURFEX() +! +ALLOCATE(YSURF_LIST(KMODEL)) +! +DO J = 1,KMODEL + CALL SURFEX_ALLOC(YSURF_LIST(J)) +ENDDO +! +IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:SURFEX_ALLOC_LIST",1,ZHOOK_HANDLE) +! +END SUBROUTINE SURFEX_ALLOC_LIST +! +SUBROUTINE SURFEX_DEALLO_LIST +! +USE MODI_SURFEX_DEALLO +! +INTEGER :: J +REAL(KIND=JPRB) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:SURFEX_DEALLO_LIST",0,ZHOOK_HANDLE) +! +DO J=1,SIZE(YSURF_LIST) + CALL SURFEX_DEALLO(YSURF_LIST(J)) +ENDDO +! +IF (ASSOCIATED(YSURF_CUR)) NULLIFY(YSURF_CUR) +IF (ALLOCATED(YSURF_LIST)) DEALLOCATE(YSURF_LIST) +! +IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:SURFEX_DEALLO_LIST",1,ZHOOK_HANDLE) +! +END SUBROUTINE SURFEX_DEALLO_LIST +! +END MODULE MODD_MNH_SURFEX_n diff --git a/src/MNH/sum_on_all_procs_mnh_hal.f90 b/src/MNH/sum_on_all_procs_mnh_hal.f90 new file mode 100644 index 0000000000000000000000000000000000000000..982081140a0954fc85c36382fb3f17779375e27b --- /dev/null +++ b/src/MNH/sum_on_all_procs_mnh_hal.f90 @@ -0,0 +1,84 @@ +!MNH_LIC Copyright 1994-2014 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. +! ######### + SUBROUTINE SUM_ON_ALL_PROCS_MNH_HAL(KSIZE,KIN,KOUT) +! ####################################################### +! +! +!!**** *SUM_ON_ALL_PROCS* - sums the values of the integers provided on each processor +!! +!! PURPOSE +!! ------- +!! +!!** METHOD +!! ------ +!! +!! EXTERNAL +!! -------- +!! +!! +!! IMPLICIT ARGUMENTS +!! ------------------ +!! +!! REFERENCE +!! --------- +!! +!! +!! AUTHOR +!! ------ +!! V. Masson *Meteo France* +!! +!! MODIFICATIONS +!! ------------- +!! Original 07/2011 +!------------------------------------------------------------------------------- +! +!* 0. DECLARATIONS +! ------------ +! +! +USE MODD_IO_SURF_MNH, ONLY : NHALO +USE MODE_ll +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! ------------------------- +! +INTEGER, INTENT(IN) :: KSIZE ! sim of integer array +INTEGER, DIMENSION(KSIZE), INTENT(IN) :: KIN ! array of integer to sum +INTEGER, INTENT(OUT):: KOUT ! sum on all processors +! ! (excluding halos) +! +!* 0.2 Declarations of local variables +! ------------------------------- +! +REAL :: ZIN +INTEGER :: IIB, IIE, IJB, IJE +INTEGER :: NIMAX, NJMAX +INTEGER :: JI, JJ +INTEGER :: IINDEX +! +INTEGER :: IRESP ! return code +!------------------------------------------------------------------------------- +! +CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) +NIMAX=IIE-IIB+1 +NJMAX=IJE-IJB+1 +! +ZIN = 0. +DO JJ=1,NJMAX+2*NHALO + DO JI=1,NIMAX+2*NHALO + IINDEX = JI + (JJ-1) * (NIMAX+2*NHALO) + ZIN = ZIN + FLOAT(KIN(IINDEX)) + END DO +END DO +! +CALL REDUCESUM_ll(ZIN,IRESP) +KOUT = NINT(ZIN) +! +!------------------------------------------------------------------------------- +! +END SUBROUTINE SUM_ON_ALL_PROCS_MNH_HAL