mode_rw_trip.F90

Go to the documentation of this file.

!######################
MODULE mode_rw_trip
!######################
!
!!****  *MODE_RW_TRIP*
!!
!!    PURPOSE
!!    -------
!    
!      The purpose of this routine is to store here all routines 
!      used by TRIP for read/write variables.
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!       NONE          
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme       * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    25/04/08
!!      S.Sénési    08/11/16 : interface to XIOS
!--------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_trip_par, ONLY : xundef, lncprint
!
USE yomhook ,      ONLY : lhook,   dr_hook
USE parkind1,      ONLY : jprb
!
USE netcdf
!
USE mode_trip_netcdf
!
INTERFACE read_trip
    MODULE PROCEDURE read_trip_x
    MODULE PROCEDURE read_trip_xy
    MODULE PROCEDURE read_trip_xyz
END INTERFACE
!
INTERFACE write_trip
    MODULE PROCEDURE write_trip_xy
    MODULE PROCEDURE write_trip_xyz
END INTERFACE
!
!-------------------------------------------------------------------------------
!
 CONTAINS
!
!-------------------------------------------------------------------------------
!
!##################################################
SUBROUTINE read_trip_x(KLISTING,HFILE,HVNAME,PREAD)
!##################################################
!
!!    PURPOSE
!!    -------
!    
!     Read a XY variable in a netcdf file
!
IMPLICIT NONE
!
!*      declarations of arguments
!
 CHARACTER(LEN=*), INTENT(IN) :: HFILE
 CHARACTER(LEN=*), INTENT(IN) :: HVNAME
!
INTEGER, INTENT(IN) :: KLISTING
!
REAL, DIMENSION(:), INTENT(OUT) :: PREAD
!
!*      declarations of local variables
!
 CHARACTER(LEN=NF90_MAX_NAME) :: YFILE
 CHARACTER(LEN=NF90_MAX_NAME) :: YVNAME
!
LOGICAL, PARAMETER     :: LRW = .false.
!
INTEGER :: INCID
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:READ_TRIP_X',0,zhook_handle)
yfile  = hfile(1:len_trim(hfile ))
yvname = hvname(1:len_trim(hvname))
!
 CALL ncopen(klisting,lrw,lncprint,yfile,incid)
 CALL ncread(klisting,incid,yvname,pread,lncprint)
 CALL ncclose(klisting,lncprint,yfile,incid)
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:READ_TRIP_X',1,zhook_handle)
!
END SUBROUTINE read_trip_x
!
!-------------------------------------------------------------------------------
!
!##################################################
SUBROUTINE read_trip_xy(KLISTING,HFILE,HVNAME,PREAD)
!##################################################
!
!!    PURPOSE
!!    -------
!    
!     Read a XY variable in a netcdf file
!
IMPLICIT NONE
!
!*      declarations of arguments
!
 CHARACTER(LEN=*), INTENT(IN) :: HFILE
 CHARACTER(LEN=*), INTENT(IN) :: HVNAME
!
INTEGER, INTENT(IN) :: KLISTING
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PREAD
!
!*      declarations of local variables
!
 CHARACTER(LEN=NF90_MAX_NAME) :: YFILE
 CHARACTER(LEN=NF90_MAX_NAME) :: YVNAME
!
LOGICAL, PARAMETER     :: LRW = .false.
!
INTEGER :: INCID
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:READ_TRIP_XY',0,zhook_handle)
yfile  = hfile(1:len_trim(hfile ))
yvname = hvname(1:len_trim(hvname))
!
 CALL ncopen(klisting,lrw,lncprint,yfile,incid)
 CALL ncread(klisting,incid,yvname,pread,lncprint)
 CALL ncclose(klisting,lncprint,yfile,incid)
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:READ_TRIP_XY',1,zhook_handle)
!
END SUBROUTINE read_trip_xy
!
!-------------------------------------------------------------------------------
!
!##################################################
SUBROUTINE read_trip_xyz(KLISTING,HFILE,HVNAME,PREAD)
!##################################################
!
!!    PURPOSE
!!    -------
!    
!     Read a XYZ variable in a netcdf file
!
IMPLICIT NONE
!
!*      declarations of arguments
!
 CHARACTER(LEN=*), INTENT(IN) :: HFILE
 CHARACTER(LEN=*), INTENT(IN) :: HVNAME
!
INTEGER, INTENT(IN) :: KLISTING
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREAD
!
!*      declarations of local variables
!
 CHARACTER(LEN=NF90_MAX_NAME) :: YFILE
 CHARACTER(LEN=NF90_MAX_NAME) :: YVNAME
