put_in_time.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.
SUBROUTINE put_in_time(HNAME,HTYPE,NTIME1,NTIME2,PDATA)

USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb

USE modi_abor1_sfx

IMPLICIT NONE

 CHARACTER(LEN=*), INTENT(IN) :: hname
 CHARACTER(LEN=3), INTENT(IN) :: htype

INTEGER, INTENT(IN) :: ntime1
INTEGER, INTENT(IN) :: ntime2
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: pdata

 CHARACTER(LEN=2) :: ytime1, ytime2
INTEGER :: i1, i2, jj, jtime
REAL, DIMENSION(SIZE(PDATA,1),NTIME1,SIZE(PDATA,3)) :: zdata
REAL(KIND=JPRB) :: zhook_handle


IF (lhook) CALL dr_hook('PUT_IN_TIME',0,zhook_handle)

IF (ntime1.LE.0 .OR. ntime1.GT.ntime2) THEN
  CALL abor1_sfx("PUT_IN_TIME: NTIME1 MUST BE <= NTIME2 AND > 0")
ELSEIF (ntime1==ntime2) THEN
  IF (lhook) CALL dr_hook('PUT_IN_TIME',1,zhook_handle)
  RETURN
ELSEIF (ntime1==1) THEN
  DO jj=2,ntime2
    pdata(:,jj,:)=pdata(:,1,:)
  ENDDO
ELSEIF (ntime1==2) THEN !2 values: winter and summer
  IF (ntime2.NE.36) THEN
      CALL abor1_sfx('PUT_IN_TIME: WITH NTIME1=2, NTIME2 MUST BE =36 (WINTER AND SUMMER VALUES) '//&
                     'PROBLEM VAR '//hname//''//htype)
  ENDIF
  zdata=pdata(:,1:2,:)
  DO jj=1,8
    pdata(:,jj,:)=zdata(:,1,:)  !until 20 march
  ENDDO
  DO jj=9,26
    pdata(:,jj,:)=zdata(:,2,:) !from 21 march to 20 september
  ENDDO
  DO jj=27,36
    pdata(:,jj,:)=zdata(:,1,:) !from 21 september to 31 december
  ENDDO
ELSE
  i1=ntime2/ntime1
  i2=ntime2/i1  
  IF (i2.NE.ntime1)THEN
     WRITE(ytime1,'(I2.2)')ntime1
     WRITE(ytime2,'(I2.2)')ntime2
     CALL abor1_sfx('PUT_INT_TIME: NTIME2 (='//ytime2(1:len_trim(ytime2))          // &
                    ') MUST BE A MULTIPLE OF NTIME1 (='//ytime1(1:len_trim(ytime1))// &
                    ') PROBLEM VAR '//hname//''//htype)
  ENDIF
  zdata=pdata(:,1:ntime1,:)
  DO jtime=1,ntime1
    DO jj=(jtime-1)*i1+1,jtime*i1
      pdata(:,jj,:)=zdata(:,jtime,:)
    ENDDO
  ENDDO
ENDIF

IF (lhook) CALL dr_hook('PUT_IN_TIME',1,zhook_handle)

END SUBROUTINE put_in_time