trip_diag_write.F90

Go to the documentation of this file.

!     #########
      SUBROUTINE trip_diag_write (TPDG, TPG, &
                                  KLISTING,KLON,KLAT,KDIAG,PTSTEP_DIAG,OXIOS)  
!     ############################################################
!
!!****  *TRIP_DIAG_WRITE*  
!!
!!    PURPOSE
!!    -------
!
!     TRIP river routing outputs.
!     
!!      
!!    AUTHOR
!!    ------
!!      B. Decharme
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    28/05/05 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE modd_trip_diag, ONLY : trip_diag_t
USE modd_trip_grid, ONLY : trip_grid_t
!
USE modn_trip,       ONLY : cgroundw, cvit, lflood
USE modn_trip_run,   ONLY : ldiag_misc
USE modd_trip_oasis, ONLY : lcpl_land
!
USE modd_trip_par,   ONLY : xtime_diag
!
#ifdef WXIOS
use xios
#endif
!
USE mode_rw_trip
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(trip_diag_t), INTENT(INOUT) :: TPDG
TYPE(trip_grid_t), INTENT(INOUT) :: TPG
!
INTEGER, INTENT(IN)             :: KLISTING
INTEGER, INTENT(IN)             :: KLON
INTEGER, INTENT(IN)             :: KLAT
INTEGER, INTENT(IN)             :: KDIAG
REAL,    INTENT(IN)             :: PTSTEP_DIAG
LOGICAL, INTENT(IN)             :: OXIOS
!
!*      0.2    declarations of local variables
!
 CHARACTER(LEN=19), PARAMETER         :: YDIAG  = 'TRIP_DIAG.nc'
 CHARACTER(LEN=50)                    :: YFILE
 CHARACTER(LEN=10)                    :: YVNAME
!
REAL,   DIMENSION(KLON,KLAT)         :: ZWRITE
LOGICAL,DIMENSION(KLON,KLAT)         :: LMASK
LOGICAL,DIMENSION(KLON,KLAT)         :: LMASK_GW
!
INTEGER :: ITNUM, ITVAL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TRIP_DIAG_WRITE',0,zhook_handle)
!
! * Trip mask
!
lmask(:,:) = tpg%GMASK(:,:)
!
! * Groundwater specific mask
!
IF(cgroundw/='DEF')THEN
  lmask_gw(:,:) = tpg%GMASK_GW(:,:)        
ENDIF
!
!-------------------------------------------------------------------------------
!outputs
!-------------------------------------------------------------------------------
!
! * Recup diag file
!
yfile =ydiag
!
! * Time attribut
!
itnum = kdiag
!
IF (oxios) THEN
#ifdef WXIOS
  CALL xios_update_calendar(kdiag)
#endif
  itval = 0
ELSE
  itval = (kdiag-1)*int(ptstep_diag/xtime_diag)
ENDIF
!
! * Store output in diag file
!
yvname = 'SURF_STO'
zwrite = tpdg%TDIAG%XSURF_STO / ptstep_diag
 CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)   
 CALL cum_diag(tpdg%TDIAG%XSURF_STO,tpdg%TDIAG_RUN%XSURF_STO)
!                
yvname = 'QDIS'
zwrite = tpdg%TDIAG%XQDIS / ptstep_diag
 CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios) 
 CALL cum_diag(tpdg%TDIAG%XQDIS,tpdg%TDIAG_RUN%XQDIS)
!
IF(ldiag_misc)THEN                
  yvname = 'QSIN'
  zwrite = tpdg%TDIAG%XQIN / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)
  CALL cum_diag(tpdg%TDIAG%XQIN,tpdg%TDIAG_RUN%XQIN)
ENDIF
!
IF(lcpl_land.AND.ldiag_misc)THEN                
! kg/m2 (can be used to force the model offline) 
  yvname = 'RUNOFF'
  zwrite = tpdg%TDIAG%XRUNOFF
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)
  CALL cum_diag(tpdg%TDIAG%XRUNOFF,tpdg%TDIAG_RUN%XRUNOFF)
! kg/m2 (can be used to force the model offline)
  yvname = 'DRAIN'
  zwrite = tpdg%TDIAG%XDRAIN
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)
  CALL cum_diag(tpdg%TDIAG%XDRAIN,tpdg%TDIAG_RUN%XDRAIN)
!          
ENDIF
!
IF(cgroundw/='DEF')THEN
!
  yvname = 'QGF'
  zwrite = tpdg%TDIAG%XQGF / ptstep_diag 
  CALL write_trip(klisting,yfile,yvname,lmask_gw,zwrite,itnum,itval,oxios=oxios)
  CALL cum_diag(tpdg%TDIAG%XQGF,tpdg%TDIAG_RUN%XQGF)
!          
  yvname = 'GROUND_STO'
  zwrite = tpdg%TDIAG%XGROUND_STO / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask_gw,zwrite,itnum,itval,oxios=oxios) 
  CALL cum_diag(tpdg%TDIAG%XGROUND_STO,tpdg%TDIAG_RUN%XGROUND_STO)
!  
ENDIF
!
IF(cgroundw=='DIF')THEN
!
  yvname = 'HGROUND'
  zwrite = tpdg%TDIAG%XHGROUND / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask_gw,zwrite,itnum,itval,oxios=oxios)
  CALL cum_diag(tpdg%TDIAG%XHGROUND,tpdg%TDIAG_RUN%XHGROUND)
!       
  yvname = 'FWTD'
  zwrite = tpdg%TDIAG%XFWTD / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask_gw,zwrite,itnum,itval,oxios=oxios)  
  CALL cum_diag(tpdg%TDIAG%XFWTD,tpdg%TDIAG_RUN%XFWTD)