!
LOGICAL, PARAMETER       :: LRW = .false.
!
INTEGER :: INCID
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:READ_TRIP_XYZ',0,zhook_handle)
yfile  = hfile(1:len_trim(hfile ))
yvname = hvname(1:len_trim(hvname))
!
 CALL ncopen(klisting,lrw,lncprint,yfile,incid)
 CALL ncread(klisting,incid,yvname,pread,lncprint)
 CALL ncclose(klisting,lncprint,yfile,incid)
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:READ_TRIP_XYZ',1,zhook_handle)
!
END SUBROUTINE read_trip_xyz
!
!-------------------------------------------------------------------------------
!
!######################################################################
SUBROUTINE write_trip_xy(KLISTING,HFILE,HVNAME,OMASK,PWRITE,KTNUM,KTVAL,ODOUBLE,OXIOS)
!######################################################################
!
!!    PURPOSE
!!    -------
!    
!     Write a XY variable in HFILE
!
#ifdef WXIOS
USE xios 
#endif
!
IMPLICIT NONE
!
!*      declarations of arguments
!
 CHARACTER(LEN=*), INTENT(IN) :: HFILE
 CHARACTER(LEN=*), INTENT(IN) :: HVNAME
!
INTEGER, INTENT(IN) :: KLISTING
!
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK
REAL,    DIMENSION(:,:), INTENT(IN) :: PWRITE
!
INTEGER, INTENT(IN), OPTIONAL :: KTNUM
INTEGER, INTENT(IN), OPTIONAL :: KTVAL
LOGICAL, INTENT(IN), OPTIONAL :: ODOUBLE
LOGICAL, INTENT(IN), OPTIONAL :: OXIOS
!
!*      declarations of local variables
!
 CHARACTER(LEN=NF90_MAX_NAME) :: YFILE
 CHARACTER(LEN=NF90_MAX_NAME) :: YVNAME
!
LOGICAL, PARAMETER     :: LRW = .true.
!
REAL, DIMENSION(SIZE(PWRITE,1),SIZE(PWRITE,2)) :: ZWRITE
!
INTEGER :: INCID
LOGICAL :: GXIOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:WRITE_TRIP_XY',0,zhook_handle)
yfile  = hfile(1:len_trim(hfile ))
yvname = hvname(1:len_trim(hvname))
gxios=.false.
!
WHERE(omask) 
    zwrite(:,:) = pwrite(:,:)
ELSEWHERE        
    zwrite(:,:) = xundef
ENDWHERE
!
IF (PRESENT(oxios)) gxios=oxios
!
IF (gxios) THEN
#ifdef WXIOS
   CALL xios_send_field(yvname,zwrite)
#endif
ELSE
  CALL ncopen(klisting,lrw,lncprint,yfile,incid)
  IF(PRESENT(ktnum).AND.PRESENT(ktval).AND.PRESENT(odouble))THEN
    CALL ncstore(klisting,incid,yvname,zwrite,lncprint,ktnum,ktval,odouble=odouble)
  ELSEIF(PRESENT(ktnum).AND.PRESENT(ktval))THEN
    CALL ncstore(klisting,incid,yvname,zwrite,lncprint,ktnum,ktval)
  ELSEIF(PRESENT(odouble))THEN
    CALL ncstore(klisting,incid,yvname,zwrite,lncprint,odouble=odouble)
  ELSE
    CALL ncstore(klisting,incid,yvname,zwrite,lncprint)
  ENDIF
  CALL ncclose(klisting,lncprint,yfile,incid)
ENDIF
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:WRITE_TRIP_XY',1,zhook_handle)
!
END SUBROUTINE write_trip_xy
!
!-------------------------------------------------------------------------------
!
!#######################################################################
SUBROUTINE write_trip_xyz(KLISTING,HFILE,HVNAME,OMASK,PWRITE,KTNUM,KTVAL,ODOUBLE,OXIOS)
!#######################################################################
!
!!    PURPOSE
!!    -------
!    
!     Write a XY variable in HFILE
!
#ifdef WXIOS
USE xios
#endif
!
IMPLICIT NONE
!
!*      declarations of arguments
!
 CHARACTER(LEN=*), INTENT(IN) :: HFILE
 CHARACTER(LEN=*), INTENT(IN) :: HVNAME
