read_buffer.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #######################
      MODULE modi_read_buffer
!     #######################
INTERFACE read_buffer
!
      SUBROUTINE read_bufx1(HNAME,PFIELD,KRET)
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
REAL, DIMENSION(:),           INTENT(OUT)  :: PFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
END SUBROUTINE read_bufx1
!
      SUBROUTINE read_bufx0(HNAME,PFIELD,KRET)
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
REAL,                         INTENT(OUT)  :: PFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
END SUBROUTINE read_bufx0
!
      SUBROUTINE read_bufn0(HNAME,KFIELD,KRET)
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
INTEGER,                      INTENT(OUT)  :: KFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
END SUBROUTINE read_bufn0
!
      SUBROUTINE read_bufn1(HNAME,KFIELD,KRET)
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
INTEGER, DIMENSION(:),        INTENT(OUT)  :: KFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
END SUBROUTINE read_bufn1
!
      SUBROUTINE read_bufc0(HNAME,HFIELD,KRET)
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME     ! name of field
 CHARACTER(LEN=*),             INTENT(OUT)  :: HFIELD    ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
END SUBROUTINE read_bufc0
!
END INTERFACE
END MODULE modi_read_buffer
!     #######################################################
 SUBROUTINE read_bufc0(HNAME,HFIELD,KRET)
!     #######################################################
!
!!****  *READ_BUFC0* - routine to read a character (LEN=6) in a buffer from SURFEX
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S.Malardel   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2005 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modi_get_luout
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_ARO
#include "get_bufc0.h"
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME     ! name of field
 CHARACTER(LEN=*),             INTENT(OUT)  :: HFIELD    ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                                    :: ILUOUT ! Listing file number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFC0',0,zhook_handle)
 CALL get_luout('AROME ',iluout)
!
#ifdef SFX_ARO
 CALL get_bufc0(hname,hfield,len(hfield),kret)
#endif
!
IF (kret /=0) THEN
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'ERROR'
  WRITE(iluout,*) '-------'
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'error when de-burrering article', hname,' KRET=',kret
  WRITE(iluout,*) ' '
ENDIF
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFC0',1,zhook_handle)
!
END SUBROUTINE read_bufc0
!     #######################################################
 SUBROUTINE read_bufn0(HNAME,KFIELD,KRET)
!     #######################################################
!
!!****  *READ_BUFN0* - routine to read an integer in a buffer from SURFEX
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S.Malardel   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2005 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modi_get_luout
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_ARO
#include "get_bufn0.h"
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
INTEGER,                      INTENT(OUT)  :: KFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                                    :: ILUOUT ! Listing file number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFN0',0,zhook_handle)
 CALL get_luout('AROME ',iluout)
!
#ifdef SFX_ARO
 CALL get_bufn0(hname,kfield,kret)
#endif
!
IF (kret /=0) THEN
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'ERROR'
  WRITE(iluout,*) '-------'
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'error when de-burrering article', hname,' KRET=',kret
  WRITE(iluout,*) ' '
ENDIF
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFN0',1,zhook_handle)
!
END SUBROUTINE read_bufn0
!     #######################################################
 SUBROUTINE read_bufn1(HNAME,KFIELD,KRET)
!     #######################################################
!
!!****  *READ_BUFN1* - routine to read a 1D integer array in a buffer from SURFEX
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S.Malardel   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2005 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modi_get_luout
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_ARO
#include "get_bufn1.h"
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
INTEGER, DIMENSION(:),        INTENT(OUT)  :: KFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                                    :: ILUOUT ! Listing file number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFN1',0,zhook_handle)
 CALL get_luout('AROME ',iluout)
!
#ifdef SFX_ARO
 CALL get_bufn1(hname,SIZE(kfield),kfield,kret)
#endif
!
IF (kret /=0) THEN
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'ERROR'
  WRITE(iluout,*) '-------'
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'error when de-burrering article', hname,' KRET=',kret
  WRITE(iluout,*) ' '
ENDIF
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFN1',1,zhook_handle)
!
END SUBROUTINE read_bufn1
!     #######################################################
 SUBROUTINE read_bufx0(HNAME,PFIELD,KRET)
!     #######################################################
!
!!****  *READ_BUFX0* - routine to read a real in a buffer from SURFEX
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S.Malardel   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2005 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modi_get_luout
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_ARO
#include "get_bufx0.h"
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
REAL,                         INTENT(OUT)  :: PFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                                    :: ILUOUT ! Listing file number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFX0',0,zhook_handle)
 CALL get_luout('AROME ',iluout)
!
#ifdef SFX_ARO
 CALL get_bufx0(hname,pfield,kret)
#endif
!
IF (kret /=0) THEN
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'ERROR'
  WRITE(iluout,*) '-------'
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'error when de-burrering article', hname,' KRET=',kret
  WRITE(iluout,*) ' '
ENDIF
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFX0',1,zhook_handle)
!
END SUBROUTINE read_bufx0
!     #######################################################
 SUBROUTINE read_bufx1(HNAME,PFIELD,KRET)
!     #######################################################
!
!!****  *READ_BUFX1* - routine to read a 1D real array in a buffer from SURFEX
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S.Malardel   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2005 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modi_get_luout
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_ARO
#include "get_bufx1.h"
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*),             INTENT(IN)   :: HNAME        ! name of field
REAL, DIMENSION(:),           INTENT(OUT)  :: PFIELD ! array containing the data field
INTEGER,                      INTENT(OUT)  :: KRET      !  error code
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                                    :: ILUOUT ! Listing file number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFX1',0,zhook_handle)
 CALL get_luout('AROME ',iluout)
!
#ifdef SFX_ARO
 CALL get_bufx1(hname,SIZE(pfield),pfield,kret)
#endif
!
IF (kret /=0) THEN
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'ERROR'
  WRITE(iluout,*) '-------'
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'error when de-burrering article', hname,' KRET=',kret
  WRITE(iluout,*) ' '
ENDIF
IF (lhook) CALL dr_hook('MODI_READ_BUFFER:READ_BUFX1',1,zhook_handle)
!
END SUBROUTINE read_bufx1