New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
filter.f90 in branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src/filter.f90 @ 4213

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago

first draft of the CONFIGURATION MANAGER demonstrator
File size: 41.6 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: filter
6!
7! DESCRIPTION:
8!> @brief filter manager <br/>
9!>
10!> @details
11!>
12!> @author
13!> J.Paul
14! REVISION HISTORY:
15!> @date Nov, 2013 - Initial Version
16!
17!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
18!> @todo
19!----------------------------------------------------------------------
20MODULE filter
21   USE kind                            ! F90 kind parameter
22   USE phycst                          ! physical constant
23   USE logger                             ! log file manager
24   USE fct                             ! basic usefull function
25   use att                             ! attribute manager
26   USE var                             ! variable manager
27   USE extrap                          ! extrapolation manager
28   IMPLICIT NONE
29   PRIVATE
30   ! NOTE_avoid_public_variables_if_possible
31
32   ! type and variable
33
34
35   ! function and subroutine
36   PUBLIC :: filter_fill_value
37
38   PRIVATE :: filter__fill_value_wrapper
39   PRIVATE :: filter__fill_value
40   PRIVATE :: filter__3D_fill_value
41   PRIVATE :: filter__2D_fill_value
42   PRIVATE :: filter__2D
43   PRIVATE :: filter__2D_coef
44   PRIVATE :: filter__2D_hann
45   PRIVATE :: filter__2D_hamming
46   PRIVATE :: filter__2D_blackman
47   PRIVATE :: filter__2D_gauss
48   PRIVATE :: filter__2D_butterworth
49
50   INTERFACE filter_fill_value
51      MODULE PROCEDURE filter__fill_value_wrapper
52   END INTERFACE filter_fill_value
53
54CONTAINS
55   !-------------------------------------------------------------------
56   !> @brief
57   !> This subroutine filtering variable value.
58   !>
59   !> @details
60   !>
61   !> @author J.Paul
62   !> - Nov, 2013- Initial Version
63   !
64   !> @param[inout] td_var : variable
65   !-------------------------------------------------------------------
66   !> @code
67   SUBROUTINE filter__fill_value_wrapper( td_var )
68      IMPLICIT NONE
69      ! Argument
70      TYPE(TVAR), INTENT(INOUT) :: td_var
71
72      ! local variable
73      CHARACTER(LEN=lc) :: cl_filter
74      CHARACTER(LEN=lc) :: cl_method
75      INTEGER(I4)       :: il_radius
76      INTEGER(I4)       :: il_nturn
77      REAL(dp)          :: dl_cutoff 
78      REAL(dp)          :: dl_alpha
79
80      TYPE(TATT)        :: tl_att
81
82      ! loop indices
83      INTEGER(I4) :: jl
84      !----------------------------------------------------------------
85
86      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
87         CALL logger_error("FILTER FILL VALUE: no table of value "//&
88         &  "associted to variable "//TRIM(td_var%c_name) )
89      ELSE
90
91         SELECT CASE(TRIM(td_var%c_filter(1)))
92
93         CASE DEFAULT
94         
95            CALL logger_info("FILTER FILL VALUE: no filter selected "//&
96            &  "for variable "//TRIM(td_var%c_name))
97
98         CASE('hann','hamming','blackman','gauss','butterworth')
99
100            cl_method=TRIM(td_var%c_filter(1))
101
102            ! look for number of turn to be done
103            READ(td_var%c_filter(2),*) il_nturn
104            IF( il_nturn < 0 )THEN
105               CALL logger_error("FILTER FILL VALUE: invalid "//&
106               &  "number of turn ("//TRIM(td_var%c_filter(2))//")")
107            ENDIF
108
109            ! look for cut-off frequency
110            dl_cutoff=2
111            IF( TRIM(td_var%c_filter(3)) /= '' )THEN
112               READ(td_var%c_filter(3),*) dl_cutoff
113            ENDIF
114            IF( dl_cutoff < 0 )THEN
115               CALL logger_error("FILTER FILL VALUE: invalid cut-off "//&
116               &  "frequency ("//TRIM(td_var%c_filter(3))//")")
117            ENDIF
118
119            ! look for halo size
120            il_radius=1
121            IF( TRIM(td_var%c_filter(4)) /= '' )THEN
122               READ(td_var%c_filter(4),*) il_radius
123            ENDIF
124            IF( il_radius < 0 )THEN
125               CALL logger_error("FILTER FILL VALUE: invalid halo radius "//&
126               &  " ("//TRIM(td_var%c_filter(4))//")")
127            ENDIF
128
129            IF( REAL(2*il_radius+1,dp) < dl_cutoff )THEN
130               CALL logger_error("FILTER FILL VALUE: radius of halo and "//&
131               &  "spatial cut-off frequency are not suitable.")
132            ENDIF
133
134            ! look for alpha parameter
135            dl_alpha=2
136            IF( TRIM(td_var%c_filter(5)) /= '' )THEN
137               READ(td_var%c_filter(5),*) dl_alpha
138            ENDIF
139
140            SELECT CASE(TRIM(cl_method))
141            CASE('gauss','butterworth')
142               CALL logger_info("FILTER FILL VALUE: filtering "//&
143               &   " variable "//TRIM(td_var%c_name)//&
144               &   " using "//TRIM(fct_str(il_nturn))//" turn"//&
145               &   " of "//TRIM(cl_method)//" method,"//&
146               &   " with cut-off frequency of "//&
147               &        TRIM(fct_str(REAL(dl_cutoff,sp)))//&
148               &   ", halo's radius of "//&
149               &        TRIM(fct_str(il_radius))//&
150               &   ", and alpha parameter of "//&
151               &        TRIM(fct_str(REAL(dl_alpha,sp))) )
152            CASE DEFAULT
153               CALL logger_info("FILTER FILL VALUE: filtering "//&
154               &   " variable "//TRIM(td_var%c_name)//&
155               &   " using "//TRIM(fct_str(il_nturn))//" turn"//&
156               &   " of "//TRIM(cl_method)//" method,"//&
157               &   " with cut-off frequency of "//&
158               &        TRIM(fct_str(REAL(dl_cutoff,sp)))//&
159               &   " and halo's radius of "//&
160               &        TRIM(fct_str(il_radius)) )
161            END SELECT
162     
163            IF( .NOT. ANY(td_var%t_dim(1:3)%l_use) )THEN
164               ! no dimension I-J-K used
165               CALL logger_debug("FILTER FILL VALUE: no filtering can "//&
166               &  "be done for variable "//TRIM(td_var%c_name))
167            ELSE 
168
169               ! add attribute to variable
170               SELECT CASE(TRIM(cl_method))
171               CASE('gauss','butterworth')
172                  cl_filter=TRIM(fct_str(il_nturn))//'*'//TRIM(cl_method)//&
173                  &                    '('//TRIM(fct_str(REAL(dl_cutoff,sp)))//","//&
174                  &                         TRIM(fct_str(il_radius))//","//&
175                  &                         TRIM(fct_str(REAL(dl_alpha,sp)))//')'
176               CASE DEFAULT
177                  cl_filter=TRIM(fct_str(il_nturn))//'*'//TRIM(cl_method)//&
178                  &                    '('//TRIM(fct_str(REAL(dl_cutoff,sp)))//","//&
179                  &                         TRIM(fct_str(il_radius))//')'
180               END SELECT
181               tl_att=att_init('filter',cl_filter)
182               CALL var_move_att(td_var,tl_att)
183               
184               DO jl=1,il_nturn
185                  CALL filter__fill_value( td_var, TRIM(cl_method),  & 
186                  &                        dl_cutoff, il_radius, dl_alpha )
187               ENDDO
188            ENDIF               
189
190         END SELECT
191
192      ENDIF
193   END SUBROUTINE filter__fill_value_wrapper
194   !> @endcode
195   !-------------------------------------------------------------------
196   !> @brief
197   !> This subroutine filtering variable value.
198   !>
199   !> @details
200   !>
201   !> @author J.Paul
202   !> - Nov, 2013- Initial Version
203   !
204   !> @param[inout] td_var : variable
205   !> @param[in] cd_name : filter name
206   !> @param[in] dd_cutoff : cuto-off frequency
207   !> @param[in] id_radius : filter halo radius
208   !> @param[in] dd_alpha : filter parameter
209   !-------------------------------------------------------------------
210   !> @code
211   SUBROUTINE filter__fill_value( td_var, cd_name, &
212   &                              dd_cutoff, id_radius, dd_alpha )
213      IMPLICIT NONE
214      ! Argument
215      TYPE(TVAR)      , INTENT(INOUT) :: td_var
216      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
217      REAL(dp)        , INTENT(IN   ) :: dd_cutoff 
218      INTEGER(I4)     , INTENT(IN   ) :: id_radius
219      REAL(dp)        , INTENT(IN   ) :: dd_alpha
220
221      ! local variable
222      TYPE(TVAR)                                         :: tl_mask
223
224      INTEGER(i1)      , DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
225
226      ! loop indices
227      INTEGER(i4) :: jl
228      !----------------------------------------------------------------
229
230      CALL logger_debug("FILTER: "//TRIM(fct_str(td_var%d_fill)) )
231
232      !1-add extraband
233      CALL extrap_add_extrabands(td_var, id_radius, id_radius)
234
235      !2-compute mask
236      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
237      &                td_var%t_dim(2)%i_len, &
238      &                td_var%t_dim(3)%i_len, &
239      &                td_var%t_dim(4)%i_len) )
240
241      bl_mask(:,:,:,:)=1
242      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0     
243
244      tl_mask=var_init('tmask', bl_mask(:,:,:,:))
245
246      DEALLOCATE(bl_mask)
247
248      !3-extrapolate
249      CALL extrap_fill_value( td_var, id_iext=id_radius, id_jext=id_radius )
250
251      !4-filtering
252      DO jl=1,td_var%t_dim(4)%i_len
253         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
254            ! dimension I-J-K used
255            CALL filter__3D_fill_value( td_var%d_value(:,:,:,jl),       &
256            &                           td_var%d_fill, TRIM(cd_name), &
257            &                           dd_cutoff, id_radius, dd_alpha)
258         ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
259            ! dimension I-J used
260            CALL filter__2D_fill_value( td_var%d_value(:,:,1,jl),       &
261            &                           td_var%d_fill, TRIM(cd_name), &
262            &                           dd_cutoff, id_radius, dd_alpha)         
263         ELSE IF( td_var%t_dim(3)%l_use )THEN 
264            ! dimension K used
265            CALL filter__1D_fill_value( td_var%d_value(1,1,:,jl),       &
266            &                           td_var%d_fill, TRIM(cd_name), &
267            &                           dd_cutoff, id_radius, dd_alpha)         
268         ENDIF
269      ENDDO
270
271      !5-keep original mask
272      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
273         td_var%d_value(:,:,:,:)=td_var%d_fill
274      END WHERE
275
276      !6-remove extraband
277      CALL extrap_del_extrabands(td_var, id_radius, id_radius)
278
279   END SUBROUTINE filter__fill_value
280   !> @endcode
281   !-------------------------------------------------------------------
282   !> @brief This subroutine compute filtered value of 3D table.
283   !>
284   !> @details
285   !>
286   !> @warning table of value should have been already extrapolated before
287   !> running this subroutine.
288   !
289   !> @author J.Paul
290   !> - Nov, 2013- Initial Version
291   !
292   !> @param[inout] dd_value : table of value to be filtered
293   !> @param[in] dd_fill : fill value
294   !> @param[in] cd_name : filter name
295   !> @param[in] dd_cutoff : cuto-off frequency
296   !> @param[in] id_radius : filter halo radius
297   !> @param[in] dd_alpha : filter parameter
298   !-------------------------------------------------------------------
299   !> @code
300   SUBROUTINE filter__3D_fill_value( dd_value, dd_fill, cd_name, &
301   &                                 dd_cutoff, id_radius, dd_alpha)
302      IMPLICIT NONE
303      ! Argument     
304      REAL(dp)        , DIMENSION(:,:,:), INTENT(INOUT) :: dd_value
305      REAL(dp)        ,                   INTENT(IN   ) :: dd_fill
306      CHARACTER(LEN=*),                   INTENT(IN   ) :: cd_name
307      REAL(dp)        ,                   INTENT(IN   ) :: dd_cutoff
308      INTEGER(i4)     ,                   INTENT(IN   ) :: id_radius
309      REAL(dp)        ,                   INTENT(IN   ) :: dd_alpha     
310
311      ! local variable
312      INTEGER(i4), DIMENSION(3)                :: il_shape
313      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_coef
314
315      ! loop indices
316      INTEGER(i4) :: jk
317      !----------------------------------------------------------------
318     
319      il_shape(:)=SHAPE(dd_value(:,:,:))
320
321      ALLOCATE( dl_coef(2*id_radius+1,2*id_radius+1) )
322
323      dl_coef(:,:)=filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
324
325      DO jk=1,il_shape(3)
326         CALL filter__2D(dd_value(:,:,jk), dd_fill,dl_coef(:,:),id_radius)
327      ENDDO
328
329      DEALLOCATE( dl_coef )
330
331   END SUBROUTINE filter__3D_fill_value
332   !> @endcode
333   !-------------------------------------------------------------------
334   !> @brief This subroutine compute filtered value of 2D table.
335   !
336   !> @details
337   !
338   !> @warning table of value should have been already extrapolated before
339   !> running this subroutine.
340   !>
341   !> @author J.Paul
342   !> - Nov, 2013- Initial Version
343   !
344   !> @param[inout] dd_value : table of value to be filtered
345   !> @param[in] dd_fill : fill value
346   !> @param[in] cd_name : filter name
347   !> @param[in] dd_cutoff : cuto-off frequency
348   !> @param[in] id_radius : filter halo radius
349   !> @param[in] dd_alpha : filter parameter
350   !-------------------------------------------------------------------
351   !> @code
352   SUBROUTINE filter__2D_fill_value( dd_value, dd_fill, cd_name, &
353   &                                 dd_cutoff, id_radius, dd_alpha)
354      IMPLICIT NONE
355      ! Argument
356      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value
357      REAL(dp)        ,                 INTENT(IN   ) :: dd_fill
358      CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_name
359      REAL(dp)        ,                 INTENT(IN   ) :: dd_cutoff
360      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
361      REAL(dp)        ,                 INTENT(IN   ) :: dd_alpha     
362
363      ! local variable
364
365      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_coef
366      ! loop indices
367      !----------------------------------------------------------------
368
369      ALLOCATE( dl_coef(2*id_radius+1,2*id_radius+1) )
370
371      dl_coef(:,:)=filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
372
373      CALL filter__2D(dd_value(:,:), dd_fill, dl_coef(:,:), id_radius)
374
375      DEALLOCATE( dl_coef )
376
377   END SUBROUTINE filter__2D_fill_value
378   !> @endcode
379   !-------------------------------------------------------------------
380   !> @brief This subroutine compute filtered value of 1D table.
381   !
382   !> @details
383   !
384   !> @warning table of value should have been already extrapolated before
385   !> running this subroutine.
386   !>
387   !> @author J.Paul
388   !> - Nov, 2013- Initial Version
389   !
390   !> @param[inout] dd_value : table of value to be filtered
391   !> @param[in] dd_fill : fill value
392   !> @param[in] cd_name : filter name
393   !> @param[in] dd_cutoff : cuto-off frequency
394   !> @param[in] id_radius : filter halo radius
395   !> @param[in] dd_alpha : filter parameter
396   !-------------------------------------------------------------------
397   !> @code
398   SUBROUTINE filter__1D_fill_value( dd_value, dd_fill, cd_name, &
399   &                                 dd_cutoff, id_radius, dd_alpha)
400      IMPLICIT NONE
401      ! Argument     
402      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value
403      REAL(dp)        ,               INTENT(IN   ) :: dd_fill
404      CHARACTER(LEN=*),               INTENT(IN   ) :: cd_name
405      REAL(dp)        ,               INTENT(IN   ) :: dd_cutoff
406      INTEGER(i4)     ,               INTENT(IN   ) :: id_radius
407      REAL(dp)        ,               INTENT(IN   ) :: dd_alpha     
408
409      ! local variable
410
411      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_coef
412      ! loop indices
413      !----------------------------------------------------------------
414
415      ALLOCATE( dl_coef(2*id_radius+1) )
416
417      dl_coef(:)=filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
418
419      CALL filter__1D(dd_value(:), dd_fill, dl_coef(:),id_radius)
420
421      DEALLOCATE( dl_coef )
422
423   END SUBROUTINE filter__1D_fill_value
424   !> @endcode
425   !-------------------------------------------------------------------
426   !> @brief This subroutine
427   !
428   !> @details
429   !
430   !> @note
431   !> if fill value are detected in the computing area,
432   !> no filtering is done.
433   !>
434   !> @author J.Paul
435   !> - Nov, 2013- Initial Version
436   !
437   !> @param[inout] dd_value : table of value to be filtered
438   !> @param[in] dd_fill : fill value
439   !> @param[in] dd_coef :  filter coefficent table
440   !> @param[in] id_radius : filter halo radius
441   !-------------------------------------------------------------------
442   !> @code
443   SUBROUTINE filter__2D(dd_value, dd_fill, dd_coef, id_radius)
444      IMPLICIT NONE
445      ! Argument     
446      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value
447      REAL(dp)        ,                 INTENT(IN   ) :: dd_fill 
448      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_coef 
449      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
450
451      ! local variable
452      INTEGER(i4), DIMENSION(2)                :: il_shape
453      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
454      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_area
455
456      ! loop indices
457      INTEGER(i4) :: jj
458      INTEGER(i4) :: ji
459      !----------------------------------------------------------------
460      il_shape(:)=SHAPE(dd_value(:,:))
461
462      ALLOCATE(dl_value(il_shape(1),il_shape(2)))
463      dl_value(:,:)=dd_value(:,:)
464
465      ALLOCATE(dl_area(2*id_radius+1,2*id_radius+1))
466
467      DO jj=1+id_radius,il_shape(2)-id_radius
468         DO ji=1+id_radius,il_shape(1)-id_radius
469
470            dl_area(:,:)=dd_fill
471            dl_area(:,:)=dl_value(ji-id_radius:ji+id_radius, &
472            &                     jj-id_radius:jj+id_radius)
473
474            IF( ALL(dl_area(:,:)/=dd_fill) )THEN
475               dd_value(ji,jj)=SUM(dl_area(:,:)*dd_coef(:,:))
476            ENDIF
477
478         ENDDO
479      ENDDO
480
481      DEALLOCATE(dl_area)
482      DEALLOCATE(dl_value)
483
484   END SUBROUTINE filter__2D
485   !> @endcode
486   !-------------------------------------------------------------------
487   !> @brief This subroutine
488   !
489   !> @details
490   !
491   !> @author J.Paul
492   !> - Nov, 2013- Initial Version
493   !
494   !> @param[inout] dd_value : table of value to be filtered
495   !> @param[in] dd_fill : fill value
496   !> @param[in] dd_coef :  filter coefficent table
497   !> @param[in] id_radius : filter halo radius
498   !-------------------------------------------------------------------
499   !> @code
500   SUBROUTINE filter__1D(dd_value, dd_fill, dd_coef, id_radius)
501      IMPLICIT NONE
502      ! Argument     
503      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value
504      REAL(dp)        ,               INTENT(IN   ) :: dd_fill 
505      REAL(dp)        , DIMENSION(:), INTENT(IN   ) :: dd_coef 
506      INTEGER(i4)     ,               INTENT(IN   ) :: id_radius
507
508      ! local variable
509      INTEGER(i4), DIMENSION(1)                :: il_shape
510      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
511
512      ! loop indices
513      INTEGER(i4) :: ji
514      !----------------------------------------------------------------
515      il_shape(:)=SHAPE(dd_value(:))
516
517      ALLOCATE(dl_value(2*id_radius+1))
518
519      DO ji=1+id_radius,il_shape(1)-id_radius
520
521         dl_value(:)=dd_value(ji-id_radius:ji+id_radius)
522
523         IF( ANY(dl_value(:)==dd_fill) )THEN
524            CALL logger_error("FILTER FILL VALUE: fill value detected. "//&
525            &  " can't compute filtered value. "//&
526            &  "you should have extrapolate table before running "//&
527            &  " filter_fill_value")
528         ELSE
529            dd_value(ji)=SUM(dl_value(:)*dd_coef(:))
530         ENDIF
531
532      ENDDO
533
534      DEALLOCATE(dl_value)
535
536   END SUBROUTINE filter__1D
537   !> @endcode
538   !-------------------------------------------------------------------
539   !> @brief This function compute filter coefficient.
540   !
541   !> @details
542   !>
543   !> filter could be choose between :
544   !> - hann
545   !> - hamming
546   !> - blackman
547   !> - gauss
548   !> - butterworth
549   !> Cut-off frequency could be specify.
550   !> As well as a filter parameter for gauss an butterworth filter
551   !
552   !> @author J.Paul
553   !> - Nov, 2013- Initial Version
554   !
555   !> @param[in] cd_name : filter name
556   !> @param[in] dd_cutoff : cut-off frequency
557   !> @param[in] id_radius : filter halo radius
558   !> @param[in] dd_alpha : filter parameter
559   !> @return table of filter coefficient
560   !-------------------------------------------------------------------
561   !> @code
562   FUNCTION filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
563      IMPLICIT NONE
564      ! Argument     
565      CHARACTER(LEN=*), INTENT(IN) :: cd_name
566      REAL(dp)        , INTENT(IN) :: dd_cutoff
567      INTEGER(i4)     , INTENT(IN) :: id_radius
568      REAL(dp)        , INTENT(IN) :: dd_alpha
569
570      ! function
571      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_coef
572
573      ! local variable
574
575      ! loop indices
576      !----------------------------------------------------------------
577      IF( REAL(id_radius,dp) < dd_cutoff )THEN
578         CALL logger_warn("FILTER COEF: radius of the filter halo "//&
579         &  "is lower than cut-off frequency")
580      ENDIF
581
582      SELECT CASE(TRIM(fct_lower(cd_name)))
583      CASE('hann')
584         filter__2D_coef(:,:)=filter__2D_hann(dd_cutoff, id_radius)
585      CASE('hamming')
586         filter__2D_coef(:,:)=filter__2D_hamming(dd_cutoff, id_radius)
587      CASE('blackman')
588         filter__2D_coef(:,:)=filter__2D_blackman(dd_cutoff, id_radius)
589      CASE('gauss')
590         filter__2D_coef(:,:)=filter__2D_gauss(dd_cutoff, id_radius, dd_alpha)
591      CASE('butterworth')
592         filter__2D_coef(:,:)=filter__2D_butterworth(dd_cutoff, id_radius, dd_alpha)
593      CASE DEFAULT
594         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name))
595      END SELECT
596
597   END FUNCTION filter__2D_coef
598   !> @endcode
599   !-------------------------------------------------------------------
600   !> @brief This function compute filter coefficient.
601   !
602   !> @details
603   !>
604   !> filter could be choose between :
605   !> - hann
606   !> - hamming
607   !> - blackman
608   !> - gauss
609   !> - butterworth
610   !> Cut-off frequency could be specify.
611   !> As well as a filter parameter for gauss an butterworth filter
612   !
613   !> @author J.Paul
614   !> - Nov, 2013- Initial Version
615   !
616   !> @param[in] cd_name : filter name
617   !> @param[in] dd_cutoff : cut-off frequency
618   !> @param[in] id_radius : filter halo radius
619   !> @param[in] dd_alpha : filter parameter
620   !> @return table of filter coefficient
621   !-------------------------------------------------------------------
622   !> @code
623   FUNCTION filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
624      IMPLICIT NONE
625      ! Argument     
626      CHARACTER(LEN=*), INTENT(IN) :: cd_name
627      REAL(dp)        , INTENT(IN) :: dd_cutoff
628      INTEGER(i4)     , INTENT(IN) :: id_radius
629      REAL(dp)        , INTENT(IN) :: dd_alpha
630
631      ! function
632      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_coef
633
634      ! local variable
635
636      ! loop indices
637      !----------------------------------------------------------------
638
639      SELECT CASE(TRIM(fct_lower(cd_name)))
640      CASE('hann')
641         filter__1D_coef(:)=filter__1D_hann(dd_cutoff, id_radius)
642      CASE('hamming')
643         filter__1D_coef(:)=filter__1D_hamming(dd_cutoff, id_radius)
644      CASE('blackman')
645         filter__1D_coef(:)=filter__1D_blackman(dd_cutoff, id_radius)
646      CASE('gauss')
647         filter__1D_coef(:)=filter__1D_gauss(dd_cutoff, id_radius, dd_alpha)
648      CASE('butterworth')
649         filter__1D_coef(:)=filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha)
650      CASE DEFAULT
651         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name))
652      END SELECT
653
654   END FUNCTION filter__1D_coef
655   !> @endcode
656   !-------------------------------------------------------------------
657   !> @brief This function compute coefficient for HANN filter.
658   !
659   !> @details
660   !
661   !> @author J.Paul
662   !> - Nov, 2013- Initial Version
663   !
664   !> @param[in] dd_cutoff : cuto-off frequency
665   !> @param[in] id_radius : filter halo radius
666   !> @return table of hann filter coefficient
667   !-------------------------------------------------------------------
668   !> @code
669   FUNCTION filter__1D_hann(dd_cutoff, id_radius)
670      IMPLICIT NONE
671      ! Argument     
672      REAL(dp)        , INTENT(IN) :: dd_cutoff 
673      INTEGER(i4)     , INTENT(IN) :: id_radius
674
675      ! function
676      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_hann
677
678      ! local variable
679      REAL(dp) :: dl_rad
680      REAL(dp) :: dl_sum
681
682      ! loop indices
683      INTEGER(i4) :: ji
684      !----------------------------------------------------------------
685
686      IF( dd_cutoff < 1 )THEN
687         CALL logger_error("FILTER COEF: cut-off frequency "//&
688         &  "should be greater than or equal to 1. No filter will be apply ")
689         filter__1D_hann(:)=0.
690         filter__1D_hann(id_radius+1)=1.
691      ELSE
692         DO ji=1,2*id_radius+1
693
694            dl_rad=SQRT(REAL(ji-id_radius+1,dp)**2 )
695           
696            IF( dl_rad < dd_cutoff )THEN
697               filter__1D_hann(ji)=0.5 + 0.5*COS(dg_pi*dl_rad/dd_cutoff)
698            ELSE
699               filter__1D_hann(ji)=0
700            ENDIF
701
702         ENDDO
703
704         ! normalize
705         dl_sum=SUM(filter__1D_hann(:))
706
707         filter__1D_hann(:)=filter__1D_hann(:)/dl_sum
708      ENDIF
709
710   END FUNCTION filter__1D_hann
711   !> @endcode
712   !-------------------------------------------------------------------
713   !> @brief This function compute coefficient for HANN filter.
714   !
715   !> @details
716   !
717   !> @author J.Paul
718   !> - Nov, 2013- Initial Version
719   !
720   !> @param[in] dd_cutoff : cuto-off frequency
721   !> @param[in] id_radius : filter halo radius
722   !> @return table of hann filter coefficient
723   !-------------------------------------------------------------------
724   !> @code
725   FUNCTION filter__2D_hann(dd_cutoff, id_radius)
726      IMPLICIT NONE
727      ! Argument     
728      REAL(dp)   , INTENT(IN) :: dd_cutoff 
729      INTEGER(i4), INTENT(IN) :: id_radius
730
731      ! function
732      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_hann
733
734      ! local variable
735      REAL(dp) :: dl_rad
736      REAL(dp) :: dl_sum
737
738      ! loop indices
739      INTEGER(i4) :: ji
740      INTEGER(i4) :: jj
741      !----------------------------------------------------------------
742
743      IF( dd_cutoff < 1.0_dp )THEN
744         CALL logger_error("FILTER COEF: cut-off frequency "//&
745         &  "should be greater than or equal to 1. No filter will be apply ")
746         filter__2D_hann(:,:)=0.
747         filter__2D_hann(id_radius+1,id_radius+1)=1.
748      ELSE
749         DO jj=1,2*id_radius+1
750            DO ji=1,2*id_radius+1
751
752               ! radius
753               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
754               &             REAL(jj-(id_radius+1),dp)**2 )
755               
756               IF( dl_rad < dd_cutoff )THEN
757                  filter__2D_hann(ji,jj)=0.5 + 0.5*COS(dg_pi*dl_rad/dd_cutoff)
758               ELSE
759                  filter__2D_hann(ji,jj)=0
760               ENDIF
761
762            ENDDO
763         ENDDO
764
765         ! normalize
766         dl_sum=SUM(filter__2D_hann(:,:))
767
768         filter__2D_hann(:,:)=filter__2D_hann(:,:)/dl_sum
769      ENDIF
770
771   END FUNCTION filter__2D_hann
772   !> @endcode
773   !-------------------------------------------------------------------
774   !> @brief This function compute coefficient for HAMMING filter.
775   !
776   !> @details
777   !
778   !> @author J.Paul
779   !> - Nov, 2013- Initial Version
780   !
781   !> @param[in] dd_cutoff : cuto-off frequency
782   !> @param[in] id_radius : filter halo radius
783   !> @return table of hamming filter coefficient
784   !-------------------------------------------------------------------
785   !> @code
786   FUNCTION filter__1D_hamming(dd_cutoff, id_radius)
787      IMPLICIT NONE
788      ! Argument     
789      REAL(dp)        , INTENT(IN) :: dd_cutoff 
790      INTEGER(i4)     , INTENT(IN) :: id_radius
791
792      ! function
793      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_hamming
794
795      ! local variable
796      REAL(dp) :: dl_rad
797      REAL(dp) :: dl_sum
798
799      ! loop indices
800      INTEGER(i4) :: ji
801      !----------------------------------------------------------------
802
803      IF( dd_cutoff < 1 )THEN
804         CALL logger_error("FILTER COEF: cut-off frequency "//&
805         &  "should be greater than or equal to 1. No filter will be apply ")
806         filter__1D_hamming(:)=0.
807         filter__1D_hamming(id_radius+11)=1.
808      ELSE
809         DO ji=1,2*id_radius+1
810
811            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
812         
813            IF( dl_rad < dd_cutoff )THEN
814               filter__1D_hamming(ji)= 0.54 &
815               &                     + 0.46*COS(dg_pi*dl_rad/dd_cutoff)
816            ELSE
817               filter__1D_hamming(ji)=0
818            ENDIF
819
820         ENDDO
821
822         ! normalize
823         dl_sum=SUM(filter__1D_hamming(:))
824
825         filter__1D_hamming(:)=filter__1D_hamming(:)/dl_sum
826      ENDIF
827
828   END FUNCTION filter__1D_hamming
829   !> @endcode
830   !-------------------------------------------------------------------
831   !> @brief This function compute coefficient for HAMMING filter.
832   !
833   !> @details
834   !
835   !> @author J.Paul
836   !> - Nov, 2013- Initial Version
837   !
838   !> @param[in] dd_cutoff : cuto-off frequency
839   !> @param[in] id_radius : filter halo radius
840   !> @return table of hamming filter coefficient
841   !-------------------------------------------------------------------
842   !> @code
843   FUNCTION filter__2D_hamming(dd_cutoff, id_radius)
844      IMPLICIT NONE
845      ! Argument     
846      REAL(dp)        , INTENT(IN) :: dd_cutoff 
847      INTEGER(i4)     , INTENT(IN) :: id_radius
848
849      ! function
850      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_hamming
851
852      ! local variable
853      REAL(dp) :: dl_rad
854      REAL(dp) :: dl_sum
855
856      ! loop indices
857      INTEGER(i4) :: ji
858      INTEGER(i4) :: jj
859      !----------------------------------------------------------------
860
861      IF( dd_cutoff < 1 )THEN
862         CALL logger_error("FILTER COEF: cut-off frequency "//&
863         &  "should be greater than or equal to 1. No filter will be apply ")
864         filter__2D_hamming(:,:)=0.
865         filter__2D_hamming(id_radius+1,id_radius+1)=1.
866      ELSE
867         DO jj=1,2*id_radius+1
868            DO ji=1,2*id_radius+1
869
870               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
871               &             REAL(jj-(id_radius+1),dp)**2 )
872           
873               IF( dl_rad < dd_cutoff )THEN
874                  filter__2D_hamming(ji,jj)= 0.54 &
875                  &                        + 0.46*COS(dg_pi*dl_rad/dd_cutoff)
876               ELSE
877                  filter__2D_hamming(ji,jj)=0
878               ENDIF
879
880            ENDDO
881         ENDDO
882
883         ! normalize
884         dl_sum=SUM(filter__2D_hamming(:,:))
885
886         filter__2D_hamming(:,:)=filter__2D_hamming(:,:)/dl_sum
887      ENDIF
888
889   END FUNCTION filter__2D_hamming
890   !> @endcode
891   !-------------------------------------------------------------------
892   !> @brief This function compute coefficient for BLACKMAN filter.
893   !
894   !> @details
895   !
896   !> @author J.Paul
897   !> - Nov, 2013- Initial Version
898   !
899   !> @param[in] dd_cutoff : cuto-off frequency
900   !> @param[in] id_radius : filter halo radius
901   !> @return table of blackman filter coefficient
902   !-------------------------------------------------------------------
903   !> @code
904   FUNCTION filter__1D_blackman(dd_cutoff, id_radius)
905      IMPLICIT NONE
906      ! Argument     
907      REAL(dp)        , INTENT(IN) :: dd_cutoff
908      INTEGER(i4)     , INTENT(IN) :: id_radius
909
910      ! function
911      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_blackman
912
913      ! local variable
914      REAL(dp) :: dl_rad
915      REAL(dp) :: dl_sum
916
917      ! loop indices
918      INTEGER(i4) :: ji
919      !----------------------------------------------------------------
920
921      IF( dd_cutoff < 1 )THEN
922         CALL logger_error("FILTER COEF: cut-off frequency "//&
923         &  "should be greater than or equal to 1. No filter will be apply ")
924         filter__1D_blackman(:)=0.
925         filter__1D_blackman(id_radius+1)=1.
926      ELSE     
927         DO ji=1,2*id_radius+1
928
929            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
930           
931            IF( dl_rad < dd_cutoff )THEN
932               filter__1D_blackman(ji)= 0.42 &
933               &                      + 0.5 *COS(  dg_pi*dl_rad/dd_cutoff) &
934               &                      + 0.08*COS(2*dg_pi*dl_rad/dd_cutoff)
935            ELSE
936               filter__1D_blackman(ji)=0
937            ENDIF                               
938
939         ENDDO
940
941         ! normalize
942         dl_sum=SUM(filter__1D_blackman(:))
943
944         filter__1D_blackman(:)=filter__1D_blackman(:)/dl_sum
945      ENDIF
946
947   END FUNCTION filter__1D_blackman
948   !> @endcode
949   !-------------------------------------------------------------------
950   !> @brief This function compute coefficient for BLACKMAN filter.
951   !
952   !> @details
953   !
954   !> @author J.Paul
955   !> - Nov, 2013- Initial Version
956   !
957   !> @param[in] dd_cutoff : cuto-off frequency
958   !> @param[in] id_radius : filter halo radius
959   !> @return table of blackman filter coefficient
960   !-------------------------------------------------------------------
961   !> @code
962   FUNCTION filter__2D_blackman(dd_cutoff, id_radius)
963      IMPLICIT NONE
964      ! Argument     
965      REAL(dp)        , INTENT(IN) :: dd_cutoff 
966      INTEGER(i4)     , INTENT(IN) :: id_radius
967
968      ! function
969      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_blackman
970
971      ! local variable
972      REAL(dp) :: dl_rad
973      REAL(dp) :: dl_sum
974
975      ! loop indices
976      INTEGER(i4) :: ji
977      INTEGER(i4) :: jj
978      !----------------------------------------------------------------
979
980      IF( dd_cutoff < 1 )THEN
981         CALL logger_error("FILTER COEF: cut-off frequency "//&
982         &  "should be greater than or equal to 1. No filter will be apply ")
983         filter__2D_blackman(:,:)=0.
984         filter__2D_blackman(id_radius+1,id_radius+1)=1.
985      ELSE     
986         DO jj=1,2*id_radius+1
987            DO ji=1,2*id_radius+1
988
989               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
990               &             REAL(jj-(id_radius+1),dp)**2 )
991               
992               IF( dl_rad < dd_cutoff )THEN
993                  filter__2D_blackman(ji,jj)= 0.42 &
994                  &                         + 0.5 *COS(  dg_pi*dl_rad/dd_cutoff) &
995                  &                         + 0.08*COS(2*dg_pi*dl_rad/dd_cutoff)
996               ELSE
997                  filter__2D_blackman(ji,jj)=0
998               ENDIF                               
999
1000            ENDDO
1001         ENDDO
1002
1003         ! normalize
1004         dl_sum=SUM(filter__2D_blackman(:,:))
1005
1006         filter__2D_blackman(:,:)=filter__2D_blackman(:,:)/dl_sum
1007      ENDIF
1008
1009   END FUNCTION filter__2D_blackman
1010   !> @endcode
1011   !-------------------------------------------------------------------
1012   !> @brief This function compute coefficient for GAUSS filter.
1013   !
1014   !> @details
1015   !
1016   !> @author J.Paul
1017   !> - Nov, 2013- Initial Version
1018   !
1019   !> @param[in] dd_cutoff : cuto-off frequency
1020   !> @param[in] id_radius : filter halo radius
1021   !> @param[in] dd_alpha : filter parameter
1022   !> @return table of gauss filter coefficient
1023   !-------------------------------------------------------------------
1024   !> @code
1025   FUNCTION filter__1D_gauss(dd_cutoff, id_radius, dd_alpha)
1026      IMPLICIT NONE
1027      ! Argument     
1028      REAL(dp)        , INTENT(IN) :: dd_cutoff 
1029      INTEGER(i4)     , INTENT(IN) :: id_radius
1030      REAL(dp)        , INTENT(IN) :: dd_alpha 
1031
1032      ! function
1033      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_gauss
1034
1035      ! local variable
1036      REAL(dp) :: dl_rad
1037      REAL(dp) :: dl_sum
1038
1039      ! loop indices
1040      INTEGER(i4) :: ji
1041      !----------------------------------------------------------------
1042
1043      IF( dd_cutoff < 1 )THEN
1044         CALL logger_error("FILTER COEF: cut-off frequency "//&
1045         &  "should be greater than or equal to 1. No filter will be apply ")
1046         filter__1D_gauss(:)=0.
1047         filter__1D_gauss(id_radius+1)=1.
1048      ELSE
1049         DO ji=1,2*id_radius+1
1050
1051            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
1052           
1053            filter__1D_gauss(ji)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2))
1054
1055         ENDDO
1056
1057         ! normalize
1058         dl_sum=SUM(filter__1D_gauss(:))
1059
1060         filter__1D_gauss(:)=filter__1D_gauss(:)/dl_sum
1061      ENDIF
1062
1063   END FUNCTION filter__1D_gauss
1064   !> @endcode
1065   !-------------------------------------------------------------------
1066   !> @brief This function compute coefficient for GAUSS filter.
1067   !
1068   !> @details
1069   !
1070   !> @author J.Paul
1071   !> - Nov, 2013- Initial Version
1072   !
1073   !> @param[in] dd_cutoff : cuto-off frequency
1074   !> @param[in] id_radius : filter halo radius
1075   !> @param[in] dd_alpha : filter parameter
1076   !> @return table of gauss filter coefficient
1077   !-------------------------------------------------------------------
1078   !> @code
1079   FUNCTION filter__2D_gauss(dd_cutoff, id_radius, dd_alpha)
1080      IMPLICIT NONE
1081      ! Argument     
1082      REAL(dp)        , INTENT(IN) :: dd_cutoff 
1083      INTEGER(i4)     , INTENT(IN) :: id_radius
1084      REAL(dp)        , INTENT(IN) :: dd_alpha 
1085
1086      ! function
1087      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_gauss
1088
1089      ! local variable
1090      REAL(dp) :: dl_rad
1091      REAL(dp) :: dl_sum
1092
1093      ! loop indices
1094      INTEGER(i4) :: ji
1095      INTEGER(i4) :: jj
1096      !----------------------------------------------------------------
1097
1098      IF( dd_cutoff < 1 )THEN
1099         CALL logger_error("FILTER COEF: cut-off frequency "//&
1100         &  "should be greater than or equal to 1. No filter will be apply ")
1101         filter__2D_gauss(:,:)=0.
1102         filter__2D_gauss(id_radius+1,id_radius+1)=1.
1103      ELSE
1104         DO jj=1,2*id_radius+1
1105            DO ji=1,2*id_radius+1
1106
1107               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
1108               &             REAL(jj-(id_radius+1),dp)**2 )
1109               
1110               filter__2D_gauss(ji,jj)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2))
1111
1112            ENDDO
1113         ENDDO
1114
1115         ! normalize
1116         dl_sum=SUM(filter__2D_gauss(:,:))
1117
1118         filter__2D_gauss(:,:)=filter__2D_gauss(:,:)/dl_sum
1119      ENDIF
1120
1121   END FUNCTION filter__2D_gauss
1122   !> @endcode
1123   !-------------------------------------------------------------------
1124   !> @brief This function compute coefficient for BUTTERWORTH filter.
1125   !
1126   !> @details
1127   !
1128   !> @author J.Paul
1129   !> - Nov, 2013- Initial Version
1130   !
1131   !> @param[in] dd_cutoff : cuto-off frequency
1132   !> @param[in] id_radius : filter halo radius
1133   !> @param[in] dd_alpha : filter parameter
1134   !> @return table of butterworth filter coefficient
1135   !-------------------------------------------------------------------
1136   !> @code
1137   FUNCTION filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha)
1138      IMPLICIT NONE
1139      ! Argument     
1140      REAL(dp)        , INTENT(IN) :: dd_cutoff 
1141      INTEGER(i4)     , INTENT(IN) :: id_radius
1142      REAL(dp)        , INTENT(IN) :: dd_alpha 
1143
1144      ! function
1145      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_butterworth
1146
1147      ! local variable
1148      REAL(dp) :: dl_rad
1149      REAL(dp) :: dl_sum
1150
1151      ! loop indices
1152      INTEGER(i4) :: ji
1153      !----------------------------------------------------------------
1154
1155      IF( dd_cutoff <= 1 )THEN
1156         CALL logger_error("FILTER COEF: cut-off frequency "//&
1157         &  "should be greater than 1. No filter will be apply ")
1158         filter__1D_butterworth(:)=0.
1159         filter__1D_butterworth(id_radius+1)=1.
1160      ELSE
1161         DO ji=1,2*id_radius+1
1162
1163            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
1164           
1165            filter__1D_butterworth(ji)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha)
1166
1167         ENDDO
1168
1169         ! normalize
1170         dl_sum=SUM(filter__1D_butterworth(:))
1171
1172         filter__1D_butterworth(:)=filter__1D_butterworth(:)/dl_sum
1173      ENDIF
1174
1175   END FUNCTION filter__1D_butterworth
1176   !> @endcode
1177   !-------------------------------------------------------------------
1178   !> @brief This function compute coefficient for BUTTERWORTH filter.
1179   !
1180   !> @details
1181   !
1182   !> @author J.Paul
1183   !> - Nov, 2013- Initial Version
1184   !
1185   !> @param[in] dd_cutoff : cuto-off frequency
1186   !> @param[in] id_radius : filter halo radius
1187   !> @param[in] dd_alpha : filter parameter
1188   !> @return table of butterworth filter coefficient
1189   !-------------------------------------------------------------------
1190   !> @code
1191   FUNCTION filter__2D_butterworth(dd_cutoff,  id_radius, dd_alpha)
1192      IMPLICIT NONE
1193      ! Argument     
1194      REAL(dp)        , INTENT(IN) :: dd_cutoff 
1195      INTEGER(i4)     , INTENT(IN) :: id_radius
1196      REAL(dp)        , INTENT(IN) :: dd_alpha 
1197
1198      ! function
1199      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_butterworth
1200
1201      ! local variable
1202      REAL(dp) :: dl_rad
1203      REAL(dp) :: dl_sum
1204
1205      ! loop indices
1206      INTEGER(i4) :: ji
1207      INTEGER(i4) :: jj
1208      !----------------------------------------------------------------
1209
1210      IF( dd_cutoff <= 1 )THEN
1211         CALL logger_error("FILTER COEF: cut-off frequency "//&
1212         &  "should be greater than 1. No filter will be apply ")
1213         filter__2D_butterworth(:,:)=0.
1214         filter__2D_butterworth(id_radius+1,id_radius+1)=1.
1215      ELSE
1216         DO jj=1,2*id_radius+1
1217            DO ji=1,2*id_radius+1
1218
1219               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
1220               &             REAL(jj-(id_radius+1),dp)**2 )
1221               
1222               filter__2D_butterworth(ji,jj)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha)
1223
1224            ENDDO
1225         ENDDO
1226
1227         ! normalize
1228         dl_sum=SUM(filter__2D_butterworth(:,:))
1229
1230         filter__2D_butterworth(:,:)=filter__2D_butterworth(:,:)/dl_sum
1231      ENDIF
1232
1233   END FUNCTION filter__2D_butterworth
1234   !> @endcode
1235!   !-------------------------------------------------------------------
1236!   !> @brief This function
1237!   !
1238!   !> @details
1239!   !
1240!   !> @author J.Paul
1241!   !> - Nov, 2013- Initial Version
1242!   !
1243!   !> @param[in]
1244!   !-------------------------------------------------------------------
1245!   !> @code
1246!   FUNCTION filter_()
1247!      IMPLICIT NONE
1248!      ! Argument     
1249!      ! function
1250!      ! local variable
1251!      ! loop indices
1252!      !----------------------------------------------------------------
1253!
1254!   END FUNCTION filter_
1255!   !> @endcode
1256!   !-------------------------------------------------------------------
1257!   !> @brief This subroutine
1258!   !
1259!   !> @details
1260!   !
1261!   !> @author J.Paul
1262!   !> - Nov, 2013- Initial Version
1263!   !
1264!   !> @param[in]
1265!   !-------------------------------------------------------------------
1266!   !> @code
1267!   SUBROUTINE filter_()
1268!      IMPLICIT NONE
1269!      ! Argument     
1270!      ! local variable
1271!      ! loop indices
1272!      !----------------------------------------------------------------
1273!
1274!   END SUBROUTINE filter_
1275!   !> @endcode
1276END MODULE filter
1277
Note: See TracBrowser for help on using the repository browser.