!
INTEGER, INTENT(IN) :: KLISTING
!
LOGICAL, DIMENSION(:,:),   INTENT(IN) :: OMASK
REAL,    DIMENSION(:,:,:), INTENT(IN) :: PWRITE
!
INTEGER, INTENT(IN), OPTIONAL :: KTNUM
INTEGER, INTENT(IN), OPTIONAL :: KTVAL
LOGICAL, INTENT(IN), OPTIONAL :: ODOUBLE
LOGICAL, INTENT(IN), OPTIONAL :: OXIOS
!
!*      declarations of local variables
!
 CHARACTER(LEN=NF90_MAX_NAME) :: YFILE
 CHARACTER(LEN=NF90_MAX_NAME) :: YVNAME
!
LOGICAL, PARAMETER     :: LRW = .true.
LOGICAL, PARAMETER     :: LZW = .true.
!
REAL, DIMENSION(SIZE(PWRITE,1),SIZE(PWRITE,2),SIZE(PWRITE,3)) :: ZWRITE
!
LOGICAL :: GXIOS
INTEGER :: INCID, IZLEN, JZ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:WRITE_TRIP_XYZ',0,zhook_handle)
izlen=SIZE(pwrite,3)
gxios=.false.
!
yfile  = hfile(1:len_trim(hfile ))
yvname = hvname(1:len_trim(hvname))
!
DO jz=1,izlen
   WHERE(omask(:,:))
         zwrite(:,:,jz) = pwrite(:,:,jz)
   ELSEWHERE
         zwrite(:,:,jz)=xundef
   ENDWHERE
ENDDO
!
IF (PRESENT(oxios)) gxios=oxios
!
IF (gxios) THEN
#ifdef WXIOS
   CALL xios_send_field(yvname,zwrite(:,:,:))
#endif
ELSE
   CALL ncopen(klisting,lrw,lncprint,yfile,incid)
   DO jz=1,izlen
      IF(PRESENT(ktnum).AND.PRESENT(ktval).AND.PRESENT(odouble))THEN
         CALL ncstore(klisting,incid,yvname,zwrite(:,:,jz),lncprint,ktnum,ktval,jz,lzw,odouble=odouble)
      ELSEIF(PRESENT(ktnum).AND.PRESENT(ktval))THEN
         CALL ncstore(klisting,incid,yvname,zwrite(:,:,jz),lncprint,ktnum,ktval,jz,lzw)
      ELSEIF(PRESENT(odouble))THEN
         CALL ncstore(klisting,incid,yvname,zwrite(:,:,jz),lncprint,klevel=jz,ovarzdim=lzw,odouble=odouble)
      ELSE
         CALL ncstore(klisting,incid,yvname,zwrite(:,:,jz),lncprint,klevel=jz,ovarzdim=lzw)
      ENDIF
   ENDDO
   CALL ncclose(klisting,lncprint,yfile,incid)
ENDIF
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:WRITE_TRIP_XYZ',1,zhook_handle)
!
END SUBROUTINE write_trip_xyz
!
!-------------------------------------------------------------------------------
!
!######################################################################
SUBROUTINE write_trip_date(KLISTING,HFILE,KYEAR,KMONTH,KDAY,PTIME)
!######################################################################
!
!!    PURPOSE
!!    -------
!    
!     Write date in HFILE
!
IMPLICIT NONE
!
!*      declarations of arguments
!
 CHARACTER(LEN=*), INTENT(IN) :: HFILE
!
INTEGER, INTENT(IN)          :: KLISTING
INTEGER, INTENT(IN)          :: KYEAR
INTEGER, INTENT(IN)          :: KMONTH
INTEGER, INTENT(IN)          :: KDAY
REAL,    INTENT(IN)          :: PTIME
!
!*      declarations of local variables
!
 CHARACTER(LEN=NF90_MAX_NAME) :: YFILE
!
LOGICAL, PARAMETER     :: LRW = .true.
!
INTEGER :: INCID
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      procedure
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:WRITE_TRIP_DATE',0,zhook_handle)
!
yfile  = hfile(1:len_trim(hfile ))
!
 CALL ncopen(klisting,lrw,lncprint,yfile,incid)
 CALL ncdate(klisting,incid,kyear,kmonth,kday,ptime,lncprint)
 CALL ncclose(klisting,lncprint,yfile,incid)
!
IF (lhook) CALL dr_hook('MODE_RW_TRIP:WRITE_TRIP_DATE',1,zhook_handle)
!
END SUBROUTINE write_trip_date
!
!-------------------------------------------------------------------------------
!
END MODULE mode_rw_trip