trip_forcing_conf.F90

Go to the documentation of this file.

!######
SUBROUTINE trip_forcing_conf(KLISTING,KYEAR,KMONTH,KDAY,PTIME,  &
                             HFILE_FRC,HREADFRC,HDRAIN,HRUNOFF, &
                             KLON,KLAT,PTSTEP_RUN,KNB_TSTEP_RUN,&
                             PRUNTIME                          )
!#######################################################################
!
!!****  *TRIP_FORCING_CONF* - prepare the dimenssions (xt or xyt) of run
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. decharme   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/2008 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_trip_par,    ONLY : xday
!
USE modi_abort_trip
USE modi_read_dimlen
USE modi_read_forcing_date
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
INTEGER,                INTENT(IN)  :: KLISTING
INTEGER,                INTENT(IN)  :: KYEAR
INTEGER,                INTENT(IN)  :: KMONTH
INTEGER,                INTENT(IN)  :: KDAY
REAL,                   INTENT(IN)  :: PTIME
!
 CHARACTER(LEN=15),      INTENT(IN)  :: HFILE_FRC
 CHARACTER(LEN=6),       INTENT(IN)  :: HREADFRC 
 CHARACTER(LEN=8),       INTENT(IN)  :: HDRAIN 
 CHARACTER(LEN=8),       INTENT(IN)  :: HRUNOFF 
INTEGER,                INTENT(IN)  :: KLON
INTEGER,                INTENT(IN)  :: KLAT
REAL,                   INTENT(IN)  :: PTSTEP_RUN
!
INTEGER,                INTENT(OUT) :: KNB_TSTEP_RUN
REAL,                   INTENT(OUT) :: PRUNTIME
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER, DIMENSION (:), ALLOCATABLE :: IDIMLEN
!
INTEGER :: INDIM
INTEGER :: ILON
INTEGER :: ILAT
INTEGER :: INI
INTEGER :: IWORK1, IWORK2
!
INTEGER :: IYEAR
INTEGER :: IMONTH
INTEGER :: IDAY
REAL    :: ZTIME
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
! Read the configuration of the run
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('TRIP_FORCING_CONF',0,zhook_handle)
!
IF(hreadfrc=='VECTOR')THEN
  indim=2
ELSE
  indim=3
ENDIF 
!
ALLOCATE(idimlen(indim))
idimlen=0
!
 CALL read_dimlen(klisting,hfile_frc,hdrain,indim,idimlen)
!
IF(hreadfrc=='VECTOR')THEN
!        
  ini    = idimlen(1)
  iwork1 = idimlen(2)
!  
  IF(ini/=klon*klat)THEN
     WRITE(klisting,*)'For the variable DRAIN : '
     WRITE(klisting,*)'TRIP_FORCING_CONF : The number of points in the forcing variables (',ini,')'
     WRITE(klisting,*)'are /= of the number of points in the TRIP domain'
     WRITE(klisting,*)'NLON = ',klon,' and NLAT = ',klat,' so the number of points = ',klon*klat
     CALL abort_trip('TRIP_FORCING_CONF: number of points in the forcing variables are /= than TRIP domain')
  ENDIF
!
ELSE
!        
  ilon   = idimlen(1)
  ilat   = idimlen(2)
  iwork1 = idimlen(3)
  ini    = ilon*ilat
!  
  IF(ini/=klon*klat)THEN
     WRITE(klisting,*)'For the variable DRAIN : '
     WRITE(klisting,*)'TRIP_FORCING_CONF : The number of points in the forcing variables (',ilon*ilat,')'
     WRITE(klisting,*)'are /= of the number of points in the TRIP domain'
     WRITE(klisting,*)'NLON = ',klon,' and NLAT = ',klat,' while FRC_LON = ',ilon,' and FRC_LAT = ',ilat
     CALL abort_trip('TRIP_FORCING_CONF: number of points in the forcing variables are /= than TRIP domain')
  ENDIF
!        
ENDIF 
!
idimlen=0
!
 CALL read_dimlen(klisting,hfile_frc,hrunoff,indim,idimlen)
!
IF(hreadfrc=='VECTOR')THEN
!        
  ini    = idimlen(1)
  iwork2 = idimlen(2)
!  
  IF(ini/=klon*klat)THEN
     WRITE(klisting,*)'For the variable RUNOFF : '
     WRITE(klisting,*)'TRIP_FORCING_CONF : The number of points in the forcing variables (',ini,')'
     WRITE(klisting,*)'are /= of the number of points in the TRIP domain'
     WRITE(klisting,*)'NLON = ',klon,' and NLAT = ',klat,' so the number of points = ',klon*klat
     CALL abort_trip('TRIP_FORCING_CONF: number of points in the forcing variables are /= than TRIP domain')
  ENDIF
!
ELSE
!        
  ilon   = idimlen(1)
  ilat   = idimlen(2)
  iwork2 = idimlen(3)
  ini    = ilon*ilat
!  
  IF(ini/=klon*klat)THEN
     WRITE(klisting,*)'For the variable RUNOFF : '
     WRITE(klisting,*)'TRIP_FORCING_CONF : The number of points in the forcing variables (',ilon*ilat,')'
     WRITE(klisting,*)'are different than the number of points in the TRIP domain'
     WRITE(klisting,*)'NLON = ',klon,' and NLAT = ',klat,' while FRC_LON = ',ilon,' and FRC_LAT = ',ilat
     CALL abort_trip('TRIP_FORCING_CONF: number of points in the forcing variables are /= than TRIP domain')
  ENDIF
!        
ENDIF 
!
DEALLOCATE(idimlen)
!
!-------------------------------------------------------------------------------
! Configuration of the run
!-------------------------------------------------------------------------------
!
! * Number of time step during the run
!
IF(iwork1/=iwork2)THEN
  WRITE(klisting,*)'TRIP_FORCING_CONF : The number of time step are different for each forcing variable !'
  WRITE(klisting,*)'NB_TSTEP for DRAIN = ',iwork1,' while NB_TSTEP for RUNOFF = ',iwork2
  CALL abort_trip('TRIP_FORCING_CONF: The number of time step are different for each forcing variable')
ELSE
  knb_tstep_run = iwork1
ENDIF
!
pruntime = REAL(KNB_TSTEP_RUN) * PTSTEP_RUN
!
! * Date the run
!
 CALL read_forcing_date(klisting,hfile_frc,knb_tstep_run, &
                       iyear,imonth,iday,ztime           )
!
IF ( (kyear /= iyear) .OR. (kmonth /= imonth) .OR. (kday /= iday) .OR. (ptime /= ztime)) THEN
  WRITE(klisting,*)' DATE INCONSISTENCY: RESTART FILE = ',kyear,kmonth,kday,ptime
  WRITE(klisting,*)' DATE INCONSISTENCY: FORCING FILE = ',iyear,imonth,iday,ztime
  CALL abort_trip('TRIP_FORCING_CONF: DATE INCONSISTENCY')
ENDIF
!
IF (lhook) CALL dr_hook('TRIP_FORCING_CONF',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE trip_forcing_conf