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/function.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/function.f90

    r9598 r12080  
    33!---------------------------------------------------------------------- 
    44! 
    5 ! MODULE: fct 
    6 ! 
    75! DESCRIPTION: 
    86!> @brief 
     
    8987!> @endcode 
    9088!>  
     89!> to show help message:<br/> 
     90!> @code 
     91!> CALL fct_help(cd_filename, cd_err) 
     92!> @endcode 
     93!>    - cd_filename : file name 
     94!>    - cd_err      : error message [optional] 
     95!> 
     96!> to show Siren's version:<br/> 
     97!> @code 
     98!> CALL fct_version(cd_filename) 
     99!> @endcode 
     100!>    - cd_filename : file name 
     101!> 
    91102!>  
    92103!> @author 
    93104!> J.Paul 
    94 ! REVISION HISTORY: 
     105!> 
    95106!> @date November, 2013 - Initial Version 
    96107!> @date September, 2014  
    97108!> - add header 
    98 ! 
    99 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     109!> @date October, 2019 
     110!> - add help and version function 
     111!> 
     112!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    100113!---------------------------------------------------------------------- 
    101114MODULE fct 
     115 
     116   USE global                          ! global variable 
    102117   USE kind                            ! F90 kind parameter 
     118 
    103119   IMPLICIT NONE 
    104120   ! NOTE_avoid_public_variables_if_possible 
     
    118134   PUBLIC :: fct_pause    !< pause statement 
    119135   PUBLIC :: fct_err      !< handle fortran error status 
     136   PUBLIC :: fct_help     !< show help message 
     137   PUBLIC :: fct_version  !< show Siren's version 
    120138 
    121139   PRIVATE :: fct__i1_str ! convert integer(1) to string character 
     
    156174 
    157175CONTAINS 
     176   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     177   PURE FUNCTION fct__i1_cat(cd_char, bd_val) & 
     178         & RESULT(cf_str) 
    158179   !-------------------------------------------------------------------  
    159180   !> @brief This function concatenate character and integer(1) (as character).  
    160    !  
     181   !> 
    161182   !> @author J.Paul  
    162183   !> @date September, 2014 - Initial Version  
    163    !  
     184   !> 
    164185   !> @param[in] cd_char   string character 
    165186   !> @param[in] bd_val    integer(1) variable value 
    166187   !> @return string character  
    167188   !-------------------------------------------------------------------  
    168    PURE CHARACTER(LEN=lc) FUNCTION fct__i1_cat(cd_char, bd_val)  
     189  
     190      IMPLICIT NONE 
    169191  
    170192      ! arguments 
     
    172194      INTEGER(i1),       INTENT(IN) :: bd_val 
    173195 
     196      ! function 
     197      CHARACTER(LEN=lc)             :: cf_str 
     198 
    174199      ! local variable 
    175200      CHARACTER(LEN=lc) :: cl_val 
     
    177202  
    178203      cl_val = fct_str(bd_val) 
    179       fct__i1_cat=TRIM(cd_char)//TRIM(cl_val) 
     204      cf_str = TRIM(cd_char)//TRIM(cl_val) 
    180205 
    181206   END FUNCTION fct__i1_cat  
     207   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     208   PURE FUNCTION fct__i2_cat(cd_char, sd_val) & 
     209         & RESULT(cf_str) 
    182210   !-------------------------------------------------------------------  
    183211   !> @brief This function concatenate character and integer(2) (as character).  
    184    !  
     212   !> 
    185213   !> @author J.Paul  
    186214   !> @date September, 2014 - Initial Version  
    187    !  
     215   !> 
    188216   !> @param[in] cd_char   string character 
    189217   !> @param[in] sd_val    integer(2) variable value 
    190218   !> @return string character  
    191219   !-------------------------------------------------------------------  
    192    PURE CHARACTER(LEN=lc) FUNCTION fct__i2_cat(cd_char, sd_val)  
     220  
     221      IMPLICIT NONE 
    193222  
    194223      ! arguments 
     
    196225      INTEGER(i2),       INTENT(IN) :: sd_val 
    197226 
     227      ! function 
     228      CHARACTER(LEN=lc)             :: cf_str 
     229 
    198230      ! local variable 
    199231      CHARACTER(LEN=lc) :: cl_val 
     
    201233  
    202234      cl_val = fct_str(sd_val) 
    203       fct__i2_cat=TRIM(cd_char)//TRIM(cl_val) 
     235      cf_str = TRIM(cd_char)//TRIM(cl_val) 
    204236 
    205237   END FUNCTION fct__i2_cat  
     238   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     239   PURE FUNCTION fct__i4_cat(cd_char, id_val) & 
     240         & RESULT(cf_str) 
    206241   !-------------------------------------------------------------------  
    207242   !> @brief This function concatenate character and integer(4) (as character).  
    208    !  
     243   !> 
    209244   !> @author J.Paul  
    210245   !> @date November, 2013 - Initial Version  
    211    !  
     246   !> 
    212247   !> @param[in] cd_char   string character 
    213248   !> @param[in] id_val    integer(4) variable value 
    214249   !> @return string character  
    215250   !-------------------------------------------------------------------  
    216    PURE CHARACTER(LEN=lc) FUNCTION fct__i4_cat(cd_char, id_val)  
     251  
     252      IMPLICIT NONE 
    217253  
    218254      ! arguments 
     
    220256      INTEGER(i4),       INTENT(IN) :: id_val 
    221257 
     258      ! function 
     259      CHARACTER(LEN=lc)             :: cf_str 
     260 
    222261      ! local variable 
    223262      CHARACTER(LEN=lc) :: cl_val 
     
    225264  
    226265      cl_val = fct_str(id_val) 
    227       fct__i4_cat=TRIM(cd_char)//TRIM(cl_val) 
     266      cf_str = TRIM(cd_char)//TRIM(cl_val) 
    228267 
    229268   END FUNCTION fct__i4_cat  
     269   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     270   PURE FUNCTION fct__i8_cat(cd_char, kd_val) & 
     271         & RESULT(cf_str) 
    230272   !-------------------------------------------------------------------  
    231273   !> @brief This function concatenate character and integer(8) (as character).  
    232    !  
     274   !> 
    233275   !> @author J.Paul  
    234276   !> @date November, 2013 - Initial Version  
    235    !  
     277   !> 
    236278   !> @param[in] cd_char   string character 
    237279   !> @param[in] kd_val    integer(8) variable value 
    238280   !> @return string character  
    239281   !-------------------------------------------------------------------  
    240    PURE CHARACTER(LEN=lc) FUNCTION fct__i8_cat(cd_char, kd_val)  
     282  
     283      IMPLICIT NONE 
    241284  
    242285      ! arguments 
     
    244287      INTEGER(i8),       INTENT(IN) :: kd_val 
    245288 
     289      ! function 
     290      CHARACTER(LEN=lc)             :: cf_str 
     291 
    246292      ! local variable 
    247293      CHARACTER(LEN=lc) :: cl_val 
     
    249295  
    250296      cl_val = fct_str(kd_val) 
    251       fct__i8_cat=TRIM(cd_char)//TRIM(cl_val) 
     297      cf_str = TRIM(cd_char)//TRIM(cl_val) 
    252298 
    253299   END FUNCTION fct__i8_cat  
     300   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     301   PURE FUNCTION fct__r4_cat(cd_char, rd_val) & 
     302         & RESULT(cf_str) 
    254303   !-------------------------------------------------------------------  
    255304   !> @brief This function concatenate character and real(4) (as character).  
    256    !  
     305   !> 
    257306   !> @author J.Paul  
    258307   !> @date November, 2013 - Initial Version  
    259    !  
     308   !> 
    260309   !> @param[in] cd_char   string character 
    261310   !> @param[in] rd_val    real(4) variable value 
    262311   !> @return string character  
    263312   !-------------------------------------------------------------------  
    264    PURE CHARACTER(LEN=lc) FUNCTION fct__r4_cat(cd_char, rd_val)  
     313  
     314      IMPLICIT NONE 
    265315  
    266316      ! arguments 
     
    268318      REAL(sp),          INTENT(IN) :: rd_val 
    269319 
     320      ! function 
     321      CHARACTER(LEN=lc)             :: cf_str 
     322 
    270323      ! local variable 
    271324      CHARACTER(LEN=lc) :: cl_val 
     
    273326  
    274327      cl_val = fct_str(rd_val) 
    275       fct__r4_cat=TRIM(cd_char)//TRIM(cl_val) 
     328      cf_str = TRIM(cd_char)//TRIM(cl_val) 
    276329 
    277330   END FUNCTION fct__r4_cat  
     331   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     332   PURE FUNCTION fct__r8_cat(cd_char, dd_val) & 
     333         & RESULT(cf_str) 
    278334   !-------------------------------------------------------------------  
    279335   !> @brief This function concatenate character and real(8) (as character).  
     
    286342   !> @return string character  
    287343   !-------------------------------------------------------------------  
    288    PURE CHARACTER(LEN=lc) FUNCTION fct__r8_cat(cd_char, dd_val)  
     344  
     345      IMPLICIT NONE 
    289346  
    290347      ! arguments 
     
    292349      REAL(dp),          INTENT(IN) :: dd_val 
    293350 
     351      ! function 
     352      CHARACTER(LEN=lc)             :: cf_str 
     353 
    294354      ! local variable 
    295355      CHARACTER(LEN=lc) :: cl_val 
     
    297357  
    298358      cl_val = fct_str(dd_val) 
    299       fct__r8_cat=TRIM(cd_char)//TRIM(cl_val) 
     359      cf_str = TRIM(cd_char)//TRIM(cl_val) 
    300360 
    301361   END FUNCTION fct__r8_cat  
     362   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     363   PURE FUNCTION fct__l_cat(cd_char, ld_val) & 
     364         & RESULT(cf_str) 
    302365   !-------------------------------------------------------------------  
    303366   !> @brief This function concatenate character and logical (as character).  
     
    310373   !> @return string character  
    311374   !-------------------------------------------------------------------  
    312    PURE CHARACTER(LEN=lc) FUNCTION fct__l_cat(cd_char, ld_val)  
     375 
     376      IMPLICIT NONE 
    313377  
    314378      ! arguments 
     
    316380      LOGICAL,           INTENT(IN) :: ld_val 
    317381 
     382      ! function 
     383      CHARACTER(LEN=lc)             :: cf_str 
     384 
    318385      ! local variable 
    319386      CHARACTER(LEN=lc) :: cl_val 
     
    321388  
    322389      cl_val = fct_str(ld_val) 
    323       fct__l_cat=TRIM(cd_char)//TRIM(cl_val) 
     390      cf_str = TRIM(cd_char)//TRIM(cl_val) 
    324391 
    325392   END FUNCTION fct__l_cat  
     393   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     394   FUNCTION fct_getunit() & 
     395         & RESULT(if_unit) 
    326396   !-------------------------------------------------------------------  
    327397   !> @brief This function returns the next available I/O unit number.  
     
    332402   !> @return file id  
    333403   !-------------------------------------------------------------------  
    334    INTEGER(i4) FUNCTION fct_getunit()  
    335   
     404 
     405      IMPLICIT NONE 
     406  
     407      ! function 
     408      INTEGER(i4) :: if_unit 
     409 
    336410      ! local variable  
    337411      LOGICAL ::  ll_opened  
    338412      !----------------------------------------------------------------  
    339413      ! initialise  
    340       fct_getunit = 10  
    341   
    342       INQUIRE(UNIT=fct_getunit, OPENED=ll_opened)  
     414      if_unit = 10  
     415  
     416      INQUIRE(UNIT=if_unit, OPENED=ll_opened)  
    343417      DO WHILE( ll_opened )  
    344          fct_getunit = fct_getunit + 1  
    345          INQUIRE(UNIT=fct_getunit, OPENED=ll_opened)   
     418         if_unit = if_unit + 1  
     419         INQUIRE(UNIT=if_unit, OPENED=ll_opened)   
    346420      ENDDO  
    347421  
    348422   END FUNCTION fct_getunit  
     423   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     424   SUBROUTINE fct_err(id_status) 
    349425   !------------------------------------------------------------------- 
    350426   !> @brief This subroutine handle Fortran status. 
    351    ! 
     427   !> 
    352428   !> @author J.Paul 
    353429   !> @date November, 2013 - Initial Version 
     
    355431   !> @param[in] id_status 
    356432   !------------------------------------------------------------------- 
    357    SUBROUTINE fct_err(id_status) 
     433 
     434      IMPLICIT NONE 
    358435 
    359436      ! Argument 
     
    363440      IF( id_status /= 0 )THEN 
    364441         !CALL ERRSNS() ! not F95 standard 
    365          PRINT *, "FORTRAN ERROR ",id_status 
     442         PRINT *, "FORTRAN ERROR ", id_status 
    366443         !STOP 
    367444      ENDIF 
    368445 
    369446   END SUBROUTINE fct_err 
     447   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     448   SUBROUTINE fct_pause(cd_msg) 
    370449   !------------------------------------------------------------------- 
    371450   !> @brief This subroutine  create a pause statement 
    372    ! 
     451   !> 
    373452   !> @author J.Paul 
    374453   !> @date November, 2014 - Initial Version 
     
    376455   !> @param[in] cd_msg optional message to be added 
    377456   !------------------------------------------------------------------- 
    378    SUBROUTINE fct_pause(cd_msg) 
     457 
     458      IMPLICIT NONE 
    379459 
    380460      ! Argument 
     
    390470 
    391471   END SUBROUTINE fct_pause 
     472   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     473   PURE FUNCTION fct__l_str(ld_var) & 
     474         & RESULT(cf_str) 
    392475   !------------------------------------------------------------------- 
    393476   !> @brief This function convert logical to string character. 
     
    395478   !> @author J.Paul 
    396479   !> @date November, 2013 - Initial Version 
    397    ! 
     480   !> 
    398481   !> @param[in] ld_var logical variable 
    399482   !> @return character of this integer variable 
    400483   !------------------------------------------------------------------- 
    401    PURE CHARACTER(LEN=lc) FUNCTION fct__l_str(ld_var) 
    402       IMPLICIT NONE 
     484 
     485      IMPLICIT NONE 
     486 
    403487      ! Argument       
    404488      LOGICAL, INTENT(IN) :: ld_var 
    405489 
     490      ! function 
     491      CHARACTER(LEN=lc)   :: cf_str 
     492 
    406493      ! local variable 
    407494      CHARACTER(LEN=lc) :: cl_tmp 
    408495      !---------------------------------------------------------------- 
    409496 
    410       write(cl_tmp,*) ld_var 
    411       fct__l_str=TRIM(ADJUSTL(cl_tmp)) 
     497      WRITE(cl_tmp,*) ld_var 
     498      cf_str=TRIM(ADJUSTL(cl_tmp)) 
    412499 
    413500   END FUNCTION fct__l_str 
     501   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     502   PURE FUNCTION fct__i1_str(bd_var) & 
     503         & RESULT(cf_str) 
    414504   !------------------------------------------------------------------- 
    415505   !> @brief This function convert integer(1) to string character. 
     
    417507   !> @author J.Paul 
    418508   !> @date November, 2013 - Initial Version 
    419    ! 
     509   !> 
    420510   !> @param[in] bd_var integer(1) variable 
    421511   !> @return character of this integer variable 
    422512   !------------------------------------------------------------------- 
    423    PURE CHARACTER(LEN=lc) FUNCTION fct__i1_str(bd_var) 
    424       IMPLICIT NONE 
     513 
     514      IMPLICIT NONE 
     515 
    425516      ! Argument       
    426517      INTEGER(i1), INTENT(IN) :: bd_var 
    427518 
     519      ! function 
     520      CHARACTER(LEN=lc)       :: cf_str 
     521 
    428522      ! local variable 
    429523      CHARACTER(LEN=lc) :: cl_tmp 
    430524      !---------------------------------------------------------------- 
    431525 
    432       write(cl_tmp,*) bd_var 
    433       fct__i1_str=TRIM(ADJUSTL(cl_tmp)) 
     526      WRITE(cl_tmp,*) bd_var 
     527      cf_str=TRIM(ADJUSTL(cl_tmp)) 
    434528 
    435529   END FUNCTION fct__i1_str 
     530   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     531   PURE FUNCTION fct__i2_str(sd_var) & 
     532         & RESULT(cf_str) 
    436533   !------------------------------------------------------------------- 
    437534   !> @brief This function convert integer(2) to string character. 
     
    439536   !> @author J.Paul 
    440537   !> @date November, 2013 - Initial Version 
    441    ! 
     538   !> 
    442539   !> @param[in] sd_var integer(2) variable 
    443540   !> @return character of this integer variable 
    444541   !------------------------------------------------------------------- 
    445    PURE CHARACTER(LEN=lc) FUNCTION fct__i2_str(sd_var) 
    446       IMPLICIT NONE 
     542 
     543      IMPLICIT NONE 
     544 
    447545      ! Argument       
    448546      INTEGER(i2), INTENT(IN) :: sd_var 
    449547 
     548      ! function 
     549      CHARACTER(LEN=lc)       :: cf_str 
     550 
    450551      ! local variable 
    451552      CHARACTER(LEN=lc) :: cl_tmp 
    452553      !---------------------------------------------------------------- 
    453554 
    454       write(cl_tmp,*) sd_var 
    455       fct__i2_str=TRIM(ADJUSTL(cl_tmp)) 
     555      WRITE(cl_tmp,*) sd_var 
     556      cf_str=TRIM(ADJUSTL(cl_tmp)) 
    456557 
    457558   END FUNCTION fct__i2_str 
     559   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     560   PURE FUNCTION fct__i4_str(id_var) & 
     561         & RESULT(cf_str) 
    458562   !------------------------------------------------------------------- 
    459563   !> @brief This function convert integer(4) to string character. 
     
    461565   !> @author J.Paul 
    462566   !> @date November, 2013 - Initial Version 
    463    ! 
     567   !> 
    464568   !> @param[in] id_var integer(4) variable 
    465569   !> @return character of this integer variable 
    466570   !------------------------------------------------------------------- 
    467    PURE CHARACTER(LEN=lc) FUNCTION fct__i4_str(id_var) 
    468       IMPLICIT NONE 
     571 
     572      IMPLICIT NONE 
     573 
    469574      ! Argument       
    470575      INTEGER(i4), INTENT(IN) :: id_var 
    471576 
     577      ! function 
     578      CHARACTER(LEN=lc)       :: cf_str 
     579 
    472580      ! local variable 
    473581      CHARACTER(LEN=lc) :: cl_tmp 
    474582      !---------------------------------------------------------------- 
    475583 
    476       write(cl_tmp,*) id_var 
    477       fct__i4_str=TRIM(ADJUSTL(cl_tmp)) 
     584      WRITE(cl_tmp,*) id_var 
     585      cf_str=TRIM(ADJUSTL(cl_tmp)) 
    478586 
    479587   END FUNCTION fct__i4_str 
     588   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     589   PURE FUNCTION fct__i8_str(kd_var) & 
     590         & RESULT(cf_str) 
    480591   !------------------------------------------------------------------- 
    481592   !> @brief This function convert integer(8) to string character. 
     
    483594   !> @author J.Paul 
    484595   !> @date November, 2013 - Initial Version 
    485    ! 
     596   !> 
    486597   !> @param[in] kd_var integer(8) variable 
    487598   !> @return character of this integer variable 
    488599   !------------------------------------------------------------------- 
    489    PURE CHARACTER(LEN=lc) FUNCTION fct__i8_str(kd_var) 
    490       IMPLICIT NONE 
     600 
     601      IMPLICIT NONE 
     602 
    491603      ! Argument       
    492604      INTEGER(i8), INTENT(IN) :: kd_var 
    493605 
     606      ! function 
     607      CHARACTER(LEN=lc)       :: cf_str 
     608 
    494609      ! local variable 
    495610      CHARACTER(LEN=lc) :: cl_tmp 
    496611      !---------------------------------------------------------------- 
    497612 
    498       write(cl_tmp,*) kd_var 
    499       fct__i8_str=TRIM(ADJUSTL(cl_tmp)) 
     613      WRITE(cl_tmp,*) kd_var 
     614      cf_str=TRIM(ADJUSTL(cl_tmp)) 
    500615 
    501616   END FUNCTION fct__i8_str 
     617   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     618   PURE FUNCTION fct__r4_str(rd_var) & 
     619         & RESULT(cf_str) 
    502620   !------------------------------------------------------------------- 
    503621   !> @brief This function convert real(4) to string character. 
     
    505623   !> @author J.Paul 
    506624   !> @date November, 2013 - Initial Version 
    507    ! 
     625   !> 
    508626   !> @param[in] rd_var real(4) variable 
    509627   !> @return character of this real variable 
    510628   !------------------------------------------------------------------- 
    511    PURE CHARACTER(LEN=lc) FUNCTION fct__r4_str(rd_var) 
    512       IMPLICIT NONE 
     629 
     630      IMPLICIT NONE 
     631 
    513632      ! Argument       
    514633      REAL(sp), INTENT(IN) :: rd_var 
    515634 
     635      ! function 
     636      CHARACTER(LEN=lc)    :: cf_str 
     637 
    516638      ! local variable 
    517639      CHARACTER(LEN=lc) :: cl_tmp 
    518640      !---------------------------------------------------------------- 
    519641 
    520       write(cl_tmp,*) rd_var 
    521       fct__r4_str=TRIM(ADJUSTL(cl_tmp)) 
     642      WRITE(cl_tmp,*) rd_var 
     643      cf_str=TRIM(ADJUSTL(cl_tmp)) 
    522644 
    523645   END FUNCTION fct__r4_str 
     646   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     647   PURE FUNCTION fct__r8_str(dd_var) & 
     648         & RESULT(cf_str) 
    524649   !------------------------------------------------------------------- 
    525650   !> @brief This function convert real(8) to string character. 
     
    527652   !> @author J.Paul 
    528653   !> @date November, 2013 - Initial Version 
    529    ! 
     654   !> 
    530655   !> @param[in] dd_var real(8) variable 
    531656   !> @return character of this real variable 
    532657   !------------------------------------------------------------------- 
    533    PURE CHARACTER(LEN=lc) FUNCTION fct__r8_str(dd_var) 
    534       IMPLICIT NONE 
     658 
     659      IMPLICIT NONE 
     660 
    535661      ! Argument       
    536662      REAL(dp), INTENT(IN) :: dd_var 
    537663 
     664      ! function 
     665      CHARACTER(LEN=lc)    :: cf_str 
     666 
    538667      ! local variable 
    539668      CHARACTER(LEN=lc) :: cl_tmp 
    540669      !---------------------------------------------------------------- 
    541670 
    542       write(cl_tmp,*) dd_var 
    543       fct__r8_str=TRIM(ADJUSTL(cl_tmp)) 
     671      WRITE(cl_tmp,*) dd_var 
     672      cf_str=TRIM(ADJUSTL(cl_tmp)) 
    544673 
    545674   END FUNCTION fct__r8_str 
     675   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     676   PURE FUNCTION fct_concat(cd_arr,cd_sep) & 
     677         & RESULT(cf_str) 
    546678   !------------------------------------------------------------------- 
    547679   !> @brief This function concatenate all the element of a character array  
     
    552684   !> @author J.Paul 
    553685   !> @date November, 2013 - Initial Version 
    554    ! 
     686   !> 
    555687   !> @param[in] cd_arr array of character 
    556688   !> @param[in] cd_sep separator character 
    557689   !> @return character 
    558690   !------------------------------------------------------------------- 
    559    PURE CHARACTER(LEN=lc) FUNCTION fct_concat(cd_arr,cd_sep) 
    560       IMPLICIT NONE 
     691 
     692      IMPLICIT NONE 
     693 
    561694      ! Argument       
    562695      CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_arr 
    563696      CHARACTER(*),               INTENT(IN), OPTIONAL :: cd_sep 
     697 
     698      ! function 
     699      CHARACTER(LEN=lc)                      :: cf_str 
    564700 
    565701      ! local variable 
     
    576712 
    577713      il_size=SIZE(cd_arr) 
    578       fct_concat='' 
     714      cf_str='' 
    579715      cl_tmp='' 
    580716      DO ji=1,il_size 
    581717 
    582          WRITE(cl_tmp,*) TRIM(fct_concat)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep) 
    583          fct_concat=TRIM(ADJUSTL(cl_tmp)) 
     718         WRITE(cl_tmp,*) TRIM(cf_str)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep) 
     719         cf_str=TRIM(ADJUSTL(cl_tmp)) 
    584720       
    585721      ENDDO 
    586722 
    587723   END FUNCTION fct_concat 
     724   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     725   PURE FUNCTION fct_lower(cd_var) & 
     726         & RESULT(cf_str) 
    588727   !------------------------------------------------------------------- 
    589728   !> @brief This function convert string character upper case to lower case. 
    590    ! 
     729   !> 
    591730   !> @details 
    592731   !> The function IACHAR returns the ASCII value of the character passed  
     
    595734   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase 
    596735   !> and the lowercase codes. 
    597    ! 
    598    !> @author J.Paul 
    599    !> @date November, 2013 - Initial Version 
    600    ! 
     736   !> 
     737   !> @author J.Paul 
     738   !> @date November, 2013 - Initial Version 
     739   !> 
    601740   !> @param[in] cd_var character 
    602741   !> @return lower case character 
    603742   !------------------------------------------------------------------- 
    604    PURE CHARACTER(LEN=lc) FUNCTION fct_lower(cd_var) 
    605       IMPLICIT NONE 
     743 
     744      IMPLICIT NONE 
     745 
    606746      ! Argument       
    607747      CHARACTER(*), INTENT(IN) :: cd_var 
     748 
     749      ! function 
     750      CHARACTER(LEN=lc)        :: cf_str 
    608751 
    609752      ! local variable 
     
    639782      ENDDO 
    640783 
    641       fct_lower=TRIM(ADJUSTL(fct_concat(cl_tmp(:)))) 
     784      cf_str=TRIM(ADJUSTL(fct_concat(cl_tmp(:)))) 
    642785      DEALLOCATE(cl_tmp) 
    643786 
    644787   END FUNCTION fct_lower 
     788   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     789   PURE FUNCTION fct_upper(cd_var) & 
     790         & RESULT(cf_str) 
    645791   !------------------------------------------------------------------- 
    646792   !> @brief This function convert string character lower case to upper case. 
    647    ! 
     793   !> 
    648794   !> @details 
    649795   !> The function IACHAR returns the ASCII value of the character passed  
     
    652798   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase 
    653799   !> and the lowercase codes. 
    654    ! 
    655    !> @author J.Paul 
    656    !> @date November, 2013 - Initial Version 
    657    ! 
     800   !> 
     801   !> @author J.Paul 
     802   !> @date November, 2013 - Initial Version 
     803   !> 
    658804   !> @param[in] cd_var character 
    659805   !> @return upper case character 
    660806   !------------------------------------------------------------------- 
    661    PURE CHARACTER(LEN=lc) FUNCTION fct_upper(cd_var) 
    662       IMPLICIT NONE 
     807 
     808      IMPLICIT NONE 
     809 
    663810      ! Argument       
    664811      CHARACTER(*), INTENT(IN) :: cd_var 
     812 
     813      ! function 
     814      CHARACTER(LEN=lc)        :: cf_str 
    665815 
    666816      ! local variable 
     
    696846      ENDDO 
    697847 
    698       fct_upper=TRIM(ADJUSTL(fct_concat(cl_tmp(:)))) 
     848      cf_str=TRIM(ADJUSTL(fct_concat(cl_tmp(:)))) 
    699849      DEALLOCATE(cl_tmp) 
    700850 
    701851   END FUNCTION fct_upper 
     852   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     853   PURE FUNCTION fct_is_num(cd_var) & 
     854         & RESULT(lf_numeric) 
    702855   !------------------------------------------------------------------- 
    703856   !> @brief This function check if character is numeric. 
    704    ! 
    705    !> @author J.Paul 
    706    !> @date November, 2013 - Initial Version 
    707    ! 
     857   !> 
     858   !> @author J.Paul 
     859   !> @date November, 2013 - Initial Version 
     860   !> 
    708861   !> @param[in] cd_var character 
    709862   !> @return character is numeric 
    710863   !------------------------------------------------------------------- 
    711    PURE LOGICAL FUNCTION fct_is_num(cd_var) 
    712       IMPLICIT NONE 
     864 
     865      IMPLICIT NONE 
     866 
    713867      ! Argument       
    714868      CHARACTER(LEN=*), INTENT(IN) :: cd_var 
     869 
     870      ! function 
     871      LOGICAL                      :: lf_numeric 
    715872 
    716873      ! loop indices 
     
    721878         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. & 
    722879         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN 
    723             fct_is_num=.TRUE. 
     880            lf_numeric=.TRUE. 
    724881         ELSE 
    725             fct_is_num=.FALSE. 
     882            lf_numeric=.FALSE. 
    726883            EXIT 
    727884         ENDIF 
     
    729886 
    730887   END FUNCTION fct_is_num 
     888   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     889   PURE FUNCTION fct_is_real(cd_var) & 
     890         & RESULT(lf_real) 
    731891   !------------------------------------------------------------------- 
    732892   !> @brief This function check if character is real number. 
    733    ! 
     893   !> 
    734894   !> @details 
    735    !> it allows exponantial and decimal number 
     895   !> it permits exponantial and decimal number 
    736896   !> exemple :  1e6, 2.3 
    737897   !> 
    738898   !> @author J.Paul 
    739899   !> @date June, 2015 - Initial Version 
    740    ! 
     900   !> @date April, 2018 
     901   !> - permit negative exposant  
     902   !> - permit sign as first character  
     903   !> 
    741904   !> @param[in] cd_var character 
    742905   !> @return character is real number 
    743906   !------------------------------------------------------------------- 
    744    PURE LOGICAL FUNCTION fct_is_real(cd_var) 
    745       IMPLICIT NONE 
     907 
     908      IMPLICIT NONE 
     909 
    746910      ! Argument       
    747911      CHARACTER(LEN=*), INTENT(IN) :: cd_var 
    748912    
     913      ! function 
     914      LOGICAL                      :: lf_real 
     915 
    749916      ! local variables 
    750917      LOGICAL :: ll_exp 
     
    761928         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN 
    762929    
    763             fct_is_real=.TRUE. 
     930            lf_real=.TRUE. 
    764931            ll_exp=.FALSE. 
    765932       
    766          ELSEIF( TRIM(cd_var(ji:ji))=='e' )THEN 
     933         ELSEIF( TRIM(fct_lower(cd_var(ji:ji)))=='e' )THEN 
    767934          
    768935            IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN 
    769                fct_is_real=.FALSE. 
     936               lf_real=.FALSE. 
    770937               EXIT 
    771938            ELSE  
    772939               ll_exp=.TRUE. 
    773940            ENDIF 
    774     
     941 
     942         ELSEIF( TRIM(cd_var(ji:ji))=='+' )THEN 
     943            IF( ji /= 1 )THEN 
     944               lf_real=.FALSE. 
     945               EXIT 
     946            ELSE 
     947               lf_real=.TRUE. 
     948            ENDIF 
     949          
     950         ELSEIF( TRIM(cd_var(ji:ji))=='-' )THEN 
     951          
     952            IF( ji <= 1 )THEN 
     953               IF( ji /= 1 )THEN 
     954                  lf_real=.FALSE. 
     955                  EXIT 
     956               ELSE 
     957                  lf_real=.TRUE. 
     958               ENDIF 
     959            ELSE ! ji > 1 
     960               IF( TRIM(fct_lower(cd_var(ji-1:ji-1)))/='e' )THEN 
     961                  lf_real=.FALSE. 
     962                  EXIT 
     963               ELSE 
     964                  lf_real=.TRUE. 
     965               ENDIF 
     966            ENDIF 
     967 
    775968         ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN 
    776969    
    777970            IF( ll_dec )THEN 
    778                fct_is_real=.FALSE. 
     971               lf_real=.FALSE. 
    779972               EXIT 
    780973            ELSE 
    781                fct_is_real=.TRUE. 
     974               lf_real=.TRUE. 
    782975               ll_dec=.TRUE. 
    783976            ENDIF 
     
    785978         ELSE 
    786979    
    787             fct_is_real=.FALSE. 
     980            lf_real=.FALSE. 
    788981            EXIT 
    789982    
     
    792985    
    793986   END FUNCTION fct_is_real 
     987   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     988   PURE FUNCTION fct_split(cd_string, id_ind, cd_sep) & 
     989         & RESULT(cf_elt) 
    794990   !------------------------------------------------------------------- 
    795991   !> @brief This function split string of character  
    796992   !> using separator character, by default '|', 
    797993   !> and return the element on index ind. 
    798    ! 
    799    !> @author J.Paul 
    800    !> @date November, 2013 - Initial Version 
    801    ! 
     994   !> 
     995   !> @author J.Paul 
     996   !> @date November, 2013 - Initial Version 
     997   !> 
    802998   !> @param[in] cd_string string of character 
    803999   !> @param[in] id_ind    indice 
    8041000   !> @param[in] cd_sep    separator character 
    805    !> @return return the element on index id_ind 
    806    !------------------------------------------------------------------- 
    807    PURE FUNCTION fct_split(cd_string, id_ind, cd_sep) 
    808       IMPLICIT NONE 
     1001   !> @return return the element of index id_ind 
     1002   !------------------------------------------------------------------- 
     1003 
     1004      IMPLICIT NONE 
     1005 
    8091006      ! Argument       
    8101007      CHARACTER(LEN=*), INTENT(IN) :: cd_string 
     
    8131010 
    8141011      ! function 
    815       CHARACTER(LEN=lc) :: fct_split 
     1012      CHARACTER(LEN=lc)            :: cf_elt 
    8161013 
    8171014      ! local variable 
     
    8261023      !---------------------------------------------------------------- 
    8271024      ! initialize 
    828       fct_split='' 
     1025      cf_elt='' 
    8291026      cl_string=ADJUSTL(cd_string) 
    8301027 
     
    8451042 
    8461043         IF( il_sep /= 0 )THEN 
    847             fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     1044            cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    8481045         ELSE 
    849             fct_split=TRIM(ADJUSTL(cl_string)) 
     1046            cf_elt=TRIM(ADJUSTL(cl_string)) 
    8501047         ENDIF 
    8511048 
     
    8591056 
    8601057            IF( il_sep /= 0 )THEN 
    861                fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     1058               cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    8621059            ELSE 
    863                fct_split=TRIM(ADJUSTL(cl_string)) 
     1060               cf_elt=TRIM(ADJUSTL(cl_string)) 
    8641061            ENDIF 
    8651062 
    8661063         ENDDO 
    8671064 
    868          IF( ji /= id_ind ) fct_split='' 
     1065         IF( ji /= id_ind ) cf_elt='' 
    8691066      ELSE 
    870          fct_split=fct__split_space(TRIM(cl_string), id_ind) 
     1067         cf_elt=fct__split_space(TRIM(cl_string), id_ind) 
    8711068      ENDIF 
    8721069 
    8731070   END FUNCTION fct_split 
     1071   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1072   PURE FUNCTION fct__split_space(cd_string, id_ind) & 
     1073         & RESULT(cf_elt) 
    8741074   !------------------------------------------------------------------- 
    8751075   !> @brief This function split string of character  
    8761076   !> using space as separator,  
    8771077   !> and return the element on index ind. 
    878    ! 
    879    !> @author J.Paul 
    880    !> @date November, 2013 - Initial Version 
    881    ! 
     1078   !> 
     1079   !> @author J.Paul 
     1080   !> @date November, 2013 - Initial Version 
     1081   !> 
    8821082   !> @param[in] cd_string string of character 
    8831083   !> @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 
     1084   !> @return return the element of index id_ind 
     1085   !------------------------------------------------------------------- 
     1086 
     1087      IMPLICIT NONE 
     1088 
    8881089      ! Argument       
    8891090      CHARACTER(LEN=*), INTENT(IN) :: cd_string 
     
    8911092 
    8921093      ! function 
    893       CHARACTER(LEN=lc) :: fct__split_space 
     1094      CHARACTER(LEN=lc)            :: cf_elt 
    8941095 
    8951096      ! local variable 
     
    9031104      !---------------------------------------------------------------- 
    9041105      ! initialize 
    905       fct__split_space='' 
     1106      cf_elt='' 
    9061107      cl_string=ADJUSTL(cd_string) 
    9071108 
     
    9111112 
    9121113      IF( il_sep /= 0 )THEN 
    913          fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     1114         cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    9141115      ELSE 
    915          fct__split_space=TRIM(ADJUSTL(cl_string)) 
     1116         cf_elt=TRIM(ADJUSTL(cl_string)) 
    9161117      ENDIF 
    9171118 
     
    9251126 
    9261127         IF( il_sep /= 0 )THEN 
    927             fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
     1128            cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 
    9281129         ELSE 
    929             fct__split_space=TRIM(ADJUSTL(cl_string)) 
     1130            cf_elt=TRIM(ADJUSTL(cl_string)) 
    9301131         ENDIF 
    9311132 
    9321133      ENDDO 
    9331134 
    934       IF( ji /= id_ind ) fct__split_space='' 
     1135      IF( ji /= id_ind ) cf_elt='' 
    9351136 
    9361137   END FUNCTION fct__split_space 
     1138   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1139   PURE FUNCTION fct_basename(cd_string, cd_sep) & 
     1140         & RESULT(cf_file) 
    9371141   !------------------------------------------------------------------- 
    9381142   !> @brief This function return basename of a filename. 
    939    ! 
     1143   !> 
    9401144   !> @details 
    9411145   !> Actually it splits filename using sperarator '/' 
     
    9441148   !> @author J.Paul 
    9451149   !> @date November, 2013 - Initial Version 
    946    ! 
     1150   !> 
    9471151   !> @param[in] cd_string filename 
    9481152   !> @param[in] cd_sep    separator character 
    9491153   !> @return basename (filename without path) 
    9501154   !------------------------------------------------------------------- 
    951    PURE FUNCTION fct_basename(cd_string, cd_sep) 
    952       IMPLICIT NONE 
     1155 
     1156      IMPLICIT NONE 
     1157 
    9531158      ! Argument       
    9541159      CHARACTER(LEN=*), INTENT(IN) :: cd_string 
     
    9561161 
    9571162      ! function 
    958       CHARACTER(LEN=lc) :: fct_basename 
     1163      CHARACTER(LEN=lc)            :: cf_file 
    9591164 
    9601165      ! local variable 
     
    9731178 
    9741179      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.) 
    975       fct_basename=TRIM(cl_string(il_sep+1:)) 
     1180      cf_file=TRIM(cl_string(il_sep+1:)) 
    9761181 
    9771182   END FUNCTION fct_basename 
     1183   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1184   PURE FUNCTION fct_dirname(cd_string, cd_sep) & 
     1185         & RESULT(cf_dir) 
    9781186   !------------------------------------------------------------------- 
    9791187   !> @brief This function return dirname of a filename. 
    980    ! 
     1188   !> 
    9811189   !> @details 
    9821190   !> Actually it splits filename using sperarator '/' 
     
    9851193   !> @author J.Paul 
    9861194   !> @date November, 2013 - Initial Version 
    987    ! 
     1195   !> 
    9881196   !> @param[in] cd_string filename 
    9891197   !> @param[in] cd_sep    separator character 
    9901198   !> @return dirname (path of the filename) 
    9911199   !------------------------------------------------------------------- 
    992    PURE FUNCTION fct_dirname(cd_string, cd_sep) 
    993       IMPLICIT NONE 
     1200 
     1201      IMPLICIT NONE 
     1202 
    9941203      ! Argument       
    9951204      CHARACTER(LEN=*), INTENT(IN) :: cd_string 
     
    9971206 
    9981207      ! function 
    999       CHARACTER(LEN=lc) :: fct_dirname 
     1208      CHARACTER(LEN=lc)            :: cf_dir 
    10001209 
    10011210      ! local variable 
     
    10151224      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.) 
    10161225      IF( il_sep == 0 )THEN 
    1017          fct_dirname='' 
     1226         cf_dir='' 
    10181227      ELSE 
    1019          fct_dirname=TRIM(cl_string(1:il_sep)) 
     1228         cf_dir=TRIM(cl_string(1:il_sep)) 
    10201229      ENDIF 
    10211230 
    10221231   END FUNCTION fct_dirname 
     1232   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1233   SUBROUTINE fct_help(cd_filename, cd_err) 
     1234   !------------------------------------------------------------------- 
     1235   !> @brief 
     1236   !> This function show help message. 
     1237   !>  
     1238   !> @details  
     1239   !>  Optionaly, print error detected 
     1240   !> 
     1241   !> @author J.Paul 
     1242   !> @date October, 2019 - Initial Version 
     1243   !> 
     1244   !> @param[in] cd_filename   file name  
     1245   !> @param[in] cd_err        error message 
     1246   !> 
     1247   !> @return print help message 
     1248   !------------------------------------------------------------------- 
     1249 
     1250      IMPLICIT NONE 
     1251 
     1252      ! Argument 
     1253      CHARACTER(LEN=*), INTENT(IN) :: cd_filename 
     1254      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_err 
     1255      !---------------------------------------------------------------- 
     1256 
     1257      PRINT '( /,   a,/)', 'USAGE: '//TRIM(cd_filename)//' namelist [-v] [-h]' 
     1258      PRINT '(   2x,a,/)', 'positional arguments:' 
     1259      PRINT '(   5x,a   )',    'namelist                       '//TRIM(cd_filename)//" namelist" 
     1260      PRINT '( /,5x,a,/)', 'NB : a template of the namelist could be created running (in templates directory):' 
     1261      PRINT '(   8x,a  )',    'python create_templates.py '//TRIM(cd_filename) 
     1262      PRINT '( /,2x,a,/)', 'optional arguments:' 
     1263      PRINT '(   5x,a  )',    "-h, --help                      display this help and exit" 
     1264      PRINT '(   5x,a,/)',    "-v, --version                   output Siren's version information and exit" 
     1265      IF (PRESENT(cd_err)) THEN 
     1266         PRINT '(2x,a,/)', 'ERROR DETECTED:' 
     1267         PRINT '(5x,a,/)', TRIM(cd_err) 
     1268      ENDIF 
     1269 
     1270   END SUBROUTINE fct_help 
     1271   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1272   SUBROUTINE fct_version(cd_filename) 
     1273   !------------------------------------------------------------------- 
     1274   !> @brief 
     1275   !> This function show the version of Siren. 
     1276   !>  
     1277   !> @author J.Paul 
     1278   !> @date October, 2019 - Initial Version 
     1279   !> 
     1280   !> @param[in] cd_filename   file name  
     1281   !> 
     1282   !> @return print version message 
     1283   !------------------------------------------------------------------- 
     1284 
     1285      IMPLICIT NONE 
     1286 
     1287      ! Argument 
     1288      CHARACTER(LEN=*), INTENT(IN) :: cd_filename 
     1289      !---------------------------------------------------------------- 
     1290 
     1291      PRINT '( /, a,/)', 'PROGRAM: Siren - '//TRIM(cd_filename) 
     1292      PRINT '(2x,2a  )', 'Revision of last commit : ', TRIM(fct_split(fct_split(cp_version,2,'$'),2,'Revision:')) 
     1293      PRINT '(2x,2a  )', 'Author   of last commit : ', TRIM(fct_split(fct_split(cp_author,2,'$'),2,'Author:')) 
     1294      PRINT '(2x,2a  )', 'Date     of last commit : ', TRIM(fct_split(fct_split(cp_date,2,'$'),2,'Date:')) 
     1295      PRINT '(2x,2a,/)', 'SVN URL                 : ', TRIM(fct_split(fct_split(fct_split(cp_url,2,'$'),2,'URL:'),1,'/src/global.f90')) 
     1296 
     1297   END SUBROUTINE fct_version 
     1298   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    10231299END MODULE fct 
    10241300 
Note: See TracChangeset for help on using the changeset viewer.