source: LMDZ4/branches/LMDZ4V5.0-dev/libf/cosp/cosp_utils.F90 @ 5423

Last change on this file since 5423 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210
File size: 10.6 KB
Line 
1! (c) British Crown Copyright 2008, the Met Office.
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without modification, are permitted
5! provided that the following conditions are met:
6!
7!     * Redistributions of source code must retain the above copyright notice, this list
8!       of conditions and the following disclaimer.
9!     * Redistributions in binary form must reproduce the above copyright notice, this list
10!       of conditions and the following disclaimer in the documentation and/or other materials
11!       provided with the distribution.
12!     * Neither the name of the Met Office nor the names of its contributors may be used
13!       to endorse or promote products derived from this software without specific prior written
14!       permission.
15!
16! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
17! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
18! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
19! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
20! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
21! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
22! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
23! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
24
25!
26! History:
27! Jul 2007 - A. Bodas-Salcedo - Initial version
28!
29
30MODULE MOD_COSP_UTILS
31  USE MOD_COSP_CONSTANTS
32  IMPLICIT NONE
33
34  INTERFACE Z_TO_DBZ
35    MODULE PROCEDURE Z_TO_DBZ_2D,Z_TO_DBZ_3D,Z_TO_DBZ_4D
36  END INTERFACE
37
38  INTERFACE COSP_CHECK_INPUT
39    MODULE PROCEDURE COSP_CHECK_INPUT_1D,COSP_CHECK_INPUT_2D,COSP_CHECK_INPUT_3D
40  END INTERFACE
41CONTAINS
42
43
44!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
45!------------------- SUBROUTINE ZERO_INT -------------------------
46!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
47ELEMENTAL SUBROUTINE ZERO_INT(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
48                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
49                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
50
51  integer,intent(inout) :: x
52  integer,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
53                                    y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
54                                    y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
55  x = 0
56  if (present(y01)) y01 = 0
57  if (present(y02)) y02 = 0
58  if (present(y03)) y03 = 0
59  if (present(y04)) y04 = 0
60  if (present(y05)) y05 = 0
61  if (present(y06)) y06 = 0
62  if (present(y07)) y07 = 0
63  if (present(y08)) y08 = 0
64  if (present(y09)) y09 = 0
65  if (present(y10)) y10 = 0
66  if (present(y11)) y11 = 0
67  if (present(y12)) y12 = 0
68  if (present(y13)) y13 = 0
69  if (present(y14)) y14 = 0
70  if (present(y15)) y15 = 0
71  if (present(y16)) y16 = 0
72  if (present(y17)) y17 = 0
73  if (present(y18)) y18 = 0
74  if (present(y19)) y19 = 0
75  if (present(y20)) y20 = 0
76  if (present(y21)) y21 = 0
77  if (present(y22)) y22 = 0
78  if (present(y23)) y23 = 0
79  if (present(y24)) y24 = 0
80  if (present(y25)) y25 = 0
81  if (present(y26)) y26 = 0
82  if (present(y27)) y27 = 0
83  if (present(y28)) y28 = 0
84  if (present(y29)) y29 = 0
85  if (present(y30)) y30 = 0
86END SUBROUTINE  ZERO_INT
87
88!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
89!------------------- SUBROUTINE ZERO_REAL ------------------------
90!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91ELEMENTAL SUBROUTINE ZERO_REAL(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
92                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
93                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
94
95  real,intent(inout) :: x
96  real,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
97                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
98                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
99  x = 0.0
100  if (present(y01)) y01 = 0.0
101  if (present(y02)) y02 = 0.0
102  if (present(y03)) y03 = 0.0
103  if (present(y04)) y04 = 0.0
104  if (present(y05)) y05 = 0.0
105  if (present(y06)) y06 = 0.0
106  if (present(y07)) y07 = 0.0
107  if (present(y08)) y08 = 0.0
108  if (present(y09)) y09 = 0.0
109  if (present(y10)) y10 = 0.0
110  if (present(y11)) y11 = 0.0
111  if (present(y12)) y12 = 0.0
112  if (present(y13)) y13 = 0.0
113  if (present(y14)) y14 = 0.0
114  if (present(y15)) y15 = 0.0
115  if (present(y16)) y16 = 0.0
116  if (present(y17)) y17 = 0.0
117  if (present(y18)) y18 = 0.0
118  if (present(y19)) y19 = 0.0
119  if (present(y20)) y20 = 0.0
120  if (present(y21)) y21 = 0.0
121  if (present(y22)) y22 = 0.0
122  if (present(y23)) y23 = 0.0
123  if (present(y24)) y24 = 0.0
124  if (present(y25)) y25 = 0.0
125  if (present(y26)) y26 = 0.0
126  if (present(y27)) y27 = 0.0
127  if (present(y28)) y28 = 0.0
128  if (present(y29)) y29 = 0.0
129  if (present(y30)) y30 = 0.0
130END SUBROUTINE  ZERO_REAL
131
132!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
133!--------------------- SUBROUTINE Z_TO_DBZ_2D --------------------
134!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
135  SUBROUTINE Z_TO_DBZ_2D(mdi,z)
136    real,intent(in) :: mdi
137    real,dimension(:,:),intent(inout) :: z
138    ! Reflectivity Z:
139    ! Input in [m3]
140    ! Output in dBZ, with Z in [mm6 m-3]
141   
142    ! 1.e18 to convert from [m3] to [mm6 m-3]
143    z = 1.e18*z
144    where (z > 1.0e-6) ! Limit to -60 dBZ
145      z = 10.0*log10(z)
146    elsewhere
147      z = mdi
148    end where 
149  END SUBROUTINE Z_TO_DBZ_2D
150!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
151!--------------------- SUBROUTINE Z_TO_DBZ_3D --------------------
152!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
153  SUBROUTINE Z_TO_DBZ_3D(mdi,z)
154    real,intent(in) :: mdi
155    real,dimension(:,:,:),intent(inout) :: z
156    ! Reflectivity Z:
157    ! Input in [m3]
158    ! Output in dBZ, with Z in [mm6 m-3]
159   
160    ! 1.e18 to convert from [m3] to [mm6 m-3]
161    z = 1.e18*z
162    where (z > 1.0e-6) ! Limit to -60 dBZ
163      z = 10.0*log10(z)
164    elsewhere
165      z = mdi
166    end where 
167  END SUBROUTINE Z_TO_DBZ_3D
168!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
169!--------------------- SUBROUTINE Z_TO_DBZ_4D --------------------
170!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
171  SUBROUTINE Z_TO_DBZ_4D(mdi,z)
172    real,intent(in) :: mdi
173    real,dimension(:,:,:,:),intent(inout) :: z
174    ! Reflectivity Z:
175    ! Input in [m3]
176    ! Output in dBZ, with Z in [mm6 m-3]
177   
178    ! 1.e18 to convert from [m3] to [mm6 m-3]
179    z = 1.e18*z
180    where (z > 1.0e-6) ! Limit to -60 dBZ
181      z = 10.0*log10(z)
182    elsewhere
183      z = mdi
184    end where 
185  END SUBROUTINE Z_TO_DBZ_4D
186
187!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
188!----------------- SUBROUTINES COSP_CHECK_INPUT_1D ---------------
189!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
190  SUBROUTINE COSP_CHECK_INPUT_1D(vname,x,min_val,max_val)
191    character(len=*) :: vname
192    real,intent(inout) :: x(:)
193    real,intent(in),optional :: min_val,max_val
194    logical :: l_min,l_max
195    character(len=128) :: pro_name='COSP_CHECK_INPUT_1D'
196   
197    l_min=.false.
198    l_max=.false.
199   
200    if (present(min_val)) then
201!       if (x < min_val) x = min_val
202      if (any(x < min_val)) then
203      l_min = .true.
204        where (x < min_val)
205          x = min_val
206        end where
207      endif
208    endif   
209    if (present(max_val)) then
210!       if (x > max_val) x = max_val
211      if (any(x > max_val)) then
212        l_max = .true.
213        where (x > max_val)
214          x = max_val
215        end where 
216      endif   
217    endif   
218   
219    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
220    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
221  END SUBROUTINE COSP_CHECK_INPUT_1D
222!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
223!----------------- SUBROUTINES COSP_CHECK_INPUT_2D ---------------
224!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
225  SUBROUTINE COSP_CHECK_INPUT_2D(vname,x,min_val,max_val)
226    character(len=*) :: vname
227    real,intent(inout) :: x(:,:)
228    real,intent(in),optional :: min_val,max_val
229    logical :: l_min,l_max
230    character(len=128) :: pro_name='COSP_CHECK_INPUT_2D'
231   
232    l_min=.false.
233    l_max=.false.
234   
235    if (present(min_val)) then
236!       if (x < min_val) x = min_val
237      if (any(x < min_val)) then
238      l_min = .true.
239        where (x < min_val)
240          x = min_val
241        end where
242      endif
243    endif   
244    if (present(max_val)) then
245!       if (x > max_val) x = max_val
246      if (any(x > max_val)) then
247        l_max = .true.
248        where (x > max_val)
249          x = max_val
250        end where 
251      endif   
252    endif   
253   
254    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
255    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
256  END SUBROUTINE COSP_CHECK_INPUT_2D
257!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
258!----------------- SUBROUTINES COSP_CHECK_INPUT_3D ---------------
259!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
260  SUBROUTINE COSP_CHECK_INPUT_3D(vname,x,min_val,max_val)
261    character(len=*) :: vname
262    real,intent(inout) :: x(:,:,:)
263    real,intent(in),optional :: min_val,max_val
264    logical :: l_min,l_max
265    character(len=128) :: pro_name='COSP_CHECK_INPUT_3D'
266   
267    l_min=.false.
268    l_max=.false.
269   
270    if (present(min_val)) then
271!       if (x < min_val) x = min_val
272      if (any(x < min_val)) then
273      l_min = .true.
274        where (x < min_val)
275          x = min_val
276        end where
277      endif
278    endif   
279    if (present(max_val)) then
280!       if (x > max_val) x = max_val
281      if (any(x > max_val)) then
282        l_max = .true.
283        where (x > max_val)
284          x = max_val
285        end where 
286      endif   
287    endif   
288   
289    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
290    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
291  END SUBROUTINE COSP_CHECK_INPUT_3D
292
293
294END MODULE MOD_COSP_UTILS
Note: See TracBrowser for help on using the repository browser.