source: CONFIG_DEVT/IPSLCM6.5_work_ENSEMBLES/modeles/NEMO/tools/SIREN/src/function.f90 @ 5501

Last change on this file since 5501 was 5501, checked in by aclsce, 4 years ago

First import of IPSLCM6.5_work_ENSEMBLES working configuration

File size: 40.8 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! DESCRIPTION:
6!> @brief
7!> This module groups some basic useful function.
8!>
9!> @details
10!>  to get free I/O unit number:<br/>
11!> @code
12!>  il_id=fct_getunit()
13!> @endcode
14!>
15!>  to convert "numeric" to string character:<br/>
16!> @code
17!>  cl_string=fct_str(numeric)
18!> @endcode
19!>  - "numeric" could be integer, real, or logical
20!>
21!>  to concatenate "numeric" to a string character:<br/>
22!> @code
23!>  cl_str=cd_char//num
24!> @endcode
25!>  - cd_char is the string character
26!>  - num is the numeric value (integer, real or logical) 
27!>
28!>  to concatenate all the element of a character array:<br/>
29!> @code
30!>  cl_string=fct_concat(cd_arr [,cd_sep])
31!> @endcode
32!>  - cd_arr is a 1D array of character
33!>  - cd_sep is a separator character to add between each element of cd_arr
34!> [optional]
35!>
36!>  to convert character from lower to upper case:<br/>
37!> @code
38!>  cl_upper=fct_upper(cd_var)
39!> @endcode
40!>
41!>  to convert character from upper to lower case:<br/>
42!> @code
43!>  cl_lower=fct_lower(cd_var)
44!> @endcode
45!>
46!>  to check if character is numeric
47!> @code
48!>  ll_is_num=fct_is_num(cd_var)
49!> @endcode
50!>
51!>  to check if character is real
52!> @code
53!>  ll_is_real=fct_is_real(cd_var)
54!> @endcode
55!>
56!>  to split string into substring and return one of the element:<br/> 
57!> @code
58!>  cl_str=fct_split(cd_string ,id_ind [,cd_sep])
59!> @endcode
60!>  - cd_string is a string of character
61!>  - id_ind is the indice of the lement to extract
62!>  - cd_sep is the separator use to split cd_string (default '|')
63!>
64!>  to get basename (name without path):<br/>
65!> @code
66!>  cl_str=fct_basename(cd_string [,cd_sep])
67!> @endcode
68!>  - cd_string is the string filename
69!>  - cd_sep is the separator ti be used (default '/')
70!>
71!>  to get dirname (path of the filename):<br/>
72!> @code
73!>  cl_str=fct_dirname(cd_string [,cd_sep])
74!> @endcode
75!>  - cd_string is the string filename
76!>  - cd_sep is the separator ti be used (default '/')
77!> 
78!> to create a pause statement:<br/>
79!> @code
80!> CALL fct_pause(cd_msg)
81!> @endcode
82!>    - cd_msg : message to be added [optional]
83!>
84!> to handle frotran error:<br/>
85!> @code
86!> CALL fct_err(id_status)
87!> @endcode
88!>
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!>
102!>
103!> @author
104!> J.Paul
105!>
106!> @date November, 2013 - Initial Version
107!> @date September, 2014
108!> - add header
109!> @date October, 2019
110!> - add help and version function
111!>
112!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
113!----------------------------------------------------------------------
114MODULE fct
115
116   USE global                          ! global variable
117   USE kind                            ! F90 kind parameter
118
119   IMPLICIT NONE
120   ! NOTE_avoid_public_variables_if_possible
121
122   ! function and subroutine
123   PUBLIC :: fct_getunit  !< returns free unit number
124   PUBLIC :: fct_str      !< convert numeric to string character
125   PUBLIC :: OPERATOR(//) !< concatenate operator
126   PUBLIC :: fct_concat   !< concatenate all the element of a character array
127   PUBLIC :: fct_upper    !< convert character from lower to upper case
128   PUBLIC :: fct_lower    !< convert character from upper to lower case
129   PUBLIC :: fct_is_num   !< check if character is numeric
130   PUBLIC :: fct_is_real  !< check if character is real
131   PUBLIC :: fct_split    !< split string into substring
132   PUBLIC :: fct_basename !< return basename (name without path)
133   PUBLIC :: fct_dirname  !< return dirname (path without filename)
134   PUBLIC :: fct_pause    !< pause statement
135   PUBLIC :: fct_err      !< handle fortran error status
136   PUBLIC :: fct_help     !< show help message
137   PUBLIC :: fct_version  !< show Siren's version
138
139   PRIVATE :: fct__i1_str ! convert integer(1) to string character
140   PRIVATE :: fct__i2_str ! convert integer(2) to string character
141   PRIVATE :: fct__i4_str ! convert integer(4) to string character
142   PRIVATE :: fct__i8_str ! convert integer(8) to string character
143   PRIVATE :: fct__r4_str ! convert real(4) to string character
144   PRIVATE :: fct__r8_str ! convert real(8) to string character
145   PRIVATE :: fct__l_str  ! convert logical to string character
146   PRIVATE :: fct__i1_cat ! concatenate integer(1) to string character
147   PRIVATE :: fct__i2_cat ! concatenate integer(2) to string character
148   PRIVATE :: fct__i4_cat ! concatenate integer(4) to string character
149   PRIVATE :: fct__i8_cat ! concatenate integer(8) to string character
150   PRIVATE :: fct__r4_cat ! concatenate real(4) to string character
151   PRIVATE :: fct__r8_cat ! concatenate real(8) to string character
152   PRIVATE :: fct__l_cat  ! concatenate logical to string character
153   PRIVATE :: fct__split_space ! split string into substring using space as separator
154
155   INTERFACE fct_str
156      MODULE PROCEDURE fct__i1_str ! convert integer(1) to string character
157      MODULE PROCEDURE fct__i2_str ! convert integer(2) to string character
158      MODULE PROCEDURE fct__i4_str ! convert integer(4) to string character
159      MODULE PROCEDURE fct__i8_str ! convert integer(8) to string character
160      MODULE PROCEDURE fct__r4_str ! convert real(4) to string character
161      MODULE PROCEDURE fct__r8_str ! convert real(8) to string character
162      MODULE PROCEDURE fct__l_str  ! convert logical to string character
163   END INTERFACE fct_str
164
165   INTERFACE OPERATOR(//)
166      MODULE PROCEDURE fct__i1_cat ! concatenate integer(1) to string character
167      MODULE PROCEDURE fct__i2_cat ! concatenate integer(2) to string character
168      MODULE PROCEDURE fct__i4_cat ! concatenate integer(4) to string character
169      MODULE PROCEDURE fct__i8_cat ! concatenate integer(8) to string character
170      MODULE PROCEDURE fct__r4_cat ! concatenate real(4) to string character
171      MODULE PROCEDURE fct__r8_cat ! concatenate real(8) to string character
172      MODULE PROCEDURE fct__l_cat  ! concatenate logical to string character
173   END INTERFACE
174
175CONTAINS
176   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
177   PURE FUNCTION fct__i1_cat(cd_char, bd_val) &
178         & RESULT(cf_str)
179   !-------------------------------------------------------------------
180   !> @brief This function concatenate character and integer(1) (as character).
181   !>
182   !> @author J.Paul
183   !> @date September, 2014 - Initial Version
184   !>
185   !> @param[in] cd_char   string character
186   !> @param[in] bd_val    integer(1) variable value
187   !> @return string character
188   !-------------------------------------------------------------------
189 
190      IMPLICIT NONE
191 
192      ! arguments
193      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
194      INTEGER(i1),       INTENT(IN) :: bd_val
195
196      ! function
197      CHARACTER(LEN=lc)             :: cf_str
198
199      ! local variable
200      CHARACTER(LEN=lc) :: cl_val
201      !----------------------------------------------------------------
202 
203      cl_val = fct_str(bd_val)
204      cf_str = TRIM(cd_char)//TRIM(cl_val)
205
206   END FUNCTION fct__i1_cat 
207   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
208   PURE FUNCTION fct__i2_cat(cd_char, sd_val) &
209         & RESULT(cf_str)
210   !-------------------------------------------------------------------
211   !> @brief This function concatenate character and integer(2) (as character).
212   !>
213   !> @author J.Paul
214   !> @date September, 2014 - Initial Version
215   !>
216   !> @param[in] cd_char   string character
217   !> @param[in] sd_val    integer(2) variable value
218   !> @return string character
219   !-------------------------------------------------------------------
220 
221      IMPLICIT NONE
222 
223      ! arguments
224      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
225      INTEGER(i2),       INTENT(IN) :: sd_val
226
227      ! function
228      CHARACTER(LEN=lc)             :: cf_str
229
230      ! local variable
231      CHARACTER(LEN=lc) :: cl_val
232      !----------------------------------------------------------------
233 
234      cl_val = fct_str(sd_val)
235      cf_str = TRIM(cd_char)//TRIM(cl_val)
236
237   END FUNCTION fct__i2_cat 
238   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
239   PURE FUNCTION fct__i4_cat(cd_char, id_val) &
240         & RESULT(cf_str)
241   !-------------------------------------------------------------------
242   !> @brief This function concatenate character and integer(4) (as character).
243   !>
244   !> @author J.Paul
245   !> @date November, 2013 - Initial Version
246   !>
247   !> @param[in] cd_char   string character
248   !> @param[in] id_val    integer(4) variable value
249   !> @return string character
250   !-------------------------------------------------------------------
251 
252      IMPLICIT NONE
253 
254      ! arguments
255      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
256      INTEGER(i4),       INTENT(IN) :: id_val
257
258      ! function
259      CHARACTER(LEN=lc)             :: cf_str
260
261      ! local variable
262      CHARACTER(LEN=lc) :: cl_val
263      !----------------------------------------------------------------
264 
265      cl_val = fct_str(id_val)
266      cf_str = TRIM(cd_char)//TRIM(cl_val)
267
268   END FUNCTION fct__i4_cat 
269   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
270   PURE FUNCTION fct__i8_cat(cd_char, kd_val) &
271         & RESULT(cf_str)
272   !-------------------------------------------------------------------
273   !> @brief This function concatenate character and integer(8) (as character).
274   !>
275   !> @author J.Paul
276   !> @date November, 2013 - Initial Version
277   !>
278   !> @param[in] cd_char   string character
279   !> @param[in] kd_val    integer(8) variable value
280   !> @return string character
281   !-------------------------------------------------------------------
282 
283      IMPLICIT NONE
284 
285      ! arguments
286      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
287      INTEGER(i8),       INTENT(IN) :: kd_val
288
289      ! function
290      CHARACTER(LEN=lc)             :: cf_str
291
292      ! local variable
293      CHARACTER(LEN=lc) :: cl_val
294      !----------------------------------------------------------------
295 
296      cl_val = fct_str(kd_val)
297      cf_str = TRIM(cd_char)//TRIM(cl_val)
298
299   END FUNCTION fct__i8_cat 
300   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
301   PURE FUNCTION fct__r4_cat(cd_char, rd_val) &
302         & RESULT(cf_str)
303   !-------------------------------------------------------------------
304   !> @brief This function concatenate character and real(4) (as character).
305   !>
306   !> @author J.Paul
307   !> @date November, 2013 - Initial Version
308   !>
309   !> @param[in] cd_char   string character
310   !> @param[in] rd_val    real(4) variable value
311   !> @return string character
312   !-------------------------------------------------------------------
313 
314      IMPLICIT NONE
315 
316      ! arguments
317      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
318      REAL(sp),          INTENT(IN) :: rd_val
319
320      ! function
321      CHARACTER(LEN=lc)             :: cf_str
322
323      ! local variable
324      CHARACTER(LEN=lc) :: cl_val
325      !----------------------------------------------------------------
326 
327      cl_val = fct_str(rd_val)
328      cf_str = TRIM(cd_char)//TRIM(cl_val)
329
330   END FUNCTION fct__r4_cat 
331   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
332   PURE FUNCTION fct__r8_cat(cd_char, dd_val) &
333         & RESULT(cf_str)
334   !-------------------------------------------------------------------
335   !> @brief This function concatenate character and real(8) (as character).
336   !>
337   !> @author J.Paul
338   !> @date November, 2013 - Initial Version
339   !>
340   !> @param[in] cd_char   string character
341   !> @param[in] dd_val    real(8) variable value
342   !> @return string character
343   !-------------------------------------------------------------------
344 
345      IMPLICIT NONE
346 
347      ! arguments
348      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
349      REAL(dp),          INTENT(IN) :: dd_val
350
351      ! function
352      CHARACTER(LEN=lc)             :: cf_str
353
354      ! local variable
355      CHARACTER(LEN=lc) :: cl_val
356      !----------------------------------------------------------------
357 
358      cl_val = fct_str(dd_val)
359      cf_str = TRIM(cd_char)//TRIM(cl_val)
360
361   END FUNCTION fct__r8_cat 
362   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
363   PURE FUNCTION fct__l_cat(cd_char, ld_val) &
364         & RESULT(cf_str)
365   !-------------------------------------------------------------------
366   !> @brief This function concatenate character and logical (as character).
367   !>
368   !> @author J.Paul
369   !> @date November, 2013 - Initial Version
370   !>
371   !> @param[in] cd_char   string character
372   !> @param[in] ld_val    logical variable value
373   !> @return string character
374   !-------------------------------------------------------------------
375
376      IMPLICIT NONE
377 
378      ! arguments
379      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
380      LOGICAL,           INTENT(IN) :: ld_val
381
382      ! function
383      CHARACTER(LEN=lc)             :: cf_str
384
385      ! local variable
386      CHARACTER(LEN=lc) :: cl_val
387      !----------------------------------------------------------------
388 
389      cl_val = fct_str(ld_val)
390      cf_str = TRIM(cd_char)//TRIM(cl_val)
391
392   END FUNCTION fct__l_cat 
393   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
394   FUNCTION fct_getunit() &
395         & RESULT(if_unit)
396   !-------------------------------------------------------------------
397   !> @brief This function returns the next available I/O unit number.
398   !>
399   !> @author J.Paul
400   !> @date November, 2013 - Initial Version
401   !>
402   !> @return file id
403   !-------------------------------------------------------------------
404
405      IMPLICIT NONE
406 
407      ! function
408      INTEGER(i4) :: if_unit
409
410      ! local variable
411      LOGICAL ::  ll_opened 
412      !----------------------------------------------------------------
413      ! initialise
414      if_unit = 10 
415 
416      INQUIRE(UNIT=if_unit, OPENED=ll_opened) 
417      DO WHILE( ll_opened ) 
418         if_unit = if_unit + 1 
419         INQUIRE(UNIT=if_unit, OPENED=ll_opened) 
420      ENDDO 
421 
422   END FUNCTION fct_getunit 
423   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
424   SUBROUTINE fct_err(id_status)
425   !-------------------------------------------------------------------
426   !> @brief This subroutine handle Fortran status.
427   !>
428   !> @author J.Paul
429   !> @date November, 2013 - Initial Version
430   !>
431   !> @param[in] id_status
432   !-------------------------------------------------------------------
433
434      IMPLICIT NONE
435
436      ! Argument
437      INTEGER(i4),       INTENT(IN) :: id_status
438      !----------------------------------------------------------------
439
440      IF( id_status /= 0 )THEN
441         !CALL ERRSNS() ! not F95 standard
442         PRINT *, "FORTRAN ERROR ", id_status
443         !STOP
444      ENDIF
445
446   END SUBROUTINE fct_err
447   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
448   SUBROUTINE fct_pause(cd_msg)
449   !-------------------------------------------------------------------
450   !> @brief This subroutine  create a pause statement
451   !>
452   !> @author J.Paul
453   !> @date November, 2014 - Initial Version
454   !>
455   !> @param[in] cd_msg optional message to be added
456   !-------------------------------------------------------------------
457
458      IMPLICIT NONE
459
460      ! Argument
461      CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: cd_msg
462      !----------------------------------------------------------------
463
464      IF( PRESENT(cd_msg) )THEN
465         WRITE( *, * ) 'Press Enter to continue '//TRIM(cd_msg)
466      ELSE
467         WRITE( *, * ) 'Press Enter to continue'
468      ENDIF
469      READ( *, * )
470
471   END SUBROUTINE fct_pause
472   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
473   PURE FUNCTION fct__l_str(ld_var) &
474         & RESULT(cf_str)
475   !-------------------------------------------------------------------
476   !> @brief This function convert logical to string character.
477   !>
478   !> @author J.Paul
479   !> @date November, 2013 - Initial Version
480   !>
481   !> @param[in] ld_var logical variable
482   !> @return character of this integer variable
483   !-------------------------------------------------------------------
484
485      IMPLICIT NONE
486
487      ! Argument     
488      LOGICAL, INTENT(IN) :: ld_var
489
490      ! function
491      CHARACTER(LEN=lc)   :: cf_str
492
493      ! local variable
494      CHARACTER(LEN=lc) :: cl_tmp
495      !----------------------------------------------------------------
496
497      WRITE(cl_tmp,*) ld_var
498      cf_str=TRIM(ADJUSTL(cl_tmp))
499
500   END FUNCTION fct__l_str
501   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
502   PURE FUNCTION fct__i1_str(bd_var) &
503         & RESULT(cf_str)
504   !-------------------------------------------------------------------
505   !> @brief This function convert integer(1) to string character.
506   !>
507   !> @author J.Paul
508   !> @date November, 2013 - Initial Version
509   !>
510   !> @param[in] bd_var integer(1) variable
511   !> @return character of this integer variable
512   !-------------------------------------------------------------------
513
514      IMPLICIT NONE
515
516      ! Argument     
517      INTEGER(i1), INTENT(IN) :: bd_var
518
519      ! function
520      CHARACTER(LEN=lc)       :: cf_str
521
522      ! local variable
523      CHARACTER(LEN=lc) :: cl_tmp
524      !----------------------------------------------------------------
525
526      WRITE(cl_tmp,*) bd_var
527      cf_str=TRIM(ADJUSTL(cl_tmp))
528
529   END FUNCTION fct__i1_str
530   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
531   PURE FUNCTION fct__i2_str(sd_var) &
532         & RESULT(cf_str)
533   !-------------------------------------------------------------------
534   !> @brief This function convert integer(2) to string character.
535   !>
536   !> @author J.Paul
537   !> @date November, 2013 - Initial Version
538   !>
539   !> @param[in] sd_var integer(2) variable
540   !> @return character of this integer variable
541   !-------------------------------------------------------------------
542
543      IMPLICIT NONE
544
545      ! Argument     
546      INTEGER(i2), INTENT(IN) :: sd_var
547
548      ! function
549      CHARACTER(LEN=lc)       :: cf_str
550
551      ! local variable
552      CHARACTER(LEN=lc) :: cl_tmp
553      !----------------------------------------------------------------
554
555      WRITE(cl_tmp,*) sd_var
556      cf_str=TRIM(ADJUSTL(cl_tmp))
557
558   END FUNCTION fct__i2_str
559   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
560   PURE FUNCTION fct__i4_str(id_var) &
561         & RESULT(cf_str)
562   !-------------------------------------------------------------------
563   !> @brief This function convert integer(4) to string character.
564   !>
565   !> @author J.Paul
566   !> @date November, 2013 - Initial Version
567   !>
568   !> @param[in] id_var integer(4) variable
569   !> @return character of this integer variable
570   !-------------------------------------------------------------------
571
572      IMPLICIT NONE
573
574      ! Argument     
575      INTEGER(i4), INTENT(IN) :: id_var
576
577      ! function
578      CHARACTER(LEN=lc)       :: cf_str
579
580      ! local variable
581      CHARACTER(LEN=lc) :: cl_tmp
582      !----------------------------------------------------------------
583
584      WRITE(cl_tmp,*) id_var
585      cf_str=TRIM(ADJUSTL(cl_tmp))
586
587   END FUNCTION fct__i4_str
588   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
589   PURE FUNCTION fct__i8_str(kd_var) &
590         & RESULT(cf_str)
591   !-------------------------------------------------------------------
592   !> @brief This function convert integer(8) to string character.
593   !>
594   !> @author J.Paul
595   !> @date November, 2013 - Initial Version
596   !>
597   !> @param[in] kd_var integer(8) variable
598   !> @return character of this integer variable
599   !-------------------------------------------------------------------
600
601      IMPLICIT NONE
602
603      ! Argument     
604      INTEGER(i8), INTENT(IN) :: kd_var
605
606      ! function
607      CHARACTER(LEN=lc)       :: cf_str
608
609      ! local variable
610      CHARACTER(LEN=lc) :: cl_tmp
611      !----------------------------------------------------------------
612
613      WRITE(cl_tmp,*) kd_var
614      cf_str=TRIM(ADJUSTL(cl_tmp))
615
616   END FUNCTION fct__i8_str
617   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
618   PURE FUNCTION fct__r4_str(rd_var) &
619         & RESULT(cf_str)
620   !-------------------------------------------------------------------
621   !> @brief This function convert real(4) to string character.
622   !>
623   !> @author J.Paul
624   !> @date November, 2013 - Initial Version
625   !>
626   !> @param[in] rd_var real(4) variable
627   !> @return character of this real variable
628   !-------------------------------------------------------------------
629
630      IMPLICIT NONE
631
632      ! Argument     
633      REAL(sp), INTENT(IN) :: rd_var
634
635      ! function
636      CHARACTER(LEN=lc)    :: cf_str
637
638      ! local variable
639      CHARACTER(LEN=lc) :: cl_tmp
640      !----------------------------------------------------------------
641
642      WRITE(cl_tmp,*) rd_var
643      cf_str=TRIM(ADJUSTL(cl_tmp))
644
645   END FUNCTION fct__r4_str
646   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
647   PURE FUNCTION fct__r8_str(dd_var) &
648         & RESULT(cf_str)
649   !-------------------------------------------------------------------
650   !> @brief This function convert real(8) to string character.
651   !>
652   !> @author J.Paul
653   !> @date November, 2013 - Initial Version
654   !>
655   !> @param[in] dd_var real(8) variable
656   !> @return character of this real variable
657   !-------------------------------------------------------------------
658
659      IMPLICIT NONE
660
661      ! Argument     
662      REAL(dp), INTENT(IN) :: dd_var
663
664      ! function
665      CHARACTER(LEN=lc)    :: cf_str
666
667      ! local variable
668      CHARACTER(LEN=lc) :: cl_tmp
669      !----------------------------------------------------------------
670
671      WRITE(cl_tmp,*) dd_var
672      cf_str=TRIM(ADJUSTL(cl_tmp))
673
674   END FUNCTION fct__r8_str
675   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
676   PURE FUNCTION fct_concat(cd_arr,cd_sep) &
677         & RESULT(cf_str)
678   !-------------------------------------------------------------------
679   !> @brief This function concatenate all the element of a character array
680   !> in a character string.
681   !> @details
682   !> optionnally a separator could be added between each element.
683   !>
684   !> @author J.Paul
685   !> @date November, 2013 - Initial Version
686   !>
687   !> @param[in] cd_arr array of character
688   !> @param[in] cd_sep separator character
689   !> @return character
690   !-------------------------------------------------------------------
691
692      IMPLICIT NONE
693
694      ! Argument     
695      CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_arr
696      CHARACTER(*),               INTENT(IN), OPTIONAL :: cd_sep
697
698      ! function
699      CHARACTER(LEN=lc)                      :: cf_str
700
701      ! local variable
702      CHARACTER(LEN=lc) :: cl_tmp
703      CHARACTER(LEN=lc) :: cl_sep
704      INTEGER(i4)       :: il_size
705
706      ! loop indices
707      INTEGER(i4) :: ji
708      !----------------------------------------------------------------
709
710      cl_sep=''
711      IF(PRESENT(cd_sep)) cl_sep=cd_sep
712
713      il_size=SIZE(cd_arr)
714      cf_str=''
715      cl_tmp=''
716      DO ji=1,il_size
717
718         WRITE(cl_tmp,*) TRIM(cf_str)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep)
719         cf_str=TRIM(ADJUSTL(cl_tmp))
720     
721      ENDDO
722
723   END FUNCTION fct_concat
724   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
725   PURE FUNCTION fct_lower(cd_var) &
726         & RESULT(cf_str)
727   !-------------------------------------------------------------------
728   !> @brief This function convert string character upper case to lower case.
729   !>
730   !> @details
731   !> The function IACHAR returns the ASCII value of the character passed
732   !> as argument. The ASCII code has the uppercase alphabet starting at
733   !> code 65, and the lower case one at code 101, therefore
734   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase
735   !> and the lowercase codes.
736   !>
737   !> @author J.Paul
738   !> @date November, 2013 - Initial Version
739   !>
740   !> @param[in] cd_var character
741   !> @return lower case character
742   !-------------------------------------------------------------------
743
744      IMPLICIT NONE
745
746      ! Argument     
747      CHARACTER(*), INTENT(IN) :: cd_var
748
749      ! function
750      CHARACTER(LEN=lc)        :: cf_str
751
752      ! local variable
753      INTEGER(i4)                                  :: il_nletter ! number of letters in variable
754      CHARACTER(LEN=lc)                            :: cl_var
755      CHARACTER(LEN=lc), DIMENSION(:), ALLOCATABLE :: cl_tmp
756
757      INTEGER(i4) :: il_icode    ! ASCII value
758      INTEGER(i4) :: il_lacode   ! ASCII value of the lower case 'a'
759      INTEGER(i4) :: il_uacode   ! ASCII value of the upper case 'A'
760      INTEGER(i4) :: il_uzcode   ! ASCII value of the upper case 'z'
761
762      ! loop indices
763      INTEGER(i4) :: ji
764      !----------------------------------------------------------------
765
766      il_lacode=IACHAR('a')
767      il_uacode=IACHAR('A')
768      il_uzcode=IACHAR('Z')
769
770      cl_var=TRIM(ADJUSTL(cd_var))
771      il_nletter=LEN(TRIM(cl_var))
772      ALLOCATE(cl_tmp(il_nletter))
773      DO ji=1,il_nletter
774         il_icode=IACHAR(cl_var(ji:ji))
775         IF( il_icode >= il_uacode .AND. il_icode <= il_uzcode )THEN
776            ! upper case
777            cl_tmp(ji)=TRIM(CHAR(il_icode + (il_lacode - il_uacode) ))
778         ELSE
779            ! lower case and other character
780            cl_tmp(ji)=TRIM(CHAR(il_icode))
781         ENDIF
782      ENDDO
783
784      cf_str=TRIM(ADJUSTL(fct_concat(cl_tmp(:))))
785      DEALLOCATE(cl_tmp)
786
787   END FUNCTION fct_lower
788   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
789   PURE FUNCTION fct_upper(cd_var) &
790         & RESULT(cf_str)
791   !-------------------------------------------------------------------
792   !> @brief This function convert string character lower case to upper case.
793   !>
794   !> @details
795   !> The function IACHAR returns the ASCII value of the character passed
796   !> as argument. The ASCII code has the uppercase alphabet starting at
797   !> code 65, and the lower case one at code 101, therefore
798   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase
799   !> and the lowercase codes.
800   !>
801   !> @author J.Paul
802   !> @date November, 2013 - Initial Version
803   !>
804   !> @param[in] cd_var character
805   !> @return upper case character
806   !-------------------------------------------------------------------
807
808      IMPLICIT NONE
809
810      ! Argument     
811      CHARACTER(*), INTENT(IN) :: cd_var
812
813      ! function
814      CHARACTER(LEN=lc)        :: cf_str
815
816      ! local variable
817      INTEGER(i4)                                  :: il_nletter ! number of letters in cd_var
818      CHARACTER(LEN=lc)                            :: cl_var
819      CHARACTER(LEN=lc), DIMENSION(:), ALLOCATABLE :: cl_tmp
820
821      INTEGER(i4) :: il_icode    ! ASCII value
822      INTEGER(i4) :: il_lacode   ! ASCII value of the lower case 'a'
823      INTEGER(i4) :: il_uacode   ! ASCII value of the upper case 'A'
824      INTEGER(i4) :: il_lzcode   ! ASCII value of the lower case 'z'
825
826      ! loop indices
827      INTEGER(i4) :: ji
828      !----------------------------------------------------------------
829
830      il_lacode=ICHAR('a')
831      il_uacode=ICHAR('A')
832      il_lzcode=IACHAR('z')
833
834      cl_var=TRIM(ADJUSTL(cd_var))
835      il_nletter=LEN(TRIM(cl_var))
836      ALLOCATE(cl_tmp(il_nletter))
837      DO ji=1,il_nletter
838         il_icode=IACHAR(cl_var(ji:ji))
839         IF( il_icode >= il_lacode .AND. il_icode <= il_lzcode )THEN
840            ! lower case
841            cl_tmp(ji)=CHAR(il_icode - (il_lacode - il_uacode) )
842         ELSE
843            ! upper case and other character
844            cl_tmp(ji)=CHAR(il_icode)
845         ENDIF
846      ENDDO
847
848      cf_str=TRIM(ADJUSTL(fct_concat(cl_tmp(:))))
849      DEALLOCATE(cl_tmp)
850
851   END FUNCTION fct_upper
852   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
853   PURE FUNCTION fct_is_num(cd_var) &
854         & RESULT(lf_numeric)
855   !-------------------------------------------------------------------
856   !> @brief This function check if character is numeric.
857   !>
858   !> @author J.Paul
859   !> @date November, 2013 - Initial Version
860   !>
861   !> @param[in] cd_var character
862   !> @return character is numeric
863   !-------------------------------------------------------------------
864
865      IMPLICIT NONE
866
867      ! Argument     
868      CHARACTER(LEN=*), INTENT(IN) :: cd_var
869
870      ! function
871      LOGICAL                      :: lf_numeric
872
873      ! loop indices
874      INTEGER(i4) :: ji
875      !----------------------------------------------------------------
876
877      DO ji=1,LEN(TRIM(cd_var))
878         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
879         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
880            lf_numeric=.TRUE.
881         ELSE
882            lf_numeric=.FALSE.
883            EXIT
884         ENDIF
885      ENDDO
886
887   END FUNCTION fct_is_num
888   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
889   PURE FUNCTION fct_is_real(cd_var) &
890         & RESULT(lf_real)
891   !-------------------------------------------------------------------
892   !> @brief This function check if character is real number.
893   !>
894   !> @details
895   !> it permits exponantial and decimal number
896   !> exemple :  1e6, 2.3
897   !>
898   !> @author J.Paul
899   !> @date June, 2015 - Initial Version
900   !> @date April, 2018
901   !> - permit negative exposant
902   !> - permit sign as first character
903   !>
904   !> @param[in] cd_var character
905   !> @return character is real number
906   !-------------------------------------------------------------------
907
908      IMPLICIT NONE
909
910      ! Argument     
911      CHARACTER(LEN=*), INTENT(IN) :: cd_var
912   
913      ! function
914      LOGICAL                      :: lf_real
915
916      ! local variables
917      LOGICAL :: ll_exp
918      LOGICAL :: ll_dec
919   
920      ! loop indices
921      INTEGER :: ji
922      !----------------------------------------------------------------
923   
924      ll_exp=.TRUE.
925      ll_dec=.FALSE.
926      DO ji=1,LEN(TRIM(cd_var))
927         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
928         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
929   
930            lf_real=.TRUE.
931            ll_exp=.FALSE.
932     
933         ELSEIF( TRIM(fct_lower(cd_var(ji:ji)))=='e' )THEN
934         
935            IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN
936               lf_real=.FALSE.
937               EXIT
938            ELSE
939               ll_exp=.TRUE.
940            ENDIF
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
968         ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN
969   
970            IF( ll_dec )THEN
971               lf_real=.FALSE.
972               EXIT
973            ELSE
974               lf_real=.TRUE.
975               ll_dec=.TRUE.
976            ENDIF
977   
978         ELSE
979   
980            lf_real=.FALSE.
981            EXIT
982   
983         ENDIF
984      ENDDO
985   
986   END FUNCTION fct_is_real
987   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
988   PURE FUNCTION fct_split(cd_string, id_ind, cd_sep) &
989         & RESULT(cf_elt)
990   !-------------------------------------------------------------------
991   !> @brief This function split string of character
992   !> using separator character, by default '|',
993   !> and return the element on index ind.
994   !>
995   !> @author J.Paul
996   !> @date November, 2013 - Initial Version
997   !>
998   !> @param[in] cd_string string of character
999   !> @param[in] id_ind    indice
1000   !> @param[in] cd_sep    separator character
1001   !> @return return the element of index id_ind
1002   !-------------------------------------------------------------------
1003
1004      IMPLICIT NONE
1005
1006      ! Argument     
1007      CHARACTER(LEN=*), INTENT(IN) :: cd_string
1008      INTEGER(i4)     , INTENT(IN) :: id_ind
1009      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
1010
1011      ! function
1012      CHARACTER(LEN=lc)            :: cf_elt
1013
1014      ! local variable
1015      CHARACTER(LEN=lc) :: cl_sep
1016      CHARACTER(LEN=lc) :: cl_string
1017
1018      INTEGER(i4) :: il_sep
1019      INTEGER(i4) :: il_lsep
1020     
1021      ! loop indices
1022      INTEGER(i4) :: ji
1023      !----------------------------------------------------------------
1024      ! initialize
1025      cf_elt=''
1026      cl_string=ADJUSTL(cd_string)
1027
1028      ! get separator
1029      cl_sep='|'
1030      IF( PRESENT(cd_sep) )THEN
1031         IF( cd_sep==' ')THEN
1032            cl_sep=' '
1033         ELSE
1034            cl_sep=TRIM(ADJUSTL(cd_sep))
1035         ENDIF
1036      ENDIF
1037     
1038      IF( cl_sep /= ' ' )THEN
1039         ! get separator index
1040         il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) )
1041         il_lsep=LEN(TRIM(cl_sep)) 
1042
1043         IF( il_sep /= 0 )THEN
1044            cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
1045         ELSE
1046            cf_elt=TRIM(ADJUSTL(cl_string))
1047         ENDIF
1048
1049         ji=1
1050         DO WHILE( il_sep /= 0 .AND. ji /= id_ind )
1051           
1052            ji=ji+1
1053           
1054            cl_string=TRIM(cl_string(il_sep+il_lsep:))
1055            il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) )
1056
1057            IF( il_sep /= 0 )THEN
1058               cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
1059            ELSE
1060               cf_elt=TRIM(ADJUSTL(cl_string))
1061            ENDIF
1062
1063         ENDDO
1064
1065         IF( ji /= id_ind ) cf_elt=''
1066      ELSE
1067         cf_elt=fct__split_space(TRIM(cl_string), id_ind)
1068      ENDIF
1069
1070   END FUNCTION fct_split
1071   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1072   PURE FUNCTION fct__split_space(cd_string, id_ind) &
1073         & RESULT(cf_elt)
1074   !-------------------------------------------------------------------
1075   !> @brief This function split string of character
1076   !> using space as separator,
1077   !> and return the element on index ind.
1078   !>
1079   !> @author J.Paul
1080   !> @date November, 2013 - Initial Version
1081   !>
1082   !> @param[in] cd_string string of character
1083   !> @param[in] id_ind    indice
1084   !> @return return the element of index id_ind
1085   !-------------------------------------------------------------------
1086
1087      IMPLICIT NONE
1088
1089      ! Argument     
1090      CHARACTER(LEN=*), INTENT(IN) :: cd_string
1091      INTEGER(i4)     , INTENT(IN) :: id_ind
1092
1093      ! function
1094      CHARACTER(LEN=lc)            :: cf_elt
1095
1096      ! local variable
1097      CHARACTER(LEN=lc) :: cl_string
1098
1099      INTEGER(i4) :: il_sep
1100      INTEGER(i4) :: il_lsep
1101     
1102      ! loop indices
1103      INTEGER(i4) :: ji
1104      !----------------------------------------------------------------
1105      ! initialize
1106      cf_elt=''
1107      cl_string=ADJUSTL(cd_string)
1108
1109      ! get separator index
1110      il_sep=INDEX( TRIM(cl_string), ' ' )
1111      il_lsep=LEN(' ') 
1112
1113      IF( il_sep /= 0 )THEN
1114         cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
1115      ELSE
1116         cf_elt=TRIM(ADJUSTL(cl_string))
1117      ENDIF
1118
1119      ji=1
1120      DO WHILE( il_sep /= 0 .AND. ji /= id_ind )
1121         
1122         ji=ji+1
1123         
1124         cl_string=TRIM(cl_string(il_sep+il_lsep:))
1125         il_sep=INDEX( TRIM(cl_string), ' ' )
1126
1127         IF( il_sep /= 0 )THEN
1128            cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
1129         ELSE
1130            cf_elt=TRIM(ADJUSTL(cl_string))
1131         ENDIF
1132
1133      ENDDO
1134
1135      IF( ji /= id_ind ) cf_elt=''
1136
1137   END FUNCTION fct__split_space
1138   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1139   PURE FUNCTION fct_basename(cd_string, cd_sep) &
1140         & RESULT(cf_file)
1141   !-------------------------------------------------------------------
1142   !> @brief This function return basename of a filename.
1143   !>
1144   !> @details
1145   !> Actually it splits filename using sperarator '/'
1146   !> and return last string character.<br/>
1147   !> Optionally you could specify another separator.
1148   !> @author J.Paul
1149   !> @date November, 2013 - Initial Version
1150   !>
1151   !> @param[in] cd_string filename
1152   !> @param[in] cd_sep    separator character
1153   !> @return basename (filename without path)
1154   !-------------------------------------------------------------------
1155
1156      IMPLICIT NONE
1157
1158      ! Argument     
1159      CHARACTER(LEN=*), INTENT(IN) :: cd_string
1160      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
1161
1162      ! function
1163      CHARACTER(LEN=lc)            :: cf_file
1164
1165      ! local variable
1166      CHARACTER(LEN=lc) :: cl_sep
1167      CHARACTER(LEN=lc) :: cl_string
1168      INTEGER(i4)       :: il_sep
1169     
1170      ! loop indices
1171      !----------------------------------------------------------------
1172      ! initialize
1173      cl_string=TRIM(ADJUSTL(cd_string))
1174
1175      ! get separator
1176      cl_sep='/'
1177      IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep))
1178
1179      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.)
1180      cf_file=TRIM(cl_string(il_sep+1:))
1181
1182   END FUNCTION fct_basename
1183   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1184   PURE FUNCTION fct_dirname(cd_string, cd_sep) &
1185         & RESULT(cf_dir)
1186   !-------------------------------------------------------------------
1187   !> @brief This function return dirname of a filename.
1188   !>
1189   !> @details
1190   !> Actually it splits filename using sperarator '/'
1191   !> and return all except last string character.<br/>
1192   !> Optionally you could specify another separator.
1193   !> @author J.Paul
1194   !> @date November, 2013 - Initial Version
1195   !>
1196   !> @param[in] cd_string filename
1197   !> @param[in] cd_sep    separator character
1198   !> @return dirname (path of the filename)
1199   !-------------------------------------------------------------------
1200
1201      IMPLICIT NONE
1202
1203      ! Argument     
1204      CHARACTER(LEN=*), INTENT(IN) :: cd_string
1205      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
1206
1207      ! function
1208      CHARACTER(LEN=lc)            :: cf_dir
1209
1210      ! local variable
1211      CHARACTER(LEN=lc) :: cl_sep
1212      CHARACTER(LEN=lc) :: cl_string
1213      INTEGER(i4)       :: il_sep
1214     
1215      ! loop indices
1216      !----------------------------------------------------------------
1217      ! initialize
1218      cl_string=TRIM(ADJUSTL(cd_string))
1219
1220      ! get separator
1221      cl_sep='/'
1222      IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep))
1223
1224      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.)
1225      IF( il_sep == 0 )THEN
1226         cf_dir=''
1227      ELSE
1228         cf_dir=TRIM(cl_string(1:il_sep))
1229      ENDIF
1230
1231   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   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1299END MODULE fct
1300
Note: See TracBrowser for help on using the repository browser.