7 USE yomhook
,ONLY : lhook, dr_hook
8 USE parkind1
,ONLY : jprb
14 CHARACTER(LEN=*),
INTENT(IN) :: hname
15 CHARACTER(LEN=3),
INTENT(IN) :: htype
17 INTEGER,
INTENT(IN) :: ntime1
18 INTEGER,
INTENT(IN) :: ntime2
19 REAL,
DIMENSION(:,:,:),
INTENT(INOUT) :: pdata
21 CHARACTER(LEN=2) :: ytime1, ytime2
22 INTEGER :: i1, i2, jj, jtime
23 REAL,
DIMENSION(SIZE(PDATA,1),NTIME1,SIZE(PDATA,3)) :: zdata
24 REAL(KIND=JPRB) :: zhook_handle
27 IF (lhook) CALL dr_hook(
'PUT_IN_TIME',0,zhook_handle)
29 IF (ntime1.LE.0 .OR. ntime1.GT.ntime2)
THEN
30 CALL
abor1_sfx(
"PUT_IN_TIME: NTIME1 MUST BE <= NTIME2 AND > 0")
31 ELSEIF (ntime1==ntime2)
THEN
32 IF (lhook) CALL dr_hook(
'PUT_IN_TIME',1,zhook_handle)
34 ELSEIF (ntime1==1)
THEN
36 pdata(:,jj,:)=pdata(:,1,:)
38 ELSEIF (ntime1==2)
THEN
39 IF (ntime2.NE.36)
THEN
40 CALL
abor1_sfx(
'PUT_IN_TIME: WITH NTIME1=2, NTIME2 MUST BE =36 (WINTER AND SUMMER VALUES) '//&
41 'PROBLEM VAR '//hname//
''//htype)
45 pdata(:,jj,:)=zdata(:,1,:)
48 pdata(:,jj,:)=zdata(:,2,:)
51 pdata(:,jj,:)=zdata(:,1,:)
57 WRITE(ytime1,
'(I2.2)')ntime1
58 WRITE(ytime2,
'(I2.2)')ntime2
59 CALL
abor1_sfx(
'PUT_INT_TIME: NTIME2 (='//ytime2(1:len_trim(ytime2)) // &
60 ') MUST BE A MULTIPLE OF NTIME1 (='//ytime1(1:len_trim(ytime1))// &
61 ') PROBLEM VAR '//hname//
''//htype)
63 zdata=pdata(:,1:ntime1,:)
65 DO jj=(jtime-1)*i1+1,jtime*i1
66 pdata(:,jj,:)=zdata(:,jtime,:)
71 IF (lhook) CALL dr_hook(
'PUT_IN_TIME',1,zhook_handle)
subroutine abor1_sfx(YTEXT)
subroutine put_in_time(HNAME, HTYPE, NTIME1, NTIME2, PDATA)