From bb9b30b3f8c0031f960fa041acdd8df56e99fc38 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 14 Feb 2019 17:06:37 +0100
Subject: [PATCH] Philippe 14/02/2019: move UPCASE function to tools.f90
---
src/LIB/SURCOUCHE/src/mode_io.f90 | 24 +++-----------
src/MNH/ini_deep_convection.f90 | 22 ++----------
src/MNH/ini_lb.f90 | 26 +++------------
src/MNH/read_all_data_grib_case.f90 | 2 +-
src/MNH/read_chem_data_netcdf_case.f90 | 2 +-
src/MNH/read_field.f90 | 2 +-
src/MNH/spawn_field2.f90 | 6 ++--
src/MNH/tools.f90 | 46 ++++++++++++++++++++++++++
src/MNH/write_lbn.f90 | 2 +-
src/MNH/write_lfifm1_for_diag.f90 | 7 ++--
src/MNH/write_lfin.f90 | 2 +-
11 files changed, 68 insertions(+), 73 deletions(-)
create mode 100644 src/MNH/tools.f90
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index f42f0b08e..b4f6ba125 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -28,6 +28,7 @@
! P. Wautelet 06/02/2019: simplify OPEN_ll and do somme assignments at a more logical place
! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
! (nsubfiles_ioz is now determined in IO_FILE_ADD2LIST)
+! P. Wautelet 14/02/2019: move UPCASE function to tools.f90
!
!-----------------------------------------------------------------
MODULE MODE_IO_ll
@@ -43,29 +44,11 @@ MODULE MODE_IO_ll
LOGICAL,SAVE :: GCONFIO = .FALSE. ! Turn TRUE when SET_CONFIO_ll is called.
- PUBLIC UPCASE,INITIO_ll,OPEN_ll,CLOSE_ll
+ PUBLIC INITIO_ll,OPEN_ll,CLOSE_ll
PUBLIC SET_CONFIO_ll,GCONFIO
CONTAINS
- FUNCTION UPCASE(HSTRING)
- CHARACTER(LEN=*) :: HSTRING
- CHARACTER(LEN=LEN(HSTRING)) :: UPCASE
-
- INTEGER :: JC
- INTEGER, PARAMETER :: IAMIN = IACHAR("a")
- INTEGER, PARAMETER :: IAMAJ = IACHAR("A")
-
- DO JC=1,LEN(HSTRING)
- IF (HSTRING(JC:JC) >= "a" .AND. HSTRING(JC:JC) <= "z") THEN
- UPCASE(JC:JC) = ACHAR(IACHAR(HSTRING(JC:JC)) - IAMIN + IAMAJ)
- ELSE
- UPCASE(JC:JC) = HSTRING(JC:JC)
- END IF
- END DO
-
- END FUNCTION UPCASE
-
SUBROUTINE SET_CONFIO_ll()
USE MODN_CONFIO
@@ -161,6 +144,7 @@ CONTAINS
use mode_io_file_lfi, only: io_create_file_lfi, io_open_file_lfi
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST, IO_FILE_FIND_BYNAME
use mode_io_tools, only: io_rank
+ use mode_tools, only: upcase
TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE
INTEGER, INTENT(OUT) :: IOSTAT
@@ -194,7 +178,7 @@ CONTAINS
IF (PRESENT(MODE)) THEN
YMODE = MODE
YMODE = UPCASE(TRIM(ADJUSTL(YMODE)))
- ELSE
+ ELSE
YMODE = 'GLOBAL' ! Default Mode
END IF
diff --git a/src/MNH/ini_deep_convection.f90 b/src/MNH/ini_deep_convection.f90
index 476199193..1622565cc 100644
--- a/src/MNH/ini_deep_convection.f90
+++ b/src/MNH/ini_deep_convection.f90
@@ -109,6 +109,7 @@ END MODULE MODI_INI_DEEP_CONVECTION
!! for a correct restart this variable has to be writen in FM file
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 14/02/2019: move UPCASE function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -134,6 +135,7 @@ USE MODD_SALT, ONLY : CSALTNAMES
USE MODE_FIELD
USE MODE_FM
USE MODE_FMREAD
+USE MODE_TOOLS, ONLY: UPCASE
!
IMPLICIT NONE
!
@@ -336,25 +338,5 @@ ELSE
!
!
END IF
-!
-CONTAINS
-FUNCTION UPCASE(HSTRING)
-
-CHARACTER(LEN=*) :: HSTRING
-CHARACTER(LEN=LEN(HSTRING)) :: UPCASE
-
-INTEGER :: JC
-INTEGER, PARAMETER :: IAMIN = IACHAR("a")
-INTEGER, PARAMETER :: IAMAJ = IACHAR("A")
-
-DO JC=1,LEN(HSTRING)
- IF (HSTRING(JC:JC) >= "a" .AND. HSTRING(JC:JC) <= "z") THEN
- UPCASE(JC:JC) = ACHAR(IACHAR(HSTRING(JC:JC)) - IAMIN + IAMAJ)
- ELSE
- UPCASE(JC:JC) = HSTRING(JC:JC)
- END IF
-END DO
-
-END FUNCTION UPCASE
!
END SUBROUTINE INI_DEEP_CONVECTION
diff --git a/src/MNH/ini_lb.f90 b/src/MNH/ini_lb.f90
index eb93466cf..004e340ec 100644
--- a/src/MNH/ini_lb.f90
+++ b/src/MNH/ini_lb.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2019 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.
@@ -132,6 +132,7 @@ SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
!! J.-P. Pinty 09/02/16 Add LIMA that is LBC for CCN and IFN
!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/02/2019: move UPCASE function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -158,6 +159,7 @@ USE MODD_SALT
USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
USE MODE_FMREAD
USE MODE_MSG
+USE MODE_TOOLS, ONLY: UPCASE
!
IMPLICIT NONE
!
@@ -1623,27 +1625,7 @@ IF (OLSOURCE) THEN
PLBYSVM(:,:,:,JSV) = (PLBYSVM(:,:,:,JSV) - PLBYSVMM(:,:,:,JSV)) / PLENG
ENDIF
END DO
-!
+!
ENDIF
-
-CONTAINS
-FUNCTION UPCASE(HSTRING)
-
-CHARACTER(LEN=*) :: HSTRING
-CHARACTER(LEN=LEN(HSTRING)) :: UPCASE
-
-INTEGER :: JC
-INTEGER, PARAMETER :: IAMIN = IACHAR("a")
-INTEGER, PARAMETER :: IAMAJ = IACHAR("A")
-
-DO JC=1,LEN(HSTRING)
- IF (HSTRING(JC:JC) >= "a" .AND. HSTRING(JC:JC) <= "z") THEN
- UPCASE(JC:JC) = ACHAR(IACHAR(HSTRING(JC:JC)) - IAMIN + IAMAJ)
- ELSE
- UPCASE(JC:JC) = HSTRING(JC:JC)
- END IF
-END DO
-
-END FUNCTION UPCASE
!
END SUBROUTINE INI_LB
diff --git a/src/MNH/read_all_data_grib_case.f90 b/src/MNH/read_all_data_grib_case.f90
index fdcbbf4e4..8d26d8f74 100644
--- a/src/MNH/read_all_data_grib_case.f90
+++ b/src/MNH/read_all_data_grib_case.f90
@@ -135,10 +135,10 @@ END MODULE MODI_READ_ALL_DATA_GRIB_CASE
!
USE MODE_DATETIME
USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
-USE MODE_IO_ll, ONLY: UPCASE
USE MODE_MSG
USE MODE_TIME
USE MODE_THERMO
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_READ_HGRID_n
USE MODI_READ_VER_GRID
diff --git a/src/MNH/read_chem_data_netcdf_case.f90 b/src/MNH/read_chem_data_netcdf_case.f90
index c230fd1f5..1ba217830 100644
--- a/src/MNH/read_chem_data_netcdf_case.f90
+++ b/src/MNH/read_chem_data_netcdf_case.f90
@@ -111,10 +111,10 @@ USE MODD_TIME
USE MODD_TIME_n
!
USE MODE_FM
-USE MODE_IO_ll
USE MODE_MPPDB
USE MODE_THERMO
USE MODE_TIME
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_CH_AER_INIT_SOA
USE MODI_CH_INIT_SCHEME_n
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index da3a813fc..819595627 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -279,8 +279,8 @@ USE MODD_TIME ! for type DATE_TIME
!
USE MODE_FIELD, ONLY: TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME,TYPEDATE,TYPEREAL
USE MODE_FMREAD
-USE MODE_IO_ll, ONLY: UPCASE
USE MODE_MSG
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_INI_LB
USE MODI_INI_LS
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index b083a03d6..69346e7ba 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2019 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.
!#######################
MODULE MODI_SPAWN_FIELD2
@@ -185,11 +185,11 @@ USE MODD_SPAWN
!
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_FMREAD
-USE MODE_IO_ll, ONLY: UPCASE
USE MODE_ll
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
USE MODE_THERMO
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_BIKHARDT
!
diff --git a/src/MNH/tools.f90 b/src/MNH/tools.f90
new file mode 100644
index 000000000..68a195fac
--- /dev/null
+++ b/src/MNH/tools.f90
@@ -0,0 +1,46 @@
+!MNH_LIC Copyright 2019-2019 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 mode_tools
+!################
+!
+! Purpose
+! -------
+!
+! The Purpose of this module is to provide useful tools for MesoNH
+!
+! Author
+! ------
+! P. Wautelet 14/02/2019
+!
+
+implicit none
+
+private
+
+public :: upcase
+
+contains
+
+function upcase(hstring)
+ character(len=*), intent(in) :: hstring
+ character(len=len(hstring)) :: upcase
+
+ integer :: jc
+ integer, parameter :: iamin = iachar("a")
+ integer, parameter :: iamaj = iachar("A")
+
+ do jc = 1,len(hstring)
+ if ( hstring(jc:jc) >= "a" .and. hstring(jc:jc) <= "z" ) then
+ upcase(jc:jc) = achar( iachar( hstring(jc:jc) ) - iamin + iamaj )
+ else
+ upcase(jc:jc) = hstring(jc:jc)
+ end if
+ end do
+end function upcase
+
+end module mode_tools
diff --git a/src/MNH/write_lbn.f90 b/src/MNH/write_lbn.f90
index b9378bd92..88fc2bf91 100644
--- a/src/MNH/write_lbn.f90
+++ b/src/MNH/write_lbn.f90
@@ -94,9 +94,9 @@ USE MODD_PARAM_n
!
USE MODE_FMWRIT
USE MODE_ll
-USE MODE_IO_ll, ONLY: UPCASE
USE MODE_MSG
USE MODE_MODELN_HANDLER
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index 150421cb6..ab6f980b4 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 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.
!-----------------------------------------------------------------
!################################
@@ -236,9 +236,10 @@ USE MODE_FIELD
USE MODE_FMWRIT
USE MODE_GATHER_ll
USE MODE_ll
-USE MODE_IO_ll
+! USE MODE_IO_ll
USE MODE_IO_MANAGE_STRUCT,ONLY: IO_FILE_ADD2LIST
USE MODE_THERMO
+USE MODE_TOOLS, ONLY: UPCASE
USE MODE_MODELN_HANDLER
USE MODI_LIDAR
USE MODI_CLUSTERING
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 6ae1a2e70..19576446c 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -242,12 +242,12 @@ USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
USE MODE_FMWRIT
USE MODE_ll
USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_IO_ll, ONLY: UPCASE
USE MODE_FIELD
USE MODE_GATHER_ll
USE MODE_GRIDPROJ
USE MODE_MSG
USE MODE_MODELN_HANDLER
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_WRITE_LB_n
USE MODI_WRITE_BALLOON_n
--
GitLab