diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90 index f42f0b08e0d09a83df269bec3ab4c791f57d78c6..b4f6ba125672d7cc8e79907bbbea588586d3ff37 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 4761991934180b3213c317e60d5c6d6d0a3f6cdc..1622565cc38060dcb6f986589eecc005e4ca902f 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 eb93466cf480caafe489156463fb6eeef365a339..004e340ec97ba0cd21baaa122bf44c9ca1c170b7 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 fdcbbf4e4ca1f8b699b71a3c33aa54c26e69558b..8d26d8f74c4965c3094456e84e144c1bf2d58daa 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 c230fd1f5bde744133e4077c14382101bf7c1d7f..1ba217830c2ee4bf33303b2bb26534217b6c3259 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 da3a813fc4094a0bb365d9a3e859f96872e293fd..81959562724abdf4659ddcec6d83e47ee096e7c5 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 b083a03d68516e936982ae973153c0c63e69351b..69346e7ba102feef4a6b8d3a4c87b8dc930d2ec1 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 0000000000000000000000000000000000000000..68a195fac3c0874493ec93b5f4ced23a6c58ab93 --- /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 b9378bd92f2dc92778cd6ab83e1bc8181067cc26..88fc2bf919d0a21bfe37602564658ee1bc019c72 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 150421cb6a5e824e9d822c7cbb22f1e9d435d141..ab6f980b465c9836eff15f0e14fbfe8586eb946b 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 6ae1a2e708d4c6c8b6529506a66a6939cbbd4066..19576446c4f78e1b599be87f9e26b5eb8134b125 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