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.EQ.36) THEN
    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
  ELSEIF (ntime2.EQ.12) THEN
    zdata=pdata(:,1:2,:)
    DO jj=1,3
      pdata(:,jj,:)=zdata(:,1,:)  !until 20 march
    ENDDO
    DO jj=4,9
      pdata(:,jj,:)=zdata(:,2,:) !from 21 march to 20 september
    ENDDO
    DO jj=10,12
      pdata(:,jj,:)=zdata(:,1,:) !from 21 september to 31 december
    ENDDO          
  ELSE
    CALL abor1_sfx('PUT_IN_TIME: WITH NTIME1=2, NTIME2 MUST BE =36 OR =12 (WINTER AND SUMMER VALUES) '//&
                   'PROBLEM VAR '//hname//''//htype)          
  ENDIF
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