Skip to content
Snippets Groups Projects
Commit 097036c8 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 12/07/2023: stations/profilers: deduplicate WRITE_STATION_n and... 

Philippe 12/07/2023: stations/profilers: deduplicate WRITE_STATION_n and WRITE_PROFILER_n => WRITE_STATPROF_n
parent bb4d0f98
Branches
Tags
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/modeln.f90
+ 3
− 4
View file @ 097036c8
......@@ -397,8 +397,7 @@ USE MODE_ONE_WAY_n
USE MODE_WRITE_AIRCRAFT_BALLOON
use mode_write_les_n, only: Write_les_n
use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n
USE MODE_WRITE_STATION_n, ONLY: WRITE_STATION_n
USE MODE_WRITE_STATPROF_n, ONLY: WRITE_STATPROF_n
!
USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
......@@ -2271,8 +2270,8 @@ IF (OEXIT) THEN
IF ( .NOT. LIO_NO_WRITE ) THEN
IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
CALL WRITE_STATION_n(TDIAFILE)
CALL WRITE_PROFILER_n(TDIAFILE)
CALL WRITE_STATPROF_n( TDIAFILE, TSTATIONS )
CALL WRITE_STATPROF_n( TDIAFILE, TPROFILERS )
call Write_les_n( tdiafile )
#ifdef MNH_IOLFI
CALL MENU_DIACHRO(TDIAFILE,'END')
......
src/MNH/write_profilern.f90
+ 1
− 116
View file @ 097036c8
......@@ -31,7 +31,7 @@ implicit none
private
public :: WRITE_PROFILER_n
public :: PROFILER_DIACHRO_n
CHARACTER(LEN=NCOMMENTLGTMAX), DIMENSION(:), ALLOCATABLE :: CCOMMENT ! comment string
CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTITLE ! title
......@@ -40,121 +40,6 @@ CHARACTER(LEN=NUNITLGTMAX), DIMENSION(:), ALLOCATABLE :: CUNIT ! physical
REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: XWORK6 ! contains temporal serie
contains
!
!#######################################
SUBROUTINE WRITE_PROFILER_n( TPDIAFILE )
!#######################################
!
!
!**** *WRITE_PROFILER* - write the profilers records in the diachronic file
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
USE MODD_MPIF
USE MODD_PRECISION, ONLY: MNHINT_MPI
USE MODD_PROFILER_n, only: NUMBPROFILER_LOC, TPROFILERS, TPROFILERS_TIME
USE MODD_TYPE_STATPROF, ONLY: TPROFILERDATA
!
USE MODE_MSG
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
INTEGER :: IERR
INTEGER :: JP, JS
INTEGER :: IDX
INTEGER :: INUMPROF ! Total number of profilers (for the current model)
INTEGER :: ISTORE
INTEGER, DIMENSION(:), ALLOCATABLE :: INPROFPRC ! Array to store the number of profilers per process (for the current model)
INTEGER, DIMENSION(:), ALLOCATABLE :: IPROFIDS ! Intermediate array for MPI communication
INTEGER, DIMENSION(:), ALLOCATABLE :: IPROFPRCRANK ! Array to store the ranks of the processes where the profilers are
INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the profiler number to send
INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
TYPE(TPROFILERDATA) :: TZPROFILER
!
!----------------------------------------------------------------------------
!
ALLOCATE( INPROFPRC(ISNPROC) )
ALLOCATE( IDS(NUMBPROFILER_LOC) )
!Gather number of profiler present on each process
CALL MPI_ALLGATHER( NUMBPROFILER_LOC, 1, MNHINT_MPI, INPROFPRC, 1, MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
!Store the identification number of local profilers (these numbers are globals)
DO JS = 1, NUMBPROFILER_LOC
IDS(JS) = TPROFILERS(JS)%NID
END DO
ALLOCATE( IDISP(ISNPROC) )
IDISP(1) = 0
DO JP = 2, ISNPROC
IDISP(JP) = IDISP(JP-1) + INPROFPRC(JP-1)
END DO
INUMPROF = SUM( INPROFPRC(:) )
ALLOCATE( IPROFIDS(INUMPROF) )
ALLOCATE( IPROFPRCRANK(INUMPROF) )
!Gather the list of all the profilers of all processes
CALL MPI_ALLGATHERV( IDS(:), NUMBPROFILER_LOC, MNHINT_MPI, IPROFIDS(:), INPROFPRC(:), &
IDISP(:), MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
!Store the rank of each process corresponding to a given profiler
IDX = 1
IPROFPRCRANK(:) = -1
DO JP = 1, ISNPROC
DO JS = 1, INPROFPRC(JP)
IPROFPRCRANK(IPROFIDS(IDX)) = JP
IDX = IDX + 1
END DO
END DO
ISTORE = SIZE( TPROFILERS_TIME%TPDATES )
CALL TZPROFILER%DATA_ARRAYS_ALLOCATE( ISTORE )
IDX = 1
PROFILER: DO JS = 1, INUMPROF
IF ( IPROFPRCRANK(JS) == TPDIAFILE%NMASTER_RANK ) THEN
!No communication necessary, the profiler data is already on the writer process
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
TZPROFILER = TPROFILERS(IDX)
IDX = IDX + 1
END IF
ELSE
!The profiler data is not on the writer process
IF ( ISP == IPROFPRCRANK(JS) ) THEN
! This process has the data and needs to send it to the writer process
CALL TPROFILERS(IDX)%SEND_DEALLOCATE( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .FALSE. )
IDX = IDX + 1
ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
! This process is the writer and will receive the profiler data from its owner
CALL TZPROFILER%RECV_ALLOCATE( KFROM = IPROFPRCRANK(JS), KSTORE_CUR = ISTORE, KSTORE_MAX = ISTORE )
END IF
END IF
CALL PROFILER_DIACHRO_n( TPDIAFILE, TZPROFILER )
END DO PROFILER
! Deallocate arrays (if still allocated)
IF ( TZPROFILER%NSTORE_MAX >= 0 ) CALL TZPROFILER%DATA_ARRAYS_DEALLOCATE( )
END SUBROUTINE WRITE_PROFILER_n
! ####################################################
SUBROUTINE PROFILER_DIACHRO_n( TPDIAFILE, TPPROFILER )
......
src/MNH/write_stationn.f90
+ 1
− 115
View file @ 097036c8
......@@ -24,7 +24,7 @@ implicit none
private
public :: WRITE_STATION_n
public :: STATION_DIACHRO_n
CHARACTER(LEN=NCOMMENTLGTMAX), DIMENSION(:), ALLOCATABLE :: CCOMMENT ! comment string
CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: CTITLE ! title
......@@ -33,120 +33,6 @@ CHARACTER(LEN=NUNITLGTMAX), DIMENSION(:), ALLOCATABLE :: CUNIT ! physical
REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: XWORK6 ! contains temporal serie
contains
!
! #####################################
SUBROUTINE WRITE_STATION_n( TPDIAFILE )
! #####################################
!
!
!**** *WRITE_STATION* - write the stations records in the diachronic file
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
USE MODD_MPIF
USE MODD_PRECISION, ONLY: MNHINT_MPI
USE MODD_STATION_n, ONLY: NUMBSTAT_LOC, TSTATIONS, TSTATIONS_TIME
USE MODD_TYPE_STATPROF, ONLY: TSTATIONDATA
!
USE MODE_MSG
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
INTEGER :: IERR
INTEGER :: JP, JS
INTEGER :: IDX
INTEGER :: INUMSTAT ! Total number of stations (for the current model)
INTEGER :: ISTORE
INTEGER, DIMENSION(:), ALLOCATABLE :: INSTATPRC ! Array to store the number of stations per process (for the current model)
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATIDS ! Intermediate array for MPI communication
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATPRCRANK ! Array to store the ranks of the processes where the stations are
INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the station number to send
INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
TYPE(TSTATIONDATA) :: TZSTATION
!
!----------------------------------------------------------------------------
ALLOCATE( INSTATPRC(ISNPROC) )
ALLOCATE( IDS(NUMBSTAT_LOC) )
!Gather number of station present on each process
CALL MPI_ALLGATHER( NUMBSTAT_LOC, 1, MNHINT_MPI, INSTATPRC, 1, MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
!Store the identification number of local stations (these numbers are globals)
DO JS = 1, NUMBSTAT_LOC
IDS(JS) = TSTATIONS(JS)%NID
END DO
ALLOCATE( IDISP(ISNPROC) )
IDISP(1) = 0
DO JP = 2, ISNPROC
IDISP(JP) = IDISP(JP-1) + INSTATPRC(JP-1)
END DO
INUMSTAT = SUM( INSTATPRC(:) )
ALLOCATE( ISTATIDS(INUMSTAT) )
ALLOCATE( ISTATPRCRANK(INUMSTAT) )
!Gather the list of all the stations of all processes
CALL MPI_ALLGATHERV( IDS(:), NUMBSTAT_LOC, MNHINT_MPI, ISTATIDS(:), INSTATPRC(:), &
IDISP(:), MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
!Store the rank of each process corresponding to a given station
IDX = 1
ISTATPRCRANK(:) = -1
DO JP = 1, ISNPROC
DO JS = 1, INSTATPRC(JP)
ISTATPRCRANK(ISTATIDS(IDX)) = JP
IDX = IDX + 1
END DO
END DO
ISTORE = SIZE( TSTATIONS_TIME%TPDATES )
CALL TZSTATION%DATA_ARRAYS_ALLOCATE( ISTORE )
IDX = 1
STATION: DO JS = 1, INUMSTAT
IF ( ISTATPRCRANK(JS) == TPDIAFILE%NMASTER_RANK ) THEN
!No communication necessary, the station data is already on the writer process
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
TZSTATION = TSTATIONS(IDX)
IDX = IDX + 1
END IF
ELSE
!The station data is not on the writer process
IF ( ISP == ISTATPRCRANK(JS) ) THEN
! This process has the data and needs to send it to the writer process
CALL TSTATIONS(IDX)%SEND_DEALLOCATE( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .FALSE. )
IDX = IDX + 1
ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
! This process is the writer and will receive the station data from its owner
! Remark: allocation is already done and will be skipped in RECV_ALLOCATE
CALL TZSTATION%RECV_ALLOCATE( KFROM = ISTATPRCRANK(JS), KSTORE_CUR = ISTORE, KSTORE_MAX = ISTORE )
END IF
END IF
CALL STATION_DIACHRO_n( TPDIAFILE, TZSTATION )
END DO STATION
! Deallocate arrays (if still allocated)
IF ( TZSTATION%NSTORE_MAX >= 0 ) CALL TZSTATION%DATA_ARRAYS_DEALLOCATE( )
END SUBROUTINE WRITE_STATION_n
! ##################################################
SUBROUTINE STATION_DIACHRO_n( TPDIAFILE, TPSTATION )
......
src/MNH/write_statprofn.f90 0 → 100644
+ 169
− 0
View file @ 097036c8
!MNH_LIC Copyright 2002-2023 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.
!-----------------------------------------------------------------
! Module to initiate the writing for stations and profilers
! It was initially created to deduplicate code from the WRITE_STATION_n and WRITE_PROFILER_n subroutines.
! Author:
! P. Wautelet 12/07/2023
!
! Modifications
! --------------------------------------------------------------------------
! #####################
MODULE MODE_WRITE_STATPROF_n
! #####################
IMPLICIT NONE
PRIVATE
PUBLIC :: WRITE_STATPROF_n
contains
!
! ##################################################
SUBROUTINE WRITE_STATPROF_n( TPDIAFILE, TPSTATPROF )
! ##################################################
!
!
!**** *WRITE_STATPROF_n* - write the stations or profilers records in the diachronic file
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
USE MODD_MPIF
USE MODD_PRECISION, ONLY: MNHINT_MPI
USE MODD_PROFILER_n, only: NUMBPROFILER_LOC, TPROFILERS, TPROFILERS_TIME
USE MODD_STATION_n, ONLY: NUMBSTAT_LOC, TSTATIONS, TSTATIONS_TIME
USE MODD_TYPE_STATPROF, ONLY: TSTATIONDATA, TSTATPROFDATA, TPROFILERDATA
!
USE MODE_MSG
USE MODE_WRITE_PROFILER_n, ONLY: PROFILER_DIACHRO_n
USE MODE_WRITE_STATION_n, ONLY: STATION_DIACHRO_n
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! Diachronic file to write
CLASS(TSTATPROFDATA), DIMENSION(:), INTENT(IN) :: TPSTATPROF ! Stations/profilers to write
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
INTEGER :: IERR
INTEGER :: JP, JS
INTEGER :: IDX
INTEGER :: INUMSTATPROF ! Total number of stations/profilers (for the current model)
INTEGER :: INUMSTATPROF_LOC ! Number of local stations/profilers (for the current model)
INTEGER :: ISTORE
INTEGER, DIMENSION(:), ALLOCATABLE :: INSTATPROFPRC ! Array to store the number of statprof per process (for the current model)
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATPROFIDS ! Intermediate array for MPI communication
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATPROFPRCRANK ! Array to store the ranks of the processes where the statprof are
INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the statprof number to send
INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
CLASS(TSTATPROFDATA), ALLOCATABLE :: TZSTATPROF
CLASS(TSTATPROFDATA), DIMENSION(:), POINTER :: TZSTATPROFLIST
!
!----------------------------------------------------------------------------
SELECT TYPE ( TPSTATPROF )
TYPE IS ( TPROFILERDATA )
INUMSTATPROF_LOC = NUMBPROFILER_LOC
ISTORE = SIZE( TPROFILERS_TIME%TPDATES )
ALLOCATE( TPROFILERDATA :: TZSTATPROF )
TZSTATPROFLIST => TPROFILERS
TYPE IS ( TSTATIONDATA )
INUMSTATPROF_LOC = NUMBSTAT_LOC
ISTORE = SIZE( TSTATIONS_TIME%TPDATES )
ALLOCATE( TSTATIONDATA :: TZSTATPROF )
TZSTATPROFLIST => TSTATIONS
CLASS DEFAULT
CALL PRINT_MSG( NVERB_ERROR, 'IO', 'WRITE_STATPROF_n', 'unknown type' )
END SELECT
ALLOCATE( INSTATPROFPRC(ISNPROC) )
ALLOCATE( IDS(INUMSTATPROF_LOC) )
!Gather number of stations/profilers present on each process
CALL MPI_ALLGATHER( INUMSTATPROF_LOC, 1, MNHINT_MPI, INSTATPROFPRC, 1, MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
!Store the identification number of local stations (these numbers are globals)
DO JS = 1, INUMSTATPROF_LOC
IDS(JS) = TPSTATPROF(JS)%NID
END DO
ALLOCATE( IDISP(ISNPROC) )
IDISP(1) = 0
DO JP = 2, ISNPROC
IDISP(JP) = IDISP(JP-1) + INSTATPROFPRC(JP-1)
END DO
INUMSTATPROF = SUM( INSTATPROFPRC(:) )
ALLOCATE( ISTATPROFIDS(INUMSTATPROF) )
ALLOCATE( ISTATPROFPRCRANK(INUMSTATPROF) )
!Gather the list of all the stations of all processes
CALL MPI_ALLGATHERV( IDS(:), INUMSTATPROF_LOC, MNHINT_MPI, ISTATPROFIDS(:), INSTATPROFPRC(:), &
IDISP(:), MNHINT_MPI, TPDIAFILE%NMPICOMM, IERR )
!Store the rank of each process corresponding to a given station/profiler
IDX = 1
ISTATPROFPRCRANK(:) = -1
DO JP = 1, ISNPROC
DO JS = 1, INSTATPROFPRC(JP)
ISTATPROFPRCRANK(ISTATPROFIDS(IDX)) = JP
IDX = IDX + 1
END DO
END DO
CALL TZSTATPROF%DATA_ARRAYS_ALLOCATE( ISTORE )
IDX = 1
STATPROF: DO JS = 1, INUMSTATPROF
IF ( ISTATPROFPRCRANK(JS) == TPDIAFILE%NMASTER_RANK ) THEN
!No communication necessary, the station data is already on the writer process
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
TZSTATPROF = TZSTATPROFLIST(IDX)
IDX = IDX + 1
END IF
ELSE
!The station data is not on the writer process
IF ( ISP == ISTATPROFPRCRANK(JS) ) THEN
! This process has the data and needs to send it to the writer process
CALL TZSTATPROFLIST(IDX)%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .FALSE. )
IDX = IDX + 1
ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
! This process is the writer and will receive the station data from its owner
! Remark: allocation is already done and will be skipped in RECV_ALLOCATE
CALL TZSTATPROF%RECV_ALLOCATE( KFROM = ISTATPROFPRCRANK(JS), KSTORE_CUR = ISTORE, KSTORE_MAX = ISTORE )
END IF
END IF
SELECT TYPE ( TZSTATPROF )
TYPE IS ( TPROFILERDATA )
CALL PROFILER_DIACHRO_n( TPDIAFILE, TZSTATPROF )
TYPE IS ( TSTATIONDATA )
CALL STATION_DIACHRO_n( TPDIAFILE, TZSTATPROF )
CLASS DEFAULT
CALL PRINT_MSG( NVERB_ERROR, 'IO', 'WRITE_STATPROF_n', 'unknown type' )
END SELECT
END DO STATPROF
! Deallocate arrays (if still allocated)
IF ( TZSTATPROF%NSTORE_MAX >= 0 ) CALL TZSTATPROF%DATA_ARRAYS_DEALLOCATE( )
END SUBROUTINE WRITE_STATPROF_n
END MODULE MODE_WRITE_STATPROF_N
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme