From f0f9ed40adc05de812e53e759199f8ab7adbc1cb Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 27 May 2021 16:07:14 +0200
Subject: [PATCH] Philippe 27/05/2021: IO: improve IO_Mnhname_clean to
autocorrect names to be CF compliant
---
src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 | 88 ++++++++++++++++-----
1 file changed, 69 insertions(+), 19 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
index ec3968b86..5c8d70ea6 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
@@ -18,6 +18,7 @@
! P. Wautelet 08/12/2020: add nbutotwrite
! P. Wautelet 18/03/2021: workaround for an intel compiler bug
! P. Wautelet 04/05/2021: improve IO_Vdims_fill_nc4 if l2d and lpack
+! P. Wautelet 27/05/2021: improve IO_Mnhname_clean to autocorrect names to be CF compliant
!-----------------------------------------------------------------
#ifdef MNH_IOCDF4
module mode_io_tools_nc4
@@ -832,31 +833,80 @@ end if
end subroutine IO_Err_handle_nc4
-SUBROUTINE IO_Mnhname_clean(HINNAME,HOUTNAME)
- CHARACTER(LEN=*),INTENT(IN) :: HINNAME
- CHARACTER(LEN=*),INTENT(OUT) :: HOUTNAME
-
+subroutine IO_Mnhname_clean( hinname, houtname )
+ ! Try to autocorrect hinname to be CF compliant
! NetCDF var names can't contain '%' nor '.'
- ! CF convention allows only letters, digits and underscores
- HOUTNAME = str_replace(HINNAME, '%', '__')
- HOUTNAME = str_replace(HOUTNAME, '.', '___')
-END SUBROUTINE
+ ! CF convention allows only letters, digits and underscores for variable, dimension, attribute and group names
+ ! and they should begin with a letter
+ character(len=*), intent(in) :: hinname
+ character(len=*), intent(out) :: houtname
+ character(len=:), allocatable :: yresult
+ integer :: ipos
-FUNCTION str_replace(hstr, hold, hnew)
-CHARACTER(LEN=*) :: hstr, hold, hnew
-CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace
+ if ( Len_trim( hinname ) == 0 ) then
+ houtname = ''
+ return
+ end if
-INTEGER :: pos
+ ipos = Scan( Trim( hinname), 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' )
+ if ( ipos == 0 ) then
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Mnhname_clean', 'name (' // Trim( hinname) // &
+ ') must begin with a letter to conform to CF convention' )
+ end if
-pos = INDEX(hstr,hold)
-IF (pos /= 0) THEN
- str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):)
-ELSE
- str_replace = hstr
-END IF
+ ipos = Verify( Trim( hinname), 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_' )
+ if ( ipos > 0 ) then
+ yresult = Str_replace( hinname, '%', '__' )
+ yresult = Str_replace( yresult, '.', '___' )
+ yresult = Str_replace( yresult, '-', '_' )
+ yresult = Str_replace( yresult, '*', 'star' )
+ yresult = Str_replace( Trim( yresult ), ' ', '_' ) !Trim to prevent problem with spaces at the end of the string
+
+ cmnhmsg(1) = 'name (' // Trim( hinname) // ') contains characters not allowed in CF convention'
+ cmnhmsg(2) = 'Allowed: alphanumeric + underscore'
+
+ !Chek corrected name
+ ipos = Verify( Trim( yresult ), 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_' )
+
+ if ( ipos == 0 ) then
+ cmnhmsg(3) = 'Trying to correct => successful'
+ cmnhmsg(4) = Trim( hinname ) // '->' // Trim( yresult )
+ call Print_msg( NVERB_DEBUG, 'IO', 'IO_Mnhname_clean' )
+ else
+ cmnhmsg(3) = 'Trying to correct => FAILED'
+ cmnhmsg(4) = Trim( hinname ) // '->' // Trim( yresult )
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Mnhname_clean' )
+ end if
+ else
+ yresult = Trim( hinname )
+ end if
+
+ houtname = Trim( yresult )
+
+ if ( Len_trim( yresult ) > Len( houtname ) ) &
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Mnhname_clean', &
+ 'houtname has been truncated (' // Trim( houtname) // '->' // Trim( yresult ) // ')' )
+
+end subroutine
+
+
+recursive function Str_replace( hstr, hold, hnew ) result( hout )
+character(len=*), intent(in) :: hstr, hold, hnew
+
+character(len=:), allocatable :: hout
+
+integer :: ipos
+
+ipos = Index( hstr, hold )
+if ( ipos > 0 ) then
+ hout = hstr(1 : ipos - 1) // hnew // hstr( ipos + Len( hold ) : )
+ if ( ipos < Len_trim( hstr ) ) hout = Str_replace( hout, hold, hnew )
+else
+ hout = hstr
+end if
-END FUNCTION str_replace
+end function Str_replace
end module mode_io_tools_nc4
--
GitLab