- Timestamp:
- 2015-04-29T12:17:12+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/TOOLS/SIREN/src/function.f90
r4213 r5240 7 7 ! DESCRIPTION: 8 8 !> @brief 9 !> This module group some basic useful function 10 ! 9 !> This module groups some basic useful function. 10 !> 11 !> @details 12 !> to get free I/O unit number:<br/> 13 !> @code 14 !> il_id=fct_getunit() 15 !> @endcode 16 !> 17 !> to convert "numeric" to string character:<br/> 18 !> @code 19 !> cl_string=fct_str(numeric) 20 !> @endcode 21 !> - "numeric" could be integer, real, or logical 22 !> 23 !> to concatenate "numeric" to a string character:<br/> 24 !> @code 25 !> cl_str=cd_char//num 26 !> @endcode 27 !> - cd_char is the string character 28 !> - num is the numeric value (integer, real or logical) 29 !> 30 !> to concatenate all the element of a character array:<br/> 31 !> @code 32 !> cl_string=fct_concat(cd_arr [,cd_sep]) 33 !> @endcode 34 !> - cd_arr is a 1D array of character 35 !> - cd_sep is a separator character to add between each element of cd_arr 36 !> [optional] 37 !> 38 !> to convert character from lower to upper case:<br/> 39 !> @code 40 !> cl_upper=fct_upper(cd_var) 41 !> @endcode 42 !> 43 !> to convert character from upper to lower case:<br/> 44 !> @code 45 !> cl_lower=fct_lower(cd_var) 46 !> @endcode 47 !> 48 !> to check if character is numeric 49 !> @code 50 !> ll_is_num=fct_is_num(cd_var) 51 !> @endcode 52 !> 53 !> to split string into substring and return one of the element:<br/> 54 !> @code 55 !> cl_str=fct_split(cd_string ,id_ind [,cd_sep]) 56 !> @endcode 57 !> - cd_string is a string of character 58 !> - id_ind is the indice of the lement to extract 59 !> - cd_sep is the separator use to split cd_string (default '|') 60 !> 61 !> to get basename (name without path):<br/> 62 !> @code 63 !> cl_str=fct_basename(cd_string [,cd_sep]) 64 !> @endcode 65 !> - cd_string is the string filename 66 !> - cd_sep is the separator ti be used (default '/') 67 !> 68 !> to get dirname (path of the filename):<br/> 69 !> @code 70 !> cl_str=fct_dirname(cd_string [,cd_sep]) 71 !> @endcode 72 !> - cd_string is the string filename 73 !> - cd_sep is the separator ti be used (default '/') 74 !> 75 !> to create a pause statement:<br/> 76 !> @code 77 !> CALL fct_pause(cd_msg) 78 !> @endcode 79 !> - cd_msg : message to be added [optional] 80 !> 81 !> to handle frotran error:<br/> 82 !> @code 83 !> CALL fct_err(id_status) 84 !> @endcode 85 !> 86 !> 11 87 !> @author 12 88 !> J.Paul 13 89 ! REVISION HISTORY: 14 !> @date Nov, 2013 - Initial Version 15 ! 16 !> @todo 17 !> - TODO_describe_appropriate_changes - TODO_name 18 !> @param MyModule_type : brief_description 90 !> @date November, 2013 - Initial Version 91 !> @date September, 2014 - add header 19 92 ! 20 93 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 23 96 USE kind ! F90 kind parameter 24 97 IMPLICIT NONE 25 PRIVATE26 98 ! NOTE_avoid_public_variables_if_possible 27 99 28 100 ! function and subroutine 29 PUBLIC :: OPERATOR(//) 30 PUBLIC :: fct_getunit! returns free unit number 31 PUBLIC :: fct_err ! handle fortran error status 32 PUBLIC :: fct_str ! convert numeric to string character 33 PUBLIC :: fct_concat ! concatenate all the element of a character table 34 PUBLIC :: fct_upper ! convert lower character to upper case 35 PUBLIC :: fct_lower ! convert upper character to lower case 36 PUBLIC :: fct_is_num ! check if character is numeric 37 PUBLIC :: fct_split ! split string into substring 38 PUBLIC :: fct_basename ! return basename (name without path) 39 PUBLIC :: fct_dirname ! return dirname (path without name) 101 PUBLIC :: fct_getunit !< returns free unit number 102 PUBLIC :: fct_str !< convert numeric to string character 103 PUBLIC :: OPERATOR(//) !< concatenate operator 104 PUBLIC :: fct_concat !< concatenate all the element of a character array 105 PUBLIC :: fct_upper !< convert character from lower to upper case 106 PUBLIC :: fct_lower !< convert character from upper to lower case 107 PUBLIC :: fct_is_num !< check if character is numeric 108 PUBLIC :: fct_split !< split string into substring 109 PUBLIC :: fct_basename !< return basename (name without path) 110 PUBLIC :: fct_dirname !< return dirname (path without filename) 111 PUBLIC :: fct_pause !< pause statement 112 PUBLIC :: fct_err !< handle fortran error status 40 113 41 114 PRIVATE :: fct__i1_str ! convert integer(1) to string character … … 46 119 PRIVATE :: fct__r8_str ! convert real(8) to string character 47 120 PRIVATE :: fct__l_str ! convert logical to string character 48 121 PRIVATE :: fct__i1_cat ! concatenate integer(1) to string character 122 PRIVATE :: fct__i2_cat ! concatenate integer(2) to string character 123 PRIVATE :: fct__i4_cat ! concatenate integer(4) to string character 124 PRIVATE :: fct__i8_cat ! concatenate integer(8) to string character 125 PRIVATE :: fct__r4_cat ! concatenate real(4) to string character 126 PRIVATE :: fct__r8_cat ! concatenate real(8) to string character 127 PRIVATE :: fct__l_cat ! concatenate logical to string character 128 PRIVATE :: fct__split_space ! split string into substring using space as separator 49 129 50 130 INTERFACE fct_str … … 59 139 60 140 INTERFACE OPERATOR(//) 141 MODULE PROCEDURE fct__i1_cat ! concatenate integer(1) to string character 142 MODULE PROCEDURE fct__i2_cat ! concatenate integer(2) to string character 61 143 MODULE PROCEDURE fct__i4_cat ! concatenate integer(4) to string character 62 144 MODULE PROCEDURE fct__i8_cat ! concatenate integer(8) to string character … … 68 150 CONTAINS 69 151 !------------------------------------------------------------------- 70 !> @brief This routine concatenate character and integer(4) (as character). 152 !> @brief This function concatenate character and integer(1) (as character). 153 ! 154 !> @author J.Paul 155 !> - September, 2014- Initial Version 156 ! 157 !> @param[in] cd_char string character 158 !> @param[in] bd_val integer(1) variable value 159 !> @return string character 160 !------------------------------------------------------------------- 161 PURE CHARACTER(LEN=lc) FUNCTION fct__i1_cat(cd_char, bd_val) 162 163 ! arguments 164 CHARACTER(LEN=lc), INTENT(IN) :: cd_char 165 INTEGER(i1), INTENT(IN) :: bd_val 166 167 ! local variable 168 CHARACTER(LEN=lc) :: cl_val 169 !---------------------------------------------------------------- 170 171 cl_val = fct_str(bd_val) 172 fct__i1_cat=TRIM(cd_char)//TRIM(cl_val) 173 174 END FUNCTION fct__i1_cat 175 !------------------------------------------------------------------- 176 !> @brief This function concatenate character and integer(2) (as character). 177 ! 178 !> @author J.Paul 179 !> - September, 2014- Initial Version 180 ! 181 !> @param[in] cd_char string character 182 !> @param[in] sd_val integer(2) variable value 183 !> @return string character 184 !------------------------------------------------------------------- 185 PURE CHARACTER(LEN=lc) FUNCTION fct__i2_cat(cd_char, sd_val) 186 187 ! arguments 188 CHARACTER(LEN=lc), INTENT(IN) :: cd_char 189 INTEGER(i2), INTENT(IN) :: sd_val 190 191 ! local variable 192 CHARACTER(LEN=lc) :: cl_val 193 !---------------------------------------------------------------- 194 195 cl_val = fct_str(sd_val) 196 fct__i2_cat=TRIM(cd_char)//TRIM(cl_val) 197 198 END FUNCTION fct__i2_cat 199 !------------------------------------------------------------------- 200 !> @brief This function concatenate character and integer(4) (as character). 71 201 ! 72 202 !> @author J.Paul 73 203 !> - Nov, 2013- Initial Version 74 204 ! 205 !> @param[in] cd_char string character 206 !> @param[in] id_val integer(4) variable value 75 207 !> @return string character 76 208 !------------------------------------------------------------------- 77 ! @code78 209 PURE CHARACTER(LEN=lc) FUNCTION fct__i4_cat(cd_char, id_val) 79 210 … … 90 221 91 222 END FUNCTION fct__i4_cat 92 ! @endcode 93 !------------------------------------------------------------------- 94 !> @brief This routine concatenate character and integer(8) (as character). 223 !------------------------------------------------------------------- 224 !> @brief This function concatenate character and integer(8) (as character). 95 225 ! 96 226 !> @author J.Paul 97 !> - Nov , 2013- Initial Version227 !> - November, 2013- Initial Version 98 228 ! 229 !> @param[in] cd_char string character 230 !> @param[in] kd_val integer(8) variable value 99 231 !> @return string character 100 232 !------------------------------------------------------------------- 101 ! @code102 233 PURE CHARACTER(LEN=lc) FUNCTION fct__i8_cat(cd_char, kd_val) 103 234 … … 114 245 115 246 END FUNCTION fct__i8_cat 116 ! @endcode 117 !------------------------------------------------------------------- 118 !> @brief This routine concatenate character and real(4) (as character). 247 !------------------------------------------------------------------- 248 !> @brief This function concatenate character and real(4) (as character). 119 249 ! 120 250 !> @author J.Paul 121 !> - Nov , 2013- Initial Version251 !> - November, 2013- Initial Version 122 252 ! 253 !> @param[in] cd_char string character 254 !> @param[in] rd_val real(4) variable value 123 255 !> @return string character 124 256 !------------------------------------------------------------------- 125 ! @code126 257 PURE CHARACTER(LEN=lc) FUNCTION fct__r4_cat(cd_char, rd_val) 127 258 … … 138 269 139 270 END FUNCTION fct__r4_cat 140 ! @endcode 141 !------------------------------------------------------------------- 142 !> @brief This routine concatenate character and real(8) (as character). 143 ! 271 !------------------------------------------------------------------- 272 !> @brief This function concatenate character and real(8) (as character). 273 !> 144 274 !> @author J.Paul 145 !> - Nov, 2013- Initial Version 146 ! 275 !> - November, 2013- Initial Version 276 !> 277 !> @param[in] cd_char string character 278 !> @param[in] dd_val real(8) variable value 147 279 !> @return string character 148 280 !------------------------------------------------------------------- 149 ! @code150 281 PURE CHARACTER(LEN=lc) FUNCTION fct__r8_cat(cd_char, dd_val) 151 282 … … 162 293 163 294 END FUNCTION fct__r8_cat 164 ! @endcode 165 !------------------------------------------------------------------- 166 !> @brief This routine concatenate character and logical (as character). 167 ! 295 !------------------------------------------------------------------- 296 !> @brief This function concatenate character and logical (as character). 297 !> 168 298 !> @author J.Paul 169 !> - Nov, 2013- Initial Version 170 ! 299 !> - November, 2013- Initial Version 300 !> 301 !> @param[in] cd_char string character 302 !> @param[in] ld_val logical variable value 171 303 !> @return string character 172 304 !------------------------------------------------------------------- 173 ! @code174 305 PURE CHARACTER(LEN=lc) FUNCTION fct__l_cat(cd_char, ld_val) 175 306 … … 186 317 187 318 END FUNCTION fct__l_cat 188 ! @endcode 189 !------------------------------------------------------------------- 190 !> @brief This routine returns the next available I/O unit number. 191 ! 319 !------------------------------------------------------------------- 320 !> @brief This function returns the next available I/O unit number. 321 !> 192 322 !> @author J.Paul 193 !> - Nov , 2013- Initial Version194 ! 323 !> - November, 2013- Initial Version 324 !> 195 325 !> @return file id 196 326 !------------------------------------------------------------------- 197 ! @code198 327 INTEGER(i4) FUNCTION fct_getunit() 199 328 … … 211 340 212 341 END FUNCTION fct_getunit 213 ! @endcode214 ! -------------------------------------------------------------------215 ! > @brief This routine handle Fortran status.216 ! 217 !> @author J.Paul218 !> - Nov, 2013- Initial Version219 ! -------------------------------------------------------------------220 ! @code342 !------------------------------------------------------------------- 343 !> @brief This subroutine handle Fortran status. 344 ! 345 !> @author J.Paul 346 !> - November, 2013- Initial Version 347 !> 348 !> @param[in] id_status 349 !------------------------------------------------------------------- 221 350 SUBROUTINE fct_err(id_status) 222 351 … … 232 361 233 362 END SUBROUTINE fct_err 234 ! @endcode 363 !------------------------------------------------------------------- 364 !> @brief This subroutine create a pause statement 365 ! 366 !> @author J.Paul 367 !> - November, 2014- Initial Version 368 !> 369 !> @param[in] cd_msg optional message to be added 370 !------------------------------------------------------------------- 371 SUBROUTINE fct_pause(cd_msg) 372 373 ! Argument 374 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_msg 375 !---------------------------------------------------------------- 376 377 IF( PRESENT(cd_msg) )THEN 378 WRITE( *, * ) 'Press Enter to continue '//TRIM(cd_msg) 379 ELSE 380 WRITE( *, * ) 'Press Enter to continue' 381 ENDIF 382 READ( *, * ) 383 384 END SUBROUTINE fct_pause 235 385 !------------------------------------------------------------------- 236 386 !> @brief This function convert logical to string character. 237 387 !> 238 388 !> @author J.Paul 239 !> - Nov , 2013- Initial Version240 ! 241 !> @param[in] ld_var :logical variable389 !> - November, 2013- Initial Version 390 ! 391 !> @param[in] ld_var logical variable 242 392 !> @return character of this integer variable 243 393 !------------------------------------------------------------------- 244 ! @code245 394 PURE CHARACTER(LEN=lc) FUNCTION fct__l_str(ld_var) 246 395 IMPLICIT NONE … … 256 405 257 406 END FUNCTION fct__l_str 258 ! @endcode259 407 !------------------------------------------------------------------- 260 408 !> @brief This function convert integer(1) to string character. 261 409 !> 262 410 !> @author J.Paul 263 !> - Nov , 2013- Initial Version264 ! 265 !> @param[in] bd_var :integer(1) variable411 !> - November, 2013- Initial Version 412 ! 413 !> @param[in] bd_var integer(1) variable 266 414 !> @return character of this integer variable 267 415 !------------------------------------------------------------------- 268 ! @code269 416 PURE CHARACTER(LEN=lc) FUNCTION fct__i1_str(bd_var) 270 417 IMPLICIT NONE … … 280 427 281 428 END FUNCTION fct__i1_str 282 ! @endcode283 429 !------------------------------------------------------------------- 284 430 !> @brief This function convert integer(2) to string character. 285 431 !> 286 432 !> @author J.Paul 287 !> - Nov , 2013- Initial Version288 ! 289 !> @param[in] sd_var :integer(2) variable433 !> - November, 2013- Initial Version 434 ! 435 !> @param[in] sd_var integer(2) variable 290 436 !> @return character of this integer variable 291 437 !------------------------------------------------------------------- 292 ! @code293 438 PURE CHARACTER(LEN=lc) FUNCTION fct__i2_str(sd_var) 294 439 IMPLICIT NONE … … 304 449 305 450 END FUNCTION fct__i2_str 306 ! @endcode307 451 !------------------------------------------------------------------- 308 452 !> @brief This function convert integer(4) to string character. 309 453 !> 310 454 !> @author J.Paul 311 !> - Nov , 2013- Initial Version312 ! 313 !> @param[in] id_var :integer(4) variable455 !> - November, 2013- Initial Version 456 ! 457 !> @param[in] id_var integer(4) variable 314 458 !> @return character of this integer variable 315 459 !------------------------------------------------------------------- 316 ! @code317 460 PURE CHARACTER(LEN=lc) FUNCTION fct__i4_str(id_var) 318 461 IMPLICIT NONE … … 328 471 329 472 END FUNCTION fct__i4_str 330 ! @endcode331 473 !------------------------------------------------------------------- 332 474 !> @brief This function convert integer(8) to string character. 333 475 !> 334 476 !> @author J.Paul 335 !> - Nov , 2013- Initial Version336 ! 337 !> @param[in] kd_var :integer(8) variable477 !> - November, 2013- Initial Version 478 ! 479 !> @param[in] kd_var integer(8) variable 338 480 !> @return character of this integer variable 339 481 !------------------------------------------------------------------- 340 ! @code341 482 PURE CHARACTER(LEN=lc) FUNCTION fct__i8_str(kd_var) 342 483 IMPLICIT NONE … … 352 493 353 494 END FUNCTION fct__i8_str 354 ! @endcode355 495 !------------------------------------------------------------------- 356 496 !> @brief This function convert real(4) to string character. 357 497 !> 358 498 !> @author J.Paul 359 !> - Nov, 2013- Initial Version 360 ! 361 !> @param[in] rd_var : real(4) variable 362 !> @return character of this integer variable 363 !------------------------------------------------------------------- 364 ! @code 499 !> - November, 2013- Initial Version 500 ! 501 !> @param[in] rd_var real(4) variable 502 !> @return character of this real variable 503 !------------------------------------------------------------------- 365 504 PURE CHARACTER(LEN=lc) FUNCTION fct__r4_str(rd_var) 366 505 IMPLICIT NONE … … 376 515 377 516 END FUNCTION fct__r4_str 378 ! @endcode379 517 !------------------------------------------------------------------- 380 518 !> @brief This function convert real(8) to string character. 381 519 !> 382 520 !> @author J.Paul 383 !> - Nov, 2013- Initial Version 384 ! 385 !> @param[in] dd_var : real(8) variable 386 !> @return character of this integer variable 387 !------------------------------------------------------------------- 388 ! @code 521 !> - November, 2013- Initial Version 522 ! 523 !> @param[in] dd_var real(8) variable 524 !> @return character of this real variable 525 !------------------------------------------------------------------- 389 526 PURE CHARACTER(LEN=lc) FUNCTION fct__r8_str(dd_var) 390 527 IMPLICIT NONE … … 400 537 401 538 END FUNCTION fct__r8_str 402 ! @endcode403 ! -------------------------------------------------------------------404 !> @brief This function concatenate all the element of a character table405 !> except unknown one, in a character string.406 !> 407 !> optionnally a separator could be added between each element408 !> 409 !> @author J.Paul410 ! > - Nov, 2013- Initial Version411 ! 412 !> @param[in] cd_ tab : table ofcharacter539 !------------------------------------------------------------------- 540 !> @brief This function concatenate all the element of a character array 541 !> in a character string. 542 !> @details 543 !> optionnally a separator could be added between each element. 544 !> 545 !> @author J.Paul 546 !> - November, 2013- Initial Version 547 ! 548 !> @param[in] cd_arr array of character 549 !> @param[in] cd_sep separator character 413 550 !> @return character 414 551 !------------------------------------------------------------------- 415 ! @code 416 PURE CHARACTER(LEN=lc) FUNCTION fct_concat(cd_tab,cd_sep) 417 IMPLICIT NONE 418 ! Argument 419 CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_tab 552 PURE CHARACTER(LEN=lc) FUNCTION fct_concat(cd_arr,cd_sep) 553 IMPLICIT NONE 554 ! Argument 555 CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_arr 420 556 CHARACTER(*), INTENT(IN), OPTIONAL :: cd_sep 421 557 … … 432 568 IF(PRESENT(cd_sep)) cl_sep=cd_sep 433 569 434 il_size=SIZE(cd_ tab)570 il_size=SIZE(cd_arr) 435 571 fct_concat='' 436 572 cl_tmp='' 437 573 DO ji=1,il_size 438 574 439 !IF( TRIM(ADJUSTL(cd_tab(ji))) /= 'unknown' )THEN 440 WRITE(cl_tmp,*) TRIM(fct_concat)//TRIM(ADJUSTL(cd_tab(ji)))//TRIM(cl_sep) 441 !ENDIF 442 575 WRITE(cl_tmp,*) TRIM(fct_concat)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep) 443 576 fct_concat=TRIM(ADJUSTL(cl_tmp)) 444 577 … … 446 579 447 580 END FUNCTION fct_concat 448 ! @endcode449 581 !------------------------------------------------------------------- 450 582 !> @brief This function convert string character upper case to lower case. … … 458 590 ! 459 591 !> @author J.Paul 460 !> - Nov , 2013- Initial Version461 ! 462 !> @param[in] cd_var :character592 !> - November, 2013- Initial Version 593 ! 594 !> @param[in] cd_var character 463 595 !> @return lower case character 464 596 !------------------------------------------------------------------- 465 ! @code466 597 PURE CHARACTER(LEN=lc) FUNCTION fct_lower(cd_var) 467 598 IMPLICIT NONE … … 505 636 506 637 END FUNCTION fct_lower 507 ! @endcode508 638 !------------------------------------------------------------------- 509 639 !> @brief This function convert string character lower case to upper case. … … 517 647 ! 518 648 !> @author J.Paul 519 !> - Nov , 2013- Initial Version520 ! 521 !> @param[in] cd_var :character649 !> - November, 2013- Initial Version 650 ! 651 !> @param[in] cd_var character 522 652 !> @return upper case character 523 653 !------------------------------------------------------------------- 524 ! @code525 654 PURE CHARACTER(LEN=lc) FUNCTION fct_upper(cd_var) 526 655 IMPLICIT NONE … … 564 693 565 694 END FUNCTION fct_upper 566 ! @endcode567 695 !------------------------------------------------------------------- 568 696 !> @brief This function check if character is numeric. 569 697 ! 570 !> @details 571 ! 572 !> @author J.Paul 573 !> - Nov, 2013- Initial Version 574 ! 575 !> @param[in] cd_var : character 698 !> @author J.Paul 699 !> - November, 2013- Initial Version 700 ! 701 !> @param[in] cd_var character 576 702 !> @return character is numeric 577 703 !------------------------------------------------------------------- 578 ! @code579 704 PURE LOGICAL FUNCTION fct_is_num(cd_var) 580 705 IMPLICIT NONE … … 597 722 598 723 END FUNCTION fct_is_num 599 ! @endcode600 724 !------------------------------------------------------------------- 601 725 !> @brief This function split string of character 602 726 !> using separator character, by default '|', 603 !> and return the element on index ind 604 ! 605 !> @details 606 ! 607 !> @author J.Paul 608 !> - Nov, 2013- Initial Version 609 ! 610 !> @param[in] cd_string : string of character 611 !> @param[in] id_ind : indice 612 !> @param[in] cd_sep separator character 727 !> and return the element on index ind. 728 ! 729 !> @author J.Paul 730 !> - November, 2013- Initial Version 731 ! 732 !> @param[in] cd_string string of character 733 !> @param[in] id_ind indice 734 !> @param[in] cd_sep separator character 613 735 !> @return return the element on index id_ind 614 736 !------------------------------------------------------------------- 615 ! @code616 737 PURE FUNCTION fct_split(cd_string, id_ind, cd_sep) 617 738 IMPLICIT NONE … … 629 750 630 751 INTEGER(i4) :: il_sep 752 INTEGER(i4) :: il_lsep 631 753 632 754 ! loop indices … … 639 761 ! get separator 640 762 cl_sep='|' 641 IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep)) 763 IF( PRESENT(cd_sep) )THEN 764 IF( cd_sep==' ')THEN 765 cl_sep=' ' 766 ELSE 767 cl_sep=TRIM(ADJUSTL(cd_sep)) 768 ENDIF 769 ENDIF 642 770 771 IF( cl_sep /= ' ' )THEN 772 ! get separator index 773 il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 774 il_lsep=LEN(TRIM(cl_sep)) 775 776 IF( il_sep /= 0 )THEN 777 fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 778 ELSE 779 fct_split=TRIM(ADJUSTL(cl_string)) 780 ENDIF 781 782 ji=1 783 DO WHILE( il_sep /= 0 .AND. ji /= id_ind ) 784 785 ji=ji+1 786 787 cl_string=TRIM(cl_string(il_sep+il_lsep:)) 788 il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 789 790 IF( il_sep /= 0 )THEN 791 fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 792 ELSE 793 fct_split=TRIM(ADJUSTL(cl_string)) 794 ENDIF 795 796 ENDDO 797 798 IF( ji /= id_ind ) fct_split='' 799 ELSE 800 fct_split=fct__split_space(TRIM(cl_string), id_ind) 801 ENDIF 802 803 END FUNCTION fct_split 804 !------------------------------------------------------------------- 805 !> @brief This function split string of character 806 !> using space as separator, 807 !> and return the element on index ind. 808 ! 809 !> @author J.Paul 810 !> - November, 2013- Initial Version 811 ! 812 !> @param[in] cd_string string of character 813 !> @param[in] id_ind indice 814 !> @return return the element on index id_ind 815 !------------------------------------------------------------------- 816 PURE FUNCTION fct__split_space(cd_string, id_ind) 817 IMPLICIT NONE 818 ! Argument 819 CHARACTER(LEN=*), INTENT(IN) :: cd_string 820 INTEGER(i4) , INTENT(IN) :: id_ind 821 822 ! function 823 CHARACTER(LEN=lc) :: fct__split_space 824 825 ! local variable 826 CHARACTER(LEN=lc) :: cl_string 827 828 INTEGER(i4) :: il_sep 829 INTEGER(i4) :: il_lsep 830 831 ! loop indices 832 INTEGER(i4) :: ji 833 !---------------------------------------------------------------- 834 ! initialize 835 fct__split_space='' 836 cl_string=ADJUSTL(cd_string) 837 643 838 ! get separator index 644 il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) ) 645 839 il_sep=INDEX( TRIM(cl_string), ' ' ) 840 il_lsep=LEN(' ') 841 646 842 IF( il_sep /= 0 )THEN 647 fct_ split=TRIM(ADJUSTL(cl_string(1:il_sep-1)))843 fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 648 844 ELSE 649 fct_ split=TRIM(ADJUSTL(cl_string))845 fct__split_space=TRIM(ADJUSTL(cl_string)) 650 846 ENDIF 651 847 … … 655 851 ji=ji+1 656 852 657 cl_string=TRIM(cl_string(il_sep+ 1:))658 il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep))853 cl_string=TRIM(cl_string(il_sep+il_lsep:)) 854 il_sep=INDEX( TRIM(cl_string), ' ' ) 659 855 660 856 IF( il_sep /= 0 )THEN 661 fct_ split=TRIM(ADJUSTL(cl_string(1:il_sep-1)))857 fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1))) 662 858 ELSE 663 fct_ split=TRIM(ADJUSTL(cl_string))859 fct__split_space=TRIM(ADJUSTL(cl_string)) 664 860 ENDIF 665 861 666 862 ENDDO 667 863 668 IF( ji /= id_ind ) fct_split='' 669 670 END FUNCTION fct_split 671 ! @endcode 864 IF( ji /= id_ind ) fct__split_space='' 865 866 END FUNCTION fct__split_space 672 867 !------------------------------------------------------------------- 673 868 !> @brief This function return basename of a filename. 674 869 ! 675 870 !> @details 676 !> actually it splits filename using sperarator '/' 677 !> and return last string character 678 ! 679 !> @author J.Paul 680 !> - Nov, 2013- Initial Version 681 ! 682 !> @param[in] cd_string : filename 871 !> Actually it splits filename using sperarator '/' 872 !> and return last string character.<br/> 873 !> Optionally you could specify another separator. 874 !> @author J.Paul 875 !> - November, 2013- Initial Version 876 ! 877 !> @param[in] cd_string filename 878 !> @param[in] cd_sep separator character 683 879 !> @return basename (filename without path) 684 880 !------------------------------------------------------------------- 685 ! @code686 881 PURE FUNCTION fct_basename(cd_string, cd_sep) 687 882 IMPLICIT NONE … … 711 906 712 907 END FUNCTION fct_basename 713 ! @endcode714 908 !------------------------------------------------------------------- 715 909 !> @brief This function return dirname of a filename. 716 910 ! 717 911 !> @details 718 !> actually it splits filename using sperarator '/' 719 !> and return all exept last string character 720 ! 721 !> @author J.Paul 722 !> - Nov, 2013- Initial Version 723 ! 724 !> @param[in] cd_string : filename 912 !> Actually it splits filename using sperarator '/' 913 !> and return all except last string character.<br/> 914 !> Optionally you could specify another separator. 915 !> @author J.Paul 916 !> - November, 2013- Initial Version 917 ! 918 !> @param[in] cd_string filename 919 !> @param[in] cd_sep separator character 725 920 !> @return dirname (path of the filename) 726 921 !------------------------------------------------------------------- 727 ! @code728 922 PURE FUNCTION fct_dirname(cd_string, cd_sep) 729 923 IMPLICIT NONE … … 757 951 758 952 END FUNCTION fct_dirname 759 ! @endcode760 953 END MODULE fct 761 954
Note: See TracChangeset
for help on using the changeset viewer.