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.
Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/TOOLS/SIREN/src/filter.f90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/TOOLS/SIREN/src/filter.f90

    r4213 r5965  
    66! 
    77! DESCRIPTION: 
    8 !> @brief filter manager <br/> 
     8!> @brief This module is filter manager. 
    99!> 
    10 !> @details 
     10!> @details Filtering method to be used is specify inside variable strcuture, 
     11!>    as array of string character.<br/> 
     12!>    td_var\%c_filter(1) string character is the filter name choose between:<br/> 
     13!>       - 'hann' 
     14!>          - rad < cutoff : @f$ filter=0.5+0.5*COS(\pi*\frac{rad}{cutoff}) @f$ 
     15!>          - rad > cutoff : @f$ filter=0 @f$ 
     16!>       - 'hamming' 
     17!>          - rad < cutoff : @f$ filter=0.54+0.46*COS(\pi*\frac{rad}{cutoff}) @f$ 
     18!>          - rad > cutoff : @f$ filter=0 @f$                
     19!>       - 'blackman' 
     20!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 0.08*COS(2\pi*\frac{rad}{cutoff}) @f$ 
     21!>          - rad > cutoff : @f$ filter=0 @f$ 
     22!>       - 'gauss' 
     23!>          - @f$filter=exp(-(\alpha * rad^2) / (2*cutoff^2))@f$ 
     24!>       - 'butterworth' 
     25!>          - @f$ filer=1 / (1+(rad^2 / cutoff^2)^{\alpha}) @f$ 
     26!>             . 
     27!> 
     28!>       with @f$ rad= \sqrt{(dist-radius)^2} @f$ 
     29!> 
     30!>    td_var\%c_filter(2) string character is the number of turn to be done<br/> 
     31!>    td_var\%c_filter(3) string character is the cut-off frequency (count in number of mesh grid)<br/> 
     32!>    td_var\%c_filter(4) string character is the halo radius (count in number of mesh grid)<br/> 
     33!>    td_var\%c_filter(5) string character is the alpha parameter (for gauss and butterworth method)<br/> 
     34!>     
     35!>    @note Filter method could be specify for each variable in namelist _namvar_, 
     36!>    defining string character _cn\_varinfo_. None by default.<br/> 
     37!>    Filter method parameters are informed inside bracket. 
     38!>       - @f$\alpha@f$ parameter is added for _gauss_ and _butterworth_ methods 
    1139!>  
     40!>    The number of turn is specify using '*' separator.<br/> 
     41!>    Example: 
     42!>       - cn_varinfo='varname1:2*hamming(@f$cutoff@f$,@f$radius@f$)', 'varname2:gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)' 
     43!> 
     44!>    to filter variable value:<br/> 
     45!> @code 
     46!>    CALL filter_fill_value( td_var ) 
     47!> @endcode 
     48!>       - td_var is variable structure 
     49!> 
    1250!> @author 
    1351!> J.Paul 
    1452! REVISION HISTORY: 
    15 !> @date Nov, 2013 - Initial Version 
     53!> @date November, 2013 - Initial Version 
    1654! 
    1755!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    18 !> @todo 
    1956!---------------------------------------------------------------------- 
    2057MODULE filter 
    2158   USE kind                            ! F90 kind parameter 
    2259   USE phycst                          ! physical constant 
    23    USE logger                             ! log file manager 
     60   USE logger                          ! log file manager 
    2461   USE fct                             ! basic usefull function 
    2562   use att                             ! attribute manager 
     
    2764   USE extrap                          ! extrapolation manager 
    2865   IMPLICIT NONE 
    29    PRIVATE 
    3066   ! NOTE_avoid_public_variables_if_possible 
    3167 
     
    3470 
    3571   ! 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 
     72   PUBLIC :: filter_fill_value   !< filter variable value 
     73 
     74   PRIVATE :: filter__fill_value_wrapper ! 
     75   PRIVATE :: filter__fill_value         ! 
     76   PRIVATE :: filter__3D_fill_value      !  
     77   PRIVATE :: filter__2D_fill_value      ! 
     78   PRIVATE :: filter__2D                 ! 
     79   PRIVATE :: filter__2D_coef            ! 
     80   PRIVATE :: filter__2D_hann            ! 
     81   PRIVATE :: filter__2D_hamming         ! 
     82   PRIVATE :: filter__2D_blackman        ! 
     83   PRIVATE :: filter__2D_gauss           ! 
     84   PRIVATE :: filter__2D_butterworth     ! 
     85   PRIVATE :: filter__1D_fill_value      ! 
     86   PRIVATE :: filter__1D                 ! 
     87   PRIVATE :: filter__1D_coef            ! 
     88   PRIVATE :: filter__1D_hann            ! 
     89   PRIVATE :: filter__1D_hamming         ! 
     90   PRIVATE :: filter__1D_blackman        ! 
     91   PRIVATE :: filter__1D_gauss           ! 
     92   PRIVATE :: filter__1D_butterworth     ! 
    4993 
    5094   INTERFACE filter_fill_value 
     
    5599   !------------------------------------------------------------------- 
    56100   !> @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 
     101   !> This subroutine filter variable value. 
     102   !> 
     103   !> @details 
     104   !> it checks if filtering method is available, 
     105   !>  gets parameter value, and launch filter__fill_value  
     106   !> 
     107   !> @author J.Paul 
     108   !> - November, 2013- Initial Version 
     109   ! 
     110   !> @param[inout] td_var variable structure  
     111   !------------------------------------------------------------------- 
    67112   SUBROUTINE filter__fill_value_wrapper( td_var ) 
    68113      IMPLICIT NONE 
     
    85130 
    86131      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 
    87          CALL logger_error("FILTER FILL VALUE: no table of value "//& 
     132         CALL logger_error("FILTER FILL VALUE: no array of value "//& 
    88133         &  "associted to variable "//TRIM(td_var%c_name) ) 
    89134      ELSE 
     
    93138         CASE DEFAULT 
    94139          
    95             CALL logger_info("FILTER FILL VALUE: no filter selected "//& 
     140            CALL logger_trace("FILTER FILL VALUE: no filter selected "//& 
    96141            &  "for variable "//TRIM(td_var%c_name)) 
    97142 
     
    181226               tl_att=att_init('filter',cl_filter) 
    182227               CALL var_move_att(td_var,tl_att) 
    183                 
     228               ! clean 
     229               CALL att_clean(tl_att) 
     230 
    184231               DO jl=1,il_nturn 
    185232                  CALL filter__fill_value( td_var, TRIM(cl_method),  &  
     
    192239      ENDIF 
    193240   END SUBROUTINE filter__fill_value_wrapper 
    194    !> @endcode 
    195241   !------------------------------------------------------------------- 
    196242   !> @brief 
    197    !> This subroutine filtering variable value. 
     243   !> This subroutine filtering variable value, given cut-off frequency 
     244   !> halo radius and alpha parameter. 
    198245   !>  
    199246   !> @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 
     247   !>    First extrabands are added to array of variable value. 
     248   !>    Then values are extrapolated, before apply filter. 
     249   !>    Finally extrabands are removed. 
     250   !> 
     251   !> @author J.Paul 
     252   !> - November, 2013- Initial Version 
     253   ! 
     254   !> @param[inout] td_var variable  
     255   !> @param[in] cd_name   filter name 
     256   !> @param[in] dd_cutoff cut-off frequency 
     257   !> @param[in] id_radius filter halo radius 
     258   !> @param[in] dd_alpha  filter parameter 
     259   !------------------------------------------------------------------- 
    211260   SUBROUTINE filter__fill_value( td_var, cd_name, & 
    212261   &                              dd_cutoff, id_radius, dd_alpha ) 
     
    274323      END WHERE 
    275324 
     325      ! clean 
     326      CALL var_clean(tl_mask) 
     327 
    276328      !6-remove extraband 
    277329      CALL extrap_del_extrabands(td_var, id_radius, id_radius) 
    278330 
    279331   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 
     332   !------------------------------------------------------------------- 
     333   !> @brief This subroutine compute filtered value of 3D array.  
     334   !> 
     335   !> @details 
     336   !>    First compute filter coefficient. 
     337   !>    Then apply it on each level of variable value. 
     338   !> 
     339   !> @warning array of value should have been already extrapolated before 
    287340   !> running this subroutine. 
    288341   ! 
    289342   !> @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 
     343   !> - November, 2013- Initial Version 
     344   ! 
     345   !> @param[inout] dd_value  array of value to be filtered  
     346   !> @param[in] dd_fill      fill value  
     347   !> @param[in] cd_name      filter name 
     348   !> @param[in] dd_cutoff    cut-off frequency 
     349   !> @param[in] id_radius    filter halo radius 
     350   !> @param[in] dd_alpha     filter parameter 
     351   !------------------------------------------------------------------- 
    300352   SUBROUTINE filter__3D_fill_value( dd_value, dd_fill, cd_name, & 
    301353   &                                 dd_cutoff, id_radius, dd_alpha) 
     
    330382 
    331383   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 
     384   !------------------------------------------------------------------- 
     385   !> @brief This subroutine compute filtered value of 2D array. 
     386   ! 
     387   !> @details 
     388   !>    First compute filter coefficient. 
     389   !>    Then apply it on variable value. 
     390   !> 
     391   !> @warning array of value should have been already extrapolated before 
    339392   !> running this subroutine. 
    340393   !> 
    341394   !> @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 
     395   !> - November, 2013- Initial Version 
     396   ! 
     397   !> @param[inout] dd_value  array of value to be filtered  
     398   !> @param[in] dd_fill      fill value  
     399   !> @param[in] cd_name      filter name 
     400   !> @param[in] dd_cutoff    cut-off frequency 
     401   !> @param[in] id_radius    filter halo radius 
     402   !> @param[in] dd_alpha     filter parameter 
     403   !------------------------------------------------------------------- 
    352404   SUBROUTINE filter__2D_fill_value( dd_value, dd_fill, cd_name, & 
    353405   &                                 dd_cutoff, id_radius, dd_alpha) 
     
    376428 
    377429   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 
     430   !------------------------------------------------------------------- 
     431   !> @brief This subroutine compute filtered value of 1D array. 
     432   ! 
     433   !> @details 
     434   !>    First compute filter coefficient. 
     435   !>    Then apply it on variable value. 
     436   !> 
     437   !> @warning array of value should have been already extrapolated before 
    385438   !> running this subroutine. 
    386439   !> 
    387440   !> @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 
     441   !> - November, 2013- Initial Version 
     442   ! 
     443   !> @param[inout] dd_value  array of value to be filtered  
     444   !> @param[in] dd_fill      fill value  
     445   !> @param[in] cd_name      filter name 
     446   !> @param[in] dd_cutoff    cut-off frequency 
     447   !> @param[in] id_radius    filter halo radius 
     448   !> @param[in] dd_alpha     filter parameter 
     449   !------------------------------------------------------------------- 
    398450   SUBROUTINE filter__1D_fill_value( dd_value, dd_fill, cd_name, & 
    399451   &                                 dd_cutoff, id_radius, dd_alpha) 
     
    422474 
    423475   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 
     476   !------------------------------------------------------------------- 
     477   !> @brief This subroutine filtered 2D array of value  
     478   !> 
     479   !> @details 
     480   !>    loop on first and second dimension,  
     481   !>    and apply coefficient 2D array on each point 
     482   !> 
     483   !> @author J.Paul 
     484   !> - November, 2013- Initial Version 
     485   ! 
     486   !> @param[inout] dd_value  array of value to be filtered  
     487   !> @param[in] dd_fill      fill value  
     488   !> @param[in] dd_coef      filter coefficent array 
     489   !> @param[in] id_radius    filter halo radius 
     490   !------------------------------------------------------------------- 
    443491   SUBROUTINE filter__2D(dd_value, dd_fill, dd_coef, id_radius) 
    444492      IMPLICIT NONE 
     
    452500      INTEGER(i4), DIMENSION(2)                :: il_shape 
    453501      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value 
    454       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_area 
     502      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_halo 
    455503 
    456504      ! loop indices 
     
    463511      dl_value(:,:)=dd_value(:,:) 
    464512 
    465       ALLOCATE(dl_area(2*id_radius+1,2*id_radius+1)) 
     513      ALLOCATE(dl_halo(2*id_radius+1,2*id_radius+1)) 
    466514 
    467515      DO jj=1+id_radius,il_shape(2)-id_radius 
    468516         DO ji=1+id_radius,il_shape(1)-id_radius 
    469517 
    470             dl_area(:,:)=dd_fill 
    471             dl_area(:,:)=dl_value(ji-id_radius:ji+id_radius, & 
     518            dl_halo(:,:)=dd_fill 
     519            dl_halo(:,:)=dl_value(ji-id_radius:ji+id_radius, & 
    472520            &                     jj-id_radius:jj+id_radius) 
    473521 
    474             IF( ALL(dl_area(:,:)/=dd_fill) )THEN 
    475                dd_value(ji,jj)=SUM(dl_area(:,:)*dd_coef(:,:)) 
    476             ENDIF 
     522            dd_value(ji,jj)=SUM(dl_halo(:,:)*dd_coef(:,:)) 
    477523 
    478524         ENDDO 
    479525      ENDDO 
    480526 
    481       DEALLOCATE(dl_area) 
     527      DEALLOCATE(dl_halo) 
    482528      DEALLOCATE(dl_value) 
    483529 
    484530   END SUBROUTINE filter__2D 
    485    !> @endcode 
    486    !------------------------------------------------------------------- 
    487    !> @brief This subroutine  
    488    ! 
    489    !> @details 
    490    ! 
     531   !------------------------------------------------------------------- 
     532   !> @brief This subroutine filtered 1D array of value   
     533   ! 
     534   !> @details 
     535   !>    loop on first dimension,  
     536   !>    and apply coefficient 1D array on each point 
     537   !> 
    491538   !> @author J.Paul 
    492539   !> - Nov, 2013- Initial Version 
    493540   ! 
    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 
     541   !> @param[inout] dd_value  array of value to be filtered  
     542   !> @param[in] dd_fill      fill value  
     543   !> @param[in] dd_coef      filter coefficent array 
     544   !> @param[in] id_radius    filter halo radius 
     545   !------------------------------------------------------------------- 
    500546   SUBROUTINE filter__1D(dd_value, dd_fill, dd_coef, id_radius) 
    501547      IMPLICIT NONE 
     
    507553 
    508554      ! local variable 
    509       INTEGER(i4), DIMENSION(1)                :: il_shape 
     555      INTEGER(i4), DIMENSION(1)              :: il_shape 
    510556      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value 
    511557 
     
    519565      DO ji=1+id_radius,il_shape(1)-id_radius 
    520566 
     567         dl_value(:)=dd_fill 
    521568         dl_value(:)=dd_value(ji-id_radius:ji+id_radius) 
    522569 
    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 
     570         dd_value(ji)=SUM(dl_value(:)*dd_coef(:)) 
    531571 
    532572      ENDDO 
     
    535575 
    536576   END SUBROUTINE filter__1D 
    537    !> @endcode 
    538577   !------------------------------------------------------------------- 
    539578   !> @brief This function compute filter coefficient.  
     
    548587   !> - butterworth 
    549588   !> 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 
     589   !> As well as a filter parameter for gauss and butterworth filter 
     590   ! 
     591   !> @author J.Paul 
     592   !> - November, 2013- Initial Version 
     593   ! 
     594   !> @param[in] cd_name   filter name 
     595   !> @param[in] dd_cutoff cut-off frequency 
     596   !> @param[in] id_radius filter halo radius 
     597   !> @param[in] dd_alpha  filter parameter  
     598   !> @return array of filter coefficient 
     599   !------------------------------------------------------------------- 
    562600   FUNCTION filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) 
    563601      IMPLICIT NONE 
     
    596634 
    597635   END FUNCTION filter__2D_coef 
    598    !> @endcode 
    599636   !------------------------------------------------------------------- 
    600637   !> @brief This function compute filter coefficient.  
     
    612649   ! 
    613650   !> @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 
     651   !> - November, 2013- Initial Version 
     652   ! 
     653   !> @param[in] cd_name   filter name 
     654   !> @param[in] dd_cutoff cut-off frequency 
     655   !> @param[in] id_radius filter halo radius 
     656   !> @param[in] dd_alpha  filter parameter  
     657   !> @return array of filter coefficient 
     658   !------------------------------------------------------------------- 
    623659   FUNCTION filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) 
    624660      IMPLICIT NONE 
     
    653689 
    654690   END FUNCTION filter__1D_coef 
    655    !> @endcode 
    656691   !------------------------------------------------------------------- 
    657692   !> @brief This function compute coefficient for HANN filter. 
     
    660695   ! 
    661696   !> @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 
     697   !> - November, 2013- Initial Version 
     698   ! 
     699   !> @param[in] dd_cutoff cut-off frequency 
     700   !> @param[in] id_radius filter halo radius 
     701   !> @return array of hann filter coefficient  
     702   !------------------------------------------------------------------- 
    669703   FUNCTION filter__1D_hann(dd_cutoff, id_radius) 
    670704      IMPLICIT NONE 
     
    695729             
    696730            IF( dl_rad < dd_cutoff )THEN 
    697                filter__1D_hann(ji)=0.5 + 0.5*COS(dg_pi*dl_rad/dd_cutoff) 
     731               filter__1D_hann(ji)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff) 
    698732            ELSE 
    699733               filter__1D_hann(ji)=0 
     
    709743 
    710744   END FUNCTION filter__1D_hann 
    711    !> @endcode 
    712745   !------------------------------------------------------------------- 
    713746   !> @brief This function compute coefficient for HANN filter. 
     
    716749   ! 
    717750   !> @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 
     751   !> - November, 2013- Initial Version 
     752   ! 
     753   !> @param[in] dd_cutoff cut-off frequency 
     754   !> @param[in] id_radius filter halo radius 
     755   !> @return array of hann filter coefficient  
     756   !------------------------------------------------------------------- 
    725757   FUNCTION filter__2D_hann(dd_cutoff, id_radius) 
    726758      IMPLICIT NONE 
     
    755787                
    756788               IF( dl_rad < dd_cutoff )THEN 
    757                   filter__2D_hann(ji,jj)=0.5 + 0.5*COS(dg_pi*dl_rad/dd_cutoff) 
     789                  filter__2D_hann(ji,jj)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff) 
    758790               ELSE 
    759791                  filter__2D_hann(ji,jj)=0 
     
    770802 
    771803   END FUNCTION filter__2D_hann 
    772    !> @endcode 
    773804   !------------------------------------------------------------------- 
    774805   !> @brief This function compute coefficient for HAMMING filter. 
     
    777808   ! 
    778809   !> @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 
     810   !> - November, 2013- Initial Version 
     811   ! 
     812   !> @param[in] dd_cutoff cut-off frequency 
     813   !> @param[in] id_radius filter halo radius 
     814   !> @return array of hamming filter coefficient  
     815   !------------------------------------------------------------------- 
    786816   FUNCTION filter__1D_hamming(dd_cutoff, id_radius) 
    787817      IMPLICIT NONE 
     
    813843            IF( dl_rad < dd_cutoff )THEN 
    814844               filter__1D_hamming(ji)= 0.54 & 
    815                &                     + 0.46*COS(dg_pi*dl_rad/dd_cutoff) 
     845               &                     + 0.46*COS(dp_pi*dl_rad/dd_cutoff) 
    816846            ELSE 
    817847               filter__1D_hamming(ji)=0 
     
    827857 
    828858   END FUNCTION filter__1D_hamming 
    829    !> @endcode 
    830859   !------------------------------------------------------------------- 
    831860   !> @brief This function compute coefficient for HAMMING filter. 
     
    834863   ! 
    835864   !> @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 
     865   !> - November, 2013- Initial Version 
     866   ! 
     867   !> @param[in] dd_cutoff cut-off frequency 
     868   !> @param[in] id_radius filter halo radius 
     869   !> @return array of hamming filter coefficient  
     870   !------------------------------------------------------------------- 
    843871   FUNCTION filter__2D_hamming(dd_cutoff, id_radius) 
    844872      IMPLICIT NONE 
     
    873901               IF( dl_rad < dd_cutoff )THEN 
    874902                  filter__2D_hamming(ji,jj)= 0.54 & 
    875                   &                        + 0.46*COS(dg_pi*dl_rad/dd_cutoff) 
     903                  &                        + 0.46*COS(dp_pi*dl_rad/dd_cutoff) 
    876904               ELSE 
    877905                  filter__2D_hamming(ji,jj)=0 
     
    888916 
    889917   END FUNCTION filter__2D_hamming 
    890    !> @endcode 
    891918   !------------------------------------------------------------------- 
    892919   !> @brief This function compute coefficient for BLACKMAN filter. 
     
    895922   ! 
    896923   !> @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 
     924   !> - November, 2013- Initial Version 
     925   ! 
     926   !> @param[in] dd_cutoff cut-off frequency 
     927   !> @param[in] id_radius filter halo radius 
     928   !> @return array of blackman filter coefficient  
     929   !------------------------------------------------------------------- 
    904930   FUNCTION filter__1D_blackman(dd_cutoff, id_radius) 
    905931      IMPLICIT NONE 
     
    931957            IF( dl_rad < dd_cutoff )THEN 
    932958               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) 
     959               &                      + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) & 
     960               &                      + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff) 
    935961            ELSE 
    936962               filter__1D_blackman(ji)=0 
     
    946972 
    947973   END FUNCTION filter__1D_blackman 
    948    !> @endcode 
    949974   !------------------------------------------------------------------- 
    950975   !> @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 
     976   !> 
     977   !> @details 
     978   !> 
     979   !> @author J.Paul 
     980   !> - November, 2013- Initial Version 
     981   !> 
     982   !> @param[in] dd_cutoff cut-off frequency 
     983   !> @param[in] id_radius filter halo radius 
     984   !> @return array of blackman filter coefficient  
     985   !------------------------------------------------------------------- 
    962986   FUNCTION filter__2D_blackman(dd_cutoff, id_radius) 
    963987      IMPLICIT NONE 
     
    9921016               IF( dl_rad < dd_cutoff )THEN 
    9931017                  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) 
     1018                  &                         + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) & 
     1019                  &                         + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff) 
    9961020               ELSE 
    9971021                  filter__2D_blackman(ji,jj)=0 
     
    10081032 
    10091033   END FUNCTION filter__2D_blackman 
    1010    !> @endcode 
    10111034   !------------------------------------------------------------------- 
    10121035   !> @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 
     1036   !> 
     1037   !> @details 
     1038   !> 
     1039   !> @author J.Paul 
     1040   !> - November, 2013- Initial Version 
     1041   !> 
     1042   !> @param[in] dd_cutoff cut-off frequency 
     1043   !> @param[in] id_radius filter halo radius 
     1044   !> @param[in] dd_alpha  filter parameter 
     1045   !> @return array of gauss filter coefficient  
     1046   !------------------------------------------------------------------- 
    10251047   FUNCTION filter__1D_gauss(dd_cutoff, id_radius, dd_alpha) 
    10261048      IMPLICIT NONE 
     
    10621084 
    10631085   END FUNCTION filter__1D_gauss 
    1064    !> @endcode 
    10651086   !------------------------------------------------------------------- 
    10661087   !> @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 
     1088   !> 
     1089   !> @details 
     1090   !> 
     1091   !> @author J.Paul 
     1092   !> - November, 2013- Initial Version 
     1093   !> 
     1094   !> @param[in] dd_cutoff cut-off frequency 
     1095   !> @param[in] id_radius filter halo radius 
     1096   !> @param[in] dd_alpha  filter parameter 
     1097   !> @return array of gauss filter coefficient  
     1098   !------------------------------------------------------------------- 
    10791099   FUNCTION filter__2D_gauss(dd_cutoff, id_radius, dd_alpha) 
    10801100      IMPLICIT NONE 
     
    11201140 
    11211141   END FUNCTION filter__2D_gauss 
    1122    !> @endcode 
    11231142   !------------------------------------------------------------------- 
    11241143   !> @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 
     1144   !> 
     1145   !> @details 
     1146   !> 
     1147   !> @author J.Paul 
     1148   !> - November, 2013- Initial Version 
     1149   !> 
     1150   !> @param[in] dd_cutoff cut-off frequency 
     1151   !> @param[in] id_radius filter halo radius 
     1152   !> @param[in] dd_alpha  filter parameter 
     1153   !> @return array of butterworth filter coefficient  
     1154   !------------------------------------------------------------------- 
    11371155   FUNCTION filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha) 
    11381156      IMPLICIT NONE 
     
    11741192 
    11751193   END FUNCTION filter__1D_butterworth 
    1176    !> @endcode 
    11771194   !------------------------------------------------------------------- 
    11781195   !> @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 
     1196   !> 
     1197   !> @details 
     1198   !> 
     1199   !> @author J.Paul 
     1200   !> - November, 2013- Initial Version 
     1201   !> 
     1202   !> @param[in] dd_cutoff cut-off frequency 
     1203   !> @param[in] id_radius filter halo radius 
     1204   !> @param[in] dd_alpha  filter parameter 
     1205   !> @return array of butterworth filter coefficient  
     1206   !------------------------------------------------------------------- 
    11911207   FUNCTION filter__2D_butterworth(dd_cutoff,  id_radius, dd_alpha) 
    11921208      IMPLICIT NONE 
     
    12321248 
    12331249   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 
    12761250END MODULE filter 
    12771251 
Note: See TracChangeset for help on using the changeset viewer.