diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90 index ebd3572b1f5c07d69965b3ec57bf62f142768a2b..cd989f536c9937a9cedc3bfb5d9d823e53978cf0 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 56299ed082821fde079659190f5ca3632c0fdf17..06ee660134f17a2d09b2726c20bb193ffa576bd1 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 5af85e8d1869d24ade9f9abdcc70ad5d6e881702..da109e179b3f7b592d017254436696fac2d5d23a 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)