diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index b5ab334898edb2435108ee39274f9f58f0bd6ee0..2ae06f47d2024e6d5473f08773e1180b9f7174ef 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -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')
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index 5cd2e0c0424c36fbbf79596c30da231dc8e480e8..bf58e8166d649f37ca6da7e60bedd6b5a4475b8f 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -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 )
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index ecdc90dfdd56443a08ec98aa04da991a008fb00d..99c9bba86f4384684649515c1ff14701bc6e720a 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -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 )
diff --git a/src/MNH/write_statprofn.f90 b/src/MNH/write_statprofn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bf6ada28aef95922c210ab8967ebcea936c9a6a0
--- /dev/null
+++ b/src/MNH/write_statprofn.f90
@@ -0,0 +1,169 @@
+!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