trip_forcing.F90

Go to the documentation of this file.

!     ######
SUBROUTINE trip_forcing (TPG, &
                         KLUOUT,KLON,KLAT,KNB_TSTEP_RUN, &
                        PDRAIN,PRUNOFF,PSRC_FLOOD       )
!######################################################################
!
!!****  *TRIP_FORCING* - prepare the forcing for running trip
!!
!!    PURPOSE
!!    -------
!!
!!    AUTHOR
!!    ------
!!      B. decharme   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/2008 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_trip_grid, ONLY : trip_grid_t
!
USE modn_trip_run, ONLY : cfile_frc,creadfrc,cdrain, &
                          crunoff,lcumfrc,csrc_flood
!
!
USE modd_trip_par,ONLY : xundef
!
USE mode_rw_trip
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(trip_grid_t), INTENT(INOUT) :: TPG
!
INTEGER,                INTENT(IN)  :: KLUOUT
INTEGER,                INTENT(IN)  :: KLON
INTEGER,                INTENT(IN)  :: KLAT
INTEGER,                INTENT(IN)  :: KNB_TSTEP_RUN
!
REAL, DIMENSION(KLON,KLAT,KNB_TSTEP_RUN), INTENT(OUT) :: PDRAIN         
REAL, DIMENSION(KLON,KLAT,KNB_TSTEP_RUN), INTENT(OUT) :: PRUNOFF
REAL, DIMENSION(KLON,KLAT,KNB_TSTEP_RUN), INTENT(OUT) :: PSRC_FLOOD
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(KLON,KLAT,KNB_TSTEP_RUN) :: ZREAD_LATLON_DRAIN         
REAL, DIMENSION(KLON,KLAT,KNB_TSTEP_RUN) :: ZREAD_LATLON_RUNOFF
REAL, DIMENSION(KLON,KLAT,KNB_TSTEP_RUN) :: ZREAD_LATLON_SRC_FLOOD
!
REAL, DIMENSION(KLON*KLAT,KNB_TSTEP_RUN) :: ZREAD_VECTOR_DRAIN         
REAL, DIMENSION(KLON*KLAT,KNB_TSTEP_RUN) :: ZREAD_VECTOR_RUNOFF
REAL, DIMENSION(KLON*KLAT,KNB_TSTEP_RUN) :: ZREAD_VECTOR_SRC_FLOOD
!
 CHARACTER(LEN=6) :: YVAR
INTEGER          :: JLON,JLAT,JSTEP,ICOUNT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('TRIP_FORCING',0,zhook_handle)
!
!*       1.     Initialize :
!               ------------
!
pdrain(:,:,:) = 0.0
prunoff(:,:,:) = 0.0
psrc_flood(:,:,:) = 0.0
!
!-------------------------------------------------------------------------------
!
!*       2.     Get fields :
!               ------------
!
IF(creadfrc=='LATLON')THEN
!
! * Lat lon case
!
  CALL read_trip(kluout,cfile_frc,cdrain ,zread_latlon_drain(:,:,:))
  CALL read_trip(kluout,cfile_frc,crunoff,zread_latlon_runoff(:,:,:))
!
  WHERE(zread_latlon_drain(:,:,:)==xundef)zread_latlon_drain(:,:,:)=0.0
  WHERE(zread_latlon_runoff(:,:,:)==xundef)zread_latlon_runoff(:,:,:)=0.0
! 
  IF(len_trim(csrc_flood)/=0)THEN
    CALL read_trip(kluout,cfile_frc,csrc_flood,zread_latlon_src_flood(:,:,:))
    WHERE(zread_latlon_src_flood(:,:,:)==xundef)zread_latlon_src_flood(:,:,:)=0.0
  ELSE
    zread_latlon_src_flood(:,:,:) = 0.0
  ENDIF
!
  IF(lcumfrc)THEN
    DO jstep = knb_tstep_run,2,-1
       zread_latlon_drain(:,:,jstep) = zread_latlon_drain(:,:,jstep) - zread_latlon_drain(:,:,jstep-1)
       zread_latlon_runoff(:,:,jstep) = zread_latlon_runoff(:,:,jstep) - zread_latlon_runoff(:,:,jstep-1)
       zread_latlon_src_flood(:,:,jstep) = zread_latlon_src_flood(:,:,jstep) - zread_latlon_src_flood(:,:,jstep-1)
    ENDDO
  ENDIF
!
  pdrain(:,:,:) = zread_latlon_drain(:,:,:)
  prunoff(:,:,:) = zread_latlon_runoff(:,:,:)
  psrc_flood(:,:,:) = zread_latlon_src_flood(:,:,:)
!
ELSE
!        
! * Vector case
!
  CALL read_trip(kluout,cfile_frc,cdrain ,zread_vector_drain(:,:))
  CALL read_trip(kluout,cfile_frc,crunoff,zread_vector_runoff(:,:))
!
  WHERE(zread_vector_drain(:,:)==xundef)zread_vector_drain(:,:)=0.0
  WHERE(zread_vector_runoff(:,:)==xundef)zread_vector_runoff(:,:)=0.0
!
  IF(len_trim(csrc_flood)/=0)THEN
    CALL read_trip(kluout,cfile_frc,csrc_flood,zread_vector_src_flood(:,:))
    WHERE(zread_vector_src_flood(:,:)==xundef)zread_vector_src_flood(:,:)=0.0
  ELSE
    zread_vector_src_flood(:,:) = 0.0
  ENDIF
!
  IF(lcumfrc)THEN
    DO jstep = knb_tstep_run,2,-1
       zread_vector_drain(:,jstep) = zread_vector_drain(:,jstep) - zread_vector_drain(:,jstep-1)
       zread_vector_runoff(:,jstep) = zread_vector_runoff(:,jstep) - zread_vector_runoff(:,jstep-1)
       zread_vector_src_flood(:,jstep) = zread_vector_src_flood(:,jstep) - zread_vector_src_flood(:,jstep-1)
    ENDDO
  ENDIF
!  
  icount=0
  DO jlat=1,klat
     DO jlon=1,klon
        icount=icount+1
        pdrain(jlon,jlat,:)= zread_vector_drain(icount,:)
        prunoff(jlon,jlat,:)= zread_vector_runoff(icount,:)
        psrc_flood(jlon,jlat,:)= zread_vector_src_flood(icount,:)
     ENDDO
  ENDDO
!
ENDIF
!
DO jstep=1,knb_tstep_run
   pdrain(:,:,jstep) = pdrain(:,:,jstep)*tpg%XAREA(:,:)
   prunoff(:,:,jstep) = prunoff(:,:,jstep)*tpg%XAREA(:,:)
   psrc_flood(:,:,jstep) = psrc_flood(:,:,jstep)*tpg%XAREA(:,:)
ENDDO
!
IF (lhook) CALL dr_hook('TRIP_FORCING',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE trip_forcing