From d38e0cddd1da27efb236005ed927ecac8d94df44 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 18 May 2021 11:22:59 +0200
Subject: [PATCH] Philippe 18/05/2021: add AIRCRAFT_BALLOON_LONGTYPE_GET
subroutine
---
src/MNH/aircraft_balloon.f90 | 42 ++++++++++++++++++++++++++++--
src/MNH/write_aircraft_balloon.f90 | 15 +++--------
2 files changed, 43 insertions(+), 14 deletions(-)
diff --git a/src/MNH/aircraft_balloon.f90 b/src/MNH/aircraft_balloon.f90
index 5e48b0481..93782678d 100644
--- a/src/MNH/aircraft_balloon.f90
+++ b/src/MNH/aircraft_balloon.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2021 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -41,6 +41,13 @@ REAL, DIMENSION(:,:),INTENT(IN) :: PSEA
!
END SUBROUTINE AIRCRAFT_BALLOON
!
+SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET( TPFLYER, HLONGTYPE )
+ USE MODD_AIRCRAFT_BALLOON, ONLY: FLYER
+
+ TYPE(FLYER), INTENT(IN) :: TPFLYER
+ CHARACTER(LEN=*), INTENT(OUT) :: HLONGTYPE
+END SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET
+
END INTERFACE
!
END MODULE MODI_AIRCRAFT_BALLOON
@@ -337,3 +344,34 @@ ENDIF
!----------------------------------------------------------------------------
!
END SUBROUTINE AIRCRAFT_BALLOON
+
+
+SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET( TPFLYER, HLONGTYPE )
+USE MODD_AIRCRAFT_BALLOON, ONLY: FLYER
+
+USE MODE_MSG
+
+TYPE(FLYER), INTENT(IN) :: TPFLYER
+CHARACTER(LEN=*), INTENT(OUT) :: HLONGTYPE
+
+character(len=:), allocatable :: ytype
+
+if ( Trim( TPFLYER%TYPE ) == 'AIRCRA' ) then
+ ytype = 'aircraft'
+else if ( Trim( TPFLYER%TYPE ) == 'RADIOS' ) then
+ ytype = 'radiosonde balloon'
+else if ( Trim( TPFLYER%TYPE ) == 'ISODEN' ) then
+ ytype = 'iso-density balloon'
+else if ( Trim( TPFLYER%TYPE ) == 'CVBALL' ) then
+ ytype = 'constant volume balloon'
+else
+ call Print_msg( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', 'unknown category for flyer ' // Trim( tpflyer%title ) )
+ ytype = 'unknown'
+end if
+
+if ( Len_trim( ytype ) > Len( HLONGTYPE ) ) &
+ call Print_msg( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', &
+ 'HLONGTYPE truncated for flyer ' // Trim( tpflyer%title ) )
+HLONGTYPE = Trim( ytype )
+
+END SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index c2d69198f..fc6126822 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -180,6 +180,8 @@ use modd_budget, only: tbudiachrometadata
use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_FLYER_PROC, NMNHDIM_FLYER_TIME, NMNHDIM_UNUSED, &
tfield_metadata_base, TYPEREAL
+use modi_aircraft_balloon, only: Aircraft_balloon_longtype_get
+
TYPE(FLYER), INTENT(IN) :: TPFLYER
!
!* 0.2 declaration of local variables for diachro
@@ -854,18 +856,7 @@ tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
tzbudiachro%cname = ygroup
tzbudiachro%ccomment = 'Values at position of flyer ' // Trim( tpflyer%title )
-if ( Trim( tpflyer%type ) == 'AIRCRA' ) then
- tzbudiachro%ccategory = 'aircraft'
-else if ( Trim( tpflyer%type ) == 'RADIOS' ) then
- tzbudiachro%ccategory = 'radiosonde balloon'
-else if ( Trim( tpflyer%type ) == 'ISODEN' ) then
- tzbudiachro%ccategory = 'iso-density balloon'
-else if ( Trim( tpflyer%type ) == 'CVBALL' ) then
- tzbudiachro%ccategory = 'constant volume balloon'
-else
- call Print_msg( NVERB_ERROR, 'IO', 'WRITE_AIRCRAFT_BALLOON', 'unknown category for flyer ' // Trim( tpflyer%title ) )
- tzbudiachro%ccategory = 'unknown'
-end if
+call Aircraft_balloon_longtype_get( tpflyer, tzbudiachro%ccategory )
tzbudiachro%cgroupname = ygroup
tzbudiachro%cshape = 'point'
! tzbudiachro%cmask = NOT SET (default values)
--
GitLab