ectrans_field_api_mod.F90 Source File

! (C) Copyright 2001- ECMWF.
! (C) Copyright 2001- Meteo-France.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.

MODULE ECTRANS_FIELD_API_MOD

USE PARKIND1, ONLY : JPIM, JPRB
USE FIELD_ACCESS_MODULE, ONLY: GET_HOST_DATA_RDWR, GET_DEVICE_DATA_RDWR, GET_HOST_DATA_RDONLY,GET_DEVICE_DATA_RDONLY
USE FIELD_BASIC_MODULE, ONLY: FIELD_BASIC
USE FIELD_MODULE, ONLY:FIELD_1RB, FIELD_2RB, FIELD_3RB, FIELD_4RB, FIELD_2RB_VIEW, FIELD_3RB_VIEW
IMPLICIT NONE

PRIVATE

PUBLIC :: FIELD_GRID, FIELD_SPEC,SPEC_VIEW, GRID_VIEW, MAKE_FIELD_GRID, MAKE_FIELD_SPEC, LS, LG, &
        & IVSET_PTR, LS_COUNT, LG_COUNT, GET_LAYOUT_S, GET_LAYOUT_G

TYPE FIELD_GRID
 ! A pointer to field API field with additional METADATA
  CLASS (FIELD_BASIC), POINTER :: PTR      ! POINTER TO FIELD_BASIC from field API
  CHARACTER(LEN=10)            :: NAME     ! Name
  INTEGER(KIND=JPIM)           :: DIM_V    ! Vertical dimension (0 if not applicable)
END TYPE

TYPE FIELD_SPEC
 ! A pointer to field API field with additional METADATA
  CLASS (FIELD_BASIC), POINTER :: PTR      ! POINTER TO FIELD_BASIC from field API
  CHARACTER(LEN=10)            :: NAME     ! Name
  INTEGER(KIND=JPIM), POINTER  :: IVSET(:) ! b-set for spectral fields
END TYPE

TYPE SPEC_VIEW
  ! Spectral field view
  REAL(KIND=JPRB),POINTER :: P(:)
  CHARACTER(LEN=12)     :: NAME
END TYPE

TYPE GRID_VIEW
! Grid point field view
  REAL(KIND=JPRB),POINTER :: P(:,:)
  INTEGER(KIND=JPIM)    :: IVSET
  CHARACTER(LEN=12)     :: NAME
END TYPE

TYPE IVSET_PTR
  INTEGER(KIND=JPIM), POINTER :: PTR(:)
END TYPE

INTERFACE MAKE_FIELD_GRID
  MODULE PROCEDURE :: MAKE_FIELD_GRID_1RB, MAKE_FIELD_GRID_2RB, MAKE_FIELD_GRID_3RB, MAKE_FIELD_GRID_4RB
END INTERFACE

INTERFACE MAKE_FIELD_SPEC
  MODULE PROCEDURE :: MAKE_FIELD_SPEC_1RB, MAKE_FIELD_SPEC_2RB, MAKE_FIELD_SPEC_3RB
END INTERFACE

CONTAINS

