Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
! ######spl
FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ###############################################
!
!!**** *CART_COMPRESS* - function to compress the Source in CART case.
!!
!!
!! PURPOSE
!! -------
! This function compresses or not the Source XVARS of the VARiable
! VAR whose budget is analysed. This compression is controlled by 3
! logical switches for the budget in I,J and K directions (LBU_ICP,
! LBU_JCP, LBU_KCP), in the budget box described by the lowest and
! highest values of the I,J and K indices.
!
!!** METHOD
!! ------
!! The source PVARS is first transfered in a local array whose
!! dimensions correspond to the budget box. Then compressions
!! are or aren't achieved depending on the logical switches.
!!
!! EXTERNAL
!! --------
!! NONE
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_BUDGET
!! LBU_ICP : switch for compression in I direction
!! LBU_JCP : switch for compression in J direction
!! LBU_KCP : switch for compression in K direction
!! NBUIL : lowest I indice value of the budget box
!! NBUJL : lowest J indice value of the budget box
!! NBUKL : lowest K indice value of the budget box
!! NBUIH : highest I indice value of the budget box
!! NBUJH : highest J indice value of the budget box
!! NBUKH : highest K indice value of the budget box
!! NBUIMAX : dimension along I of the budget tabular
!! NBUJMAX : dimension along J of the budget tabular
!! NBUKMAX : dimension along K of the budget tabular
!!
!!
!!
!! REFERENCE
!! ---------
!! Book2 of MESO-NH documentation (function CART_COMPRESS)
!!
!!
!! AUTHOR
!! ------
!! J. Nicolau * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 27/02/95
!! JP Pinty & J Escobar 12/10/98 Enable vectorization and remove
!! SUM functions
!! V. Ducrocq 4/06/99 //
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_BUDGET
!
!
IMPLICIT NONE
!
!
!* 0.1 Declarations of arguments and result :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
!
!* 0.2 Declarations of local variables :
!
!
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZVARS ! 3D Work
! array
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUKH-NBUKL+1) :: ZWORKIK ! 2D Work array
REAL, DIMENSION (NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZWORKJK ! 2D Work array
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1) :: ZWORKIJ ! 2D Work array
!
INTEGER :: JJ,JK ! loop indexes
!
!
!-------------------------------------------------------------------------------
!
!* 1. SOURCE TRANSFERT IN A LOCAL ARRAY
! ---------------------------------
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!JUAN
IF (SIZE (PCOMPRESS) .EQ. 0 ) RETURN
!JUAN
!
IF (LHOOK) CALL DR_HOOK('CART_COMPRESS',0,ZHOOK_HANDLE)
ZVARS(1:NBUSIH-NBUSIL+1,1:NBUSJH-NBUSJL+1,1:NBUKH-NBUKL+1) = &
PVARS(NBUSIL:NBUSIH,NBUSJL:NBUSJH,NBUKL:NBUKH)
!
!-------------------------------------------------------------------------------
!
!* 2. COMPRESSIONS IN I,J AND K DIRECTIONS
! ------------------------------------
!
!
IF (LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
PCOMPRESS(1,1,1)=SUM(ZVARS)
!
ELSE IF (LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
ZWORKJK(:,:) =SUM(ZVARS,1)
PCOMPRESS(1,1,:)=SUM(ZWORKJK,1)
!
ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
ZWORKIJ(:,:)=0.0
DO JK = 1,NBUKH-NBUKL+1
ZWORKIJ(:,:) = ZWORKIJ(:,:) + ZVARS(:,:,JK)
END DO
PCOMPRESS(1,:,1)=SUM(ZWORKIJ,1)
!
ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
ZWORKIK(:,:)=0.0
DO JJ = 1,NBUSJH-NBUSJL+1
ZWORKIK(:,:) = ZWORKIK(:,:) + ZVARS(:,JJ,:)
END DO
PCOMPRESS(:,1,1)=SUM(ZWORKIK,2)
!
ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND..NOT.LBU_KCP) THEN
PCOMPRESS(1,:,:)=SUM(ZVARS,1)
!
ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
PCOMPRESS(:,1,:)=SUM(ZVARS,2)
!
ELSE IF (.NOT.LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
PCOMPRESS(:,:,1)=SUM(ZVARS,3)
!
ELSE
PCOMPRESS=ZVARS
!
END IF
!
!
IF (LHOOK) CALL DR_HOOK('CART_COMPRESS',1,ZHOOK_HANDLE)
END FUNCTION CART_COMPRESS