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

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r4213 r6225  
    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 check if character is real 
     54!> @code 
     55!>  ll_is_real=fct_is_real(cd_var) 
     56!> @endcode 
     57!> 
     58!>  to split string into substring and return one of the element:<br/>   
     59!> @code 
     60!>  cl_str=fct_split(cd_string ,id_ind [,cd_sep]) 
     61!> @endcode 
     62!>  - cd_string is a string of character 
     63!>  - id_ind is the indice of the lement to extract 
     64!>  - cd_sep is the separator use to split cd_string (default '|') 
     65!> 
     66!>  to get basename (name without path):<br/> 
     67!> @code 
     68!>  cl_str=fct_basename(cd_string [,cd_sep]) 
     69!> @endcode 
     70!>  - cd_string is the string filename 
     71!>  - cd_sep is the separator ti be used (default '/') 
     72!> 
     73!>  to get dirname (path of the filename):<br/> 
     74!> @code 
     75!>  cl_str=fct_dirname(cd_string [,cd_sep]) 
     76!> @endcode 
     77!>  - cd_string is the string filename 
     78!>  - cd_sep is the separator ti be used (default '/') 
     79!>   
     80!> to create a pause statement:<br/> 
     81!> @code 
     82!> CALL fct_pause(cd_msg) 
     83!> @endcode 
     84!>    - cd_msg : message to be added [optional] 
     85!> 
     86!> to handle frotran error:<br/> 
     87!> @code 
     88!> CALL fct_err(id_status) 
     89!> @endcode 
     90!>  
     91!>  
    1192!> @author 
    1293!> J.Paul 
    1394! REVISION HISTORY: 
    14 !> @date Nov, 2013 - Initial Version 
    15 ! 
    16 !> @todo 
    17 !> - TODO_describe_appropriate_changes - TODO_name 
    18 !> @param MyModule_type : brief_description 
     95!> @date November, 2013 - Initial Version 
     96!> @date September, 2014  
     97!> - add header 
    1998! 
    2099!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    23102   USE kind                            ! F90 kind parameter 
    24103   IMPLICIT NONE 
    25    PRIVATE 
    26104   ! NOTE_avoid_public_variables_if_possible 
    27105 
    28106   ! 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) 
     107   PUBLIC :: fct_getunit  !< returns free unit number 
     108   PUBLIC :: fct_str      !< convert numeric to string character 
     109   PUBLIC :: OPERATOR(//) !< concatenate operator 
     110   PUBLIC :: fct_concat   !< concatenate all the element of a character array 
     111   PUBLIC :: fct_upper    !< convert character from lower to upper case 
     112   PUBLIC :: fct_lower    !< convert character from upper to lower case 
     113   PUBLIC :: fct_is_num   !< check if character is numeric 
     114   PUBLIC :: fct_is_real  !< check if character is real 
     115   PUBLIC :: fct_split    !< split string into substring 
     116   PUBLIC :: fct_basename !< return basename (name without path) 
     117   PUBLIC :: fct_dirname  !< return dirname (path without filename) 
     118   PUBLIC :: fct_pause    !< pause statement 
     119   PUBLIC :: fct_err      !< handle fortran error status 
    40120 
    41121   PRIVATE :: fct__i1_str ! convert integer(1) to string character 
    … …  
    46126   PRIVATE :: fct__r8_str ! convert real(8) to string character 
    47127   PRIVATE :: fct__l_str  ! convert logical to string character 
    48  
     128   PRIVATE :: fct__i1_cat ! concatenate integer(1) to string character 
     129   PRIVATE :: fct__i2_cat ! concatenate integer(2) to string character 
     130   PRIVATE :: fct__i4_cat ! concatenate integer(4) to string character 
     131   PRIVATE :: fct__i8_cat ! concatenate integer(8) to string character 
     132   PRIVATE :: fct__r4_cat ! concatenate real(4) to string character 
     133   PRIVATE :: fct__r8_cat ! concatenate real(8) to string character 
     134   PRIVATE :: fct__l_cat  ! concatenate logical to string character 
     135   PRIVATE :: fct__split_space ! split string into substring using space as separator 
    49136 
    50137   INTERFACE fct_str 
    … …  
    59146 
    60147   INTERFACE OPERATOR(//) 
     148      MODULE PROCEDURE fct__i1_cat ! concatenate integer(1) to string character 
     149      MODULE PROCEDURE fct__i2_cat ! concatenate integer(2) to string character 
    61150      MODULE PROCEDURE fct__i4_cat ! concatenate integer(4) to string character 
    62151      MODULE PROCEDURE fct__i8_cat ! concatenate integer(8) to string character 
    … …  
    68157CONTAINS 
    69158   !-------------------------------------------------------------------  
    70    !> @brief This routine concatenate character and integer(4) (as character).  
     159   !> @brief This function concatenate character and integer(1) (as character).  
    71160   !  
    72161   !> @author J.Paul  
    73    !> - Nov, 2013- Initial Version  
     162   !> @date September, 2014 - Initial Version  
    74163   !  
     164   !> @param[in] cd_char   string character 
     165   !> @param[in] bd_val    integer(1) variable value 
    75166   !> @return string character  
    76167   !-------------------------------------------------------------------  
    77    ! @code  
     168   PURE CHARACTER(LEN=lc) FUNCTION fct__i1_cat(cd_char, bd_val)  
     169  
     170      ! arguments 
     171      CHARACTER(LEN=lc), INTENT(IN) :: cd_char 
     172      INTEGER(i1),       INTENT(IN) :: bd_val 
     173 
     174      ! local variable 
     175      CHARACTER(LEN=lc) :: cl_val 
     176      !----------------------------------------------------------------  
     177  
     178      cl_val = fct_str(bd_val) 
     179      fct__i1_cat=TRIM(cd_char)//TRIM(cl_val) 
     180 
     181   END FUNCTION fct__i1_cat  
     182   !-------------------------------------------------------------------  
     183   !> @brief This function concatenate character and integer(2) (as character).  
     184   !  
     185   !> @author J.Paul  
     186   !> @date September, 2014 - Initial Version  
     187   !  
     188   !> @param[in] cd_char   string character 
     189   !> @param[in] sd_val    integer(2) variable value 
     190   !> @return string character  
     191   !-------------------------------------------------------------------  
     192   PURE CHARACTER(LEN=lc) FUNCTION fct__i2_cat(cd_char, sd_val)  
     193  
     194      ! arguments 
     195      CHARACTER(LEN=lc), INTENT(IN) :: cd_char 
     196      INTEGER(i2),       INTENT(IN) :: sd_val 
     197 
     198      ! local variable 
     199      CHARACTER(LEN=lc) :: cl_val 
     200      !----------------------------------------------------------------  
     201  
     202      cl_val = fct_str(sd_val) 
     203      fct__i2_cat=TRIM(cd_char)//TRIM(cl_val) 
     204 
     205   END FUNCTION fct__i2_cat  
     206   !-------------------------------------------------------------------  
     207   !> @brief This function concatenate character and integer(4) (as character).  
     208   !  
     209   !> @author J.Paul  
     210   !> @date November, 2013 - Initial Version  
     211   !  
     212   !> @param[in] cd_char   string character 
     213   !> @param[in] id_val    integer(4) variable value 
     214   !> @return string character  
     215   !-------------------------------------------------------------------  
    78216   PURE CHARACTER(LEN=lc) FUNCTION fct__i4_cat(cd_char, id_val)  
    79217  
    … …  
    90228 
    91229   END FUNCTION fct__i4_cat  
    92    ! @endcode 
    93    !-------------------------------------------------------------------  
    94    !> @brief This routine concatenate character and integer(8) (as character).  
     230   !-------------------------------------------------------------------  
     231   !> @brief This function concatenate character and integer(8) (as character).  
    95232   !  
    96233   !> @author J.Paul  
    97    !> - Nov, 2013- Initial Version  
     234   !> @date November, 2013 - Initial Version  
    98235   !  
     236   !> @param[in] cd_char   string character 
     237   !> @param[in] kd_val    integer(8) variable value 
    99238   !> @return string character  
    100239   !-------------------------------------------------------------------  
    101    ! @code  
    102240   PURE CHARACTER(LEN=lc) FUNCTION fct__i8_cat(cd_char, kd_val)  
    103241  
    … …  
    114252 
    115253   END FUNCTION fct__i8_cat  
    116    ! @endcode 
    117    !-------------------------------------------------------------------  
    118    !> @brief This routine concatenate character and real(4) (as character).  
     254   !-------------------------------------------------------------------  
     255   !> @brief This function concatenate character and real(4) (as character).  
    119256   !  
    120257   !> @author J.Paul  
    121    !> - Nov, 2013- Initial Version  
     258   !> @date November, 2013 - Initial Version  
    122259   !  
     260   !> @param[in] cd_char   string character 
     261   !> @param[in] rd_val    real(4) variable value 
    123262   !> @return string character  
    124263   !-------------------------------------------------------------------  
    125    ! @code  
    126264   PURE CHARACTER(LEN=lc) FUNCTION fct__r4_cat(cd_char, rd_val)  
    127265  
    … …  
    138276 
    139277   END FUNCTION fct__r4_cat  
    140    ! @endcode 
    141    !-------------------------------------------------------------------  
    142    !> @brief This routine concatenate character and real(8) (as character).  
    143    !  
     278   !-------------------------------------------------------------------  
     279   !> @brief This function concatenate character and real(8) (as character).  
     280   !> 
    144281   !> @author J.Paul  
    145    !> - Nov, 2013- Initial Version  
    146    !  
     282   !> @date November, 2013 - Initial Version  
     283   !> 
     284   !> @param[in] cd_char   string character 
     285   !> @param[in] dd_val    real(8) variable value 
    147286   !> @return string character  
    148287   !-------------------------------------------------------------------  
    149    ! @code  
    150288   PURE CHARACTER(LEN=lc) FUNCTION fct__r8_cat(cd_char, dd_val)  
    151289  
    … …  
    162300 
    163301   END FUNCTION fct__r8_cat  
    164    ! @endcode 
    165    !-------------------------------------------------------------------  
    166    !> @brief This routine concatenate character and logical (as character).  
    167    !  
     302   !-------------------------------------------------------------------  
     303   !> @brief This function concatenate character and logical (as character).  
     304   !> 
    168305   !> @author J.Paul  
    169    !> - Nov, 2013- Initial Version  
    170    !  
     306   !> @date November, 2013 - Initial Version  
     307   !> 
     308   !> @param[in] cd_char   string character 
     309   !> @param[in] ld_val    logical variable value 
    171310   !> @return string character  
    172311   !-------------------------------------------------------------------  
    173    ! @code  
    174312   PURE CHARACTER(LEN=lc) FUNCTION fct__l_cat(cd_char, ld_val)  
    175313  
    … …  
    186324 
    187325   END FUNCTION fct__l_cat  
    188    ! @endcode 
    189    !-------------------------------------------------------------------  
    190    !> @brief This routine returns the next available I/O unit number.  
    191    !  
     326   !-------------------------------------------------------------------  
     327   !> @brief This function returns the next available I/O unit number.  
     328   !> 
    192329   !> @author J.Paul  
    193    !> - Nov, 2013- Initial Version  
    194    !  
     330   !> @date November, 2013 - Initial Version  
     331   !> 
    195332   !> @return file id  
    196333   !-------------------------------------------------------------------  
    197    ! @code  
    198334   INTEGER(i4) FUNCTION fct_getunit()  
    199335  
    … …  
    211347  
    212348   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 
     349   !------------------------------------------------------------------- 
     350   !> @brief This subroutine handle Fortran status. 
     351   ! 
     352   !> @author J.Paul 
     353   !> @date November, 2013 - Initial Version 
     354   !> 
     355   !> @param[in] id_status 
     356   !------------------------------------------------------------------- 
    221357   SUBROUTINE fct_err(id_status) 
    222358 
    … …  
    232368 
    233369   END SUBROUTINE fct_err 
    234    ! @endcode 
     370   !------------------------------------------------------------------- 
     371   !> @brief This subroutine  create a pause statement 
     372   ! 
     373   !> @author J.Paul 
     374   !> @date November, 2014 - Initial Version 
     375   !> 
     376   !> @param[in] cd_msg optional message to be added 
     377   !------------------------------------------------------------------- 
     378   SUBROUTINE fct_pause(cd_msg) 
     379 
     380      ! Argument 
     381      CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: cd_msg 
     382      !---------------------------------------------------------------- 
     383 
     384      IF( PRESENT(cd_msg) )THEN 
     385         WRITE( *, * ) 'Press Enter to continue '//TRIM(cd_msg) 
     386      ELSE 
     387         WRITE( *, * ) 'Press Enter to continue' 
     388      ENDIF 
     389      READ( *, * ) 
     390 
     391   END SUBROUTINE fct_pause 
    235392   !------------------------------------------------------------------- 
    236393   !> @brief This function convert logical to string character. 
    237394   !> 
    238395   !> @author J.Paul 
    239    !> - Nov, 2013- Initial Version 
    240    ! 
    241    !> @param[in] ld_var : logical variable 
     396   !> @date November, 2013 - Initial Version 
     397   ! 
     398   !> @param[in] ld_var logical variable 
    242399   !> @return character of this integer variable 
    243400   !------------------------------------------------------------------- 
    244    ! @code 
    245401   PURE CHARACTER(LEN=lc) FUNCTION fct__l_str(ld_var) 
    246402      IMPLICIT NONE 
    … …  
    256412 
    257413   END FUNCTION fct__l_str 
    258    ! @endcode 
    259414   !------------------------------------------------------------------- 
    260415   !> @brief This function convert integer(1) to string character. 
    261416   !> 
    262417   !> @author J.Paul 
    263    !> - Nov, 2013- Initial Version 
    264    ! 
    265    !> @param[in] bd_var : integer(1) variable 
     418   !> @date November, 2013 - Initial Version 
     419   ! 
     420   !> @param[in] bd_var integer(1) variable 
    266421   !> @return character of this integer variable 
    267422   !------------------------------------------------------------------- 
    268    ! @code 
    269423   PURE CHARACTER(LEN=lc) FUNCTION fct__i1_str(bd_var) 
    270424      IMPLICIT NONE 
    … …  
    280434 
    281435   END FUNCTION fct__i1_str 
    282    ! @endcode 
    283436   !------------------------------------------------------------------- 
    284437   !> @brief This function convert integer(2) to string character. 
    285438   !> 
    286439   !> @author J.Paul 
    287    !> - Nov, 2013- Initial Version 
    288    ! 
    289    !> @param[in] sd_var : integer(2) variable 
     440   !> @date November, 2013 - Initial Version 
     441   ! 
     442   !> @param[in] sd_var integer(2) variable 
    290443   !> @return character of this integer variable 
    291444   !------------------------------------------------------------------- 
    292    ! @code 
    293445   PURE CHARACTER(LEN=lc) FUNCTION fct__i2_str(sd_var) 
    294446      IMPLICIT NONE 
    … …  
    304456 
    305457   END FUNCTION fct__i2_str 
    306    ! @endcode 
    307458   !------------------------------------------------------------------- 
    308459   !> @brief This function convert integer(4) to string character. 
    309460   !> 
    310461   !> @author J.Paul 
    311    !> - Nov, 2013- Initial Version 
    312    ! 
    313    !> @param[in] id_var : integer(4) variable 
     462   !> @date November, 2013 - Initial Version 
     463   ! 
     464   !> @param[in] id_var integer(4) variable 
    314465   !> @return character of this integer variable 
    315466   !------------------------------------------------------------------- 
    316    ! @code 
    317467   PURE CHARACTER(LEN=lc) FUNCTION fct__i4_str(id_var) 
    318468      IMPLICIT NONE 
    … …  
    328478 
    329479   END FUNCTION fct__i4_str 
    330    ! @endcode 
    331480   !------------------------------------------------------------------- 
    332481   !> @brief This function convert integer(8) to string character. 
    333482   !> 
    334483   !> @author J.Paul 
    335    !> - Nov, 2013- Initial Version 
    336    ! 
    337    !> @param[in] kd_var : integer(8) variable 
     484   !> @date November, 2013 - Initial Version 
     485   ! 
     486   !> @param[in] kd_var integer(8) variable 
    338487   !> @return character of this integer variable 
    339488   !------------------------------------------------------------------- 
    340    ! @code 
    341489   PURE CHARACTER(LEN=lc) FUNCTION fct__i8_str(kd_var) 
    342490      IMPLICIT NONE 
    … …  
    352500 
    353501   END FUNCTION fct__i8_str 
    354    ! @endcode    
    355502   !------------------------------------------------------------------- 
    356503   !> @brief This function convert real(4) to string character. 
    357504   !> 
    358505   !> @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 
     506   !> @date November, 2013 - Initial Version 
     507   ! 
     508   !> @param[in] rd_var real(4) variable 
     509   !> @return character of this real variable 
     510   !------------------------------------------------------------------- 
    365511   PURE CHARACTER(LEN=lc) FUNCTION fct__r4_str(rd_var) 
    366512      IMPLICIT NONE 
    … …  
    376522 
    377523   END FUNCTION fct__r4_str 
    378    ! @endcode    
    379524   !------------------------------------------------------------------- 
    380525   !> @brief This function convert real(8) to string character. 
    381526   !> 
    382527   !> @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 
     528   !> @date November, 2013 - Initial Version 
     529   ! 
     530   !> @param[in] dd_var real(8) variable 
     531   !> @return character of this real variable 
     532   !------------------------------------------------------------------- 
    389533   PURE CHARACTER(LEN=lc) FUNCTION fct__r8_str(dd_var) 
    390534      IMPLICIT NONE 
    … …  
    400544 
    401545   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 
     546   !------------------------------------------------------------------- 
     547   !> @brief This function concatenate all the element of a character array  
     548   !> in a character string. 
     549   !> @details 
     550   !> optionnally a separator could be added between each element. 
     551   !> 
     552   !> @author J.Paul 
     553   !> @date November, 2013 - Initial Version 
     554   ! 
     555   !> @param[in] cd_arr array of character 
     556   !> @param[in] cd_sep separator character 
    413557   !> @return character 
    414558   !------------------------------------------------------------------- 
    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 
     559   PURE CHARACTER(LEN=lc) FUNCTION fct_concat(cd_arr,cd_sep) 
     560      IMPLICIT NONE 
     561      ! Argument       
     562      CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_arr 
    420563      CHARACTER(*),               INTENT(IN), OPTIONAL :: cd_sep 
    421564 
    … …  
    432575      IF(PRESENT(cd_sep)) cl_sep=cd_sep 
    433576 
    434       il_size=SIZE(cd_tab) 
     577      il_size=SIZE(cd_arr) 
    435578      fct_concat='' 
    436579      cl_tmp='' 
    437580      DO ji=1,il_size 
    438581 
    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        
     582         WRITE(cl_tmp,*) TRIM(fct_concat)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep) 
    443583         fct_concat=TRIM(ADJUSTL(cl_tmp)) 
    444584       
    … …  
    446586 
    447587   END FUNCTION fct_concat 
    448    ! @endcode    
    449588   !------------------------------------------------------------------- 
    450589   !> @brief This function convert string character upper case to lower case. 
    … …  
    458597   ! 
    459598   !> @author J.Paul 
    460    !> - Nov, 2013- Initial Version 
    461    ! 
    462    !> @param[in] cd_var : character 
     599   !> @date November, 2013 - Initial Version 
     600   ! 
     601   !> @param[in] cd_var character 
    463602   !> @return lower case character 
    464603   !------------------------------------------------------------------- 
    465    ! @code 
    466604   PURE CHARACTER(LEN=lc) FUNCTION fct_lower(cd_var) 
    467605      IMPLICIT NONE 
    … …  
    505643 
    506644   END FUNCTION fct_lower 
    507    ! @endcode 
    508645   !------------------------------------------------------------------- 
    509646   !> @brief This function convert string character lower case to upper case. 
    … …  
    517654   ! 
    518655   !> @author J.Paul 
    519    !> - Nov, 2013- Initial Version 
    520    ! 
    521    !> @param[in] cd_var : character 
     656   !> @date November, 2013 - Initial Version 
     657   ! 
     658   !> @param[in] cd_var character 
    522659   !> @return upper case character 
    523660   !------------------------------------------------------------------- 
    524    ! @code 
    525661   PURE CHARACTER(LEN=lc) FUNCTION fct_upper(cd_var) 
    526662      IMPLICIT NONE 
    … …  
    564700 
    565701   END FUNCTION fct_upper 
    566    ! @endcode    
    567702   !------------------------------------------------------------------- 
    568703   !> @brief This function check if character is numeric. 
    569704   ! 
    570    !> @details 
    571    ! 
    572    !> @author J.Paul 
    573    !> - Nov, 2013- Initial Version 
    574    ! 
    575    !> @param[in] cd_var : character 
     705   !> @author J.Paul 
     706   !> @date November, 2013 - Initial Version 
     707   ! 
     708   !> @param[in] cd_var character 
    576709   !> @return character is numeric 
    577710   !------------------------------------------------------------------- 
    578    ! @code 
    579711   PURE LOGICAL FUNCTION fct_is_num(cd_var) 
    580712      IMPLICIT NONE 
    … …  
    597729 
    598730   END FUNCTION fct_is_num 
    599    ! @endcode 
     731   !------------------------------------------------------------------- 
     732   !> @brief This function check if character is real number. 
     733   ! 
     734   !> @details 
     735   !> it allows exponantial and decimal number 
     736   !> exemple :  1e6, 2.3 
     737   !> 
     738   !> @author J.Paul 
     739   !> @date June, 2015 - Initial Version 
     740   ! 
     741   !> @param[in] cd_var character 
     742   !> @return character is numeric 
     743   !------------------------------------------------------------------- 
     744   PURE LOGICAL FUNCTION fct_is_real(cd_var) 
     745      IMPLICIT NONE 
     746      ! Argument       
     747      CHARACTER(LEN=*), INTENT(IN) :: cd_var 
     748    
     749      ! local variables 
     750      LOGICAL :: ll_exp 
     751      LOGICAL :: ll_dec 
     752    
     753      ! loop indices 
     754      INTEGER :: ji 
     755      !---------------------------------------------------------------- 
     756    
     757      ll_exp=.TRUE. 
     758      ll_dec=.FALSE. 
     759      DO ji=1,LEN(TRIM(cd_var)) 
     760         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. & 
     761         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN 
     762    
     763            fct_is_real=.TRUE. 
     764            ll_exp=.FALSE. 
     765       
     766         ELSEIF( TRIM(cd_var(ji:ji))=='e' )THEN 
     767          
     768            IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN 
     769               fct_is_real=.FALSE. 
     770               EXIT 
     771            ELSE  
     772               ll_exp=.TRUE. 
     773            ENDIF 
     774    
     775         ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN 
     776    
     777            IF( ll_dec )THEN 
     778               fct_is_real=.FALSE. 
     779               EXIT 
     780            ELSE 
     781               fct_is_real=.TRUE. 
     782               ll_dec=.TRUE. 
     783            ENDIF 
     784    
     785         ELSE 
     786    
     787            fct_is_real=.FALSE. 
     788            EXIT 
     789    
     790         ENDIF 
     791      ENDDO 
     792    
     793   END FUNCTION fct_is_real 
    600794   !------------------------------------------------------------------- 
    601795   !> @brief This function split string of character  
    602796   !> 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 
     797   !> and return the element on index ind. 
     798   ! 
     799   !> @author J.Paul 
     800   !> @date November, 2013 - Initial Version 
     801   ! 
     802   !> @param[in] cd_string string of character 
     803   !> @param[in] id_ind    indice 
     804   !> @param[in] cd_sep    separator character 
    613805   !> @return return the element on index id_ind 
    614806   !------------------------------------------------------------------- 
    615    ! @code 
    616807   PURE FUNCTION fct_split(cd_string, id_ind, cd_sep) 
    617808      IMPLICIT NONE 
    … …  
    629820 
    630821      INTEGER(i4) :: il_sep 
     822      INTEGER(i4) :: il_lsep 
    631823       
    632824      ! loop indices 
    … …  
    639831      ! get separator 
    640832      cl_sep='|' 
    641       IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep)) 
     833      IF( PRESENT(cd_sep) )THEN 
     834         IF( cd_sep==' ')THEN 
     835            cl_sep=' ' 
     836         ELSE 
     837            cl_sep=TRIM(ADJUSTL(cd_sep)) 
     838         ENDIF 
     839      ENDIF 
    642840       
     841      IF( cl_sep /= ' ' )THEN 
     842         ! get separator index 
     843         il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
     844         il_lsep=LEN(TRIM(cl_sep))  
     845 
     846         IF( il_sep /= 0 )THEN 
     847            fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     848         ELSE 
     849            fct_split=TRIM(ADJUSTL(cl_string)) 
     850         ENDIF 
     851 
     852         ji=1 
     853         DO WHILE( il_sep /= 0 .AND. ji /= id_ind ) 
     854             
     855            ji=ji+1 
     856             
     857            cl_string=TRIM(cl_string(il_sep+il_lsep:)) 
     858            il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
     859 
     860            IF( il_sep /= 0 )THEN 
     861               fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     862            ELSE 
     863               fct_split=TRIM(ADJUSTL(cl_string)) 
     864            ENDIF 
     865 
     866         ENDDO 
     867 
     868         IF( ji /= id_ind ) fct_split='' 
     869      ELSE 
     870         fct_split=fct__split_space(TRIM(cl_string), id_ind) 
     871      ENDIF 
     872 
     873   END FUNCTION fct_split 
     874   !------------------------------------------------------------------- 
     875   !> @brief This function split string of character  
     876   !> using space as separator,  
     877   !> and return the element on index ind. 
     878   ! 
     879   !> @author J.Paul 
     880   !> @date November, 2013 - Initial Version 
     881   ! 
     882   !> @param[in] cd_string string of character 
     883   !> @param[in] id_ind    indice 
     884   !> @return return the element on index id_ind 
     885   !------------------------------------------------------------------- 
     886   PURE FUNCTION fct__split_space(cd_string, id_ind) 
     887      IMPLICIT NONE 
     888      ! Argument       
     889      CHARACTER(LEN=*), INTENT(IN) :: cd_string 
     890      INTEGER(i4)     , INTENT(IN) :: id_ind 
     891 
     892      ! function 
     893      CHARACTER(LEN=lc) :: fct__split_space 
     894 
     895      ! local variable 
     896      CHARACTER(LEN=lc) :: cl_string 
     897 
     898      INTEGER(i4) :: il_sep 
     899      INTEGER(i4) :: il_lsep 
     900       
     901      ! loop indices 
     902      INTEGER(i4) :: ji 
     903      !---------------------------------------------------------------- 
     904      ! initialize 
     905      fct__split_space='' 
     906      cl_string=ADJUSTL(cd_string) 
     907 
    643908      ! get separator index 
    644       il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
    645        
     909      il_sep=INDEX( TRIM(cl_string), ' ' ) 
     910      il_lsep=LEN(' ')  
     911 
    646912      IF( il_sep /= 0 )THEN 
    647          fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     913         fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    648914      ELSE 
    649          fct_split=TRIM(ADJUSTL(cl_string)) 
     915         fct__split_space=TRIM(ADJUSTL(cl_string)) 
    650916      ENDIF 
    651917 
    … …  
    655921         ji=ji+1 
    656922          
    657          cl_string=TRIM(cl_string(il_sep+1:)) 
    658          il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 
     923         cl_string=TRIM(cl_string(il_sep+il_lsep:)) 
     924         il_sep=INDEX( TRIM(cl_string), ' ' ) 
    659925 
    660926         IF( il_sep /= 0 )THEN 
    661             fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     927            fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    662928         ELSE 
    663             fct_split=TRIM(ADJUSTL(cl_string)) 
     929            fct__split_space=TRIM(ADJUSTL(cl_string)) 
    664930         ENDIF 
    665931 
    666932      ENDDO 
    667933 
    668       IF( ji /= id_ind ) fct_split='' 
    669  
    670    END FUNCTION fct_split 
    671    ! @endcode 
     934      IF( ji /= id_ind ) fct__split_space='' 
     935 
     936   END FUNCTION fct__split_space 
    672937   !------------------------------------------------------------------- 
    673938   !> @brief This function return basename of a filename. 
    674939   ! 
    675940   !> @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 
     941   !> Actually it splits filename using sperarator '/' 
     942   !> and return last string character.<br/> 
     943   !> Optionally you could specify another separator. 
     944   !> @author J.Paul 
     945   !> @date November, 2013 - Initial Version 
     946   ! 
     947   !> @param[in] cd_string filename 
     948   !> @param[in] cd_sep    separator character 
    683949   !> @return basename (filename without path) 
    684950   !------------------------------------------------------------------- 
    685    ! @code 
    686951   PURE FUNCTION fct_basename(cd_string, cd_sep) 
    687952      IMPLICIT NONE 
    … …  
    711976 
    712977   END FUNCTION fct_basename 
    713    ! @endcode 
    714978   !------------------------------------------------------------------- 
    715979   !> @brief This function return dirname of a filename. 
    716980   ! 
    717981   !> @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 
     982   !> Actually it splits filename using sperarator '/' 
     983   !> and return all except last string character.<br/> 
     984   !> Optionally you could specify another separator. 
     985   !> @author J.Paul 
     986   !> @date November, 2013 - Initial Version 
     987   ! 
     988   !> @param[in] cd_string filename 
     989   !> @param[in] cd_sep    separator character 
    725990   !> @return dirname (path of the filename) 
    726991   !------------------------------------------------------------------- 
    727    ! @code 
    728992   PURE FUNCTION fct_dirname(cd_string, cd_sep) 
    729993      IMPLICIT NONE 
    … …  
    7571021 
    7581022   END FUNCTION fct_dirname 
    759    ! @endcode 
    7601023END MODULE fct 
    7611024 
Note: See TracChangeset for help on using the changeset viewer.