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 12080 for utils/tools/SIREN/src/filter.f90 – NEMO

Ignore:
Timestamp:
2019-12-06T10:30:14+01:00 (4 years ago)
Author:
jpaul
Message:

update nemo trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • utils/tools/SIREN/src/filter.f90

    r9598 r12080  
    22! NEMO system team, System and Interface for oceanic RElocable Nesting 
    33!---------------------------------------------------------------------- 
    4 ! 
    5 ! MODULE: filter 
    64! 
    75! DESCRIPTION: 
    … …  
    5553!> @author 
    5654!> J.Paul 
    57 ! REVISION HISTORY: 
     55!> 
    5856!> @date November, 2013 - Initial Version 
    59 ! 
    60 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     57!> 
     58!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6159!---------------------------------------------------------------------- 
    6260MODULE filter 
     61 
    6362   USE kind                            ! F90 kind parameter 
    6463   USE phycst                          ! physical constant 
    … …  
    6867   USE var                             ! variable manager 
    6968   USE extrap                          ! extrapolation manager 
     69 
    7070   IMPLICIT NONE 
    7171   ! NOTE_avoid_public_variables_if_possible 
    … …  
    102102 
    103103CONTAINS 
     104   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     105   SUBROUTINE filter__fill_value_wrapper(td_var) 
    104106   !------------------------------------------------------------------- 
    105107   !> @brief 
    … …  
    112114   !> @author J.Paul 
    113115   !> @date November, 2013 - Initial Version 
    114    ! 
     116   !> 
    115117   !> @param[inout] td_var variable structure  
    116118   !------------------------------------------------------------------- 
    117    SUBROUTINE filter__fill_value_wrapper( td_var ) 
    118       IMPLICIT NONE 
     119 
     120      IMPLICIT NONE 
     121 
    119122      ! Argument 
    120123      TYPE(TVAR), INTENT(INOUT) :: td_var 
    … …  
    244247      ENDIF 
    245248   END SUBROUTINE filter__fill_value_wrapper 
     249   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     250   SUBROUTINE filter__fill_value(td_var, cd_name, & 
     251         &                       dd_cutoff, id_radius, dd_alpha) 
    246252   !------------------------------------------------------------------- 
    247253   !> @brief 
    … …  
    256262   !> @author J.Paul 
    257263   !> @date November, 2013 - Initial Version 
    258    ! 
     264   !> 
    259265   !> @param[inout] td_var variable  
    260266   !> @param[in] cd_name   filter name 
    … …  
    263269   !> @param[in] dd_alpha  filter parameter 
    264270   !------------------------------------------------------------------- 
    265    SUBROUTINE filter__fill_value( td_var, cd_name, & 
    266    &                              dd_cutoff, id_radius, dd_alpha ) 
    267       IMPLICIT NONE 
     271 
     272      IMPLICIT NONE 
     273 
    268274      ! Argument 
    269275      TYPE(TVAR)      , INTENT(INOUT) :: td_var 
    … …  
    335341 
    336342   END SUBROUTINE filter__fill_value 
     343   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     344   SUBROUTINE filter__3D_fill_value(dd_value, dd_fill, cd_name, & 
     345         &                          dd_cutoff, id_radius, dd_alpha) 
    337346   !------------------------------------------------------------------- 
    338347   !> @brief This subroutine compute filtered value of 3D array.  
    … …  
    344353   !> @warning array of value should have been already extrapolated before 
    345354   !> running this subroutine. 
    346    ! 
    347    !> @author J.Paul 
    348    !> @date November, 2013 - Initial Version 
    349    ! 
     355   !> 
     356   !> @author J.Paul 
     357   !> @date November, 2013 - Initial Version 
     358   !> 
    350359   !> @param[inout] dd_value  array of value to be filtered  
    351360   !> @param[in] dd_fill      fill value  
    … …  
    355364   !> @param[in] dd_alpha     filter parameter 
    356365   !------------------------------------------------------------------- 
    357    SUBROUTINE filter__3D_fill_value( dd_value, dd_fill, cd_name, & 
    358    &                                 dd_cutoff, id_radius, dd_alpha) 
    359       IMPLICIT NONE 
     366 
     367      IMPLICIT NONE 
     368 
    360369      ! Argument       
    361370      REAL(dp)        , DIMENSION(:,:,:), INTENT(INOUT) :: dd_value 
    … …  
    387396 
    388397   END SUBROUTINE filter__3D_fill_value 
     398   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     399   SUBROUTINE filter__2D_fill_value(dd_value, dd_fill, cd_name, & 
     400         &                          dd_cutoff, id_radius, dd_alpha) 
    389401   !------------------------------------------------------------------- 
    390402   !> @brief This subroutine compute filtered value of 2D array. 
    391    ! 
     403   !> 
    392404   !> @details 
    393405   !>    First compute filter coefficient. 
    … …  
    399411   !> @author J.Paul 
    400412   !> @date November, 2013 - Initial Version 
    401    ! 
     413   !> 
    402414   !> @param[inout] dd_value  array of value to be filtered  
    403415   !> @param[in] dd_fill      fill value  
    … …  
    407419   !> @param[in] dd_alpha     filter parameter 
    408420   !------------------------------------------------------------------- 
    409    SUBROUTINE filter__2D_fill_value( dd_value, dd_fill, cd_name, & 
    410    &                                 dd_cutoff, id_radius, dd_alpha) 
    411       IMPLICIT NONE 
     421 
     422      IMPLICIT NONE 
     423 
    412424      ! Argument 
    413425      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
    … …  
    433445 
    434446   END SUBROUTINE filter__2D_fill_value 
     447   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     448   SUBROUTINE filter__1D_fill_value(dd_value, dd_fill, cd_name, & 
     449         &                          dd_cutoff, id_radius, dd_alpha) 
    435450   !------------------------------------------------------------------- 
    436451   !> @brief This subroutine compute filtered value of 1D array. 
    437    ! 
     452   !> 
    438453   !> @details 
    439454   !>    First compute filter coefficient. 
    … …  
    445460   !> @author J.Paul 
    446461   !> @date November, 2013 - Initial Version 
    447    ! 
     462   !> 
    448463   !> @param[inout] dd_value  array of value to be filtered  
    449464   !> @param[in] dd_fill      fill value  
    … …  
    453468   !> @param[in] dd_alpha     filter parameter 
    454469   !------------------------------------------------------------------- 
    455    SUBROUTINE filter__1D_fill_value( dd_value, dd_fill, cd_name, & 
    456    &                                 dd_cutoff, id_radius, dd_alpha) 
    457       IMPLICIT NONE 
     470 
     471      IMPLICIT NONE 
     472 
    458473      ! Argument       
    459474      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value 
    … …  
    479494 
    480495   END SUBROUTINE filter__1D_fill_value 
     496   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     497   SUBROUTINE filter__2D(dd_value, dd_fill, dd_coef, id_radius) 
    481498   !------------------------------------------------------------------- 
    482499   !> @brief This subroutine filtered 2D array of value  
    … …  
    488505   !> @author J.Paul 
    489506   !> @date November, 2013 - Initial Version 
    490    ! 
     507   !> 
    491508   !> @param[inout] dd_value  array of value to be filtered  
    492509   !> @param[in] dd_fill      fill value  
    … …  
    494511   !> @param[in] id_radius    filter halo radius 
    495512   !------------------------------------------------------------------- 
    496    SUBROUTINE filter__2D(dd_value, dd_fill, dd_coef, id_radius) 
    497       IMPLICIT NONE 
     513 
     514      IMPLICIT NONE 
     515 
    498516      ! Argument       
    499517      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
    … …  
    534552 
    535553   END SUBROUTINE filter__2D 
     554   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     555   SUBROUTINE filter__1D(dd_value, dd_fill, dd_coef, id_radius) 
    536556   !------------------------------------------------------------------- 
    537557   !> @brief This subroutine filtered 1D array of value   
    538    ! 
     558   !> 
    539559   !> @details 
    540560   !>    loop on first dimension,  
    … …  
    543563   !> @author J.Paul 
    544564   !> @date November, 2013 - Initial Version 
    545    ! 
     565   !> 
    546566   !> @param[inout] dd_value  array of value to be filtered  
    547567   !> @param[in] dd_fill      fill value  
    … …  
    549569   !> @param[in] id_radius    filter halo radius 
    550570   !------------------------------------------------------------------- 
    551    SUBROUTINE filter__1D(dd_value, dd_fill, dd_coef, id_radius) 
    552       IMPLICIT NONE 
     571 
     572      IMPLICIT NONE 
     573 
    553574      ! Argument       
    554575      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value 
    … …  
    580601 
    581602   END SUBROUTINE filter__1D 
     603   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     604   FUNCTION filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) & 
     605         & RESULT (df_coef) 
    582606   !------------------------------------------------------------------- 
    583607   !> @brief This function compute filter coefficient.  
    584    ! 
     608   !> 
    585609   !> @details 
    586610   !>  
    … …  
    593617   !> Cut-off frequency could be specify. 
    594618   !> As well as a filter parameter for gauss and butterworth filter 
    595    ! 
    596    !> @author J.Paul 
    597    !> @date November, 2013 - Initial Version 
    598    ! 
     619   !> 
     620   !> @author J.Paul 
     621   !> @date November, 2013 - Initial Version 
     622   !> 
    599623   !> @param[in] cd_name   filter name 
    600624   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    603627   !> @return array of filter coefficient 
    604628   !------------------------------------------------------------------- 
    605    FUNCTION filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) 
    606       IMPLICIT NONE 
     629 
     630      IMPLICIT NONE 
     631 
    607632      ! Argument       
    608633      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    … …  
    612637 
    613638      ! function 
    614       REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_coef 
     639      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef 
    615640 
    616641      ! local variable 
    … …  
    625650      SELECT CASE(TRIM(fct_lower(cd_name))) 
    626651      CASE('hann') 
    627          filter__2D_coef(:,:)=filter__2D_hann(dd_cutoff, id_radius) 
     652         df_coef(:,:)=filter__2D_hann(dd_cutoff, id_radius) 
    628653      CASE('hamming') 
    629          filter__2D_coef(:,:)=filter__2D_hamming(dd_cutoff, id_radius) 
     654         df_coef(:,:)=filter__2D_hamming(dd_cutoff, id_radius) 
    630655      CASE('blackman') 
    631          filter__2D_coef(:,:)=filter__2D_blackman(dd_cutoff, id_radius) 
     656         df_coef(:,:)=filter__2D_blackman(dd_cutoff, id_radius) 
    632657      CASE('gauss') 
    633          filter__2D_coef(:,:)=filter__2D_gauss(dd_cutoff, id_radius, dd_alpha) 
     658         df_coef(:,:)=filter__2D_gauss(dd_cutoff, id_radius, dd_alpha) 
    634659      CASE('butterworth') 
    635          filter__2D_coef(:,:)=filter__2D_butterworth(dd_cutoff, id_radius, dd_alpha) 
     660         df_coef(:,:)=filter__2D_butterworth(dd_cutoff, id_radius, dd_alpha) 
    636661      CASE DEFAULT 
    637662         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name)) 
    … …  
    639664 
    640665   END FUNCTION filter__2D_coef 
     666   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     667   FUNCTION filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) & 
     668         & RESULT (df_coef) 
    641669   !------------------------------------------------------------------- 
    642670   !> @brief This function compute filter coefficient.  
    643    ! 
     671   !> 
    644672   !> @details 
    645673   !>  
    … …  
    652680   !> Cut-off frequency could be specify. 
    653681   !> As well as a filter parameter for gauss an butterworth filter 
    654    ! 
    655    !> @author J.Paul 
    656    !> @date November, 2013 - Initial Version 
    657    ! 
     682   !> 
     683   !> @author J.Paul 
     684   !> @date November, 2013 - Initial Version 
     685   !> 
    658686   !> @param[in] cd_name   filter name 
    659687   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    662690   !> @return array of filter coefficient 
    663691   !------------------------------------------------------------------- 
    664    FUNCTION filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) 
    665       IMPLICIT NONE 
     692 
     693      IMPLICIT NONE 
     694 
    666695      ! Argument       
    667696      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    … …  
    671700 
    672701      ! function 
    673       REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_coef 
     702      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef 
    674703 
    675704      ! local variable 
    … …  
    680709      SELECT CASE(TRIM(fct_lower(cd_name))) 
    681710      CASE('hann') 
    682          filter__1D_coef(:)=filter__1D_hann(dd_cutoff, id_radius) 
     711         df_coef(:)=filter__1D_hann(dd_cutoff, id_radius) 
    683712      CASE('hamming') 
    684          filter__1D_coef(:)=filter__1D_hamming(dd_cutoff, id_radius) 
     713         df_coef(:)=filter__1D_hamming(dd_cutoff, id_radius) 
    685714      CASE('blackman') 
    686          filter__1D_coef(:)=filter__1D_blackman(dd_cutoff, id_radius) 
     715         df_coef(:)=filter__1D_blackman(dd_cutoff, id_radius) 
    687716      CASE('gauss') 
    688          filter__1D_coef(:)=filter__1D_gauss(dd_cutoff, id_radius, dd_alpha) 
     717         df_coef(:)=filter__1D_gauss(dd_cutoff, id_radius, dd_alpha) 
    689718      CASE('butterworth') 
    690          filter__1D_coef(:)=filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha) 
     719         df_coef(:)=filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha) 
    691720      CASE DEFAULT 
    692721         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name)) 
    … …  
    694723 
    695724   END FUNCTION filter__1D_coef 
     725   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     726   FUNCTION filter__1D_hann(dd_cutoff, id_radius) & 
     727         & RESULT (df_coef) 
    696728   !------------------------------------------------------------------- 
    697729   !> @brief This function compute coefficient for HANN filter. 
    698    ! 
    699    !> @details 
    700    ! 
    701    !> @author J.Paul 
    702    !> @date November, 2013 - Initial Version 
    703    ! 
     730   !> 
     731   !> @details 
     732   !> 
     733   !> @author J.Paul 
     734   !> @date November, 2013 - Initial Version 
     735   !> 
    704736   !> @param[in] dd_cutoff cut-off frequency 
    705737   !> @param[in] id_radius filter halo radius 
    706738   !> @return array of hann filter coefficient  
    707739   !------------------------------------------------------------------- 
    708    FUNCTION filter__1D_hann(dd_cutoff, id_radius) 
    709       IMPLICIT NONE 
     740 
     741      IMPLICIT NONE 
     742 
    710743      ! Argument       
    711744      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    713746 
    714747      ! function 
    715       REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_hann 
     748      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef 
    716749 
    717750      ! local variable 
    … …  
    726759         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    727760         &  "should be greater than or equal to 1. No filter will be apply ") 
    728          filter__1D_hann(:)=0. 
    729          filter__1D_hann(id_radius+1)=1. 
     761         df_coef(:)=0. 
     762         df_coef(id_radius+1)=1. 
    730763      ELSE 
    731764         DO ji=1,2*id_radius+1 
    … …  
    734767             
    735768            IF( dl_rad < dd_cutoff )THEN 
    736                filter__1D_hann(ji)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff) 
     769               df_coef(ji)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff) 
    737770            ELSE 
    738                filter__1D_hann(ji)=0 
     771               df_coef(ji)=0 
    739772            ENDIF 
    740773 
    … …  
    742775 
    743776         ! normalize 
    744          dl_sum=SUM(filter__1D_hann(:)) 
    745  
    746          filter__1D_hann(:)=filter__1D_hann(:)/dl_sum 
     777         dl_sum=SUM(df_coef(:)) 
     778 
     779         df_coef(:)=df_coef(:)/dl_sum 
    747780      ENDIF 
    748781 
    749782   END FUNCTION filter__1D_hann 
     783   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     784   FUNCTION filter__2D_hann(dd_cutoff, id_radius) & 
     785         & RESULT (df_coef) 
    750786   !------------------------------------------------------------------- 
    751787   !> @brief This function compute coefficient for HANN filter. 
    752    ! 
    753    !> @details 
    754    ! 
    755    !> @author J.Paul 
    756    !> @date November, 2013 - Initial Version 
    757    ! 
     788   !> 
     789   !> @details 
     790   !> 
     791   !> @author J.Paul 
     792   !> @date November, 2013 - Initial Version 
     793   !> 
    758794   !> @param[in] dd_cutoff cut-off frequency 
    759795   !> @param[in] id_radius filter halo radius 
    760796   !> @return array of hann filter coefficient  
    761797   !------------------------------------------------------------------- 
    762    FUNCTION filter__2D_hann(dd_cutoff, id_radius) 
    763       IMPLICIT NONE 
     798 
     799      IMPLICIT NONE 
     800 
    764801      ! Argument       
    765802      REAL(dp)   , INTENT(IN) :: dd_cutoff  
    … …  
    767804 
    768805      ! function 
    769       REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_hann 
     806      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef 
    770807 
    771808      ! local variable 
    … …  
    781818         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    782819         &  "should be greater than or equal to 1. No filter will be apply ") 
    783          filter__2D_hann(:,:)=0. 
    784          filter__2D_hann(id_radius+1,id_radius+1)=1. 
     820         df_coef(:,:)=0. 
     821         df_coef(id_radius+1,id_radius+1)=1. 
    785822      ELSE 
    786823         DO jj=1,2*id_radius+1 
    … …  
    792829                
    793830               IF( dl_rad < dd_cutoff )THEN 
    794                   filter__2D_hann(ji,jj)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff) 
     831                  df_coef(ji,jj)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff) 
    795832               ELSE 
    796                   filter__2D_hann(ji,jj)=0 
     833                  df_coef(ji,jj)=0 
    797834               ENDIF 
    798835 
    … …  
    801838 
    802839         ! normalize 
    803          dl_sum=SUM(filter__2D_hann(:,:)) 
    804  
    805          filter__2D_hann(:,:)=filter__2D_hann(:,:)/dl_sum 
     840         dl_sum=SUM(df_coef(:,:)) 
     841 
     842         df_coef(:,:)=df_coef(:,:)/dl_sum 
    806843      ENDIF 
    807844 
    808845   END FUNCTION filter__2D_hann 
     846   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     847   FUNCTION filter__1D_hamming(dd_cutoff, id_radius) & 
     848         & RESULT (df_coef) 
    809849   !------------------------------------------------------------------- 
    810850   !> @brief This function compute coefficient for HAMMING filter. 
    811    ! 
    812    !> @details 
    813    ! 
    814    !> @author J.Paul 
    815    !> @date November, 2013 - Initial Version 
    816    ! 
     851   !> 
     852   !> @details 
     853   !> 
     854   !> @author J.Paul 
     855   !> @date November, 2013 - Initial Version 
     856   !> 
    817857   !> @param[in] dd_cutoff cut-off frequency 
    818858   !> @param[in] id_radius filter halo radius 
    819859   !> @return array of hamming filter coefficient  
    820860   !------------------------------------------------------------------- 
    821    FUNCTION filter__1D_hamming(dd_cutoff, id_radius) 
    822       IMPLICIT NONE 
     861 
     862      IMPLICIT NONE 
     863 
    823864      ! Argument       
    824865      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    826867 
    827868      ! function 
    828       REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_hamming 
     869      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef 
    829870 
    830871      ! local variable 
    … …  
    839880         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    840881         &  "should be greater than or equal to 1. No filter will be apply ") 
    841          filter__1D_hamming(:)=0. 
    842          filter__1D_hamming(id_radius+11)=1. 
     882         df_coef(:)=0. 
     883         df_coef(id_radius+11)=1. 
    843884      ELSE 
    844885         DO ji=1,2*id_radius+1 
    … …  
    847888          
    848889            IF( dl_rad < dd_cutoff )THEN 
    849                filter__1D_hamming(ji)= 0.54 & 
    850                &                     + 0.46*COS(dp_pi*dl_rad/dd_cutoff) 
     890               df_coef(ji)= 0.54 + 0.46*COS(dp_pi*dl_rad/dd_cutoff) 
    851891            ELSE 
    852                filter__1D_hamming(ji)=0 
     892               df_coef(ji)=0 
    853893            ENDIF 
    854894 
    … …  
    856896 
    857897         ! normalize 
    858          dl_sum=SUM(filter__1D_hamming(:)) 
    859  
    860          filter__1D_hamming(:)=filter__1D_hamming(:)/dl_sum 
     898         dl_sum=SUM(df_coef(:)) 
     899 
     900         df_coef(:)=df_coef(:)/dl_sum 
    861901      ENDIF 
    862902 
    863903   END FUNCTION filter__1D_hamming 
     904   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     905   FUNCTION filter__2D_hamming(dd_cutoff, id_radius) & 
     906         & RESULT (df_coef) 
    864907   !------------------------------------------------------------------- 
    865908   !> @brief This function compute coefficient for HAMMING filter. 
    866    ! 
    867    !> @details 
    868    ! 
    869    !> @author J.Paul 
    870    !> @date November, 2013 - Initial Version 
    871    ! 
     909   !> 
     910   !> @details 
     911   !> 
     912   !> @author J.Paul 
     913   !> @date November, 2013 - Initial Version 
     914   !> 
    872915   !> @param[in] dd_cutoff cut-off frequency 
    873916   !> @param[in] id_radius filter halo radius 
    874917   !> @return array of hamming filter coefficient  
    875918   !------------------------------------------------------------------- 
    876    FUNCTION filter__2D_hamming(dd_cutoff, id_radius) 
    877       IMPLICIT NONE 
     919 
     920      IMPLICIT NONE 
     921 
    878922      ! Argument       
    879923      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    881925 
    882926      ! function 
    883       REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_hamming 
     927      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef 
    884928 
    885929      ! local variable 
    … …  
    895939         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    896940         &  "should be greater than or equal to 1. No filter will be apply ") 
    897          filter__2D_hamming(:,:)=0. 
    898          filter__2D_hamming(id_radius+1,id_radius+1)=1. 
     941         df_coef(:,:)=0. 
     942         df_coef(id_radius+1,id_radius+1)=1. 
    899943      ELSE 
    900944         DO jj=1,2*id_radius+1 
    … …  
    902946 
    903947               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + & 
    904                &             REAL(jj-(id_radius+1),dp)**2 ) 
     948                  &          REAL(jj-(id_radius+1),dp)**2 ) 
    905949             
    906950               IF( dl_rad < dd_cutoff )THEN 
    907                   filter__2D_hamming(ji,jj)= 0.54 & 
    908                   &                        + 0.46*COS(dp_pi*dl_rad/dd_cutoff) 
     951                  df_coef(ji,jj)= 0.54 + 0.46*COS(dp_pi*dl_rad/dd_cutoff) 
    909952               ELSE 
    910                   filter__2D_hamming(ji,jj)=0 
     953                  df_coef(ji,jj)=0 
    911954               ENDIF 
    912955 
    … …  
    915958 
    916959         ! normalize 
    917          dl_sum=SUM(filter__2D_hamming(:,:)) 
    918  
    919          filter__2D_hamming(:,:)=filter__2D_hamming(:,:)/dl_sum 
     960         dl_sum=SUM(df_coef(:,:)) 
     961 
     962         df_coef(:,:)=df_coef(:,:)/dl_sum 
    920963      ENDIF 
    921964 
    922965   END FUNCTION filter__2D_hamming 
     966   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     967   FUNCTION filter__1D_blackman(dd_cutoff, id_radius) & 
     968         & RESULT (df_coef) 
    923969   !------------------------------------------------------------------- 
    924970   !> @brief This function compute coefficient for BLACKMAN filter. 
    925    ! 
    926    !> @details 
    927    ! 
    928    !> @author J.Paul 
    929    !> @date November, 2013 - Initial Version 
    930    ! 
     971   !> 
     972   !> @details 
     973   !> 
     974   !> @author J.Paul 
     975   !> @date November, 2013 - Initial Version 
     976   !> 
    931977   !> @param[in] dd_cutoff cut-off frequency 
    932978   !> @param[in] id_radius filter halo radius 
    933979   !> @return array of blackman filter coefficient  
    934980   !------------------------------------------------------------------- 
    935    FUNCTION filter__1D_blackman(dd_cutoff, id_radius) 
    936       IMPLICIT NONE 
     981 
     982      IMPLICIT NONE 
     983 
    937984      ! Argument       
    938985      REAL(dp)        , INTENT(IN) :: dd_cutoff 
    … …  
    940987 
    941988      ! function 
    942       REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_blackman 
     989      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef 
    943990 
    944991      ! local variable 
    … …  
    9531000         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    9541001         &  "should be greater than or equal to 1. No filter will be apply ") 
    955          filter__1D_blackman(:)=0. 
    956          filter__1D_blackman(id_radius+1)=1. 
     1002         df_coef(:)=0. 
     1003         df_coef(id_radius+1)=1. 
    9571004      ELSE       
    9581005         DO ji=1,2*id_radius+1 
    … …  
    9611008             
    9621009            IF( dl_rad < dd_cutoff )THEN 
    963                filter__1D_blackman(ji)= 0.42 & 
    964                &                      + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) & 
    965                &                      + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff) 
     1010               df_coef(ji)= 0.42 + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) & 
     1011                  &              + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff) 
    9661012            ELSE 
    967                filter__1D_blackman(ji)=0 
     1013               df_coef(ji)=0 
    9681014            ENDIF                                 
    9691015 
    … …  
    9711017 
    9721018         ! normalize 
    973          dl_sum=SUM(filter__1D_blackman(:)) 
    974  
    975          filter__1D_blackman(:)=filter__1D_blackman(:)/dl_sum 
     1019         dl_sum=SUM(df_coef(:)) 
     1020 
     1021         df_coef(:)=df_coef(:)/dl_sum 
    9761022      ENDIF 
    9771023 
    9781024   END FUNCTION filter__1D_blackman 
     1025   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1026   FUNCTION filter__2D_blackman(dd_cutoff, id_radius) & 
     1027         & RESULT (df_coef) 
    9791028   !------------------------------------------------------------------- 
    9801029   !> @brief This function compute coefficient for BLACKMAN filter. 
    … …  
    9891038   !> @return array of blackman filter coefficient  
    9901039   !------------------------------------------------------------------- 
    991    FUNCTION filter__2D_blackman(dd_cutoff, id_radius) 
    992       IMPLICIT NONE 
     1040 
     1041      IMPLICIT NONE 
     1042 
    9931043      ! Argument       
    9941044      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    9961046 
    9971047      ! function 
    998       REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_blackman 
     1048      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef 
    9991049 
    10001050      ! local variable 
    … …  
    10101060         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    10111061         &  "should be greater than or equal to 1. No filter will be apply ") 
    1012          filter__2D_blackman(:,:)=0. 
    1013          filter__2D_blackman(id_radius+1,id_radius+1)=1. 
     1062         df_coef(:,:)=0. 
     1063         df_coef(id_radius+1,id_radius+1)=1. 
    10141064      ELSE       
    10151065         DO jj=1,2*id_radius+1 
    … …  
    10201070                
    10211071               IF( dl_rad < dd_cutoff )THEN 
    1022                   filter__2D_blackman(ji,jj)= 0.42 & 
    1023                   &                         + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) & 
    1024                   &                         + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff) 
     1072                  df_coef(ji,jj)= 0.42 + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) & 
     1073                     &                 + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff) 
    10251074               ELSE 
    1026                   filter__2D_blackman(ji,jj)=0 
     1075                  df_coef(ji,jj)=0 
    10271076               ENDIF                                 
    10281077 
    … …  
    10311080 
    10321081         ! normalize 
    1033          dl_sum=SUM(filter__2D_blackman(:,:)) 
    1034  
    1035          filter__2D_blackman(:,:)=filter__2D_blackman(:,:)/dl_sum 
     1082         dl_sum=SUM(df_coef(:,:)) 
     1083 
     1084         df_coef(:,:)=df_coef(:,:)/dl_sum 
    10361085      ENDIF 
    10371086 
    10381087   END FUNCTION filter__2D_blackman 
     1088   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1089   FUNCTION filter__1D_gauss(dd_cutoff, id_radius, dd_alpha) & 
     1090         & RESULT (df_coef) 
    10391091   !------------------------------------------------------------------- 
    10401092   !> @brief This function compute coefficient for GAUSS filter. 
    … …  
    10501102   !> @return array of gauss filter coefficient  
    10511103   !------------------------------------------------------------------- 
    1052    FUNCTION filter__1D_gauss(dd_cutoff, id_radius, dd_alpha) 
    1053       IMPLICIT NONE 
     1104 
     1105      IMPLICIT NONE 
     1106 
    10541107      ! Argument       
    10551108      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    10581111 
    10591112      ! function 
    1060       REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_gauss 
     1113      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef 
    10611114 
    10621115      ! local variable 
    … …  
    10711124         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    10721125         &  "should be greater than or equal to 1. No filter will be apply ") 
    1073          filter__1D_gauss(:)=0. 
    1074          filter__1D_gauss(id_radius+1)=1. 
     1126         df_coef(:)=0. 
     1127         df_coef(id_radius+1)=1. 
    10751128      ELSE 
    10761129         DO ji=1,2*id_radius+1 
    … …  
    10781131            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 ) 
    10791132             
    1080             filter__1D_gauss(ji)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2)) 
     1133            df_coef(ji)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2)) 
    10811134 
    10821135         ENDDO 
    10831136 
    10841137         ! normalize 
    1085          dl_sum=SUM(filter__1D_gauss(:)) 
    1086  
    1087          filter__1D_gauss(:)=filter__1D_gauss(:)/dl_sum 
     1138         dl_sum=SUM(df_coef(:)) 
     1139 
     1140         df_coef(:)=df_coef(:)/dl_sum 
    10881141      ENDIF 
    10891142 
    10901143   END FUNCTION filter__1D_gauss 
     1144   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1145   FUNCTION filter__2D_gauss(dd_cutoff, id_radius, dd_alpha) & 
     1146         & RESULT (df_coef) 
    10911147   !------------------------------------------------------------------- 
    10921148   !> @brief This function compute coefficient for GAUSS filter. 
    … …  
    11021158   !> @return array of gauss filter coefficient  
    11031159   !------------------------------------------------------------------- 
    1104    FUNCTION filter__2D_gauss(dd_cutoff, id_radius, dd_alpha) 
    1105       IMPLICIT NONE 
     1160 
     1161      IMPLICIT NONE 
     1162 
    11061163      ! Argument       
    11071164      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    11101167 
    11111168      ! function 
    1112       REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_gauss 
     1169      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef 
    11131170 
    11141171      ! local variable 
    … …  
    11241181         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    11251182         &  "should be greater than or equal to 1. No filter will be apply ") 
    1126          filter__2D_gauss(:,:)=0. 
    1127          filter__2D_gauss(id_radius+1,id_radius+1)=1. 
     1183         df_coef(:,:)=0. 
     1184         df_coef(id_radius+1,id_radius+1)=1. 
    11281185      ELSE 
    11291186         DO jj=1,2*id_radius+1 
    … …  
    11311188 
    11321189               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + & 
    1133                &             REAL(jj-(id_radius+1),dp)**2 ) 
     1190                  &          REAL(jj-(id_radius+1),dp)**2 ) 
    11341191                
    1135                filter__2D_gauss(ji,jj)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2)) 
     1192               df_coef(ji,jj)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2)) 
    11361193 
    11371194            ENDDO 
    … …  
    11391196 
    11401197         ! normalize 
    1141          dl_sum=SUM(filter__2D_gauss(:,:)) 
    1142  
    1143          filter__2D_gauss(:,:)=filter__2D_gauss(:,:)/dl_sum 
     1198         dl_sum=SUM(df_coef(:,:)) 
     1199 
     1200         df_coef(:,:)=df_coef(:,:)/dl_sum 
    11441201      ENDIF 
    11451202 
    11461203   END FUNCTION filter__2D_gauss 
     1204   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1205   FUNCTION filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha) & 
     1206         & RESULT (df_coef) 
    11471207   !------------------------------------------------------------------- 
    11481208   !> @brief This function compute coefficient for BUTTERWORTH filter. 
    … …  
    11581218   !> @return array of butterworth filter coefficient  
    11591219   !------------------------------------------------------------------- 
    1160    FUNCTION filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha) 
    1161       IMPLICIT NONE 
     1220 
     1221      IMPLICIT NONE 
     1222 
    11621223      ! Argument       
    11631224      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    11661227 
    11671228      ! function 
    1168       REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_butterworth 
     1229      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef 
    11691230 
    11701231      ! local variable 
    … …  
    11791240         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    11801241         &  "should be greater than 1. No filter will be apply ") 
    1181          filter__1D_butterworth(:)=0. 
    1182          filter__1D_butterworth(id_radius+1)=1. 
     1242         df_coef(:)=0. 
     1243         df_coef(id_radius+1)=1. 
    11831244      ELSE 
    11841245         DO ji=1,2*id_radius+1 
    … …  
    11861247            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 ) 
    11871248             
    1188             filter__1D_butterworth(ji)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha) 
     1249            df_coef(ji)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha) 
    11891250 
    11901251         ENDDO 
    11911252 
    11921253         ! normalize 
    1193          dl_sum=SUM(filter__1D_butterworth(:)) 
    1194  
    1195          filter__1D_butterworth(:)=filter__1D_butterworth(:)/dl_sum 
     1254         dl_sum=SUM(df_coef(:)) 
     1255 
     1256         df_coef(:)=df_coef(:)/dl_sum 
    11961257      ENDIF 
    11971258 
    11981259   END FUNCTION filter__1D_butterworth 
     1260   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1261   FUNCTION filter__2D_butterworth(dd_cutoff,  id_radius, dd_alpha) & 
     1262         & RESULT (df_coef) 
    11991263   !------------------------------------------------------------------- 
    12001264   !> @brief This function compute coefficient for BUTTERWORTH filter. 
    … …  
    12101274   !> @return array of butterworth filter coefficient  
    12111275   !------------------------------------------------------------------- 
    1212    FUNCTION filter__2D_butterworth(dd_cutoff,  id_radius, dd_alpha) 
    1213       IMPLICIT NONE 
     1276 
     1277      IMPLICIT NONE 
     1278 
    12141279      ! Argument       
    12151280      REAL(dp)        , INTENT(IN) :: dd_cutoff  
    … …  
    12181283 
    12191284      ! function 
    1220       REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_butterworth 
     1285      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef 
    12211286 
    12221287      ! local variable 
    … …  
    12321297         CALL logger_error("FILTER COEF: cut-off frequency "//& 
    12331298         &  "should be greater than 1. No filter will be apply ") 
    1234          filter__2D_butterworth(:,:)=0. 
    1235          filter__2D_butterworth(id_radius+1,id_radius+1)=1. 
     1299         df_coef(:,:)=0. 
     1300         df_coef(id_radius+1,id_radius+1)=1. 
    12361301      ELSE 
    12371302         DO jj=1,2*id_radius+1 
    … …  
    12391304 
    12401305               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + & 
    1241                &             REAL(jj-(id_radius+1),dp)**2 ) 
     1306                  &          REAL(jj-(id_radius+1),dp)**2 ) 
    12421307                
    1243                filter__2D_butterworth(ji,jj)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha) 
     1308               df_coef(ji,jj)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha) 
    12441309 
    12451310            ENDDO 
    … …  
    12471312 
    12481313         ! normalize 
    1249          dl_sum=SUM(filter__2D_butterworth(:,:)) 
    1250  
    1251          filter__2D_butterworth(:,:)=filter__2D_butterworth(:,:)/dl_sum 
     1314         dl_sum=SUM(df_coef(:,:)) 
     1315 
     1316         df_coef(:,:)=df_coef(:,:)/dl_sum 
    12521317      ENDIF 
    12531318 
    12541319   END FUNCTION filter__2D_butterworth 
     1320   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    12551321END MODULE filter 
    12561322 
Note: See TracChangeset for help on using the changeset viewer.