Changeset 13369 for utils/tools/SIREN/src/boundary.f90
- Timestamp:
- 2020-07-31T10:50:52+02:00 (4 years ago)
- File:
-
- 1 edited
-
utils/tools/SIREN/src/boundary.f90 (modified) (73 diffs)
Legend:
- Unmodified
- Added
- Removed
-
utils/tools/SIREN/src/boundary.f90
r12080 r13369 106 106 !> 107 107 !> @date November, 2013 - Initial Version 108 !> @date September, 2014 108 !> @date September, 2014 109 109 !> - add boundary description 110 !> @date November, 2014 110 !> @date November, 2014 111 111 !> - Fix memory leaks bug 112 !> @date February, 2015 112 !> @date February, 2015 113 113 !> - Do not change indices read from namelist 114 !> - Change string character format of boundary read from namelist, 114 !> - Change string character format of boundary read from namelist, 115 115 !> see boundary__get_info 116 !> 116 !> 117 117 !> @todo add schematic to boundary structure description 118 !> 118 !> 119 119 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 120 120 !---------------------------------------------------------------------- 121 121 MODULE boundary 122 122 123 USE netcdf ! nf90 library 123 USE netcdf ! nf90 library 124 124 USE global ! global parameter 125 125 USE phycst ! physical constant … … 143 143 PUBLIC :: boundary_init !< initialise boundary structure 144 144 PUBLIC :: boundary_print !< print information about boundary 145 PUBLIC :: boundary_clean !< clean boundary structure 145 PUBLIC :: boundary_clean !< clean boundary structure 146 146 PUBLIC :: boundary_get_indices !< get indices of each semgent for each boundary. 147 147 PUBLIC :: boundary_check !< check boundary indices and corner. … … 150 150 PUBLIC :: boundary_swap !< swap array for north and east boundary 151 151 152 PRIVATE :: boundary__clean_unit ! clean boundary structure 153 PRIVATE :: boundary__clean_arr ! clean array of boundary structure 152 PRIVATE :: boundary__clean_unit ! clean boundary structure 153 PRIVATE :: boundary__clean_arr ! clean array of boundary structure 154 154 PRIVATE :: boundary__init_wrapper ! initialise a boundary structure 155 155 PRIVATE :: boundary__init ! initialise basically a boundary structure 156 156 PRIVATE :: boundary__copy_unit ! copy boundary structure in another 157 157 PRIVATE :: boundary__copy_arr ! copy boundary structure in another 158 PRIVATE :: boundary__add_seg ! add one segment structure to a boundary 158 PRIVATE :: boundary__add_seg ! add one segment structure to a boundary 159 159 PRIVATE :: boundary__del_seg ! remove all segments of a boundary 160 160 PRIVATE :: boundary__get_info ! get boundary information from boundary description string character. 161 161 PRIVATE :: boundary__get_seg_number ! compute the number of sea segment for one boundary 162 PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary 162 PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary 163 163 PRIVATE :: boundary__print_unit ! print information about one boundary 164 164 PRIVATE :: boundary__print_arr ! print information about a array of boundary 165 165 166 166 PRIVATE :: seg__init ! initialise segment structure 167 167 PRIVATE :: seg__clean ! clean segment structure … … 175 175 INTEGER(i4) :: i_index = 0 !< segment index 176 176 INTEGER(i4) :: i_width = 0 !< segment width 177 INTEGER(i4) :: i_first = 0 !< segment first indice 177 INTEGER(i4) :: i_first = 0 !< segment first indice 178 178 INTEGER(i4) :: i_last = 0 !< segment last indices 179 179 END TYPE TSEG … … 181 181 TYPE TBDY !< boundary structure 182 182 CHARACTER(LEN=lc) :: c_card = '' !< boundary cardinal 183 LOGICAL :: l_use = .FALSE. !< boundary use or not 183 LOGICAL :: l_use = .FALSE. !< boundary use or not 184 184 LOGICAL :: l_nam = .FALSE. !< boundary get from namelist 185 185 INTEGER(i4) :: i_nseg = 0 !< number of segment in boundary … … 191 191 192 192 INTERFACE boundary_init 193 MODULE PROCEDURE boundary__init_wrapper 193 MODULE PROCEDURE boundary__init_wrapper 194 194 END INTERFACE boundary_init 195 195 196 196 INTERFACE boundary_print 197 MODULE PROCEDURE boundary__print_unit 198 MODULE PROCEDURE boundary__print_arr 197 MODULE PROCEDURE boundary__print_unit 198 MODULE PROCEDURE boundary__print_arr 199 199 END INTERFACE boundary_print 200 200 201 201 INTERFACE boundary_clean 202 MODULE PROCEDURE boundary__clean_unit 203 MODULE PROCEDURE boundary__clean_arr 202 MODULE PROCEDURE boundary__clean_unit 203 MODULE PROCEDURE boundary__clean_arr 204 204 END INTERFACE 205 205 206 206 INTERFACE seg__clean 207 MODULE PROCEDURE seg__clean_unit 208 MODULE PROCEDURE seg__clean_arr 207 MODULE PROCEDURE seg__clean_unit 208 MODULE PROCEDURE seg__clean_arr 209 209 END INTERFACE 210 210 211 211 INTERFACE boundary_copy 212 MODULE PROCEDURE boundary__copy_unit 213 MODULE PROCEDURE boundary__copy_arr 214 END INTERFACE 212 MODULE PROCEDURE boundary__copy_unit 213 MODULE PROCEDURE boundary__copy_arr 214 END INTERFACE 215 215 216 216 INTERFACE seg__copy 217 217 MODULE PROCEDURE seg__copy_unit ! copy segment structure 218 218 MODULE PROCEDURE seg__copy_arr ! copy array of segment structure 219 END INTERFACE 219 END INTERFACE 220 220 221 221 CONTAINS … … 226 226 !> @brief 227 227 !> This subroutine copy a array of boundary structure in another one 228 !> @details 228 !> @details 229 229 !> 230 230 !> @warning do not use on the output of a function who create or read an 231 231 !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden). 232 232 !> This will create memory leaks. 233 !> @warning to avoid infinite loop, do not use any function inside 233 !> @warning to avoid infinite loop, do not use any function inside 234 234 !> this subroutine 235 235 !> … … 237 237 !> @date November, 2013 - Initial Version 238 238 !> @date November, 2014 239 !> - use function instead of overload assignment operator 239 !> - use function instead of overload assignment operator 240 240 !> (to avoid memory leak) 241 241 ! 242 242 !> @param[in] td_bdy array of boundary structure 243 !> @return copy of input array of boundary structure 243 !> @return copy of input array of boundary structure 244 244 !------------------------------------------------------------------- 245 245 … … 268 268 !> @brief 269 269 !> This subroutine copy boundary structure in another one 270 !> @details 270 !> @details 271 271 !> 272 272 !> @warning do not use on the output of a function who create or read an 273 273 !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden). 274 274 !> This will create memory leaks. 275 !> @warning to avoid infinite loop, do not use any function inside 275 !> @warning to avoid infinite loop, do not use any function inside 276 276 !> this subroutine 277 277 !> … … 279 279 !> @date November, 2013 - Initial Version 280 280 !> @date November, 2014 281 !> - use function instead of overload assignment operator 281 !> - use function instead of overload assignment operator 282 282 !> (to avoid memory leak) 283 283 ! … … 325 325 !> @date November, 2013 - Initial Version 326 326 !> @date January, 2019 327 !> - nullify segment structure inside boundary structure 327 !> - nullify segment structure inside boundary structure 328 328 ! 329 329 !> @param[inout] td_bdy boundary strucutre … … 385 385 FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) & 386 386 & RESULT (cf_file) 387 !------------------------------------------------------------------- 387 !------------------------------------------------------------------- 388 388 !> @brief This function put cardinal name and date inside file name. 389 ! 390 !> @details 389 ! 390 !> @details 391 391 !> Examples : 392 392 !> cd_file="boundary.nc" 393 !> cd_card="west" 393 !> cd_card="west" 394 394 !> id_seg =2 395 395 !> cd_date=y2015m07d16 396 !> 396 !> 397 397 !> function return "boundary_west_2_y2015m07d16.nc" 398 !> 398 !> 399 399 !> cd_file="boundary.nc" 400 !> cd_card="west" 401 !> 400 !> cd_card="west" 401 !> 402 402 !> function return "boundary_west.nc" 403 !> 404 !> @author J.Paul 405 !> @date November, 2013 - Initial Version 406 ! 407 !> @param[in] cd_file file name 408 !> @param[in] cd_card cardinal name 409 !> @param[in] id_seg segment number 410 !> @param[in] cd_date file date (format: y????m??d??) 403 !> 404 !> @author J.Paul 405 !> @date November, 2013 - Initial Version 406 ! 407 !> @param[in] cd_file file name 408 !> @param[in] cd_card cardinal name 409 !> @param[in] id_seg segment number 410 !> @param[in] cd_date file date (format: y????m??d??) 411 411 !> @return file name with cardinal name inside 412 !------------------------------------------------------------------- 413 414 IMPLICIT NONE 412 !------------------------------------------------------------------- 413 414 IMPLICIT NONE 415 415 416 416 ! Argument … … 420 420 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date 421 421 422 ! function 422 ! function 423 423 CHARACTER(LEN=lc) :: cf_file 424 424 425 ! local variable 425 ! local variable 426 426 CHARACTER(LEN=lc) :: cl_dirname 427 427 CHARACTER(LEN=lc) :: cl_basename … … 435 435 INTEGER(i4) :: il_indend 436 436 437 ! loop indices 438 !---------------------------------------------------------------- 437 ! loop indices 438 !---------------------------------------------------------------- 439 439 ! init 440 440 cf_file='' … … 449 449 cl_base =fct_split(TRIM(cl_basename),1,'.') 450 450 cl_suffix=fct_split(TRIM(cl_basename),2,'.') 451 451 452 452 ! add segment number 453 453 IF( PRESENT(id_seg) )THEN … … 483 483 & " are empty") 484 484 ENDIF 485 486 END FUNCTION boundary_set_filename 485 486 END FUNCTION boundary_set_filename 487 487 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 488 488 FUNCTION boundary__init_wrapper(td_var, & … … 491 491 & ld_oneseg) & 492 492 & RESULT (tf_bdy) 493 !------------------------------------------------------------------- 493 !------------------------------------------------------------------- 494 494 !> @brief This function initialise a boundary structure. 495 ! 496 !> @details 495 ! 496 !> @details 497 497 !> Boundaries for each cardinal will be compute with variable structure. 498 !> It means that orthogonal index, first and last indices of each 498 !> It means that orthogonal index, first and last indices of each 499 499 !> sea segment will be compute automatically. 500 500 !> However you could specify which boundary to use or not with … … 502 502 !> And boundary description could be specify with argument 503 503 !> cn_north, cn_south, cn_east, cn_west. 504 !> For each cardinal you could specify orthogonal index, 504 !> For each cardinal you could specify orthogonal index, 505 505 !> first and last indices (in this order) and boundary width (between 506 506 !> parentheses). 507 507 !> ex : cn_north='index,first,last(width)' 508 !> You could specify more than one segment for each boundary. 508 !> You could specify more than one segment for each boundary. 509 509 !> However each segment will have the same width. So you do not need to 510 510 !> specify it for each segment. … … 512 512 !> 513 513 !> @warn Boundaries are compute on T point, but expressed on U,V point. 514 !> change will be done to get data on other point when need be. 514 !> change will be done to get data on other point when need be. 515 515 !> 516 !> @author J.Paul 517 !> @date November, 2013 - Initial Version 516 !> @author J.Paul 517 !> @date November, 2013 - Initial Version 518 518 !> @date September, 2014 519 519 !> - add boolean to use only one segment for each boundary 520 520 !> - check boundary width 521 ! 522 !> @param[in] td_var variable structure 523 !> @param[in] ld_north use north boundary or not 524 !> @param[in] ld_south use south boundary or not 525 !> @param[in] ld_east use east boundary or not 526 !> @param[in] ld_west use west boundary or not 527 !> @param[in] cd_north north boundary description 528 !> @param[in] cd_south south boundary description 529 !> @param[in] cd_east east boundary description 530 !> @param[in] cd_west west boundary description 531 !> @param[in] ld_oneseg force to use only one segment for each boundary 521 ! 522 !> @param[in] td_var variable structure 523 !> @param[in] ld_north use north boundary or not 524 !> @param[in] ld_south use south boundary or not 525 !> @param[in] ld_east use east boundary or not 526 !> @param[in] ld_west use west boundary or not 527 !> @param[in] cd_north north boundary description 528 !> @param[in] cd_south south boundary description 529 !> @param[in] cd_east east boundary description 530 !> @param[in] cd_west west boundary description 531 !> @param[in] ld_oneseg force to use only one segment for each boundary 532 532 !> @return boundary structure 533 !------------------------------------------------------------------- 534 535 IMPLICIT NONE 533 !------------------------------------------------------------------- 534 535 IMPLICIT NONE 536 536 537 537 ! Argument … … 539 539 LOGICAL , INTENT(IN), OPTIONAL :: ld_north 540 540 LOGICAL , INTENT(IN), OPTIONAL :: ld_south 541 LOGICAL , INTENT(IN), OPTIONAL :: ld_east 542 LOGICAL , INTENT(IN), OPTIONAL :: ld_west 541 LOGICAL , INTENT(IN), OPTIONAL :: ld_east 542 LOGICAL , INTENT(IN), OPTIONAL :: ld_west 543 543 CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_north 544 544 CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_south 545 CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_east 545 CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_east 546 546 CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_west 547 LOGICAL , INTENT(IN), OPTIONAL :: ld_oneseg 548 549 ! function 547 LOGICAL , INTENT(IN), OPTIONAL :: ld_oneseg 548 549 ! function 550 550 TYPE(TBDY) , DIMENSION(ip_ncard) :: tf_bdy 551 551 552 ! local variable 552 ! local variable 553 553 INTEGER(i4) :: il_width 554 554 INTEGER(i4) , DIMENSION(ip_ncard) :: il_max_width … … 565 565 LOGICAL :: ll_oneseg 566 566 567 ! loop indices 567 ! loop indices 568 568 INTEGER(i4) :: ji 569 569 INTEGER(i4) :: jk 570 !---------------------------------------------------------------- 570 !---------------------------------------------------------------- 571 571 IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 572 572 CALL logger_error("BOUNDARY INIT: no value associated to variable "//& … … 612 612 il_max(jp_east )=td_var%t_dim(2)%i_len 613 613 il_max(jp_west )=td_var%t_dim(2)%i_len 614 614 615 615 cl_card=(/'','','',''/) 616 616 IF( PRESENT(cd_north) ) cl_card(jp_north)=TRIM(cd_north) … … 663 663 ELSE 664 664 ! fill undefined value 665 WHERE( tf_bdy(jk)%t_seg(:)%i_index == 0 ) 665 WHERE( tf_bdy(jk)%t_seg(:)%i_index == 0 ) 666 666 tf_bdy(jk)%t_seg(:)%i_index = tl_seg%i_index 667 END WHERE 668 WHERE( tf_bdy(jk)%t_seg(:)%i_width == 0 ) 667 END WHERE 668 WHERE( tf_bdy(jk)%t_seg(:)%i_width == 0 ) 669 669 tf_bdy(jk)%t_seg(:)%i_width = tl_seg%i_width 670 670 END WHERE 671 WHERE( tf_bdy(jk)%t_seg(:)%i_first == 0 ) 671 WHERE( tf_bdy(jk)%t_seg(:)%i_first == 0 ) 672 672 tf_bdy(jk)%t_seg(:)%i_first = tl_seg%i_first 673 673 END WHERE 674 WHERE( tf_bdy(jk)%t_seg(:)%i_last == 0 ) 674 WHERE( tf_bdy(jk)%t_seg(:)%i_last == 0 ) 675 675 tf_bdy(jk)%t_seg(:)%i_last = tl_seg%i_last 676 676 END WHERE … … 688 688 689 689 ENDIF 690 691 END FUNCTION boundary__init_wrapper 690 691 END FUNCTION boundary__init_wrapper 692 692 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 693 693 FUNCTION boundary__init(cd_card, ld_use, ld_nam, td_seg) & 694 694 & RESULT (tf_bdy) 695 !------------------------------------------------------------------- 695 !------------------------------------------------------------------- 696 696 !> @brief This function initialise basically a boundary structure with 697 697 !> cardinal name. 698 ! 699 !> @details 700 !> optionnaly you could specify if this boundary is used or not, 698 ! 699 !> @details 700 !> optionnaly you could specify if this boundary is used or not, 701 701 !> and add one segment structure. 702 ! 703 !> @author J.Paul 704 !> @date November, 2013 - Initial Version 705 ! 702 ! 703 !> @author J.Paul 704 !> @date November, 2013 - Initial Version 705 ! 706 706 !> @param[in] cd_card cardinal name 707 707 !> @param[in] ld_use boundary use or not 708 708 !> @param[in] td_seg segment structure 709 709 !> @return boundary structure 710 !------------------------------------------------------------------- 711 712 IMPLICIT NONE 710 !------------------------------------------------------------------- 711 712 IMPLICIT NONE 713 713 714 714 ! Argument 715 715 CHARACTER(LEN=*), INTENT(IN) :: cd_card 716 LOGICAL , INTENT(IN), OPTIONAL :: ld_use 717 LOGICAL , INTENT(IN), OPTIONAL :: ld_nam 716 LOGICAL , INTENT(IN), OPTIONAL :: ld_use 717 LOGICAL , INTENT(IN), OPTIONAL :: ld_nam 718 718 TYPE(TSEG) , INTENT(IN), OPTIONAL :: td_seg 719 719 720 ! function 720 ! function 721 721 TYPE(TBDY) :: tf_bdy 722 722 723 ! local variable 724 ! loop indices 725 !---------------------------------------------------------------- 723 ! local variable 724 ! loop indices 725 !---------------------------------------------------------------- 726 726 727 727 SELECT CASE(TRIM(cd_card)) 728 728 CASE ('north','south','east','west') 729 729 730 730 tf_bdy%c_card=TRIM(cd_card) 731 731 … … 746 746 END FUNCTION boundary__init 747 747 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 748 SUBROUTINE boundary__add_seg(td_bdy, td_seg) 749 !------------------------------------------------------------------- 750 !> @brief This subroutine add one segment structure to a boundary structure 751 ! 752 !> @details 753 ! 754 !> @author J.Paul 755 !> @date November, 2013 - Initial Version 756 ! 757 !> @param[inout] td_bdy boundary structure 758 !> @param[in] td_seg segment structure 759 !------------------------------------------------------------------- 760 761 IMPLICIT NONE 762 763 ! Argument 748 SUBROUTINE boundary__add_seg(td_bdy, td_seg) 749 !------------------------------------------------------------------- 750 !> @brief This subroutine add one segment structure to a boundary structure 751 ! 752 !> @details 753 ! 754 !> @author J.Paul 755 !> @date November, 2013 - Initial Version 756 ! 757 !> @param[inout] td_bdy boundary structure 758 !> @param[in] td_seg segment structure 759 !------------------------------------------------------------------- 760 761 IMPLICIT NONE 762 763 ! Argument 764 764 TYPE(TBDY), INTENT(INOUT) :: td_bdy 765 765 TYPE(TSEG), INTENT(IN ) :: td_seg 766 766 767 ! local variable 767 ! local variable 768 768 INTEGER(i4) :: il_status 769 769 TYPE(TSEG) , DIMENSION(:), ALLOCATABLE :: tl_seg 770 770 771 ! loop indices 772 !---------------------------------------------------------------- 771 ! loop indices 772 !---------------------------------------------------------------- 773 773 774 774 IF( td_bdy%i_nseg > 0 )THEN … … 795 795 ! clean 796 796 CALL seg__clean(tl_seg(:)) 797 DEALLOCATE(tl_seg) 798 797 DEALLOCATE(tl_seg) 798 799 799 ENDIF 800 800 ELSE … … 808 808 CALL logger_error( & 809 809 & " BOUNDARY ADD SEG: not enough space to put segments ") 810 ENDIF 810 ENDIF 811 811 ENDIF 812 812 813 813 ! update number of segment 814 814 td_bdy%i_nseg=td_bdy%i_nseg+1 … … 817 817 td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg) 818 818 819 END SUBROUTINE boundary__add_seg 820 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 821 SUBROUTINE boundary__del_seg(td_bdy) 822 !------------------------------------------------------------------- 823 !> @brief This subroutine remove all segments of a boundary structure 824 ! 825 !> @details 826 ! 827 !> @author J.Paul 828 !> @date November, 2013 - Initial Version 829 ! 819 END SUBROUTINE boundary__add_seg 820 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 821 SUBROUTINE boundary__del_seg(td_bdy) 822 !------------------------------------------------------------------- 823 !> @brief This subroutine remove all segments of a boundary structure 824 ! 825 !> @details 826 ! 827 !> @author J.Paul 828 !> @date November, 2013 - Initial Version 829 ! 830 830 !> @param[inout] td_bdy boundary structure 831 !------------------------------------------------------------------- 832 833 IMPLICIT NONE 834 835 ! Argument 831 !------------------------------------------------------------------- 832 833 IMPLICIT NONE 834 835 ! Argument 836 836 TYPE(TBDY), INTENT(INOUT) :: td_bdy 837 837 838 ! local variable 839 ! loop indices 840 !---------------------------------------------------------------- 838 ! local variable 839 ! loop indices 840 !---------------------------------------------------------------- 841 841 842 842 IF( ASSOCIATED(td_bdy%t_seg) )THEN … … 847 847 td_bdy%i_nseg=0 848 848 849 END SUBROUTINE boundary__del_seg 849 END SUBROUTINE boundary__del_seg 850 850 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 851 851 FUNCTION boundary__get_info(cd_card, id_jcard) & 852 852 & RESULT (tf_bdy) 853 !------------------------------------------------------------------- 854 !> @brief This function get information about boundary from string character. 855 ! 853 !------------------------------------------------------------------- 854 !> @brief This function get information about boundary from string character. 855 ! 856 856 !> @details 857 857 !> This string character that will be passed through namelist could contains 858 !> orthogonal index, first and last indices, of each segment. 858 !> orthogonal index, first and last indices, of each segment. 859 859 !> And also the width of all segments of this boundary. 860 860 !> cn_north='index1,first1:last1(width)|index2,first2:last2' 861 !> 862 !> @author J.Paul 863 !> @date November, 2013 - Initial Version 864 !> @date february, 2015 861 !> 862 !> @author J.Paul 863 !> @date November, 2013 - Initial Version 864 !> @date february, 2015 865 865 !> - do not change indices read from namelist 866 866 !> - change format cn_north 867 ! 867 ! 868 868 !> @param[in] cd_card boundary description 869 869 !> @param[in] id_jcard boundary index 870 870 !> @return boundary structure 871 !------------------------------------------------------------------- 872 873 IMPLICIT NONE 874 875 ! Argument 871 !------------------------------------------------------------------- 872 873 IMPLICIT NONE 874 875 ! Argument 876 876 CHARACTER(LEN=lc), INTENT(IN) :: cd_card 877 877 INTEGER(i4) , INTENT(IN) :: id_jcard 878 878 879 ! function 879 ! function 880 880 TYPE(TBDY) :: tf_bdy 881 881 882 ! local variable 882 ! local variable 883 883 INTEGER(i4) :: il_width 884 884 INTEGER(i4) :: il_ind1 … … 890 890 CHARACTER(LEN=lc) :: cl_tmp 891 891 CHARACTER(LEN=lc) :: cl_first 892 CHARACTER(LEN=lc) :: cl_last 892 CHARACTER(LEN=lc) :: cl_last 893 893 894 894 TYPE(TSEG) :: tl_seg 895 895 896 ! loop indices 896 ! loop indices 897 897 INTEGER(i4) :: ji 898 !---------------------------------------------------------------- 899 898 !---------------------------------------------------------------- 899 900 900 ji=1 901 901 cl_seg=fct_split(cd_card,ji) 902 902 903 903 il_width=0 904 ! look for segment width 904 ! look for segment width 905 905 ! width should be the same for all segment of one boundary 906 906 IF( TRIM(cl_seg) /= '' )THEN … … 924 924 ENDIF 925 925 926 ENDIF 926 ENDIF 927 927 928 928 DO WHILE( TRIM(cl_seg) /= '' ) … … 940 940 ENDIF 941 941 ENDIF 942 943 942 943 944 944 cl_tmp=fct_split(cl_seg,2,',') 945 945 … … 956 956 & " check namelist. ") 957 957 ENDIF 958 ENDIF 959 958 ENDIF 959 960 960 cl_last =fct_split(cl_tmp,2,':') 961 961 ! remove potential width information … … 996 996 ! clean 997 997 CALL seg__clean(tl_seg) 998 ENDDO 999 1000 END FUNCTION boundary__get_info 1001 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1002 SUBROUTINE boundary_get_indices(td_bdy, td_var, ld_oneseg) 1003 !------------------------------------------------------------------- 998 ENDDO 999 1000 END FUNCTION boundary__get_info 1001 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1002 SUBROUTINE boundary_get_indices(td_bdy, td_var, ld_oneseg) 1003 !------------------------------------------------------------------- 1004 1004 !> @brief This subroutine get indices of each semgent for each boundary. 1005 ! 1006 !> @details 1005 ! 1006 !> @details 1007 1007 !> indices are compute from variable value, actually variable fill value, 1008 !> which is assume to be land mask. 1009 !> Boundary structure should have been initialized before running 1008 !> which is assume to be land mask. 1009 !> Boundary structure should have been initialized before running 1010 1010 !> this subroutine. Segment indices will be search between first and last 1011 1011 !> indies, at this orthogonal index. 1012 !> 1012 !> 1013 1013 !> Optionnally you could forced to use only one segment for each boundary. 1014 !> 1015 !> @warning number of segment (i_nseg) will be change, before the number 1014 !> 1015 !> @warning number of segment (i_nseg) will be change, before the number 1016 1016 !> of segment structure 1017 ! 1018 !> @author J.Paul 1019 !> @date November, 2013 - Initial Version 1020 ! 1021 !> @param[inout] td_bdy boundary structure 1022 !> @param[in] td_var variable structure 1023 !> @param[in] ld_onseg use only one sgment for each boundary 1024 !------------------------------------------------------------------- 1025 1026 IMPLICIT NONE 1017 ! 1018 !> @author J.Paul 1019 !> @date November, 2013 - Initial Version 1020 ! 1021 !> @param[inout] td_bdy boundary structure 1022 !> @param[in] td_var variable structure 1023 !> @param[in] ld_onseg use only one sgment for each boundary 1024 !------------------------------------------------------------------- 1025 1026 IMPLICIT NONE 1027 1027 1028 1028 ! Argument … … 1031 1031 LOGICAL , INTENT(IN ), OPTIONAL :: ld_oneseg 1032 1032 1033 ! local variable 1033 ! local variable 1034 1034 INTEGER(i4) :: il_index 1035 1035 INTEGER(i4) :: il_width 1036 1036 INTEGER(i4) :: il_first 1037 INTEGER(i4) :: il_last 1037 INTEGER(i4) :: il_last 1038 1038 1039 1039 LOGICAL :: ll_oneseg … … 1043 1043 ! loop indices 1044 1044 INTEGER(i4) :: jk 1045 !---------------------------------------------------------------- 1046 1045 !---------------------------------------------------------------- 1046 1047 1047 ll_oneseg=.TRUE. 1048 1048 IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg … … 1063 1063 il_first=td_bdy(jk)%t_seg(1)%i_first 1064 1064 il_last =td_bdy(jk)%t_seg(1)%i_last 1065 1065 1066 1066 CALL boundary__get_seg_number( td_bdy(jk), td_var) 1067 1067 … … 1091 1091 ENDDO 1092 1092 1093 END SUBROUTINE boundary_get_indices 1094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1095 SUBROUTINE boundary__get_seg_number(td_bdy, td_var) 1096 !------------------------------------------------------------------- 1097 !> @brief This subroutine compute the number of sea segment. 1098 ! 1099 !> @details 1093 END SUBROUTINE boundary_get_indices 1094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1095 SUBROUTINE boundary__get_seg_number(td_bdy, td_var) 1096 !------------------------------------------------------------------- 1097 !> @brief This subroutine compute the number of sea segment. 1098 ! 1099 !> @details 1100 1100 !> It use variable value, actually variable fill value 1101 1101 !> (which is assume to be land mask), to compute the number of segment between 1102 1102 !> first and last indices at boundary orthogonal index. 1103 !> @warning number of segment (i_nseg) will be change, before the number 1103 !> @warning number of segment (i_nseg) will be change, before the number 1104 1104 !> of segment structure 1105 ! 1106 !> @author J.Paul 1107 !> @date November, 2013 - Initial Version 1108 ! 1109 !> @param[inout] td_bdy boundary structure 1110 !> @param[in] td_var variable structure 1111 !------------------------------------------------------------------- 1112 1113 IMPLICIT NONE 1105 ! 1106 !> @author J.Paul 1107 !> @date November, 2013 - Initial Version 1108 ! 1109 !> @param[inout] td_bdy boundary structure 1110 !> @param[in] td_var variable structure 1111 !------------------------------------------------------------------- 1112 1113 IMPLICIT NONE 1114 1114 1115 1115 ! Argument … … 1117 1117 TYPE(TVAR) , INTENT(IN ) :: td_var 1118 1118 1119 ! local variable 1119 ! local variable 1120 1120 REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_value 1121 1121 LOGICAL :: ll_sea … … 1124 1124 ! loop indices 1125 1125 INTEGER(i4) :: ji 1126 !---------------------------------------------------------------- 1127 1126 !---------------------------------------------------------------- 1127 1128 1128 IF( td_bdy%l_use .AND. td_bdy%i_nseg == 1 )THEN 1129 1129 … … 1137 1137 1138 1138 IF( ANY(dl_value(:) /= td_var%d_fill) )THEN 1139 1139 1140 1140 td_bdy%l_use=.TRUE. 1141 1141 td_bdy%i_nseg=0 … … 1166 1166 1167 1167 IF( ANY(dl_value(:) /= td_var%d_fill) )THEN 1168 1168 1169 1169 td_bdy%l_use=.TRUE. 1170 1170 td_bdy%i_nseg=0 … … 1191 1191 END SELECT 1192 1192 ENDIF 1193 1194 END SUBROUTINE boundary__get_seg_number 1193 1194 END SUBROUTINE boundary__get_seg_number 1195 1195 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1196 1196 SUBROUTINE boundary__get_seg_indices(td_bdy, td_var, & 1197 & id_index, id_width, id_first, id_last) 1198 !------------------------------------------------------------------- 1197 & id_index, id_width, id_first, id_last) 1198 !------------------------------------------------------------------- 1199 1199 !> @brief This subroutine get segment indices for one boundary. 1200 ! 1201 !> @details 1202 ! 1203 !> @author J.Paul 1204 !> @date November, 2013 - Initial Version 1205 ! 1206 !> @param[inout] td_bdy boundary structure 1207 !> @param[in] td_var variable structure 1208 !> @param[in] id_index boundary orthogonal index 1209 !> @param[in] id_width bounary width 1200 ! 1201 !> @details 1202 ! 1203 !> @author J.Paul 1204 !> @date November, 2013 - Initial Version 1205 ! 1206 !> @param[inout] td_bdy boundary structure 1207 !> @param[in] td_var variable structure 1208 !> @param[in] id_index boundary orthogonal index 1209 !> @param[in] id_width bounary width 1210 1210 !> @param[in] id_first boundary first indice 1211 1211 !> @param[in] id_last boundary last indice 1212 !------------------------------------------------------------------- 1213 1214 IMPLICIT NONE 1212 !------------------------------------------------------------------- 1213 1214 IMPLICIT NONE 1215 1215 1216 1216 ! Argument … … 1222 1222 INTEGER(i4), INTENT(IN ) :: id_last 1223 1223 1224 ! local variable 1224 ! local variable 1225 1225 INTEGER(i4) :: il_nseg 1226 1226 INTEGER(i4), DIMENSION(ip_ncard) :: il_max … … 1239 1239 INTEGER(i4) :: jk 1240 1240 INTEGER(i4) :: jl 1241 !---------------------------------------------------------------- 1242 1241 !---------------------------------------------------------------- 1242 1243 1243 SELECT CASE(TRIM(td_bdy%c_card)) 1244 1244 CASE('north') 1245 1245 jk=jp_north 1246 1246 1247 1247 ALLOCATE( dl_value(td_var%t_dim(1)%i_len) ) 1248 1248 dl_value(:)=td_var%d_value(:,id_index,1,1) … … 1255 1255 1256 1256 CASE('east ') 1257 jk=jp_east 1257 jk=jp_east 1258 1258 1259 1259 ALLOCATE( dl_value(td_var%t_dim(2)%i_len) ) … … 1261 1261 1262 1262 CASE('west ') 1263 jk=jp_west 1263 jk=jp_west 1264 1264 1265 1265 ALLOCATE( dl_value(td_var%t_dim(2)%i_len) ) … … 1277 1277 il_min(jp_east )=1+ip_ghost 1278 1278 il_min(jp_west )=1+ip_ghost 1279 1280 ! special case for EW cyclic 1279 1280 ! special case for EW cyclic 1281 1281 IF( td_var%i_ew >= 0 )THEN 1282 1282 il_min(jp_north)=1 … … 1286 1286 il_max(jp_south)=td_var%t_dim(1)%i_len 1287 1287 ENDIF 1288 1288 1289 1289 il_nseg=td_bdy%i_nseg 1290 1290 ! remove all segment from boundary … … 1333 1333 ll_sea=.FALSE. 1334 1334 ENDIF 1335 1335 1336 1336 ENDDO 1337 1337 … … 1340 1340 ! clean 1341 1341 CALL seg__clean(tl_seg) 1342 1342 1343 1343 ENDDO 1344 1344 1345 1345 DEALLOCATE(dl_value) 1346 1347 END SUBROUTINE boundary__get_seg_indices 1346 1347 END SUBROUTINE boundary__get_seg_indices 1348 1348 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1349 1349 SUBROUTINE boundary_check_corner(td_bdy, td_var) 1350 !------------------------------------------------------------------- 1351 !> @brief This subroutine check if there is boundary at corner, and 1352 !> adjust boundary indices if necessary. 1353 ! 1354 !> @details 1350 !------------------------------------------------------------------- 1351 !> @brief This subroutine check if there is boundary at corner, and 1352 !> adjust boundary indices if necessary. 1353 ! 1354 !> @details 1355 1355 !> If there is a north west corner, first indices of north boundary 1356 !> should be the same as the west boundary indices. 1356 !> should be the same as the west boundary indices. 1357 1357 !> And the last indices of the west boundary should be the same as 1358 1358 !> the north indices. 1359 1359 !> More over the width of west and north boundary should be the same. 1360 ! 1361 !> @author J.Paul 1362 !> @date November, 2013 - Initial Version 1363 ! 1360 ! 1361 !> @author J.Paul 1362 !> @date November, 2013 - Initial Version 1363 ! 1364 1364 !> @param[inout] td_bdy boundary structure 1365 1365 !> @param[in] td_var variable structure 1366 !------------------------------------------------------------------- 1367 1368 IMPLICIT NONE 1366 !------------------------------------------------------------------- 1367 1368 IMPLICIT NONE 1369 1369 1370 1370 ! Argument … … 1372 1372 TYPE(TVAR) , INTENT(IN ) :: td_var 1373 1373 1374 ! local variable 1374 ! local variable 1375 1375 TYPE(TSEG) :: tl_north 1376 1376 TYPE(TSEG) :: tl_south 1377 TYPE(TSEG) :: tl_east 1377 TYPE(TSEG) :: tl_east 1378 1378 TYPE(TSEG) :: tl_west 1379 1379 … … 1381 1381 1382 1382 ! loop indices 1383 !---------------------------------------------------------------- 1384 1383 !---------------------------------------------------------------- 1384 1385 1385 IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 1386 1386 CALL logger_error("BOUNDARY CHEKC CORNER: no value associated "//& … … 1406 1406 1407 1407 il_width=MIN(tl_west%i_width,tl_north%i_width) 1408 1408 1409 1409 tl_west%i_width =il_width 1410 1410 tl_north%i_width=il_width … … 1449 1449 1450 1450 il_width=MIN(tl_east%i_width,tl_north%i_width) 1451 1451 1452 1452 tl_east%i_width =il_width 1453 1453 tl_north%i_width=il_width … … 1491 1491 1492 1492 il_width=MIN(tl_east%i_width,tl_south%i_width) 1493 1493 1494 1494 tl_east%i_width =il_width 1495 1495 tl_south%i_width=il_width … … 1533 1533 1534 1534 il_width=MIN(tl_west%i_width,tl_south%i_width) 1535 1535 1536 1536 tl_west%i_width =il_width 1537 1537 tl_south%i_width=il_width … … 1563 1563 CALL seg__clean(tl_west ) 1564 1564 1565 END SUBROUTINE boundary_check_corner 1566 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1567 SUBROUTINE boundary_check(td_bdy, td_var) 1568 !------------------------------------------------------------------- 1565 END SUBROUTINE boundary_check_corner 1566 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1567 SUBROUTINE boundary_check(td_bdy, td_var) 1568 !------------------------------------------------------------------- 1569 1569 !> @brief This subroutine check boundary. 1570 ! 1571 !> @details 1570 ! 1571 !> @details 1572 1572 !> It checks that first and last indices as well as orthogonal index are 1573 1573 !> inside domain, and check corner (see boundary_check_corner). 1574 ! 1575 !> @author J.Paul 1576 !> @date November, 2013 - Initial Version 1574 ! 1575 !> @author J.Paul 1576 !> @date November, 2013 - Initial Version 1577 1577 !> @date June, 2016 1578 1578 !> - Bug fix: take into account that boundaries are compute on T point, 1579 1579 !> but expressed on U,V point 1580 1580 !> 1581 !> @param[inout] td_bdy boundary structure 1582 !> @param[in] td_var variable structure 1583 !------------------------------------------------------------------- 1584 1585 IMPLICIT NONE 1581 !> @param[inout] td_bdy boundary structure 1582 !> @param[in] td_var variable structure 1583 !------------------------------------------------------------------- 1584 1585 IMPLICIT NONE 1586 1586 1587 1587 ! Argument … … 1589 1589 TYPE(TVAR) , INTENT(IN ) :: td_var 1590 1590 1591 ! local variable 1591 ! local variable 1592 1592 INTEGER(i4) , DIMENSION(ip_ncard) :: il_max 1593 1593 INTEGER(i4) , DIMENSION(ip_ncard) :: il_maxindex 1594 1594 1595 ! loop indices 1595 ! loop indices 1596 1596 INTEGER(i4) :: jk 1597 !---------------------------------------------------------------- 1598 1597 !---------------------------------------------------------------- 1598 1599 1599 il_max(jp_north)=td_var%t_dim(1)%i_len 1600 1600 il_max(jp_south)=td_var%t_dim(1)%i_len 1601 1601 il_max(jp_east )=td_var%t_dim(2)%i_len 1602 1602 il_max(jp_west )=td_var%t_dim(2)%i_len 1603 1603 1604 1604 ! index expressed on U,V point, move on T point. 1605 1605 il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost+1 … … 1637 1637 ENDIF 1638 1638 ENDDO 1639 1639 1640 1640 CALL boundary_check_corner(td_bdy, td_var) 1641 1641 … … 1647 1647 ! 1648 1648 !> @detail 1649 !> 1649 !> 1650 1650 !> @author J.Paul 1651 1651 !> @date November, 2013 - Initial Version … … 1672 1672 CALL logger_error("BOUNDARY SWAP: no array of value "//& 1673 1673 & "associted to variable "//TRIM(td_var%c_name) ) 1674 ELSE 1674 ELSE 1675 1675 1676 1676 SELECT CASE(TRIM(td_bdy%c_card)) … … 1688 1688 ENDDO 1689 1689 1690 DEALLOCATE( dl_value ) 1690 DEALLOCATE( dl_value ) 1691 1691 CASE('east') 1692 1692 ALLOCATE( dl_value(td_var%t_dim(1)%i_len, & … … 1710 1710 END SUBROUTINE boundary_swap 1711 1711 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1712 SUBROUTINE boundary__print_unit(td_bdy) 1713 !------------------------------------------------------------------- 1714 !> @brief This subroutine print information about one boundary. 1715 ! 1716 !> @author J.Paul 1717 !> @date November, 2013 - Initial Version 1718 ! 1719 !> @param[in] td_bdy boundary structure 1720 !------------------------------------------------------------------- 1721 1722 IMPLICIT NONE 1712 SUBROUTINE boundary__print_unit(td_bdy) 1713 !------------------------------------------------------------------- 1714 !> @brief This subroutine print information about one boundary. 1715 ! 1716 !> @author J.Paul 1717 !> @date November, 2013 - Initial Version 1718 ! 1719 !> @param[in] td_bdy boundary structure 1720 !------------------------------------------------------------------- 1721 1722 IMPLICIT NONE 1723 1723 1724 1724 ! Argument 1725 1725 TYPE(TBDY), INTENT(IN) :: td_bdy 1726 1726 1727 ! local variable 1728 ! loop indices 1727 ! local variable 1728 ! loop indices 1729 1729 INTEGER(i4) :: ji 1730 !---------------------------------------------------------------- 1730 !---------------------------------------------------------------- 1731 1731 1732 1732 WRITE(*,'(a,/1x,a,/1x,a)') "Boundary "//TRIM(td_bdy%c_card), & … … 1740 1740 & " last "//TRIM(fct_str(td_bdy%t_seg(ji)%i_last)) 1741 1741 ENDDO 1742 1742 1743 1743 END SUBROUTINE boundary__print_unit 1744 1744 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1745 SUBROUTINE boundary__print_arr(td_bdy) 1746 !------------------------------------------------------------------- 1747 !> @brief This subroutine print information about a array of boundary 1748 ! 1749 !> @details 1750 ! 1751 !> @author J.Paul 1752 !> @date November, 2013 - Initial Version 1753 ! 1754 !> @param[in] td_bdy boundary structure 1755 !------------------------------------------------------------------- 1756 1757 IMPLICIT NONE 1745 SUBROUTINE boundary__print_arr(td_bdy) 1746 !------------------------------------------------------------------- 1747 !> @brief This subroutine print information about a array of boundary 1748 ! 1749 !> @details 1750 ! 1751 !> @author J.Paul 1752 !> @date November, 2013 - Initial Version 1753 ! 1754 !> @param[in] td_bdy boundary structure 1755 !------------------------------------------------------------------- 1756 1757 IMPLICIT NONE 1758 1758 1759 1759 ! Argument 1760 1760 TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy 1761 1761 1762 ! local variable 1763 ! loop indices 1762 ! local variable 1763 ! loop indices 1764 1764 INTEGER(i4) :: ji 1765 !---------------------------------------------------------------- 1765 !---------------------------------------------------------------- 1766 1766 1767 1767 DO ji=1,SIZE(td_bdy(:)) 1768 1768 CALL boundary_print(td_bdy(ji)) 1769 1769 ENDDO 1770 1770 1771 1771 END SUBROUTINE boundary__print_arr 1772 1772 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ … … 1780 1780 !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 1781 1781 !> This will create memory leaks. 1782 !> @warning to avoid infinite loop, do not use any function inside 1782 !> @warning to avoid infinite loop, do not use any function inside 1783 1783 !> this subroutine 1784 1784 !> … … 1786 1786 !> @date November, 2013 - Initial Version 1787 1787 !> @date November, 2014 1788 !> - use function instead of overload assignment operator 1788 !> - use function instead of overload assignment operator 1789 1789 !> (to avoid memory leak) 1790 1790 ! … … 1809 1809 tf_seg%i_width = td_seg%i_width 1810 1810 tf_seg%i_first = td_seg%i_first 1811 tf_seg%i_last = td_seg%i_last 1811 tf_seg%i_last = td_seg%i_last 1812 1812 1813 1813 END FUNCTION seg__copy_unit … … 1821 1821 !> @warning do not use on the output of a function who create or read a 1822 1822 !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 1823 !> This will create memory leaks. 1824 !> @warning to avoid infinite loop, do not use any function inside 1823 !> This will create memory leaks. 1824 !> @warning to avoid infinite loop, do not use any function inside 1825 1825 !> this subroutine 1826 1826 !> … … 1828 1828 !> @date November, 2013 - Initial Version 1829 1829 !> @date November, 2014 1830 !> - use function instead of overload assignment operator 1830 !> - use function instead of overload assignment operator 1831 1831 !> (to avoid memory leak) 1832 1832 ! … … 1856 1856 FUNCTION seg__init(id_index, id_width, id_first, id_last) & 1857 1857 & RESULT(tf_seg) 1858 !------------------------------------------------------------------- 1858 !------------------------------------------------------------------- 1859 1859 !> @brief This function initialise segment structure. 1860 ! 1861 !> @details 1860 ! 1861 !> @details 1862 1862 !> It simply add orthogonal index, and optionnaly width, first 1863 !> and last indices of the segment. 1864 ! 1865 !> @author J.Paul 1866 !> @date November, 2013 - Initial Version 1867 ! 1863 !> and last indices of the segment. 1864 ! 1865 !> @author J.Paul 1866 !> @date November, 2013 - Initial Version 1867 ! 1868 1868 !> @param[in] id_index orthogonal index 1869 !> @param[in] id_width width of the segment 1870 !> @param[in] id_first first indices 1869 !> @param[in] id_width width of the segment 1870 !> @param[in] id_first first indices 1871 1871 !> @param[in] id_last last indices 1872 1872 !> @return segment structure 1873 !------------------------------------------------------------------- 1874 1875 IMPLICIT NONE 1873 !------------------------------------------------------------------- 1874 1875 IMPLICIT NONE 1876 1876 1877 1877 ! Argument … … 1879 1879 INTEGER(i4), INTENT(IN), OPTIONAL :: id_width 1880 1880 INTEGER(i4), INTENT(IN), OPTIONAL :: id_first 1881 INTEGER(i4), INTENT(IN), OPTIONAL :: id_last 1882 1883 ! function 1881 INTEGER(i4), INTENT(IN), OPTIONAL :: id_last 1882 1883 ! function 1884 1884 TYPE(TSEG) :: tf_seg 1885 1885 1886 ! local variable 1887 1888 ! loop indices 1889 !---------------------------------------------------------------- 1886 ! local variable 1887 1888 ! loop indices 1889 !---------------------------------------------------------------- 1890 1890 1891 1891 tf_seg%i_index=id_index … … 1895 1895 IF( PRESENT(id_last ) ) tf_seg%i_last =id_last 1896 1896 1897 END FUNCTION seg__init 1898 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1899 SUBROUTINE seg__clean_unit(td_seg) 1900 !------------------------------------------------------------------- 1901 !> @brief This subroutine clean segment structure. 1902 ! 1903 !> @author J.Paul 1904 !> @date November, 2013 - Initial Version 1905 ! 1897 END FUNCTION seg__init 1898 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1899 SUBROUTINE seg__clean_unit(td_seg) 1900 !------------------------------------------------------------------- 1901 !> @brief This subroutine clean segment structure. 1902 ! 1903 !> @author J.Paul 1904 !> @date November, 2013 - Initial Version 1905 ! 1906 1906 !> @param[inout] td_seg segment structure 1907 !------------------------------------------------------------------- 1908 1909 IMPLICIT NONE 1910 1911 ! Argument 1907 !------------------------------------------------------------------- 1908 1909 IMPLICIT NONE 1910 1911 ! Argument 1912 1912 TYPE(TSEG), INTENT(INOUT) :: td_seg 1913 1913 1914 ! local variable 1914 ! local variable 1915 1915 TYPE(TSEG) :: tl_seg 1916 ! loop indices 1917 !---------------------------------------------------------------- 1916 ! loop indices 1917 !---------------------------------------------------------------- 1918 1918 1919 1919 td_seg=seg__copy(tl_seg) 1920 1920 1921 1921 END SUBROUTINE seg__clean_unit 1922 1922 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1923 SUBROUTINE seg__clean_arr(td_seg) 1924 !------------------------------------------------------------------- 1925 !> @brief This subroutine clean segment structure. 1926 ! 1927 !> @author J.Paul 1928 !> @date November, 2013 - Initial Version 1929 ! 1923 SUBROUTINE seg__clean_arr(td_seg) 1924 !------------------------------------------------------------------- 1925 !> @brief This subroutine clean segment structure. 1926 ! 1927 !> @author J.Paul 1928 !> @date November, 2013 - Initial Version 1929 ! 1930 1930 !> @param[inout] td_seg array of segment structure 1931 !------------------------------------------------------------------- 1932 1933 IMPLICIT NONE 1934 1935 ! Argument 1931 !------------------------------------------------------------------- 1932 1933 IMPLICIT NONE 1934 1935 ! Argument 1936 1936 TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg 1937 1937 1938 ! local variable 1939 ! loop indices 1938 ! local variable 1939 ! loop indices 1940 1940 INTEGER(i4) :: ji 1941 !---------------------------------------------------------------- 1941 !---------------------------------------------------------------- 1942 1942 1943 1943 DO ji=SIZE(td_seg(:)),1,-1 1944 1944 CALL seg__clean(td_seg(ji)) 1945 1945 ENDDO 1946 1947 END SUBROUTINE seg__clean_arr 1946 1947 END SUBROUTINE seg__clean_arr 1948 1948 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1949 1949 END MODULE boundary
Note: See TracChangeset
for help on using the changeset viewer.
