source: LMDZ6/trunk/libf/phylmd/ecrad/radiation_check.F90 @ 4629

Last change on this file since 4629 was 4489, checked in by lguez, 19 months ago

Merge LMDZ_ECRad branch back into trunk!

File size: 6.6 KB
Line 
1! radiation_check.F90 - Checking routines
2!
3! (C) Copyright 2020- ECMWF.
4!
5! This software is licensed under the terms of the Apache Licence Version 2.0
6! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
7!
8! In applying this licence, ECMWF does not waive the privileges and immunities
9! granted to it by virtue of its status as an intergovernmental organisation
10! nor does it submit to any jurisdiction.
11!
12! Author:  Robin Hogan
13! Email:   r.j.hogan@ecmwf.int
14! License: see the COPYING file for details
15!
16
17module radiation_check
18
19  use parkind1, only : jprb
20
21  implicit none
22  public
23
24contains
25
26  !---------------------------------------------------------------------
27  ! Return .true. if 1D allocatable array "var" is out of physical
28  ! range specified by boundmin and boundmax, and issue a warning.
29  ! "do_fix" determines whether erroneous values are fixed to lie
30  ! within the physical range. To check only a subset of the array,
31  ! specify i1 and i2 for the range.
32  function out_of_bounds_1d(var, var_name, boundmin, boundmax, do_fix, i1, i2) result (is_bad)
33
34    use radiation_io,     only : nulout
35
36    real(jprb), allocatable, intent(inout) :: var(:)
37    character(len=*),        intent(in) :: var_name
38    real(jprb),              intent(in) :: boundmin, boundmax
39    logical,                 intent(in) :: do_fix
40    integer,       optional, intent(in) :: i1, i2
41
42    logical                       :: is_bad
43
44    real(jprb) :: varmin, varmax
45
46    is_bad = .false.
47
48    if (allocated(var)) then
49
50      if (present(i1) .and. present(i2)) then
51        varmin = minval(var(i1:i2))
52        varmax = maxval(var(i1:i2))
53      else
54        varmin = minval(var)
55        varmax = maxval(var)
56      end if
57
58      if (varmin < boundmin .or. varmax > boundmax) then
59        write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
60             &  '*** Warning: ', var_name, ' range', varmin, ' to', varmax, &
61             &  ' is out of physical range', boundmin, 'to', boundmax
62        is_bad = .true.
63        if (do_fix) then
64          if (present(i1) .and. present(i2)) then
65            var(i1:i2) = max(boundmin, min(boundmax, var(i1:i2)))
66          else
67            var = max(boundmin, min(boundmax, var))
68          end if
69          write(nulout,'(a)') ': corrected'
70        else
71          write(nulout,'(1x)')
72        end if
73      end if
74
75    end if
76   
77  end function out_of_bounds_1d
78
79
80  !---------------------------------------------------------------------
81  ! Return .true. if 2D allocatable array "var" is out of physical
82  ! range specified by boundmin and boundmax, and issue a warning.  To
83  ! check only a subset of the array, specify i1 and i2 for the range
84  ! of the first dimension and j1 and j2 for the range of the second.
85  function out_of_bounds_2d(var, var_name, boundmin, boundmax, do_fix, &
86       &                    i1, i2, j1, j2) result (is_bad)
87
88    use radiation_io,     only : nulout
89
90    real(jprb), allocatable, intent(inout) :: var(:,:)
91    character(len=*),        intent(in) :: var_name
92    real(jprb),              intent(in) :: boundmin, boundmax
93    logical,                 intent(in) :: do_fix
94    integer,       optional, intent(in) :: i1, i2, j1, j2
95
96    ! Local copies of indices
97    integer :: ii1, ii2, jj1, jj2
98
99    logical                       :: is_bad
100
101    real(jprb) :: varmin, varmax
102
103    is_bad = .false.
104
105    if (allocated(var)) then
106
107      if (present(i1) .and. present(i2)) then
108        ii1 = i1
109        ii2 = i2
110      else
111        ii1 = lbound(var,1)
112        ii2 = ubound(var,1)
113      end if
114      if (present(j1) .and. present(j2)) then
115        jj1 = j1
116        jj2 = j2
117      else
118        jj1 = lbound(var,2)
119        jj2 = ubound(var,2)
120      end if
121      varmin = minval(var(ii1:ii2,jj1:jj2))
122      varmax = maxval(var(ii1:ii2,jj1:jj2))
123
124      if (varmin < boundmin .or. varmax > boundmax) then
125        write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
126             &  '*** Warning: ', var_name, ' range', varmin, ' to', varmax,&
127             &  ' is out of physical range', boundmin, 'to', boundmax
128        is_bad = .true.
129        if (do_fix) then
130          var(ii1:ii2,jj1:jj2) = max(boundmin, min(boundmax, var(ii1:ii2,jj1:jj2)))
131          write(nulout,'(a)') ': corrected'
132        else
133          write(nulout,'(1x)')
134        end if
135      end if
136
137    end if
138   
139  end function out_of_bounds_2d
140
141
142  !---------------------------------------------------------------------
143  ! Return .true. if 3D allocatable array "var" is out of physical
144  ! range specified by boundmin and boundmax, and issue a warning.  To
145  ! check only a subset of the array, specify i1 and i2 for the range
146  ! of the first dimension, j1 and j2 for the second and k1 and k2 for
147  ! the third.
148  function out_of_bounds_3d(var, var_name, boundmin, boundmax, do_fix, &
149       &                    i1, i2, j1, j2, k1, k2) result (is_bad)
150
151    use radiation_io,     only : nulout
152
153    real(jprb), allocatable, intent(inout) :: var(:,:,:)
154    character(len=*),        intent(in) :: var_name
155    real(jprb),              intent(in) :: boundmin, boundmax
156    logical,                 intent(in) :: do_fix
157    integer,       optional, intent(in) :: i1, i2, j1, j2, k1, k2
158
159    ! Local copies of indices
160    integer :: ii1, ii2, jj1, jj2, kk1, kk2
161
162    logical                       :: is_bad
163
164    real(jprb) :: varmin, varmax
165
166    is_bad = .false.
167
168    if (allocated(var)) then
169
170      if (present(i1) .and. present(i2)) then
171        ii1 = i1
172        ii2 = i2
173      else
174        ii1 = lbound(var,1)
175        ii2 = ubound(var,1)
176      end if
177      if (present(j1) .and. present(j2)) then
178        jj1 = j1
179        jj2 = j2
180      else
181        jj1 = lbound(var,2)
182        jj2 = ubound(var,2)
183      end if
184      if (present(k1) .and. present(k2)) then
185        kk1 = k1
186        kk2 = k2
187      else
188        kk1 = lbound(var,3)
189        kk2 = ubound(var,3)
190      end if
191      varmin = minval(var(ii1:ii2,jj1:jj2,kk1:kk2))
192      varmax = maxval(var(ii1:ii2,jj1:jj2,kk1:kk2))
193
194      if (varmin < boundmin .or. varmax > boundmax) then
195        write(nulout,'(a,a,a,g12.4,a,g12.4,a,g12.4,a,g12.4)',advance='no') &
196             &  '*** Warning: ', var_name, ' range', varmin, ' to', varmax,&
197             &  ' is out of physical range', boundmin, 'to', boundmax
198        is_bad = .true.
199        if (do_fix) then
200          var(ii1:ii2,jj1:jj2,kk1:kk2) = max(boundmin, min(boundmax, &
201               &                             var(ii1:ii2,jj1:jj2,kk1:kk2)))
202          write(nulout,'(a)') ': corrected'
203        else
204          write(nulout,'(1x)')
205        end if
206      end if
207
208    end if
209   
210  end function out_of_bounds_3d
211
212end module radiation_check
Note: See TracBrowser for help on using the repository browser.