Skip to content
Snippets Groups Projects
Commit 40df5cc0 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

lfi2cdf: improved detection of the variable type for z-split files

parent 161b958f
No related branches found
No related tags found
No related merge requests found
......@@ -248,9 +248,10 @@ sysfield(218) = field('BIBUSER', TEXT, D0)
sysfield(219) = field('LFI_COMPRESSED', INT, D0)
END SUBROUTINE init_sysfield
FUNCTION get_ftype(hfname)
FUNCTION get_ftype(hfname,level)
CHARACTER(LEN=*) :: hfname
INTEGER :: get_ftype
INTEGER,INTENT(IN) :: level
TYPE(field) :: tzf
......@@ -266,7 +267,7 @@ END SUBROUTINE init_sysfield
& INDEX(hfname,".TR",.TRUE.)/= 0 .OR.&
& INDEX(hfname,".DA",.TRUE.)/= 0) THEN
get_ftype = FLOAT
ELSE IF (searchfield(hfname,tzf)) THEN
ELSE IF (searchfield(hfname,tzf,level)) THEN
! search in databases
get_ftype = tzf%TYPE
ELSE
......@@ -275,13 +276,15 @@ END SUBROUTINE init_sysfield
END FUNCTION get_ftype
FUNCTION searchfield(hfname, tpf)
FUNCTION searchfield(hfname, tpf, level)
CHARACTER(LEN=*), INTENT(IN) :: hfname
TYPE(field), INTENT(OUT) :: tpf
INTEGER,INTENT(IN) :: level
LOGICAL :: searchfield
INTEGER :: ji,iposx
LOGICAL :: found
CHARACTER(LEN=4) :: clevel
found = .FALSE.
......@@ -294,6 +297,8 @@ END SUBROUTINE init_sysfield
END IF
END DO
write(clevel,'(I4.4)') level
IF (.NOT. found) THEN
! Next, search in user field tab
IF (ALLOCATED(userfield)) THEN
......@@ -323,6 +328,17 @@ END SUBROUTINE init_sysfield
tpf = sysfield(ji)
EXIT
END IF
ELSE IF (level>-1) THEN
!Maybe it is a z-level splitted field
!Warning: false positives are possible (but should be rare)
iposx = INDEX(hfname,clevel)
IF (iposx /= 0) THEN
IF (hfname(:iposx-1)==sysfield(ji)%name) THEN
found = .TRUE.
tpf = sysfield(ji)
EXIT
END IF
END IF
END IF
END IF
END DO
......
......@@ -82,18 +82,18 @@ CONTAINS
END IF
END SUBROUTINE FMREADLFIN1
SUBROUTINE parse_lfi(klu, hvarlist, nbvar_lfi, nbvar_tbr, nbvar_calc, nbvar_tbw, tpreclist, kbuflen, current_level)
SUBROUTINE parse_lfi(klu, hvarlist, nbvar_lfi, nbvar_tbr, nbvar_calc, nbvar_tbw, tpreclist, kbuflen, icurrent_level)
INTEGER, INTENT(IN) :: klu
INTEGER, INTENT(IN) :: nbvar_lfi, nbvar_tbr, nbvar_calc, nbvar_tbw
CHARACTER(LEN=*), intent(IN) :: hvarlist
TYPE(workfield), DIMENSION(:), POINTER :: tpreclist
INTEGER, INTENT(OUT) :: kbuflen
INTEGER, INTENT(IN), OPTIONAL :: current_level
INTEGER, INTENT(IN), OPTIONAL :: icurrent_level
INTEGER :: ji,jj
INTEGER :: ndb, nde, ndey, idx, idx_var, maxvar
LOGICAL :: ladvan
INTEGER :: ich
INTEGER :: ich, current_level
INTEGER :: fsize,sizemax
CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm
CHARACTER(LEN=4) :: suffix
......@@ -130,10 +130,12 @@ CONTAINS
sizemax = 0
IF (present(current_level)) THEN
write(suffix,'(I4.4)') current_level
IF (present(icurrent_level)) THEN
write(suffix,'(I4.4)') icurrent_level
current_level = icurrent_level
ElSE
suffix=''
current_level = -1
END IF
! Phase 1 : build articles list to convert.
......@@ -283,7 +285,7 @@ END DO
CALL LFINFO(iresp,ilu,yrecfm,ileng,ipos)
#ifdef LOWMEM
CALL LFILEC(iresp,ilu,yrecfm,iwork,ileng)
tpreclist(ji)%TYPE = get_ftype(yrecfm)
tpreclist(ji)%TYPE = get_ftype(yrecfm,current_level)
tpreclist(ji)%grid = iwork(1)
ALLOCATE(character(len=iwork(2)) :: tpreclist(ji)%comment)
......@@ -294,7 +296,7 @@ END DO
fsize = ileng-(2+iwork(2))
#else
CALL LFILEC(iresp,ilu,yrecfm,lfiart(ji)%iwtab,ileng)
tpreclist(ji)%TYPE = get_ftype(yrecfm)
tpreclist(ji)%TYPE = get_ftype(yrecfm,current_level)
tpreclist(ji)%grid = lfiart(ji)%iwtab(1)
ALLOCATE(character(len=lfiart(ji)%iwtab(2)) :: tpreclist(ji)%comment)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment