diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90 index 8beac98104b622f24c6824f21f2871c86988223e..d38186aa84daecda17fbc92f34d358d610e5d2d0 100644 --- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 +++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90 @@ -577,7 +577,7 @@ IF (PRESENT(KVERTLEVEL)) THEN !PW: TODO: try to not do a find (for better perf) CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//'.Z'//YNUMBER,TZFILE,IRESP) IF (IRESP/=0) THEN - PRINT *,'FATAL: IO_FILE_OPEN_ll: file ',TRIM(TRIM(TPFILE%CNAME)//'.Z'//YNUMBER),' not found in list' + PRINT *,'FATAL: IO_WRITE_FIELD_NC4_X2: file ',TRIM(TRIM(TPFILE%CNAME)//'.Z'//YNUMBER),' not found in list' STOP END IF ELSE @@ -594,6 +594,11 @@ YVARNAME = str_replace(YVARNAME, '.', '--') ! The variable should not already exist but who knows ? STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID) IF (STATUS /= NF90_NOERR) THEN + IF (SIZE(PFIELD)==0) THEN + PRINT *,'WARNING: IO_WRITE_FIELD_NC4_X2: ignoring variable with a zero size (',TRIM(YVARNAME),')' + RETURN + END IF + ! Get the netcdf dimensions CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), TPFIELD%CDIR, IVDIMS) @@ -694,6 +699,11 @@ YVARNAME = str_replace(YVARNAME, '.', '--') ! The variable should not already exist but who knows ? STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID) IF (STATUS /= NF90_NOERR) THEN + IF (SIZE(PFIELD)==0) THEN + PRINT *,'WARNING: IO_WRITE_FIELD_NC4_X3: ignoring variable with a zero size (',TRIM(YVARNAME),')' + RETURN + END IF + ! Get the netcdf dimensions CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), TPFIELD%CDIR, IVDIMS) @@ -1151,6 +1161,7 @@ CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME INTEGER(KIND=IDCDF_KIND) :: IVARID INTEGER(KIND=IDCDF_KIND), DIMENSION(1) :: IVDIMS INTEGER :: IRESP, ILEN +CHARACTER(LEN=:),ALLOCATABLE :: YFIELD ! IRESP = 0 @@ -1178,12 +1189,16 @@ IF (STATUS /= NF90_NOERR) THEN IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_C0[NF90_DEF_VAR]') CALL IO_WRITE_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID) ELSE - PRINT *,'IO_WRITE_FIELD_NC4_N0: ', TRIM(YVARNAME), ' already defined !' + PRINT *,'IO_WRITE_FIELD_NC4_C0: ', TRIM(YVARNAME), ' already defined !' END IF +ALLOCATE(CHARACTER(LEN=ILEN)::YFIELD) +YFIELD(:)=TRIM(HFIELD) !Warning: keep (:) to prevent F2003 automatic reallocation +YFIELD(LEN_TRIM(HFIELD)+1:)=' ' ! Write the data -STATUS = NF90_PUT_VAR(INCID, IVARID, HFIELD) +STATUS = NF90_PUT_VAR(INCID, IVARID, YFIELD) IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_C0[NF90_PUT_VAR] '//TRIM(TPFIELD%CMNHNAME),IRESP) +DEALLOCATE(YFIELD) KRESP = IRESP END SUBROUTINE IO_WRITE_FIELD_NC4_C0 @@ -1936,8 +1951,7 @@ INTEGER(KIND=IDCDF_KIND) :: IVARID INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions INTEGER(KIND=IDCDF_KIND),DIMENSION(1) :: IVDIMS -CHARACTER(LEN=32) :: YSTR -!CHARACTER(LEN=LEN(HFIELD)) :: YSTR +CHARACTER(LEN=:),ALLOCATABLE :: YSTR INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length INTEGER(KIND=IDCDF_KIND) :: IDIMLEN INTEGER :: II @@ -1962,22 +1976,19 @@ IF (IDIMS == 1 .AND. ITYPE == NF90_CHAR) THEN ! Check size of variable before reading STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(1), LEN=IDIMLEN) IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME)) - - IF (IDIMLEN <= LEN(YSTR)) THEN - ! Read variable - STATUS = NF90_GET_VAR(KNCID, IVARID, YSTR) - IF (STATUS /= NF90_NOERR) THEN - CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP) - GOTO 1000 - END IF - IF (LEN_TRIM(YSTR) > LEN(HFIELD)) PRINT *, 'NCDREADC0 : '//TRIM(YVARNAME)//' truncated !!' - HFIELD = TRIM(YSTR) - ! Read variables attributes (GRID and COMMENT) - CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH) - ELSE - PRINT *, 'NCREADC0 : '//TRIM(YVARNAME)//' not READ (wrong size).' - IRESP = -3 + ! + ALLOCATE(CHARACTER(LEN=IDIMLEN)::YSTR) + ! Read variable + STATUS = NF90_GET_VAR(KNCID, IVARID, YSTR) + IF (STATUS /= NF90_NOERR) THEN + CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP) + GOTO 1000 END IF + IF (LEN_TRIM(YSTR) > LEN(HFIELD)) PRINT *, 'NCDREADC0 : '//TRIM(YVARNAME)//' truncated !!' + HFIELD = TRIM(YSTR) + DEALLOCATE(YSTR) + ! Read variables attributes (GRID and COMMENT) + CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH) ELSE PRINT *, 'NCREADC0 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).' IRESP = -3