- Timestamp:
- 2018-06-21T11:58:42+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/TOOLS/SIREN/src/boundary.f90
r5037 r9817 26 26 !> - ld_west is logical to force used of north boundary [optional] 27 27 !> - cd_north is string character description of north boundary [optional] 28 !> - cd_south is string character description of north boundary [optional]29 !> - cd_east is string character description of northboundary [optional]30 !> - cd_west is string character description of northboundary [optional]28 !> - cd_south is string character description of south boundary [optional] 29 !> - cd_east is string character description of east boundary [optional] 30 !> - cd_west is string character description of west boundary [optional] 31 31 !> - ld_oneseg is logical to force to use only one segment for each boundary [optional] 32 32 !> … … 36 36 !> to know if boundary is use:<br/> 37 37 !> - tl_bdy\%l_use 38 !> 39 !> to know if boundary come from namelist (cn_north,..):<br/> 40 !> - tl_bdy\%l_nam 38 41 !> 39 42 !> to get the number of segment in boundary:<br/> … … 105 108 ! REVISION HISTORY: 106 109 !> @date November, 2013 - Initial Version 107 !> @date September, 2014 - add boundary description 108 !> @date November, 2014 - Fix memory leaks bug 110 !> @date September, 2014 111 !> - add boundary description 112 !> @date November, 2014 113 !> - Fix memory leaks bug 114 !> @date February, 2015 115 !> - Do not change indices read from namelist 116 !> - Change string character format of boundary read from namelist, 117 !> see boundary__get_info 109 118 !> 110 119 !> @todo add schematic to boundary structure description … … 157 166 PRIVATE :: seg__init ! initialise segment structure 158 167 PRIVATE :: seg__clean ! clean segment structure 159 PRIVATE :: seg__clean_unit ! clean segment structure168 PRIVATE :: seg__clean_unit ! clean one segment structure 160 169 PRIVATE :: seg__clean_arr ! clean array of segment structure 161 170 PRIVATE :: seg__copy ! copy segment structure in another … … 173 182 CHARACTER(LEN=lc) :: c_card = '' !< boundary cardinal 174 183 LOGICAL :: l_use = .FALSE. !< boundary use or not 184 LOGICAL :: l_nam = .FALSE. !< boundary get from namelist 175 185 INTEGER(i4) :: i_nseg = 0 !< number of segment in boundary 176 186 TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !< array of segment structure 177 187 END TYPE TBDY 178 188 189 ! module variable 179 190 INTEGER(i4), PARAMETER :: im_width=10 180 191 … … 223 234 !> @date November, 2013 - Initial Version 224 235 !> @date November, 2014 225 !> 236 !> - use function instead of overload assignment operator 226 237 !> (to avoid memory leak) 227 238 ! … … 260 271 !> @date November, 2013 - Initial Version 261 272 !> @date November, 2014 262 !> 273 !> - use function instead of overload assignment operator 263 274 !> (to avoid memory leak) 264 275 ! … … 353 364 END SUBROUTINE boundary__clean_arr 354 365 !------------------------------------------------------------------- 355 !> @brief This function put cardinal name inside file name.366 !> @brief This function put cardinal name and date inside file name. 356 367 ! 357 368 !> @details 358 ! 369 !> Examples : 370 !> cd_file="boundary.nc" 371 !> cd_card="west" 372 !> id_seg =2 373 !> cd_date=y2015m07d16 374 !> 375 !> function return "boundary_west_2_y2015m07d16.nc" 376 !> 377 !> cd_file="boundary.nc" 378 !> cd_card="west" 379 !> 380 !> function return "boundary_west.nc" 381 !> 359 382 !> @author J.Paul 360 383 !> @date November, 2013 - Initial Version … … 385 408 CHARACTER(LEN=lc) :: cl_date 386 409 CHARACTER(LEN=lc) :: cl_name 410 411 INTEGER(i4) :: il_ind 412 INTEGER(i4) :: il_indend 413 387 414 ! loop indices 388 415 !---------------------------------------------------------------- … … 400 427 cl_suffix=fct_split(TRIM(cl_basename),2,'.') 401 428 429 ! add segment number 402 430 IF( PRESENT(id_seg) )THEN 403 cl_segnum="_"//TRIM(fct_str(id_seg)) //"_"431 cl_segnum="_"//TRIM(fct_str(id_seg)) 404 432 ELSE 405 433 cl_segnum="" 406 434 ENDIF 407 435 436 ! add date 408 437 IF( PRESENT(cd_date) )THEN 409 cl_date= TRIM(ADJUSTL(cd_date))438 cl_date="_"//TRIM(ADJUSTL(cd_date)) 410 439 ELSE 411 440 cl_date="" 412 441 ENDIF 413 442 414 cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 415 & TRIM(cl_date)//"."//TRIM(cl_suffix) 443 ! special case for obcdta 444 il_ind=INDEX(cl_base,'_obcdta_') 445 IF( il_ind/=0 )THEN 446 il_ind=il_ind-1+8 447 il_indend=LEN_TRIM(cl_base) 448 449 cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//& 450 & TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//& 451 & TRIM(cl_date)//"."//TRIM(cl_suffix) 452 ELSE 453 cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 454 & TRIM(cl_date)//"."//TRIM(cl_suffix) 455 ENDIF 416 456 417 457 boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) … … 442 482 !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 443 483 !> 444 !> @note boundaries are compute on T point. change will be done to get data445 !> on other point when need be.484 !> @note Boundaries are compute on T point, but expressed on U,V point. 485 !> change will be done to get data on other point when need be. 446 486 !> 447 487 !> @author J.Paul … … 581 621 582 622 ! get namelist information 583 tl_tmp=boundary__get_info(cl_card(jk)) 623 tl_tmp=boundary__get_info(cl_card(jk),jk) 624 625 ! get segments indices 584 626 DO ji=1,tl_tmp%i_nseg 585 627 CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji)) 586 628 ENDDO 629 ! indices from namelist or not 630 tl_bdy(jk)%l_nam=tl_tmp%l_nam 631 587 632 CALL boundary_clean(tl_tmp) 588 633 … … 642 687 !> @return boundary structure 643 688 !------------------------------------------------------------------- 644 FUNCTION boundary__init( cd_card, ld_use, td_seg )689 FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg ) 645 690 IMPLICIT NONE 646 691 ! Argument 647 692 CHARACTER(LEN=*), INTENT(IN) :: cd_card 648 693 LOGICAL , INTENT(IN), OPTIONAL :: ld_use 694 LOGICAL , INTENT(IN), OPTIONAL :: ld_nam 649 695 TYPE(TSEG) , INTENT(IN), OPTIONAL :: td_seg 650 696 … … 664 710 boundary__init%l_use=.TRUE. 665 711 IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use 712 713 boundary__init%l_nam=.FALSE. 714 IF( PRESENT(ld_nam) ) boundary__init%l_nam=ld_nam 666 715 667 716 IF( PRESENT(td_seg) )THEN … … 778 827 !> orthogonal index, first and last indices, of each segment. 779 828 !> And also the width of all segments of this boundary. 780 !> cn_north='index1,first1 ,last1(width)|index2,first2,last2'829 !> cn_north='index1,first1:last1(width)|index2,first2:last2' 781 830 !> 782 831 !> @author J.Paul 783 832 !> @date November, 2013 - Initial Version 833 !> @date february, 2015 834 !> - do not change indices read from namelist 835 !> - change format cn_north 784 836 ! 785 837 !> @param[in] cd_card boundary description 838 !> @param[in] id_jcard boundary index 786 839 !> @return boundary structure 787 840 !------------------------------------------------------------------- 788 FUNCTION boundary__get_info(cd_card )841 FUNCTION boundary__get_info(cd_card, id_jcard) 789 842 IMPLICIT NONE 790 843 ! Argument 791 844 CHARACTER(LEN=lc), INTENT(IN) :: cd_card 845 INTEGER(i4) , INTENT(IN) :: id_jcard 792 846 793 847 ! function … … 802 856 CHARACTER(LEN=lc) :: cl_index 803 857 CHARACTER(LEN=lc) :: cl_width 858 CHARACTER(LEN=lc) :: cl_tmp 804 859 CHARACTER(LEN=lc) :: cl_first 805 860 CHARACTER(LEN=lc) :: cl_last … … 818 873 ! width should be the same for all segment of one boundary 819 874 IF( TRIM(cl_seg) /= '' )THEN 875 876 ! initialise boundary 877 ! temporaty boundary, so it doesn't matter which caridnal is used 878 boundary__get_info=boundary__init('north',ld_nam=.TRUE.) 879 820 880 il_ind1=SCAN(fct_lower(cl_seg),'(') 821 881 IF( il_ind1 /=0 )THEN … … 831 891 ENDIF 832 892 ENDIF 893 833 894 ENDIF 834 895 … … 839 900 il_ind1=SCAN(fct_lower(cl_index),'(') 840 901 IF( il_ind1 /=0 )THEN 841 il_ind2=SCAN(fct_lower(cl_index),' (')902 il_ind2=SCAN(fct_lower(cl_index),')') 842 903 IF( il_ind2 /=0 )THEN 843 904 cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:)) … … 848 909 ENDIF 849 910 850 cl_first=fct_split(cl_seg,2,',') 911 912 cl_tmp=fct_split(cl_seg,2,',') 913 914 915 cl_first=fct_split(cl_tmp,1,':') 851 916 ! remove potential width information 852 917 il_ind1=SCAN(fct_lower(cl_first),'(') 853 918 IF( il_ind1 /=0 )THEN 854 il_ind2=SCAN(fct_lower(cl_first),' (')919 il_ind2=SCAN(fct_lower(cl_first),')') 855 920 IF( il_ind2 /=0 )THEN 856 921 cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:)) … … 861 926 ENDIF 862 927 863 cl_last =fct_split(cl_ seg,3,',')928 cl_last =fct_split(cl_tmp,2,':') 864 929 ! remove potential width information 865 930 il_ind1=SCAN(fct_lower(cl_last),'(') 866 931 IF( il_ind1 /=0 )THEN 867 il_ind2=SCAN(fct_lower(cl_last),' (')932 il_ind2=SCAN(fct_lower(cl_last),')') 868 933 IF( il_ind2 /=0 )THEN 869 934 cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:)) … … 879 944 IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first 880 945 IF( TRIM(cl_last) /= '' ) READ(cl_last ,*) tl_seg%i_last 946 947 ! index expressed on U,V point, move on T point. 948 SELECT CASE(id_jcard) 949 CASE(jp_north, jp_east) 950 tl_seg%i_index=tl_seg%i_index+1 951 END SELECT 881 952 882 953 IF( (tl_seg%i_first == 0 .AND. tl_seg%i_last == 0) .OR. & … … 943 1014 944 1015 DO jk=1,ip_ncard 945 IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)% i_nseg > 1)THEN1016 IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN 946 1017 ! nothing to be done 947 1018 ELSE … … 1480 1551 il_max(jp_east )=td_var%t_dim(2)%i_len 1481 1552 il_max(jp_west )=td_var%t_dim(2)%i_len 1482 1553 1483 1554 il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 1484 1555 il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost … … 1515 1586 ENDIF 1516 1587 ENDDO 1517 1588 1518 1589 CALL boundary_check_corner(td_bdy, td_var) 1519 1590 … … 1650 1721 !> @date November, 2013 - Initial Version 1651 1722 !> @date November, 2014 1652 !> 1723 !> - use function instead of overload assignment operator 1653 1724 !> (to avoid memory leak) 1654 1725 ! … … 1687 1758 !> @date November, 2013 - Initial Version 1688 1759 !> @date November, 2014 1689 !> 1760 !> - use function instead of overload assignment operator 1690 1761 !> (to avoid memory leak) 1691 1762 !
Note: See TracChangeset
for help on using the changeset viewer.