!       
  yvname = 'WTD'
  zwrite = tpdg%TDIAG%XWTD / ptstep_diag 
  CALL write_trip(klisting,yfile,yvname,lmask_gw,zwrite,itnum,itval,oxios=oxios)
  CALL cum_diag(tpdg%TDIAG%XWTD,tpdg%TDIAG_RUN%XWTD)
!   
  IF(ldiag_misc)THEN      
!      
      yvname = 'QGCELL'
      zwrite = tpdg%TDIAG%XQGCELL / ptstep_diag 
      CALL write_trip(klisting,yfile,yvname,lmask_gw,zwrite,itnum,itval,oxios=oxios)
      CALL cum_diag(tpdg%TDIAG%XQGCELL,tpdg%TDIAG_RUN%XQGCELL)
!       
      yvname = 'HGHRIV'
      zwrite = tpdg%TDIAG%XHGHS / ptstep_diag
      CALL write_trip(klisting,yfile,yvname,lmask_gw,zwrite,itnum,itval,oxios=oxios)
      CALL cum_diag(tpdg%TDIAG%XHGHS,tpdg%TDIAG_RUN%XHGHS)
!
  ENDIF
! 
ENDIF
!
IF(cvit=='VAR')THEN
!
  yvname = 'VEL'
  zwrite = tpdg%TDIAG%XVEL / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)
  CALL cum_diag(tpdg%TDIAG%XVEL,tpdg%TDIAG_RUN%XVEL)
!
  yvname = 'HSTREAM'
  zwrite = tpdg%TDIAG%XHS / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios) 
  CALL cum_diag(tpdg%TDIAG%XHS,tpdg%TDIAG_RUN%XHS)
!
ENDIF
!
IF(lflood)THEN
!
  yvname = 'FFLOOD'
  zwrite = tpdg%TDIAG%XFF / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)   
  CALL cum_diag(tpdg%TDIAG%XFF,tpdg%TDIAG_RUN%XFF)
!
  yvname = 'FLOOD_STO'
  zwrite = tpdg%TDIAG%XFLOOD_STO / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)   
  CALL cum_diag(tpdg%TDIAG%XFLOOD_STO,tpdg%TDIAG_RUN%XFLOOD_STO)
!
  yvname = 'HFLOOD'
  zwrite = tpdg%TDIAG%XHF / ptstep_diag
  CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)  
  CALL cum_diag(tpdg%TDIAG%XHF,tpdg%TDIAG_RUN%XHF)
!
  IF(ldiag_misc)THEN
!
! kg/m2 (can be used to force the model offline)
    yvname = 'FSOURCE'
    zwrite = tpdg%TDIAG%XSOURCE
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios) 
    CALL cum_diag(tpdg%TDIAG%XSOURCE,tpdg%TDIAG_RUN%XSOURCE)
!
! kg/m2/s
    yvname = 'QFR'
    zwrite = tpdg%TDIAG%XQFR / ptstep_diag
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)  
    CALL cum_diag(tpdg%TDIAG%XQFR,tpdg%TDIAG_RUN%XQFR)
!                
    yvname = 'QRF'
    zwrite = tpdg%TDIAG%XQRF / ptstep_diag
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios) 
    CALL cum_diag(tpdg%TDIAG%XQRF,tpdg%TDIAG_RUN%XQRF)
!
    yvname = 'VFIN'
    zwrite = tpdg%TDIAG%XVFIN / ptstep_diag
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios) 
    CALL cum_diag(tpdg%TDIAG%XVFIN,tpdg%TDIAG_RUN%XVFIN) 
!
    yvname = 'VFOUT'
    zwrite = tpdg%TDIAG%XVFOUT / ptstep_diag
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios) 
    CALL cum_diag(tpdg%TDIAG%XVFOUT,tpdg%TDIAG_RUN%XVFOUT)
!
    yvname = 'HSF'
    zwrite = tpdg%TDIAG%XHSF / ptstep_diag
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)
    CALL cum_diag(tpdg%TDIAG%XHSF,tpdg%TDIAG_RUN%XHSF)
!
    yvname = 'WF'
    zwrite = tpdg%TDIAG%XWF / ptstep_diag
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)  
    CALL cum_diag(tpdg%TDIAG%XWF,tpdg%TDIAG_RUN%XWF)
!
    yvname = 'LF'
    zwrite = tpdg%TDIAG%XLF / ptstep_diag
    CALL write_trip(klisting,yfile,yvname,lmask,zwrite,itnum,itval,oxios=oxios)
    CALL cum_diag(tpdg%TDIAG%XLF,tpdg%TDIAG_RUN%XLF)
!      
  ENDIF
!
ENDIF
!
IF (lhook) CALL dr_hook('TRIP_DIAG_WRITE',1,zhook_handle)
!
!-------------------------------------------------------------------------------
 CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE cum_diag(PDIAG,PRUN)
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:),INTENT(INOUT) :: PDIAG
REAL, DIMENSION(:,:),INTENT(OUT  ) :: PRUN
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('TRIP_DIAG_WRITE:CUM_DIAG',0,zhook_handle)
!
prun(:,:) = prun(:,:) + pdiag(:,:)
!
pdiag(:,:) = 0.0
!
IF (lhook) CALL dr_hook('TRIP_DIAG_WRITE:CUM_DIAG',1,zhook_handle)
!
END SUBROUTINE cum_diag
!
!-------------------------------------------------------------------------------
END SUBROUTINE trip_diag_write