FUNCTION MAKE_FIELD_SPEC_1RB(YLF,NAME,IVSET)
  ! Creation of a FIELD_SPEC encapsulating a FIELD_1RB field
  TYPE (FIELD_SPEC) :: MAKE_FIELD_SPEC_1RB
  CLASS (FIELD_1RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME
  INTEGER(KIND=JPIM), INTENT(IN), TARGET, OPTIONAL :: IVSET(:)

  MAKE_FIELD_SPEC_1RB%PTR => YLF
  MAKE_FIELD_SPEC_1RB%NAME = NAME
  IF (PRESENT(IVSET)) THEN
    MAKE_FIELD_SPEC_1RB%IVSET => IVSET
  ELSE
    MAKE_FIELD_SPEC_1RB%IVSET => NULL()
  ENDIF
END FUNCTION MAKE_FIELD_SPEC_1RB

FUNCTION MAKE_FIELD_SPEC_2RB(YLF,NAME,IVSET)
  ! Creation of a FIELD_SPEC encapsulating a FIELD_2RB field
  TYPE (FIELD_SPEC) :: MAKE_FIELD_SPEC_2RB
  CLASS (FIELD_2RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME
  INTEGER(KIND=JPIM), INTENT(IN), TARGET, OPTIONAL :: IVSET(:)

  MAKE_FIELD_SPEC_2RB%PTR => YLF
  MAKE_FIELD_SPEC_2RB%NAME = NAME
  IF (PRESENT(IVSET)) THEN
    MAKE_FIELD_SPEC_2RB%IVSET => IVSET
  ELSE
    MAKE_FIELD_SPEC_2RB%IVSET => NULL()
  ENDIF
END FUNCTION MAKE_FIELD_SPEC_2RB

FUNCTION MAKE_FIELD_SPEC_3RB(YLF,NAME,IVSET)
  ! Creation of a FIELD_SPEC encapsulating a FIELD_3RB field
  TYPE (FIELD_SPEC) :: MAKE_FIELD_SPEC_3RB
  CLASS (FIELD_3RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME
  INTEGER(KIND=JPIM), INTENT(IN), TARGET, OPTIONAL :: IVSET(:)

  MAKE_FIELD_SPEC_3RB%PTR => YLF
  MAKE_FIELD_SPEC_3RB%NAME = NAME
  IF (PRESENT(IVSET)) THEN
    MAKE_FIELD_SPEC_3RB%IVSET => IVSET
  ELSE
    MAKE_FIELD_SPEC_3RB%IVSET => NULL()
  ENDIF
END FUNCTION MAKE_FIELD_SPEC_3RB


FUNCTION MAKE_FIELD_GRID_1RB(YLF,NAME)
  ! Creation of a FIELD_GRID encapsulating a FIELD_1RB field
  TYPE (FIELD_GRID) :: MAKE_FIELD_GRID_1RB
  CLASS (FIELD_1RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME

  MAKE_FIELD_GRID_1RB%PTR => YLF
  MAKE_FIELD_GRID_1RB%NAME = NAME
    MAKE_FIELD_GRID_1RB%DIM_V = 0
END FUNCTION MAKE_FIELD_GRID_1RB

FUNCTION MAKE_FIELD_GRID_2RB(YLF,NAME)
  ! Creation of a FIELD_GRID encapsulating a FIELD_2RB field
  TYPE (FIELD_GRID) :: MAKE_FIELD_GRID_2RB
  CLASS (FIELD_2RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*),  INTENT(IN) :: NAME

  MAKE_FIELD_GRID_2RB%PTR => YLF
  MAKE_FIELD_GRID_2RB%NAME = NAME
  MAKE_FIELD_GRID_2RB%DIM_V = 0
END FUNCTION MAKE_FIELD_GRID_2RB

FUNCTION MAKE_FIELD_GRID_3RB(YLF,NAME)
  ! Creation of a FIELD_GRID encapsulating a FIELD_3RB field
  TYPE (FIELD_GRID) :: MAKE_FIELD_GRID_3RB
  CLASS (FIELD_3RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME

  MAKE_FIELD_GRID_3RB%PTR => YLF
  MAKE_FIELD_GRID_3RB%NAME = NAME
  MAKE_FIELD_GRID_3RB%DIM_V = 1
END FUNCTION MAKE_FIELD_GRID_3RB

FUNCTION MAKE_FIELD_GRID_4RB(YLF,NAME)
  ! Creation of a FIELD_SPEC encapsulating a FIELD_4RB field
  TYPE (FIELD_GRID) :: MAKE_FIELD_GRID_4RB
  CLASS (FIELD_4RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME

  MAKE_FIELD_GRID_4RB%PTR => YLF
  MAKE_FIELD_GRID_4RB%NAME = NAME
  MAKE_FIELD_GRID_4RB%DIM_V = 1
END FUNCTION MAKE_FIELD_GRID_4RB

SUBROUTINE LG2RB(LG2RBV,YLF,NAME,IVSET,LDACC,LDRDONLY)
  ! Creation of a list of GRID_VIEW encapsulating the layer of an input FIELD_2RB field
  ! Given YLF dimensioned(NPROMA, NBLKS) as input,
  ! the output list size will contain one element, its view beeing dimensioned(NPROMA, NBLKS)
  CLASS (FIELD_2RB), POINTER, INTENT (IN) :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME
  INTEGER(KIND=JPIM), POINTER, INTENT(IN) :: IVSET(:)
  LOGICAL, INTENT(IN) :: LDACC
  LOGICAL, INTENT(IN) :: LDRDONLY
  TYPE (GRID_VIEW), INTENT(INOUT) :: LG2RBV (:)

  REAL(KIND=JPRB), POINTER :: ZZ2 (:,:)
  IF (LDACC) THEN
    IF (LDRDONLY) THEN
      ZZ2 => GET_DEVICE_DATA_RDONLY(YLF)
    ELSE
      ZZ2 => GET_DEVICE_DATA_RDWR(YLF)
    ENDIF
  ELSE
    IF (LDRDONLY) THEN
      ZZ2 => GET_HOST_DATA_RDONLY(YLF)
    ELSE
      ZZ2 => GET_HOST_DATA_RDWR(YLF)
    ENDIF
  ENDIF

  IF (SIZE(LG2RBV) /= 1 ) CALL ABOR1("Error - incorrect size for LG2RBV")

  LG2RBV (1)%P => ZZ2(:,:)
  LG2RBV(1)%NAME = TRIM(NAME)
  IF (ASSOCIATED(IVSET)) THEN
    LG2RBV (1)%IVSET = IVSET(1)
  ELSE
    LG2RBV (1)%IVSET = 1 ! default value when IVSET is not provided
  ENDIF
END SUBROUTINE LG2RB

SUBROUTINE LG3RB(LG3RBV,YLF,NAME, IVSET,LDACC,LDRDONLY)
  ! Creation of a list of GRID_VIEW encapsulating the layers of an input FIELD_3RB field
  ! Given YLF dimensioned(NPROMA, NLEVS, NBLKS) as input,
  ! the output list size will contain  (NLEVS) elements, their view beeing dimensioned(NPROMA, NBLKS)
  CLASS (FIELD_3RB), POINTER, INTENT (IN) :: YLF
  CHARACTER(LEN=*), INTENT(IN) ::NAME
  INTEGER(KIND=JPIM), POINTER, INTENT(IN) :: IVSET(:)
  LOGICAL, INTENT(IN) :: LDACC
  LOGICAL, INTENT(IN) :: LDRDONLY
  TYPE (GRID_VIEW), INTENT(INOUT) :: LG3RBV (:)

  REAL(KIND=JPRB), POINTER :: ZZ3 (:,:,:)
  INTEGER(KIND=JPIM) :: JLEV, JCOUNT

  IF (LDACC) THEN
    IF (LDRDONLY) THEN
      ZZ3 => GET_DEVICE_DATA_RDONLY(YLF)
    ELSE
      ZZ3 => GET_DEVICE_DATA_RDWR(YLF)
    ENDIF
  ELSE
    IF (LDRDONLY) THEN
      ZZ3 => GET_HOST_DATA_RDONLY(YLF)
    ELSE
      ZZ3 => GET_HOST_DATA_RDWR(YLF)
    ENDIF
  ENDIF


  IF (SIZE(LG3RBV) /= SIZE (ZZ3, 2) ) CALL ABOR1("Error - incorrect size for LG3RBV")

  IF (ASSOCIATED(IVSET)) THEN
    IF (SIZE(IVSET) /= SIZE(ZZ3, 2)) THEN
      CALL ABOR1("Error - LG3RB("//TRIM(NAME)// "): incorrect size for IVSET: SIZE(IVSET) = " // TRIM(TO_STR(SIZE(IVSET))) &
        // " but SIZE(ZZ3, 2) = " // TRIM(TO_STR(SIZE(ZZ3, 2))))
    END IF
  END IF

  JCOUNT = 1
  DO JLEV = LBOUND (ZZ3, 2), UBOUND (ZZ3, 2)
    LG3RBV (JCOUNT)%P => ZZ3 (:, JLEV, :)
    LG3RBV(JCOUNT)%NAME = TRIM(NAME)
    IF (ASSOCIATED(IVSET)) THEN
      LG3RBV (JCOUNT)%IVSET = IVSET(JLEV)
    ELSE
      LG3RBV (JCOUNT)%IVSET = 1 ! default value when IVSET is not provided
    ENDIF
    JCOUNT = JCOUNT + 1
  ENDDO
CONTAINS
  FUNCTION TO_STR(I) RESULT(STR_OUT)
    INTEGER, INTENT(IN) :: I
    CHARACTER(LEN=16) :: STR_OUT
    WRITE(STR_OUT, '(I0)') I
  END FUNCTION
END SUBROUTINE LG3RB

SUBROUTINE LG4RB(LG4RBV, YLF,NAME,IVSET,LDACC,LDRDONLY)
  ! Creation of a list of GRID_VIEW encapsulating the layers of an input FIELD_4RB field
  ! Given YLF dimensioned(NPROMA, NLEVS, NFIELDS, NBLKS) as input,
  ! the output list size will contain  (NLEVS*NFIELDS) elementa, their view beeing dimensioned(NPROMA, NBLKS)

  CLASS (FIELD_4RB), INTENT(IN), POINTER :: YLF
  CHARACTER(LEN=*), INTENT(IN) :: NAME
  INTEGER(KIND=JPIM), POINTER, INTENT(IN) :: IVSET(:)
  LOGICAL, INTENT(IN) :: LDACC
  LOGICAL, INTENT(IN) :: LDRDONLY
  TYPE (GRID_VIEW), INTENT(INOUT) :: LG4RBV (:)

  REAL(KIND=JPRB), POINTER :: ZZ4 (:,:,:,:)
  INTEGER(KIND=JPIM) :: JLEV, JFLD, JCOUNT

  IF (LDACC) THEN
    IF (LDRDONLY) THEN
      ZZ4 => GET_DEVICE_DATA_RDONLY(YLF)
    ELSE
      ZZ4 => GET_DEVICE_DATA_RDWR(YLF)
    ENDIF
  ELSE
    IF (LDRDONLY) THEN
      ZZ4 => GET_HOST_DATA_RDONLY(YLF)
    ELSE
      ZZ4 => GET_HOST_DATA_RDWR(YLF)
    ENDIF
  ENDIF

  IF (SIZE(LG4RBV) /= SIZE (ZZ4, 2) * SIZE (ZZ4, 3) ) CALL ABOR1("Error - incorrect size for LG4RBV")

  IF (ASSOCIATED(IVSET)) THEN
    IF (SIZE(IVSET) /= SIZE(ZZ4, 2)) THEN
      CALL ABOR1("Error - LG4RB("//TRIM(NAME)// "): incorrect size for IVSET: SIZE(IVSET) = " // TRIM(TO_STR(SIZE(IVSET))) &
        // " but SIZE(ZZ4, 2) = " // TRIM(TO_STR(SIZE(ZZ4, 2))))
    END IF
  END IF

  JCOUNT = 1

  DO JFLD = LBOUND (ZZ4, 3), UBOUND (ZZ4, 3)
    DO JLEV = LBOUND (ZZ4, 2), UBOUND (ZZ4, 2)
      LG4RBV (JCOUNT)%P => ZZ4(:, JLEV, JFLD, :)
      LG4RBV(JCOUNT)%NAME = TRIM(NAME)
      IF (ASSOCIATED(IVSET)) THEN
        LG4RBV (JCOUNT)%IVSET = IVSET(JLEV)
      ELSE
        LG4RBV (JCOUNT)%IVSET = 1 ! default value when IVSET is not provided
      END IF
      JCOUNT = JCOUNT + 1
    ENDDO
  ENDDO
CONTAINS
  FUNCTION TO_STR(I) RESULT(STR_OUT)
    INTEGER, INTENT(IN) :: I
    CHARACTER(LEN=16) :: STR_OUT
    WRITE(STR_OUT, '(I0)') I
  END FUNCTION
END SUBROUTINE LG4RB

FUNCTION LG(YLFL,LGV,IVSET,LDACC,LDRDONLY) RESULT(IOFF)
  ! Creation of a list of GRID_VIEW from a list YLFL of FIELD_GRID
  TYPE (FIELD_GRID), INTENT(IN) :: YLFL (:)           ! input list of FIELD_GRID
  LOGICAL, INTENT(IN), OPTIONAL  :: LDACC             ! retrieve data on device
  LOGICAL, INTENT(IN), OPTIONAL  :: LDRDONLY
  TYPE (GRID_VIEW), INTENT(INOUT), OPTIONAL :: LGV (:) ! output list of GRID_VIEW
  TYPE (IVSET_PTR), INTENT(IN), OPTIONAL :: IVSET(:)

  INTEGER(KIND=JPIM) :: IOFF
  INTEGER(KIND=JPIM) :: ILEN, JFLD
  INTEGER(KIND=JPIM) :: ILBOUNDS (5), IUBOUNDS (5)
  LOGICAL :: LGV_PROVIDED
  LOGICAL :: LLACC, LLRDONLY

  LGV_PROVIDED = .FALSE.
  LLACC = .FALSE.
  LLRDONLY = .FALSE.

  IF (PRESENT(LGV)) LGV_PROVIDED = .TRUE.
  IF (PRESENT(LDACC))  LLACC = LDACC
  IF (PRESENT(LDRDONLY)) LLRDONLY = LDRDONLY
  IF (PRESENT(LGV)) THEN
    IF(.NOT. PRESENT(IVSET)) CALL ABOR1("LG FAILURE: Both LGV and IVSET need to be present")
    IF (SIZE(YLFL) /= SIZE(IVSET)) CALL ABOR1("LG FAILURE: SIZE(YLFL) /= SIZE(IVSET)")
  ENDIF

  IOFF = 0
  ILEN = -1

  ! iterate over YLFL LIST
  DO JFLD = 1, SIZE (YLFL)
  ! compute number of GRID_VIEW that will be generated for each field of the list
  ! In addition if LGV_PROVIDED: call the correct routine to create the GRID_VIEW for each field of the list
    SELECT TYPE (YLF => YLFL (JFLD)%PTR)
      CLASS IS (FIELD_1RB)
        ILEN = 1
      CLASS IS (FIELD_2RB)
        CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
        ILEN = 1
        IF (LGV_PROVIDED) CALL LG2RB(LGV (IOFF+1:IOFF+ILEN),YLF,YLFL(JFLD)%NAME,IVSET(JFLD)%PTR,LLACC,LLRDONLY)
      CLASS IS (FIELD_3RB)
        CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
        ILEN = (IUBOUNDS (2) - ILBOUNDS (2) + 1)
        IF (LGV_PROVIDED) CALL LG3RB(LGV (IOFF+1:IOFF+ILEN),YLF,YLFL(JFLD)%NAME,IVSET(JFLD)%PTR, LLACC,LLRDONLY)
      CLASS IS (FIELD_4RB)
        CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
        ILEN = (IUBOUNDS (2) - ILBOUNDS (2) + 1) * (IUBOUNDS (3) - ILBOUNDS (3) + 1)
        IF (LGV_PROVIDED) CALL LG4RB(LGV (IOFF+1:IOFF+ILEN),YLF,YLFL(JFLD)%NAME,IVSET(JFLD)%PTR,LLACC,LLRDONLY)
      CLASS DEFAULT
        CALL ABOR1("LG FAILURE: CLASS UNKNOWN")
    END SELECT
    IOFF = IOFF + ILEN
  ENDDO

  IF (LGV_PROVIDED) THEN
    IF (SIZE(LGV) /= IOFF)  CALL ABOR1("LG FAILURE: LSV has incorrect size")
  ENDIF

END FUNCTION LG

FUNCTION LG_COUNT(YLFL)
  TYPE (FIELD_GRID), INTENT(IN) :: YLFL (:)
  INTEGER(KIND=JPIM) :: LG_COUNT
  LG_COUNT = LG(YLFL)
END FUNCTION LG_COUNT


SUBROUTINE LS1RB(LS1RBV, YLF, NAME, LDACC,LDRDONLY)
  ! Creation of a list of SPEC_VIEW encapsulating the layer of an input FIELD_1RB field
  ! Given YLF dimensioned(NSPEC) as input,
  ! the output list size will contain one element, its view beeing dimensioned(NSPEC)
  CLASS (FIELD_1RB), POINTER, INTENT (IN) :: YLF
  CHARACTER(LEN=*), INTENT (IN) :: NAME
  LOGICAL, INTENT (IN) :: LDACC
  LOGICAL, INTENT (IN) :: LDRDONLY
  TYPE (SPEC_VIEW), INTENT(INOUT) :: LS1RBV (:)

  REAL(KIND=JPRB), POINTER :: ZZ1 (:)

  IF (LDACC) THEN
    IF (LDRDONLY) THEN
      ZZ1 => GET_DEVICE_DATA_RDONLY(YLF)
    ELSE
      ZZ1 => GET_DEVICE_DATA_RDWR(YLF)
    ENDIF
  ELSE
    IF (LDRDONLY) THEN
      ZZ1 => GET_HOST_DATA_RDONLY(YLF)
    ELSE
      ZZ1 => GET_HOST_DATA_RDWR(YLF)
    ENDIF
  ENDIF

  IF (SIZE(LS1RBV) /= 1 ) CALL ABOR1("Error - incorrect size for LS1RBV")
  LS1RBV(1)%P => ZZ1(:)

END SUBROUTINE LS1RB

SUBROUTINE LS2RB(LS2RBV,YLF,NAME, LDACC,LDRDONLY)
  ! Creation of a list of SPEC_VIEW, each of them encapsulating a layer of an input FIELD_2RB field.
  ! Given YLF dimensioned(NLEVS, NSPEC) as input,
  ! the output list size will contain (NLEVS) elements dimensioned(NSPEC)
  CLASS (FIELD_2RB), POINTER, INTENT (IN) :: YLF
  CHARACTER(LEN=*), INTENT (IN) :: NAME
  LOGICAL, INTENT (IN) :: LDACC
  LOGICAL, INTENT (IN) :: LDRDONLY
  TYPE (SPEC_VIEW), INTENT(INOUT) :: LS2RBV (:)

  REAL(KIND=JPRB), POINTER :: ZZ1 (:)
  REAL(KIND=JPRB), POINTER :: ZZ2 (:,:)
  INTEGER(KIND=JPIM) :: JLEV, JCOUNT
  IF (LDACC) THEN
    IF (LDRDONLY) THEN
      ZZ2 => GET_DEVICE_DATA_RDONLY(YLF)
    ELSE
      ZZ2 => GET_DEVICE_DATA_RDWR(YLF)
    ENDIF
  ELSE
    IF (LDRDONLY) THEN
      ZZ2 => GET_HOST_DATA_RDONLY(YLF)
    ELSE
      ZZ2 => GET_HOST_DATA_RDWR(YLF)
    ENDIF
  ENDIF

  IF (SIZE(LS2RBV) /= SIZE (ZZ2, 1) ) CALL ABOR1("Error - incorrect size for LS2RBV")
  JCOUNT = 1

  DO JLEV = LBOUND (ZZ2, 1), UBOUND (ZZ2, 1)
    LS2RBV (JCOUNT)%P => ZZ2 (JLEV, :)
    LS2RBV(JCOUNT)%NAME=TRIM(NAME)
    JCOUNT = JCOUNT + 1
  ENDDO

END SUBROUTINE LS2RB

SUBROUTINE LS3RB(LS3RBV,YLF,NAME, LDACC,LDRDONLY)
  ! Creation of a list of SPEC_VIEW, each of them encapsulating a layer of an input FIELD_3RB field.
  ! Given YLF dimensioned(NLEVS, NSPEC, NFIELDS) as input,
  ! the output list size will contain (NLEVS*NFIELDS) SPEC_VIEW, each of them dimensioned(NSPEC)
  CLASS (FIELD_3RB), POINTER, INTENT (IN) :: YLF
  CHARACTER(LEN=*), INTENT (IN) :: NAME
  LOGICAL, INTENT (IN) :: LDACC
  LOGICAL, INTENT (IN) :: LDRDONLY
  TYPE (SPEC_VIEW), INTENT(INOUT) :: LS3RBV (:)

  REAL(KIND=JPRB), POINTER :: ZZ3 (:,:,:)
  REAL(KIND=JPRB), POINTER :: ZZ1 (:)
  INTEGER(KIND=JPIM) :: JLEV, JFLD, JCOUNT

  IF (LDACC) THEN
    IF (LDRDONLY) THEN
      ZZ3 => GET_DEVICE_DATA_RDONLY(YLF)
    ELSE
      ZZ3 => GET_DEVICE_DATA_RDWR(YLF)
    ENDIF
  ELSE
    IF (LDRDONLY) THEN
      ZZ3 => GET_HOST_DATA_RDONLY(YLF)
    ELSE
      ZZ3 => GET_HOST_DATA_RDWR(YLF)
    ENDIF
  ENDIF

  IF (SIZE(LS3RBV) /=SIZE (ZZ3, 1) * SIZE (ZZ3, 3) ) CALL ABOR1("Error - incorrect size for LS3RBV")

  JCOUNT = 1

  DO JFLD = LBOUND (ZZ3, 3), UBOUND (ZZ3, 3)
    DO JLEV = LBOUND (ZZ3, 1), UBOUND (ZZ3, 1)
      LS3RBV(JCOUNT)%P => ZZ3 (JLEV, :, JFLD)
      LS3RBV(JCOUNT)%NAME=TRIM(NAME)
      JCOUNT = JCOUNT + 1
    ENDDO
  ENDDO

END SUBROUTINE LS3RB

FUNCTION LS(YLFL,LSV,LDACC,LDRDONLY) RESULT(IOFF)
! Creation of a list of SPEC_VIEW from a list YLFL of FIELD_SPEC
TYPE (FIELD_SPEC), INTENT(IN) :: YLFL (:) ! input list of FIELD_SPEC
TYPE (SPEC_VIEW), INTENT(INOUT), OPTIONAL :: LSV (:)        ! output list of SPEC_VIEW
LOGICAL, INTENT(IN), OPTIONAL :: LDACC                  ! retrieve data on device
LOGICAL, INTENT(IN), OPTIONAL :: LDRDONLY
INTEGER(KIND=JPIM) :: IOFF

INTEGER(KIND=JPIM) :: ILEN, JFLD
INTEGER(KIND=JPIM) :: ILBOUNDS (5), IUBOUNDS (5)

LOGICAL :: LSV_PROVIDED
REAL(KIND=JPRB), POINTER :: ZZ1 (:)
LOGICAL :: LLACC, LLRDONLY

LSV_PROVIDED = .FALSE.
LLACC = .FALSE.
LLRDONLY = .FALSE.
IF (PRESENT(LSV))LSV_PROVIDED = .TRUE.
IF (PRESENT(LDACC))  LLACC = LDACC
IF (PRESENT(LDRDONLY)) LLRDONLY = LDRDONLY

IOFF = 0
ILEN = -1

! iterate over YLFL LIST
DO JFLD = 1, SIZE (YLFL)
  ! compute number of SPEC_VIEW that will be generated for each field of the list
  ! in addition when LSV_PROVIDED: call the correct routine to create the SPEC_VIEW for each field of the list
  SELECT TYPE (YLF => YLFL (JFLD)%PTR)
    CLASS IS (FIELD_1RB)
      ILEN = 1
      IF (LSV_PROVIDED) CALL LS1RB(LSV(IOFF+1:IOFF+ILEN),YLF,YLFL(JFLD)%NAME, LLACC,LLRDONLY)
    CLASS IS (FIELD_2RB)
      CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
      ILEN = (IUBOUNDS (1) - ILBOUNDS (1) + 1)
      IF (LSV_PROVIDED) CALL LS2RB(LSV(IOFF+1:IOFF+ILEN),YLF,YLFL(JFLD)%NAME, LLACC,LLRDONLY)
    CLASS IS (FIELD_3RB)
      CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
        ILEN =  (IUBOUNDS (1) - ILBOUNDS (1) + 1)* (IUBOUNDS (3) - ILBOUNDS (3) + 1)
      IF (LSV_PROVIDED) CALL LS3RB(LSV(IOFF+1:IOFF+ILEN),YLF ,YLFL(JFLD)%NAME, LLACC,LLRDONLY)
    CLASS IS (FIELD_4RB)
        CALL ABOR1("LS not implemeted for FIELD_4RB")
    CLASS DEFAULT
        ! Skip the spectral field as it is not present on this processor
        ILEN = 0
  END SELECT

  IOFF = IOFF + ILEN
ENDDO

IF (LSV_PROVIDED ) THEN
  IF (SIZE(LSV) /= IOFF)  CALL ABOR1("LS FAILURE: LSV has incorrect size")
ENDIF

END FUNCTION LS

FUNCTION LS_COUNT(YLFL)
  TYPE (FIELD_SPEC), INTENT(IN) :: YLFL (:)  
  INTEGER(KIND=JPIM) :: LS_COUNT

  LS_COUNT = LS(YLFL)
END FUNCTION LS_COUNT

SUBROUTINE GET_LAYOUT_G(YLFL, NBLK, KPROMA)
  TYPE(FIELD_GRID), INTENT(IN) :: YLFL(:)
  INTEGER(KIND=JPIM), INTENT(INOUT) :: NBLK
  INTEGER(KIND=JPIM), INTENT(INOUT) :: KPROMA
  INTEGER(KIND=JPIM) :: ILBOUNDS (5), IUBOUNDS (5)

  INTEGER :: JFLD

  DO JFLD = 1, SIZE(YLFL)
    SELECT TYPE (YLF => YLFL (JFLD)%PTR)
      CLASS IS (FIELD_1RB)
          CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
          NBLK = MAX(NBLK, (IUBOUNDS (1) - ILBOUNDS (1) + 1))         
       CLASS IS (FIELD_2RB)
          CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
          KPROMA = MAX(KPROMA, (IUBOUNDS (1) - ILBOUNDS (1) + 1))
          NBLK = MAX(NBLK,  (IUBOUNDS (2) - ILBOUNDS (2) + 1))
       CLASS IS (FIELD_3RB)
          CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
          KPROMA = MAX(KPROMA, (IUBOUNDS (1) - ILBOUNDS (1) + 1))
          NBLK = MAX(NBLK,  (IUBOUNDS (3) - ILBOUNDS (3) + 1))
       CLASS IS (FIELD_4RB)
          CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
          KPROMA = MAX(KPROMA, (IUBOUNDS (1) - ILBOUNDS (1) + 1))      
          NBLK = MAX(NBLK,  (IUBOUNDS (4) - ILBOUNDS (4) + 1)  )
    END SELECT
  ENDDO
END SUBROUTINE GET_LAYOUT_G

SUBROUTINE GET_LAYOUT_S(YLFL, KSPEC)
  TYPE(FIELD_SPEC), INTENT(IN) :: YLFL(:)
  INTEGER(KIND=JPIM), INTENT(INOUT) :: KSPEC
  INTEGER(KIND=JPIM) :: ILBOUNDS (5), IUBOUNDS (5)

  INTEGER :: JFLD

  DO JFLD = 1, SIZE(YLFL)
    SELECT TYPE (YLF => YLFL (JFLD)%PTR)
      CLASS IS (FIELD_1RB)
          CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
          KSPEC = MAX(KSPEC, (IUBOUNDS (1) - ILBOUNDS (1) + 1))         
       CLASS IS (FIELD_2RB)
          CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
          KSPEC = MAX(KSPEC,  (IUBOUNDS (2) - ILBOUNDS (2) + 1))
       CLASS IS (FIELD_3RB)
          CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
          KSPEC = MAX(KSPEC,  (IUBOUNDS (3) - ILBOUNDS (3) + 1))    
    END SELECT
  ENDDO
END SUBROUTINE GET_LAYOUT_S

END MODULE ECTRANS_FIELD_API_MOD