From 5df702dafe9f2529d561681bb0a469a2195a7f80 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 24 May 2018 10:50:28 +0200
Subject: [PATCH] Philippe 24/05/2018: IO: bug corrections: pad correctly
character strings
---
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 34 +++++++++++++++------------
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 2 ++
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 2 +-
3 files changed, 22 insertions(+), 16 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index ebd3572b1..cd989f536 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -505,23 +505,25 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!* 0.2 Declarations of local variables
!
INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
-INTEGER :: ILENG, JLOOP
+INTEGER :: ILENG, ILENGMAX, JLOOP
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = LEN(HFIELD)
+ILENGMAX = ILENG
!
!Special treatment for MY_NAME and DAD_NAME fields (for backward compatibility)
IF (TPFIELD%CMNHNAME=='MY_NAME' .OR. TPFIELD%CMNHNAME=='DAD_NAME') THEN
- ILENG = NFILENAMELGTMAXLFI
+ ILENG = MIN(LEN(HFIELD),NFILENAMELGTMAXLFI)
+ ILENGMAX = NFILENAMELGTMAXLFI
IF (LEN(HFIELD)<NFILENAMELGTMAXLFI) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)// &
': LEN(HFIELD)<NFILENAMELGTMAXLFI')
END IF
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENGMAX,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
DO JLOOP=1,ILENG
@@ -1294,7 +1296,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG, JLOOP
+INTEGER :: ILENG, ILENGMAX, JLOOP
INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
@@ -1302,26 +1304,28 @@ CHARACTER(LEN=LEN_HREC) :: YRECFM
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_C0','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG=LEN(HFIELD)
-IF (ILENG==0) ILENG=1
+ILENGMAX = ILENG
+IF (ILENG==0) ILENGMAX=1
!
!Special treatment for MY_NAME and DAD_NAME fields (for backward compatibility)
IF (TPFIELD%CMNHNAME=='MY_NAME' .OR. TPFIELD%CMNHNAME=='DAD_NAME') THEN
- ILENG = NFILENAMELGTMAXLFI
- IF (LEN_TRIM(HFIELD)>ILENG) &
+ ILENG = MIN(LEN(HFIELD),NFILENAMELGTMAXLFI)
+ ILENGMAX = NFILENAMELGTMAXLFI
+ IF (LEN_TRIM(HFIELD)>ILENGMAX) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_C0',TRIM(TPFILE%CNAME)// &
': MY_NAME was truncated from '//TRIM(HFIELD)//' to '//HFIELD(1:NFILENAMELGTMAXLFI))
END IF
!
-CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
+CALL WRITE_PREPARE(TPFIELD,ILENGMAX,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IF (ILENG==0) THEN
- IWORK(LEN(TPFIELD%CCOMMENT)+3)=IACHAR(' ')
- ELSE
- DO JLOOP=1,ILENG
- IWORK(LEN(TPFIELD%CCOMMENT)+2+JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
- END DO
- END IF
+ DO JLOOP=1,ILENG
+ IWORK(LEN(TPFIELD%CCOMMENT)+2+JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
+ END DO
+ !Pad with blank characters
+ DO JLOOP=ILENG+1,ILENGMAX
+ IWORK(LEN(TPFIELD%CCOMMENT)+2+JLOOP)=IACHAR(' ')
+ END DO
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_C0','field name was truncated to '&
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 56299ed08..06ee66013 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -336,6 +336,7 @@ CONTAINS
ALLOCATE(CHARACTER(LEN=ILEN2) :: YDAD_NAME)
IF(ILEN>0) THEN
YDAD_NAME(1:ILEN) = TPFILE%TDADFILE%CNAME(1:ILEN)
+ YDAD_NAME(ILEN+1:ILEN2) = ' '
ELSE
YDAD_NAME(:) = ' '
END IF
@@ -345,6 +346,7 @@ CONTAINS
ALLOCATE(CHARACTER(LEN=ILEN2) :: YDAD_NAME)
IF(ILEN>0) THEN
YDAD_NAME(1:ILEN) = HDAD_NAME(1:ILEN)
+ YDAD_NAME(ILEN+1:ILEN2) = ' '
ELSE
YDAD_NAME(:) = ' '
END IF
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 5af85e8d1..da109e179 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -2171,7 +2171,7 @@ ELSE
END IF
ALLOCATE(CHARACTER(LEN=ILEN)::YFIELD)
-YFIELD(:)=TRIM(HFIELD) !Warning: keep (:) to prevent F2003 automatic reallocation
+YFIELD(1:LEN_TRIM(HFIELD))=TRIM(HFIELD)
YFIELD(LEN_TRIM(HFIELD)+1:)=' '
! Write metadata
CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
--
GitLab