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 5581 for branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/TOOLS/SIREN/src/function.f90 – NEMO

Ignore:
Timestamp:
2015-07-10T13:28:53+02:00 (9 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/TOOLS/SIREN/src/function.f90

    r4213 r5581  
    77! DESCRIPTION: 
    88!> @brief 
    9 !> This module group some basic useful function 
    10 ! 
     9!> This module groups some basic useful function. 
     10!> 
     11!> @details 
     12!>  to get free I/O unit number:<br/> 
     13!> @code 
     14!>  il_id=fct_getunit() 
     15!> @endcode 
     16!> 
     17!>  to convert "numeric" to string character:<br/> 
     18!> @code 
     19!>  cl_string=fct_str(numeric) 
     20!> @endcode 
     21!>  - "numeric" could be integer, real, or logical 
     22!> 
     23!>  to concatenate "numeric" to a string character:<br/> 
     24!> @code 
     25!>  cl_str=cd_char//num 
     26!> @endcode 
     27!>  - cd_char is the string character 
     28!>  - num is the numeric value (integer, real or logical)   
     29!> 
     30!>  to concatenate all the element of a character array:<br/>  
     31!> @code 
     32!>  cl_string=fct_concat(cd_arr [,cd_sep]) 
     33!> @endcode 
     34!>  - cd_arr is a 1D array of character 
     35!>  - cd_sep is a separator character to add between each element of cd_arr  
     36!> [optional] 
     37!> 
     38!>  to convert character from lower to upper case:<br/> 
     39!> @code 
     40!>  cl_upper=fct_upper(cd_var) 
     41!> @endcode 
     42!> 
     43!>  to convert character from upper to lower case:<br/> 
     44!> @code 
     45!>  cl_lower=fct_lower(cd_var) 
     46!> @endcode 
     47!> 
     48!>  to check if character is numeric 
     49!> @code 
     50!>  ll_is_num=fct_is_num(cd_var) 
     51!> @endcode 
     52!> 
     53!>  to split string into substring and return one of the element:<br/>   
     54!> @code 
     55!>  cl_str=fct_split(cd_string ,id_ind [,cd_sep]) 
     56!> @endcode 
     57!>  - cd_string is a string of character 
     58!>  - id_ind is the indice of the lement to extract 
     59!>  - cd_sep is the separator use to split cd_string (default '|') 
     60!> 
     61!>  to get basename (name without path):<br/> 
     62!> @code 
     63!>  cl_str=fct_basename(cd_string [,cd_sep]) 
     64!> @endcode 
     65!>  - cd_string is the string filename 
     66!>  - cd_sep is the separator ti be used (default '/') 
     67!> 
     68!>  to get dirname (path of the filename):<br/> 
     69!> @code 
     70!>  cl_str=fct_dirname(cd_string [,cd_sep]) 
     71!> @endcode 
     72!>  - cd_string is the string filename 
     73!>  - cd_sep is the separator ti be used (default '/') 
     74!>   
     75!> to create a pause statement:<br/> 
     76!> @code 
     77!> CALL fct_pause(cd_msg) 
     78!> @endcode 
     79!>    - cd_msg : message to be added [optional] 
     80!> 
     81!> to handle frotran error:<br/> 
     82!> @code 
     83!> CALL fct_err(id_status) 
     84!> @endcode 
     85!>  
     86!>  
    1187!> @author 
    1288!> J.Paul 
    1389! REVISION HISTORY: 
    14 !> @date Nov, 2013 - Initial Version 
    15 ! 
    16 !> @todo 
    17 !> - TODO_describe_appropriate_changes - TODO_name 
    18 !> @param MyModule_type : brief_description 
     90!> @date November, 2013 - Initial Version 
     91!> @date September, 2014 - add header 
    1992! 
    2093!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    2396   USE kind                            ! F90 kind parameter 
    2497   IMPLICIT NONE 
    25    PRIVATE 
    2698   ! NOTE_avoid_public_variables_if_possible 
    2799 
    28100   ! function and subroutine 
    29    PUBLIC :: OPERATOR(//) 
    30    PUBLIC :: fct_getunit! returns free unit number 
    31    PUBLIC :: fct_err    ! handle fortran error status 
    32    PUBLIC :: fct_str    ! convert numeric to string character 
    33    PUBLIC :: fct_concat ! concatenate all the element of a character table 
    34    PUBLIC :: fct_upper  ! convert lower character to upper case 
    35    PUBLIC :: fct_lower  ! convert upper character to lower case 
    36    PUBLIC :: fct_is_num ! check if character is numeric 
    37    PUBLIC :: fct_split  ! split string into substring 
    38    PUBLIC :: fct_basename ! return basename (name without path) 
    39    PUBLIC :: fct_dirname ! return dirname (path without name) 
     101   PUBLIC :: fct_getunit  !< returns free unit number 
     102   PUBLIC :: fct_str      !< convert numeric to string character 
     103   PUBLIC :: OPERATOR(//) !< concatenate operator 
     104   PUBLIC :: fct_concat   !< concatenate all the element of a character array 
     105   PUBLIC :: fct_upper    !< convert character from lower to upper case 
     106   PUBLIC :: fct_lower    !< convert character from upper to lower case 
     107   PUBLIC :: fct_is_num   !< check if character is numeric 
     108   PUBLIC :: fct_split    !< split string into substring 
     109   PUBLIC :: fct_basename !< return basename (name without path) 
     110   PUBLIC :: fct_dirname  !< return dirname (path without filename) 
     111   PUBLIC :: fct_pause    !< pause statement 
     112   PUBLIC :: fct_err      !< handle fortran error status 
    40113 
    41114   PRIVATE :: fct__i1_str ! convert integer(1) to string character 
    … …  
    46119   PRIVATE :: fct__r8_str ! convert real(8) to string character 
    47120   PRIVATE :: fct__l_str  ! convert logical to string character 
    48  
     121   PRIVATE :: fct__i1_cat ! concatenate integer(1) to string character 
     122   PRIVATE :: fct__i2_cat ! concatenate integer(2) to string character 
     123   PRIVATE :: fct__i4_cat ! concatenate integer(4) to string character 
     124   PRIVATE :: fct__i8_cat ! concatenate integer(8) to string character 
     125   PRIVATE :: fct__r4_cat ! concatenate real(4) to string character 
     126   PRIVATE :: fct__r8_cat ! concatenate real(8) to string character 
     127   PRIVATE :: fct__l_cat  ! concatenate logical to string character 
     128   PRIVATE :: fct__split_space ! split string into substring using space as separator 
    49129 
    50130   INTERFACE fct_str 
    … …  
    59139 
    60140   INTERFACE OPERATOR(//) 
     141      MODULE PROCEDURE fct__i1_cat ! concatenate integer(1) to string character 
     142      MODULE PROCEDURE fct__i2_cat ! concatenate integer(2) to string character 
    61143      MODULE PROCEDURE fct__i4_cat ! concatenate integer(4) to string character 
    62144      MODULE PROCEDURE fct__i8_cat ! concatenate integer(8) to string character 
    … …  
    68150CONTAINS 
    69151   !-------------------------------------------------------------------  
    70    !> @brief This routine concatenate character and integer(4) (as character).  
     152   !> @brief This function concatenate character and integer(1) (as character).  
     153   !  
     154   !> @author J.Paul  
     155   !> - September, 2014- Initial Version  
     156   !  
     157   !> @param[in] cd_char   string character 
     158   !> @param[in] bd_val    integer(1) variable value 
     159   !> @return string character  
     160   !-------------------------------------------------------------------  
     161   PURE CHARACTER(LEN=lc) FUNCTION fct__i1_cat(cd_char, bd_val)  
     162  
     163      ! arguments 
     164      CHARACTER(LEN=lc), INTENT(IN) :: cd_char 
     165      INTEGER(i1),       INTENT(IN) :: bd_val 
     166 
     167      ! local variable 
     168      CHARACTER(LEN=lc) :: cl_val 
     169      !----------------------------------------------------------------  
     170  
     171      cl_val = fct_str(bd_val) 
     172      fct__i1_cat=TRIM(cd_char)//TRIM(cl_val) 
     173 
     174   END FUNCTION fct__i1_cat  
     175   !-------------------------------------------------------------------  
     176   !> @brief This function concatenate character and integer(2) (as character).  
     177   !  
     178   !> @author J.Paul  
     179   !> - September, 2014- Initial Version  
     180   !  
     181   !> @param[in] cd_char   string character 
     182   !> @param[in] sd_val    integer(2) variable value 
     183   !> @return string character  
     184   !-------------------------------------------------------------------  
     185   PURE CHARACTER(LEN=lc) FUNCTION fct__i2_cat(cd_char, sd_val)  
     186  
     187      ! arguments 
     188      CHARACTER(LEN=lc), INTENT(IN) :: cd_char 
     189      INTEGER(i2),       INTENT(IN) :: sd_val 
     190 
     191      ! local variable 
     192      CHARACTER(LEN=lc) :: cl_val 
     193      !----------------------------------------------------------------  
     194  
     195      cl_val = fct_str(sd_val) 
     196      fct__i2_cat=TRIM(cd_char)//TRIM(cl_val) 
     197 
     198   END FUNCTION fct__i2_cat  
     199   !-------------------------------------------------------------------  
     200   !> @brief This function concatenate character and integer(4) (as character).  
    71201   !  
    72202   !> @author J.Paul  
    73203   !> - Nov, 2013- Initial Version  
    74204   !  
     205   !> @param[in] cd_char   string character 
     206   !> @param[in] id_val    integer(4) variable value 
    75207   !> @return string character  
    76208   !-------------------------------------------------------------------  
    77    ! @code  
    78209   PURE CHARACTER(LEN=lc) FUNCTION fct__i4_cat(cd_char, id_val)  
    79210  
    … …  
    90221 
    91222   END FUNCTION fct__i4_cat  
    92    ! @endcode 
    93    !-------------------------------------------------------------------  
    94    !> @brief This routine concatenate character and integer(8) (as character).  
     223   !-------------------------------------------------------------------  
     224   !> @brief This function concatenate character and integer(8) (as character).  
    95225   !  
    96226   !> @author J.Paul  
    97    !> - Nov, 2013- Initial Version  
     227   !> - November, 2013- Initial Version  
    98228   !  
     229   !> @param[in] cd_char   string character 
     230   !> @param[in] kd_val    integer(8) variable value 
    99231   !> @return string character  
    100232   !-------------------------------------------------------------------  
    101    ! @code  
    102233   PURE CHARACTER(LEN=lc) FUNCTION fct__i8_cat(cd_char, kd_val)  
    103234  
    … …  
    114245 
    115246   END FUNCTION fct__i8_cat  
    116    ! @endcode 
    117    !-------------------------------------------------------------------  
    118    !> @brief This routine concatenate character and real(4) (as character).  
     247   !-------------------------------------------------------------------  
     248   !> @brief This function concatenate character and real(4) (as character).  
    119249   !  
    120250   !> @author J.Paul  
    121    !> - Nov, 2013- Initial Version  
     251   !> - November, 2013- Initial Version  
    122252   !  
     253   !> @param[in] cd_char   string character 
     254   !> @param[in] rd_val    real(4) variable value 
    123255   !> @return string character  
    124256   !-------------------------------------------------------------------  
    125    ! @code  
    126257   PURE CHARACTER(LEN=lc) FUNCTION fct__r4_cat(cd_char, rd_val)  
    127258  
    … …  
    138269 
    139270   END FUNCTION fct__r4_cat  
    140    ! @endcode 
    141    !-------------------------------------------------------------------  
    142    !> @brief This routine concatenate character and real(8) (as character).  
    143    !  
     271   !-------------------------------------------------------------------  
     272   !> @brief This function concatenate character and real(8) (as character).  
     273   !> 
    144274   !> @author J.Paul  
    145    !> - Nov, 2013- Initial Version  
    146    !  
     275   !> - November, 2013- Initial Version  
     276   !> 
     277   !> @param[in] cd_char   string character 
     278   !> @param[in] dd_val    real(8) variable value 
    147279   !> @return string character  
    148280   !-------------------------------------------------------------------  
    149    ! @code  
    150281   PURE CHARACTER(LEN=lc) FUNCTION fct__r8_cat(cd_char, dd_val)  
    151282  
    … …  
    162293 
    163294   END FUNCTION fct__r8_cat  
    164    ! @endcode 
    165    !-------------------------------------------------------------------  
    166    !> @brief This routine concatenate character and logical (as character).  
    167    !  
     295   !-------------------------------------------------------------------  
     296   !> @brief This function concatenate character and logical (as character).  
     297   !> 
    168298   !> @author J.Paul  
    169    !> - Nov, 2013- Initial Version  
    170    !  
     299   !> - November, 2013- Initial Version  
     300   !> 
     301   !> @param[in] cd_char   string character 
     302   !> @param[in] ld_val    logical variable value 
    171303   !> @return string character  
    172304   !-------------------------------------------------------------------  
    173    ! @code  
    174305   PURE CHARACTER(LEN=lc) FUNCTION fct__l_cat(cd_char, ld_val)  
    175306  
    … …  
    186317 
    187318   END FUNCTION fct__l_cat  
    188    ! @endcode 
    189    !-------------------------------------------------------------------  
    190    !> @brief This routine returns the next available I/O unit number.  
    191    !  
     319   !-------------------------------------------------------------------  
     320   !> @brief This function returns the next available I/O unit number.  
     321   !> 
    192322   !> @author J.Paul  
    193    !> - Nov, 2013- Initial Version  
    194    !  
     323   !> - November, 2013- Initial Version  
     324   !> 
    195325   !> @return file id  
    196326   !-------------------------------------------------------------------  
    197    ! @code  
    198327   INTEGER(i4) FUNCTION fct_getunit()  
    199328  
    … …  
    211340  
    212341   END FUNCTION fct_getunit  
    213    ! @endcode 
    214    !------------------------------------------------------------------- 
    215    !> @brief This routine handle Fortran status. 
    216    ! 
    217    !> @author J.Paul 
    218    !> - Nov, 2013- Initial Version 
    219    !------------------------------------------------------------------- 
    220    ! @code 
     342   !------------------------------------------------------------------- 
     343   !> @brief This subroutine handle Fortran status. 
     344   ! 
     345   !> @author J.Paul 
     346   !> - November, 2013- Initial Version 
     347   !> 
     348   !> @param[in] id_status 
     349   !------------------------------------------------------------------- 
    221350   SUBROUTINE fct_err(id_status) 
    222351 
    … …  
    232361 
    233362   END SUBROUTINE fct_err 
    234    ! @endcode 
     363   !------------------------------------------------------------------- 
     364   !> @brief This subroutine  create a pause statement 
     365   ! 
     366   !> @author J.Paul 
     367   !> - November, 2014- Initial Version 
     368   !> 
     369   !> @param[in] cd_msg optional message to be added 
     370   !------------------------------------------------------------------- 
     371   SUBROUTINE fct_pause(cd_msg) 
     372 
     373      ! Argument 
     374      CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: cd_msg 
     375      !---------------------------------------------------------------- 
     376 
     377      IF( PRESENT(cd_msg) )THEN 
     378         WRITE( *, * ) 'Press Enter to continue '//TRIM(cd_msg) 
     379      ELSE 
     380         WRITE( *, * ) 'Press Enter to continue' 
     381      ENDIF 
     382      READ( *, * ) 
     383 
     384   END SUBROUTINE fct_pause 
    235385   !------------------------------------------------------------------- 
    236386   !> @brief This function convert logical to string character. 
    237387   !> 
    238388   !> @author J.Paul 
    239    !> - Nov, 2013- Initial Version 
    240    ! 
    241    !> @param[in] ld_var : logical variable 
     389   !> - November, 2013- Initial Version 
     390   ! 
     391   !> @param[in] ld_var logical variable 
    242392   !> @return character of this integer variable 
    243393   !------------------------------------------------------------------- 
    244    ! @code 
    245394   PURE CHARACTER(LEN=lc) FUNCTION fct__l_str(ld_var) 
    246395      IMPLICIT NONE 
    … …  
    256405 
    257406   END FUNCTION fct__l_str 
    258    ! @endcode 
    259407   !------------------------------------------------------------------- 
    260408   !> @brief This function convert integer(1) to string character. 
    261409   !> 
    262410   !> @author J.Paul 
    263    !> - Nov, 2013- Initial Version 
    264    ! 
    265    !> @param[in] bd_var : integer(1) variable 
     411   !> - November, 2013- Initial Version 
     412   ! 
     413   !> @param[in] bd_var integer(1) variable 
    266414   !> @return character of this integer variable 
    267415   !------------------------------------------------------------------- 
    268    ! @code 
    269416   PURE CHARACTER(LEN=lc) FUNCTION fct__i1_str(bd_var) 
    270417      IMPLICIT NONE 
    … …  
    280427 
    281428   END FUNCTION fct__i1_str 
    282    ! @endcode 
    283429   !------------------------------------------------------------------- 
    284430   !> @brief This function convert integer(2) to string character. 
    285431   !> 
    286432   !> @author J.Paul 
    287    !> - Nov, 2013- Initial Version 
    288    ! 
    289    !> @param[in] sd_var : integer(2) variable 
     433   !> - November, 2013- Initial Version 
     434   ! 
     435   !> @param[in] sd_var integer(2) variable 
    290436   !> @return character of this integer variable 
    291437   !------------------------------------------------------------------- 
    292    ! @code 
    293438   PURE CHARACTER(LEN=lc) FUNCTION fct__i2_str(sd_var) 
    294439      IMPLICIT NONE 
    … …  
    304449 
    305450   END FUNCTION fct__i2_str 
    306    ! @endcode 
    307451   !------------------------------------------------------------------- 
    308452   !> @brief This function convert integer(4) to string character. 
    309453   !> 
    310454   !> @author J.Paul 
    311    !> - Nov, 2013- Initial Version 
    312    ! 
    313    !> @param[in] id_var : integer(4) variable 
     455   !> - November, 2013- Initial Version 
     456   ! 
     457   !> @param[in] id_var integer(4) variable 
    314458   !> @return character of this integer variable 
    315459   !------------------------------------------------------------------- 
    316    ! @code 
    317460   PURE CHARACTER(LEN=lc) FUNCTION fct__i4_str(id_var) 
    318461      IMPLICIT NONE 
    … …  
    328471 
    329472   END FUNCTION fct__i4_str 
    330    ! @endcode 
    331473   !------------------------------------------------------------------- 
    332474   !> @brief This function convert integer(8) to string character. 
    333475   !> 
    334476   !> @author J.Paul 
    335    !> - Nov, 2013- Initial Version 
    336    ! 
    337    !> @param[in] kd_var : integer(8) variable 
     477   !> - November, 2013- Initial Version 
     478   ! 
     479   !> @param[in] kd_var integer(8) variable 
    338480   !> @return character of this integer variable 
    339481   !------------------------------------------------------------------- 
    340    ! @code 
    341482   PURE CHARACTER(LEN=lc) FUNCTION fct__i8_str(kd_var) 
    342483      IMPLICIT NONE 
    … …  
    352493 
    353494   END FUNCTION fct__i8_str 
    354    ! @endcode    
    355495   !------------------------------------------------------------------- 
    356496   !> @brief This function convert real(4) to string character. 
    357497   !> 
    358498   !> @author J.Paul 
    359    !> - Nov, 2013- Initial Version 
    360    ! 
    361    !> @param[in] rd_var : real(4) variable 
    362    !> @return character of this integer variable 
    363    !------------------------------------------------------------------- 
    364    ! @code 
     499   !> - November, 2013- Initial Version 
     500   ! 
     501   !> @param[in] rd_var real(4) variable 
     502   !> @return character of this real variable 
     503   !------------------------------------------------------------------- 
    365504   PURE CHARACTER(LEN=lc) FUNCTION fct__r4_str(rd_var) 
    366505      IMPLICIT NONE 
    … …  
    376515 
    377516   END FUNCTION fct__r4_str 
    378    ! @endcode    
    379517   !------------------------------------------------------------------- 
    380518   !> @brief This function convert real(8) to string character. 
    381519   !> 
    382520   !> @author J.Paul 
    383    !> - Nov, 2013- Initial Version 
    384    ! 
    385    !> @param[in] dd_var : real(8) variable 
    386    !> @return character of this integer variable 
    387    !------------------------------------------------------------------- 
    388    ! @code 
     521   !> - November, 2013- Initial Version 
     522   ! 
     523   !> @param[in] dd_var real(8) variable 
     524   !> @return character of this real variable 
     525   !------------------------------------------------------------------- 
    389526   PURE CHARACTER(LEN=lc) FUNCTION fct__r8_str(dd_var) 
    390527      IMPLICIT NONE 
    … …  
    400537 
    401538   END FUNCTION fct__r8_str 
    402    ! @endcode    
    403    !------------------------------------------------------------------- 
    404    !> @brief This function concatenate all the element of a character table  
    405    !> except unknown one, in a character string. 
    406    !> 
    407    !> optionnally a separator could be added between each element 
    408    !> 
    409    !> @author J.Paul 
    410    !> - Nov, 2013- Initial Version 
    411    ! 
    412    !> @param[in] cd_tab : table of character 
     539   !------------------------------------------------------------------- 
     540   !> @brief This function concatenate all the element of a character array  
     541   !> in a character string. 
     542   !> @details 
     543   !> optionnally a separator could be added between each element. 
     544   !> 
     545   !> @author J.Paul 
     546   !> - November, 2013- Initial Version 
     547   ! 
     548   !> @param[in] cd_arr array of character 
     549   !> @param[in] cd_sep separator character 
    413550   !> @return character 
    414551   !------------------------------------------------------------------- 
    415    ! @code 
    416    PURE CHARACTER(LEN=lc) FUNCTION fct_concat(cd_tab,cd_sep) 
    417       IMPLICIT NONE 
    418       ! Argument       
    419       CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_tab 
     552   PURE CHARACTER(LEN=lc) FUNCTION fct_concat(cd_arr,cd_sep) 
     553      IMPLICIT NONE 
     554      ! Argument       
     555      CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_arr 
    420556      CHARACTER(*),               INTENT(IN), OPTIONAL :: cd_sep 
    421557 
    … …  
    432568      IF(PRESENT(cd_sep)) cl_sep=cd_sep 
    433569 
    434       il_size=SIZE(cd_tab) 
     570      il_size=SIZE(cd_arr) 
    435571      fct_concat='' 
    436572      cl_tmp='' 
    437573      DO ji=1,il_size 
    438574 
    439          !IF( TRIM(ADJUSTL(cd_tab(ji))) /= 'unknown' )THEN 
    440             WRITE(cl_tmp,*) TRIM(fct_concat)//TRIM(ADJUSTL(cd_tab(ji)))//TRIM(cl_sep) 
    441          !ENDIF 
    442        
     575         WRITE(cl_tmp,*) TRIM(fct_concat)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep) 
    443576         fct_concat=TRIM(ADJUSTL(cl_tmp)) 
    444577       
    … …  
    446579 
    447580   END FUNCTION fct_concat 
    448    ! @endcode    
    449581   !------------------------------------------------------------------- 
    450582   !> @brief This function convert string character upper case to lower case. 
    … …  
    458590   ! 
    459591   !> @author J.Paul 
    460    !> - Nov, 2013- Initial Version 
    461    ! 
    462    !> @param[in] cd_var : character 
     592   !> - November, 2013- Initial Version 
     593   ! 
     594   !> @param[in] cd_var character 
    463595   !> @return lower case character 
    464596   !------------------------------------------------------------------- 
    465    ! @code 
    466597   PURE CHARACTER(LEN=lc) FUNCTION fct_lower(cd_var) 
    467598      IMPLICIT NONE 
    … …  
    505636 
    506637   END FUNCTION fct_lower 
    507    ! @endcode 
    508638   !------------------------------------------------------------------- 
    509639   !> @brief This function convert string character lower case to upper case. 
    … …  
    517647   ! 
    518648   !> @author J.Paul 
    519    !> - Nov, 2013- Initial Version 
    520    ! 
    521    !> @param[in] cd_var : character 
     649   !> - November, 2013- Initial Version 
     650   ! 
     651   !> @param[in] cd_var character 
    522652   !> @return upper case character 
    523653   !------------------------------------------------------------------- 
    524    ! @code 
    525654   PURE CHARACTER(LEN=lc) FUNCTION fct_upper(cd_var) 
    526655      IMPLICIT NONE 
    … …  
    564693 
    565694   END FUNCTION fct_upper 
    566    ! @endcode    
    567695   !------------------------------------------------------------------- 
    568696   !> @brief This function check if character is numeric. 
    569697   ! 
    570    !> @details 
    571    ! 
    572    !> @author J.Paul 
    573    !> - Nov, 2013- Initial Version 
    574    ! 
    575    !> @param[in] cd_var : character 
     698   !> @author J.Paul 
     699   !> - November, 2013- Initial Version 
     700   ! 
     701   !> @param[in] cd_var character 
    576702   !> @return character is numeric 
    577703   !------------------------------------------------------------------- 
    578    ! @code 
    579704   PURE LOGICAL FUNCTION fct_is_num(cd_var) 
    580705      IMPLICIT NONE 
    … …  
    597722 
    598723   END FUNCTION fct_is_num 
    599    ! @endcode 
    600724   !------------------------------------------------------------------- 
    601725   !> @brief This function split string of character  
    602726   !> using separator character, by default '|', 
    603    !> and return the element on index ind 
    604    ! 
    605    !> @details 
    606    ! 
    607    !> @author J.Paul 
    608    !> - Nov, 2013- Initial Version 
    609    ! 
    610    !> @param[in] cd_string : string of character 
    611    !> @param[in] id_ind : indice 
    612    !> @param[in] cd_sep   separator character 
     727   !> and return the element on index ind. 
     728   ! 
     729   !> @author J.Paul 
     730   !> - November, 2013- Initial Version 
     731   ! 
     732   !> @param[in] cd_string string of character 
     733   !> @param[in] id_ind    indice 
     734   !> @param[in] cd_sep    separator character 
    613735   !> @return return the element on index id_ind 
    614736   !------------------------------------------------------------------- 
    615    ! @code 
    616737   PURE FUNCTION fct_split(cd_string, id_ind, cd_sep) 
    617738      IMPLICIT NONE 
    … …  
    629750 
    630751      INTEGER(i4) :: il_sep 
     752      INTEGER(i4) :: il_lsep 
    631753       
    632754      ! loop indices 
    … …  
    639761      ! get separator 
    640762      cl_sep='|' 
    641       IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep)) 
     763      IF( PRESENT(cd_sep) )THEN 
     764         IF( cd_sep==' ')THEN 
     765            cl_sep=' ' 
     766         ELSE 
     767            cl_sep=TRIM(ADJUSTL(cd_sep)) 
     768         ENDIF 
     769      ENDIF 
    642770       
     771      IF( cl_sep /= ' ' )THEN 
     772         ! get separator index 
     773         il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
     774         il_lsep=LEN(TRIM(cl_sep))  
     775 
     776         IF( il_sep /= 0 )THEN 
     777            fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     778         ELSE 
     779            fct_split=TRIM(ADJUSTL(cl_string)) 
     780         ENDIF 
     781 
     782         ji=1 
     783         DO WHILE( il_sep /= 0 .AND. ji /= id_ind ) 
     784             
     785            ji=ji+1 
     786             
     787            cl_string=TRIM(cl_string(il_sep+il_lsep:)) 
     788            il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
     789 
     790            IF( il_sep /= 0 )THEN 
     791               fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     792            ELSE 
     793               fct_split=TRIM(ADJUSTL(cl_string)) 
     794            ENDIF 
     795 
     796         ENDDO 
     797 
     798         IF( ji /= id_ind ) fct_split='' 
     799      ELSE 
     800         fct_split=fct__split_space(TRIM(cl_string), id_ind) 
     801      ENDIF 
     802 
     803   END FUNCTION fct_split 
     804   !------------------------------------------------------------------- 
     805   !> @brief This function split string of character  
     806   !> using space as separator,  
     807   !> and return the element on index ind. 
     808   ! 
     809   !> @author J.Paul 
     810   !> - November, 2013- Initial Version 
     811   ! 
     812   !> @param[in] cd_string string of character 
     813   !> @param[in] id_ind    indice 
     814   !> @return return the element on index id_ind 
     815   !------------------------------------------------------------------- 
     816   PURE FUNCTION fct__split_space(cd_string, id_ind) 
     817      IMPLICIT NONE 
     818      ! Argument       
     819      CHARACTER(LEN=*), INTENT(IN) :: cd_string 
     820      INTEGER(i4)     , INTENT(IN) :: id_ind 
     821 
     822      ! function 
     823      CHARACTER(LEN=lc) :: fct__split_space 
     824 
     825      ! local variable 
     826      CHARACTER(LEN=lc) :: cl_string 
     827 
     828      INTEGER(i4) :: il_sep 
     829      INTEGER(i4) :: il_lsep 
     830       
     831      ! loop indices 
     832      INTEGER(i4) :: ji 
     833      !---------------------------------------------------------------- 
     834      ! initialize 
     835      fct__split_space='' 
     836      cl_string=ADJUSTL(cd_string) 
     837 
    643838      ! get separator index 
    644       il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
    645        
     839      il_sep=INDEX( TRIM(cl_string), ' ' ) 
     840      il_lsep=LEN(' ')  
     841 
    646842      IF( il_sep /= 0 )THEN 
    647          fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     843         fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    648844      ELSE 
    649          fct_split=TRIM(ADJUSTL(cl_string)) 
     845         fct__split_space=TRIM(ADJUSTL(cl_string)) 
    650846      ENDIF 
    651847 
    … …  
    655851         ji=ji+1 
    656852          
    657          cl_string=TRIM(cl_string(il_sep+1:)) 
    658          il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
     853         cl_string=TRIM(cl_string(il_sep+il_lsep:)) 
     854         il_sep=INDEX( TRIM(cl_string), ' ' ) 
    659855 
    660856         IF( il_sep /= 0 )THEN 
    661             fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     857            fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    662858         ELSE 
    663             fct_split=TRIM(ADJUSTL(cl_string)) 
     859            fct__split_space=TRIM(ADJUSTL(cl_string)) 
    664860         ENDIF 
    665861 
    666862      ENDDO 
    667863 
    668       IF( ji /= id_ind ) fct_split='' 
    669  
    670    END FUNCTION fct_split 
    671    ! @endcode 
     864      IF( ji /= id_ind ) fct__split_space='' 
     865 
     866   END FUNCTION fct__split_space 
    672867   !------------------------------------------------------------------- 
    673868   !> @brief This function return basename of a filename. 
    674869   ! 
    675870   !> @details 
    676    !> actually it splits filename using sperarator '/' 
    677    !> and return last string character 
    678    ! 
    679    !> @author J.Paul 
    680    !> - Nov, 2013- Initial Version 
    681    ! 
    682    !> @param[in] cd_string : filename 
     871   !> Actually it splits filename using sperarator '/' 
     872   !> and return last string character.<br/> 
     873   !> Optionally you could specify another separator. 
     874   !> @author J.Paul 
     875   !> - November, 2013- Initial Version 
     876   ! 
     877   !> @param[in] cd_string filename 
     878   !> @param[in] cd_sep    separator character 
    683879   !> @return basename (filename without path) 
    684880   !------------------------------------------------------------------- 
    685    ! @code 
    686881   PURE FUNCTION fct_basename(cd_string, cd_sep) 
    687882      IMPLICIT NONE 
    … …  
    711906 
    712907   END FUNCTION fct_basename 
    713    ! @endcode 
    714908   !------------------------------------------------------------------- 
    715909   !> @brief This function return dirname of a filename. 
    716910   ! 
    717911   !> @details 
    718    !> actually it splits filename using sperarator '/' 
    719    !> and return all exept last string character 
    720    ! 
    721    !> @author J.Paul 
    722    !> - Nov, 2013- Initial Version 
    723    ! 
    724    !> @param[in] cd_string : filename 
     912   !> Actually it splits filename using sperarator '/' 
     913   !> and return all except last string character.<br/> 
     914   !> Optionally you could specify another separator. 
     915   !> @author J.Paul 
     916   !> - November, 2013- Initial Version 
     917   ! 
     918   !> @param[in] cd_string filename 
     919   !> @param[in] cd_sep    separator character 
    725920   !> @return dirname (path of the filename) 
    726921   !------------------------------------------------------------------- 
    727    ! @code 
    728922   PURE FUNCTION fct_dirname(cd_string, cd_sep) 
    729923      IMPLICIT NONE 
    … …  
    757951 
    758952   END FUNCTION fct_dirname 
    759    ! @endcode 
    760953END MODULE fct 
    761954 
Note: See TracChangeset for help on using the changeset viewer.