From f14bdeac7646f5a379eaf9aef495f81bcc9a736c Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 16 Mar 2017 16:53:16 +0100
Subject: [PATCH] Philippe 16/03/2017: IO: treated case when record name is too
big for LFI
---
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 67 ++++++++++++++++++++++++----
1 file changed, 58 insertions(+), 9 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index e167b5bae..62de92314 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -300,6 +300,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
INTEGER :: ILENG
INTEGER(KIND=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -309,6 +310,10 @@ CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X0','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,KFLU,TRIM(TPFIELD%CMNHNAME),IWORK,ITOTAL)
ENDIF
!
@@ -334,6 +339,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
INTEGER :: ILENG
INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X1','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -343,7 +349,11 @@ CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG)
- CALL LFIECR(IRESP,KFLU,TRIM(TPFIELD%CMNHNAME),IWORK,ITOTAL)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X1','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
@@ -371,6 +381,7 @@ INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=4) :: YSUFFIX
CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
+CHARACTER(LEN=16) :: YRECFM
!
ILENG = SIZE(PFIELD)
IF (PRESENT(KVERTLEVEL)) THEN
@@ -386,7 +397,11 @@ CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG)
- CALL LFIECR(IRESP,KFLU,YVARNAME,IWORK,ITOTAL)
+ YRECFM=TRIM(YVARNAME)
+ IF( LEN_TRIM(YVARNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X2','field name was truncated to '&
+ //YRECFM//' for '//TRIM(YVARNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
@@ -411,6 +426,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
INTEGER :: ILENG
INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X3','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -420,7 +436,11 @@ CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
CALL TRANSFW(IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3),PFIELD,ILENG)
- CALL LFIECR(IRESP,KFLU,TPFIELD%CMNHNAME,IWORK,ITOTAL)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X3','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
@@ -445,6 +465,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
INTEGER :: ILENG
INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -454,7 +475,11 @@ CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3)=KFIELD
- CALL LFIECR(IRESP,KFLU,TPFIELD%CMNHNAME,IWORK,ITOTAL)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N0','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
@@ -479,6 +504,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
INTEGER :: ILENG
INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N1','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -488,7 +514,11 @@ CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = KFIELD(:)
- CALL LFIECR(IRESP,KFLU,TPFIELD%CMNHNAME,IWORK,ITOTAL)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N1','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
@@ -513,6 +543,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
INTEGER :: ILENG
INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N2','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -522,7 +553,11 @@ CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+3:) = RESHAPE( KFIELD(:,:) , (/ SIZE(KFIELD) /) )
- CALL LFIECR(IRESP,KFLU,TPFIELD%CMNHNAME,IWORK,ITOTAL)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N2','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
@@ -547,6 +582,7 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
INTEGER :: ILENG, JLOOP
INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_C0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -563,7 +599,11 @@ IF (IRESP==0) THEN
IWORK(LEN_TRIM(TPFIELD%CCOMMENT)+2+JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
END DO
END IF
- CALL LFIECR(IRESP,KFLU,TPFIELD%CMNHNAME,IWORK,ITOTAL)
+ 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 '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
@@ -592,6 +632,7 @@ INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
TYPE(TFIELDDATA) :: TZFIELD
INTEGER, DIMENSION(3) :: ITDATE ! date array
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=16) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_T0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -610,7 +651,11 @@ CALL WRITE_PREPARE(TZFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
IWORK(LEN_TRIM(TZFIELD%CCOMMENT)+3:)=ITDATE(:)
- CALL LFIECR(IRESP,KFLU,TRIM(TZFIELD%CMNHNAME),IWORK,ITOTAL)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_T0','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
@@ -630,7 +675,11 @@ CALL WRITE_PREPARE(TZFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
CALL TRANSFW(IWORK(LEN_TRIM(TZFIELD%CCOMMENT)+3),TPDATA%TIME,ILENG)
- CALL LFIECR(IRESP,KFLU,TRIM(TZFIELD%CMNHNAME),IWORK,ITOTAL)
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_T0','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,KFLU,YRECFM,IWORK,ITOTAL)
ENDIF
!
KRESP=IRESP
--
GitLab