- Timestamp:
- 2016-04-07T16:32:24+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90
r5037 r6440 165 165 !> to get processors to be used:<br/> 166 166 !> @code 167 !> CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim,&168 !> & id_jmin, id_jmax , id_jdim)167 !> CALL mpp_get_use( td_mpp, id_imin, id_imax, & 168 !> & id_jmin, id_jmax ) 169 169 !> @endcode 170 170 !> - id_imin 171 171 !> - id_imax 172 !> - id_idim173 172 !> - id_jmin 174 173 !> - id_jmax 175 !> - id_jdim176 174 !> 177 175 !> to get sub domains which form global domain contour:<br/> … … 198 196 ! REVISION HISTORY: 199 197 !> @date November, 2013 - Initial Version 200 !> @date November, 2014 - Fix memory leaks bug 198 !> @date November, 2014 199 !> - Fix memory leaks bug 200 !> @date October, 2015 201 !> - improve way to compute domain layout 202 !> @date January, 2016 203 !> - allow to print layout file (use lm_layout, hard coded) 204 !> - add mpp__compute_halo and mpp__read_halo 201 205 ! 202 206 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 216 220 217 221 ! type and variable 218 PUBLIC :: TMPP !< mpp structure 222 PUBLIC :: TMPP !< mpp structure 223 PRIVATE :: TLAY !< domain layout structure 219 224 220 225 ! function and subroutine … … 241 246 PUBLIC :: mpp_get_proc_size !< get processor domain size 242 247 243 PRIVATE :: mpp__add_proc ! add one proc strucutre in mpp structure 248 PRIVATE :: mpp__add_proc ! add proc strucutre in mpp structure 249 PRIVATE :: mpp__add_proc_unit ! add one proc strucutre in mpp structure 244 250 PRIVATE :: mpp__del_proc ! delete one proc strucutre in mpp structure 245 251 PRIVATE :: mpp__del_proc_id ! delete one proc strucutre in mpp structure, given procesor id 246 252 PRIVATE :: mpp__del_proc_str ! delete one proc strucutre in mpp structure, given procesor file structure 247 253 PRIVATE :: mpp__move_proc ! overwrite proc strucutre in mpp structure 248 PRIVATE :: mpp__compute ! compute domain decomposition 249 PRIVATE :: mpp__del_land ! remove land sub domain from domain decomposition 254 PRIVATE :: mpp__create_layout ! create mpp structure using domain layout 250 255 PRIVATE :: mpp__optimiz ! compute optimum domain decomposition 251 PRIVATE :: mpp__land_proc ! check if processor is a land processor252 256 PRIVATE :: mpp__check_dim ! check mpp structure dimension with proc or variable dimension 253 257 PRIVATE :: mpp__check_proc_dim ! check if processor and mpp structure use same dimension … … 269 273 PRIVATE :: mpp__clean_unit ! clean mpp strcuture 270 274 PRIVATE :: mpp__clean_arr ! clean array of mpp strcuture 275 PRIVATE :: mpp__compute_halo ! compute subdomain indices defined with halo 276 PRIVATE :: mpp__read_halo ! read subdomain indices defined with halo 277 278 PRIVATE :: layout__init ! initialise domain layout structure 279 PRIVATE :: layout__copy ! clean domain layout structure 280 PRIVATE :: layout__clean ! copy domain layout structure 271 281 272 282 TYPE TMPP !< mpp structure 273 274 283 ! general 275 284 CHARACTER(LEN=lc) :: c_name = '' !< base name … … 286 295 287 296 CHARACTER(LEN=lc) :: c_type = '' !< type of the files (cdf, cdf4, dimg) 288 CHARACTER(LEN=lc) :: c_dom = '' !< type of domain (full, overlap, nooverlap)297 CHARACTER(LEN=lc) :: c_dom = '' !< type of domain (full, noextra, nooverlap) 289 298 290 299 INTEGER(i4) :: i_ndim = 0 !< number of dimensions used in mpp … … 292 301 293 302 TYPE(TFILE), DIMENSION(:), POINTER :: t_proc => NULL() !< files/processors composing mpp 294 295 303 END TYPE 304 305 TYPE TLAY !< domain layout structure 306 INTEGER(i4) :: i_niproc = 0 !< number of processors following i 307 INTEGER(i4) :: i_njproc = 0 !< number of processors following j 308 INTEGER(i4) :: i_nland = 0 !< number of land processors 309 INTEGER(i4) :: i_nsea = 0 !< number of sea processors 310 INTEGER(i4) :: i_mean = 0 !< mean sea point per proc 311 INTEGER(i4) :: i_min = 0 !< min sea point per proc 312 INTEGER(i4) :: i_max = 0 !< max sea point per proc 313 INTEGER(i4), DIMENSION(:,:), POINTER :: i_msk => NULL() !< sea/land processor mask 314 INTEGER(i4), DIMENSION(:,:), POINTER :: i_impp => NULL() !< i-indexes for mpp-subdomain left bottom 315 INTEGER(i4), DIMENSION(:,:), POINTER :: i_jmpp => NULL() !< j-indexes for mpp-subdomain left bottom 316 INTEGER(i4), DIMENSION(:,:), POINTER :: i_lci => NULL() !< i-dimensions of subdomain 317 INTEGER(i4), DIMENSION(:,:), POINTER :: i_lcj => NULL() !< j-dimensions of subdomain 318 END TYPE 319 320 ! module variable 321 INTEGER(i4) :: im_iumout = 44 322 LOGICAL :: lm_layout =.FALSE. 296 323 297 324 INTERFACE mpp_get_use 298 325 MODULE PROCEDURE mpp__get_use_unit 299 326 END INTERFACE mpp_get_use 327 328 INTERFACE mpp__add_proc 329 MODULE PROCEDURE mpp__add_proc_unit 330 END INTERFACE mpp__add_proc 300 331 301 332 INTERFACE mpp_clean … … 352 383 !> 353 384 !> @author J.Paul 354 !> - November, 2013- Initial Version385 !> @date November, 2013 - Initial Version 355 386 !> @date November, 2014 356 387 !> - use function instead of overload assignment operator … … 379 410 ! copy mpp variable 380 411 mpp__copy_unit%c_name = TRIM(td_mpp%c_name) 412 mpp__copy_unit%i_id = td_mpp%i_id 381 413 mpp__copy_unit%i_niproc = td_mpp%i_niproc 382 414 mpp__copy_unit%i_njproc = td_mpp%i_njproc … … 425 457 !> 426 458 !> @author J.Paul 427 !> - November, 2013- Initial Version459 !> @date November, 2013 - Initial Version 428 460 !> @date November, 2014 429 461 !> - use function instead of overload assignment operator … … 454 486 ! 455 487 !> @author J.Paul 456 !> - Nov, 2013- Initial Version488 !> @date November, 2013 - Initial Version 457 489 ! 458 490 !> @param[in] td_mpp mpp structure … … 495 527 ! print dimension 496 528 IF( td_mpp%i_ndim /= 0 )THEN 497 WRITE(*,'(/a)') " Filedimension"529 WRITE(*,'(/a)') " MPP dimension" 498 530 DO ji=1,ip_maxdim 499 531 IF( td_mpp%t_dim(ji)%l_use )THEN … … 561 593 ALLOCATE( il_lci(td_mpp%i_niproc,td_mpp%i_njproc) ) 562 594 ALLOCATE( il_lcj(td_mpp%i_niproc,td_mpp%i_njproc) ) 595 il_proc(:,:)=-1 596 il_lci(:,:) =-1 597 il_lcj(:,:) =-1 563 598 564 599 DO jk=1,td_mpp%i_nproc 565 600 ji=td_mpp%t_proc(jk)%i_iind 566 601 jj=td_mpp%t_proc(jk)%i_jind 567 il_proc(ji,jj)=jk 602 il_proc(ji,jj)=jk-1 568 603 il_lci(ji,jj)=td_mpp%t_proc(jk)%i_lci 569 604 il_lcj(ji,jj)=td_mpp%t_proc(jk)%i_lcj … … 595 630 ENDIF 596 631 597 598 632 9400 FORMAT(' ***',20('*************',a3)) 599 633 9403 FORMAT(' * ',20(' * ',a3)) … … 616 650 !> @author J.Paul 617 651 !> @date November, 2013 - Initial version 652 !> @date September, 2015 653 !> - allow to define dimension with array of dimension structure 654 !> @date January, 2016 655 !> - use RESULT to rename output 656 !> - mismatch with "halo" indices 618 657 ! 619 658 !> @param[in] cd_file file name of one file composing mpp domain … … 628 667 !> @param[in] id_perio NEMO periodicity index 629 668 !> @param[in] id_pivot NEMO pivot point index F(0),T(1) 669 !> @param[in] td_dim array of dimension structure 630 670 !> @return mpp structure 631 671 !------------------------------------------------------------------- 632 TYPE(TMPP) FUNCTION mpp__init_mask(cd_file, id_mask, & 633 & id_niproc, id_njproc, id_nproc,& 634 & id_preci, id_precj, & 635 cd_type, id_ew, id_perio, id_pivot) 672 FUNCTION mpp__init_mask(cd_file, id_mask, & 673 & id_niproc, id_njproc, id_nproc, & 674 & id_preci, id_precj, & 675 & cd_type, id_ew, id_perio, id_pivot, & 676 & td_dim ) & 677 & RESULT(td_mpp) 636 678 IMPLICIT NONE 637 679 ! Argument 638 CHARACTER(LEN=*), INTENT(IN) :: cd_file 639 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 640 INTEGER(i4), INTENT(IN), OPTIONAL :: id_niproc 641 INTEGER(i4), INTENT(IN), OPTIONAL :: id_njproc 642 INTEGER(i4), INTENT(IN), OPTIONAL :: id_nproc 643 INTEGER(i4), INTENT(IN), OPTIONAL :: id_preci 644 INTEGER(i4), INTENT(IN), OPTIONAL :: id_precj 645 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type 646 INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew 647 INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio 648 INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot 680 CHARACTER(LEN=*), INTENT(IN) :: cd_file 681 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 682 INTEGER(i4), INTENT(IN), OPTIONAL :: id_niproc 683 INTEGER(i4), INTENT(IN), OPTIONAL :: id_njproc 684 INTEGER(i4), INTENT(IN), OPTIONAL :: id_nproc 685 INTEGER(i4), INTENT(IN), OPTIONAL :: id_preci 686 INTEGER(i4), INTENT(IN), OPTIONAL :: id_precj 687 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type 688 INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew 689 INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio 690 INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot 691 TYPE(TDIM) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: td_dim 692 693 ! function 694 TYPE(TMPP) :: td_mpp 649 695 650 696 ! local variable 651 CHARACTER(LEN=lc) :: cl_type 652 653 INTEGER(i4) , DIMENSION(2) :: il_shape 654 655 TYPE(TDIM) :: tl_dim 656 657 TYPE(TATT) :: tl_att 697 CHARACTER(LEN=lc) :: cl_type 698 699 INTEGER(i4) , DIMENSION(2) :: il_shape 700 701 TYPE(TDIM) :: tl_dim 702 703 TYPE(TATT) :: tl_att 704 705 TYPE(TLAY) :: tl_lay 706 658 707 ! loop indices 659 708 INTEGER(i4) :: ji … … 661 710 662 711 ! clean mpp 663 CALL mpp_clean( mpp__init_mask)712 CALL mpp_clean(td_mpp) 664 713 665 714 ! check type … … 670 719 SELECT CASE(TRIM(cd_type)) 671 720 CASE('cdf') 672 mpp__init_mask%c_type='cdf'721 td_mpp%c_type='cdf' 673 722 CASE('dimg') 674 mpp__init_mask%c_type='dimg'723 td_mpp%c_type='dimg' 675 724 CASE DEFAULT 676 725 CALL logger_warn( "MPP INIT: type "//TRIM(cd_type)//& 677 726 & " unknown. type dimg will be used for mpp "//& 678 & TRIM( mpp__init_mask%c_name) )679 mpp__init_mask%c_type='dimg'727 & TRIM(td_mpp%c_name) ) 728 td_mpp%c_type='dimg' 680 729 END SELECT 681 730 ELSE 682 mpp__init_mask%c_type=TRIM(file_get_type(cd_file))731 td_mpp%c_type=TRIM(file_get_type(cd_file)) 683 732 ENDIF 684 733 685 734 ! get mpp name 686 mpp__init_mask%c_name=TRIM(file_rename(cd_file))735 td_mpp%c_name=TRIM(file_rename(cd_file)) 687 736 688 737 ! get global domain dimension 689 738 il_shape(:)=SHAPE(id_mask) 690 739 691 tl_dim=dim_init('X',il_shape(1)) 692 CALL mpp_add_dim(mpp__init_mask, tl_dim) 693 694 tl_dim=dim_init('Y',il_shape(2)) 695 CALL mpp_add_dim(mpp__init_mask, tl_dim) 696 697 ! clean 698 CALL dim_clean(tl_dim) 699 700 IF( ( PRESENT(id_niproc) .AND. (.NOT. PRESENT(id_niproc))) .OR. & 740 IF( PRESENT(td_dim) )THEN 741 DO ji=1,ip_maxdim 742 IF( td_dim(ji)%l_use )THEN 743 CALL mpp_add_dim(td_mpp, td_dim(ji)) 744 ENDIF 745 ENDDO 746 ELSE 747 tl_dim=dim_init('X',il_shape(1)) 748 CALL mpp_add_dim(td_mpp, tl_dim) 749 750 tl_dim=dim_init('Y',il_shape(2)) 751 CALL mpp_add_dim(td_mpp, tl_dim) 752 753 ! clean 754 CALL dim_clean(tl_dim) 755 ENDIF 756 757 IF( ( PRESENT(id_niproc) .AND. (.NOT. PRESENT(id_njproc))) .OR. & 701 758 ((.NOT. PRESENT(id_niproc)) .AND. PRESENT(id_njproc) ) )THEN 702 759 CALL logger_warn( "MPP INIT: number of processors following I and J "//& … … 704 761 ELSE 705 762 ! get number of processors following I and J 706 IF( PRESENT(id_niproc) ) mpp__init_mask%i_niproc=id_niproc707 IF( PRESENT(id_njproc) ) mpp__init_mask%i_njproc=id_njproc763 IF( PRESENT(id_niproc) ) td_mpp%i_niproc=id_niproc 764 IF( PRESENT(id_njproc) ) td_mpp%i_njproc=id_njproc 708 765 ENDIF 709 766 710 767 ! get maximum number of processors to be used 711 IF( PRESENT(id_nproc) ) mpp__init_mask%i_nproc = id_nproc768 IF( PRESENT(id_nproc) ) td_mpp%i_nproc = id_nproc 712 769 713 770 ! get overlap region length 714 IF( PRESENT(id_preci) ) mpp__init_mask%i_preci= id_preci715 IF( PRESENT(id_precj) ) mpp__init_mask%i_precj= id_precj771 IF( PRESENT(id_preci) ) td_mpp%i_preci= id_preci 772 IF( PRESENT(id_precj) ) td_mpp%i_precj= id_precj 716 773 717 774 ! east-west overlap 718 IF( PRESENT(id_ew) ) mpp__init_mask%i_ew= id_ew775 IF( PRESENT(id_ew) ) td_mpp%i_ew= id_ew 719 776 ! NEMO periodicity 720 IF( PRESENT(id_perio) ) mpp__init_mask%i_perio= id_perio721 IF( PRESENT(id_pivot) ) mpp__init_mask%i_pivot= id_pivot722 723 IF( mpp__init_mask%i_nproc /= 0 .AND. &724 & mpp__init_mask%i_niproc /= 0 .AND. &725 & mpp__init_mask%i_njproc /= 0 .AND. &726 & mpp__init_mask%i_nproc > &727 & mpp__init_mask%i_niproc * mpp__init_mask%i_njproc )THEN777 IF( PRESENT(id_perio) ) td_mpp%i_perio= id_perio 778 IF( PRESENT(id_pivot) ) td_mpp%i_pivot= id_pivot 779 780 IF( td_mpp%i_nproc /= 0 .AND. & 781 & td_mpp%i_niproc /= 0 .AND. & 782 & td_mpp%i_njproc /= 0 .AND. & 783 & td_mpp%i_nproc > & 784 & td_mpp%i_niproc * td_mpp%i_njproc )THEN 728 785 729 786 CALL logger_error("MPP INIT: invalid domain decomposition ") 730 787 CALL logger_debug("MPP INIT: "// & 731 & TRIM(fct_str( mpp__init_mask%i_nproc))//" > "//&732 & TRIM(fct_str( mpp__init_mask%i_niproc))//" x "//&733 & TRIM(fct_str( mpp__init_mask%i_njproc)) )788 & TRIM(fct_str(td_mpp%i_nproc))//" > "//& 789 & TRIM(fct_str(td_mpp%i_niproc))//" x "//& 790 & TRIM(fct_str(td_mpp%i_njproc)) ) 734 791 735 792 ELSE 736 737 IF( mpp__init_mask%i_niproc /= 0 .AND. & 738 & mpp__init_mask%i_njproc /= 0 )THEN 739 ! compute domain decomposition 740 CALL mpp__compute( mpp__init_mask ) 741 ! remove land sub domain 742 CALL mpp__del_land( mpp__init_mask, id_mask ) 743 ELSEIF( mpp__init_mask%i_nproc /= 0 )THEN 793 IF( lm_layout )THEN 794 OPEN(im_iumout,FILE='processor.layout') 795 WRITE(im_iumout,*) 796 WRITE(im_iumout,*) ' optimisation de la partition' 797 WRITE(im_iumout,*) ' ----------------------------' 798 WRITE(im_iumout,*) 799 ENDIF 800 801 IF( td_mpp%i_niproc /= 0 .AND. & 802 & td_mpp%i_njproc /= 0 )THEN 803 ! compute domain layout 804 tl_lay=layout__init( td_mpp, id_mask, td_mpp%i_niproc, td_mpp%i_njproc ) 805 ! create mpp domain layout 806 CALL mpp__create_layout( td_mpp, tl_lay ) 807 ! clean 808 CALL layout__clean( tl_lay ) 809 ELSEIF( td_mpp%i_nproc /= 0 )THEN 744 810 ! optimiz 745 CALL mpp__optimiz( mpp__init_mask, id_mask)811 CALL mpp__optimiz( td_mpp, id_mask, td_mpp%i_nproc ) 746 812 747 813 ELSE 748 814 CALL logger_warn("MPP INIT: number of processor to be used "//& 749 815 & "not specify. force to one.") 750 mpp__init_mask%i_nproc = 1751 816 ! optimiz 752 CALL mpp__optimiz( mpp__init_mask, id_mask)817 CALL mpp__optimiz( td_mpp, id_mask, 1 ) 753 818 ENDIF 819 820 754 821 CALL logger_info("MPP INIT: domain decoposition : "//& 755 & 'niproc('//TRIM(fct_str( mpp__init_mask%i_niproc))//') * '//&756 & 'njproc('//TRIM(fct_str( mpp__init_mask%i_njproc))//') = '//&757 & 'nproc('//TRIM(fct_str( mpp__init_mask%i_nproc))//')' )822 & 'niproc('//TRIM(fct_str(td_mpp%i_niproc))//') * '//& 823 & 'njproc('//TRIM(fct_str(td_mpp%i_njproc))//') = '//& 824 & 'nproc('//TRIM(fct_str(td_mpp%i_nproc))//')' ) 758 825 759 826 ! get domain type 760 CALL mpp_get_dom( mpp__init_mask)761 762 DO ji=1, mpp__init_mask%i_nproc827 CALL mpp_get_dom( td_mpp ) 828 829 DO ji=1,td_mpp%i_nproc 763 830 764 831 ! get processor size 765 il_shape(:)=mpp_get_proc_size( mpp__init_mask, ji )832 il_shape(:)=mpp_get_proc_size( td_mpp, ji ) 766 833 767 834 tl_dim=dim_init('X',il_shape(1)) 768 CALL file_move_dim( mpp__init_mask%t_proc(ji), tl_dim)835 CALL file_move_dim(td_mpp%t_proc(ji), tl_dim) 769 836 770 837 tl_dim=dim_init('Y',il_shape(2)) 771 CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim) 772 838 CALL file_move_dim(td_mpp%t_proc(ji), tl_dim) 839 840 IF( PRESENT(td_dim) )THEN 841 IF( td_dim(jp_K)%l_use )THEN 842 CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_K)) 843 ENDIF 844 IF( td_dim(jp_L)%l_use )THEN 845 CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_L)) 846 ENDIF 847 ENDIF 773 848 ! add type 774 mpp__init_mask%t_proc(ji)%c_type=TRIM(mpp__init_mask%c_type)849 td_mpp%t_proc(ji)%c_type=TRIM(td_mpp%c_type) 775 850 776 851 ! clean 777 852 CALL dim_clean(tl_dim) 853 778 854 ENDDO 779 855 780 856 ! add global attribute 781 tl_att=att_init("DOMAIN_number_total",mpp__init_mask%i_nproc) 782 CALL mpp_add_att(mpp__init_mask, tl_att) 783 784 tl_att=att_init("DOMAIN_I_number_total",mpp__init_mask%i_niproc) 785 CALL mpp_add_att(mpp__init_mask, tl_att) 786 787 tl_att=att_init("DOMAIN_J_number_total",mpp__init_mask%i_njproc) 788 CALL mpp_add_att(mpp__init_mask, tl_att) 789 790 tl_att=att_init("DOMAIN_size_global",mpp__init_mask%t_dim(1:2)%i_len) 791 CALL mpp_add_att(mpp__init_mask, tl_att) 792 793 tl_att=att_init( "DOMAIN_I_position_first", & 794 & mpp__init_mask%t_proc(:)%i_impp ) 795 CALL mpp_add_att(mpp__init_mask, tl_att) 796 797 tl_att=att_init( "DOMAIN_J_position_first", & 798 & mpp__init_mask%t_proc(:)%i_jmpp ) 799 CALL mpp_add_att(mpp__init_mask, tl_att) 800 801 tl_att=att_init( "DOMAIN_I_position_last", & 802 & mpp__init_mask%t_proc(:)%i_lci ) 803 CALL mpp_add_att(mpp__init_mask, tl_att) 804 805 tl_att=att_init( "DOMAIN_J_position_last", & 806 & mpp__init_mask%t_proc(:)%i_lcj ) 807 CALL mpp_add_att(mpp__init_mask, tl_att) 808 809 tl_att=att_init( "DOMAIN_I_halo_size_start", & 810 & mpp__init_mask%t_proc(:)%i_ldi ) 811 CALL mpp_add_att(mpp__init_mask, tl_att) 812 813 tl_att=att_init( "DOMAIN_J_halo_size_start", & 814 & mpp__init_mask%t_proc(:)%i_ldj ) 815 CALL mpp_add_att(mpp__init_mask, tl_att) 816 817 tl_att=att_init( "DOMAIN_I_halo_size_end", & 818 & mpp__init_mask%t_proc(:)%i_lei ) 819 CALL mpp_add_att(mpp__init_mask, tl_att) 820 821 tl_att=att_init( "DOMAIN_J_halo_size_end", & 822 & mpp__init_mask%t_proc(:)%i_lej ) 823 CALL mpp_add_att(mpp__init_mask, tl_att) 824 825 ! clean 826 CALL att_clean(tl_att) 857 tl_att=att_init("DOMAIN_number_total",td_mpp%i_nproc) 858 CALL mpp_add_att(td_mpp, tl_att) 859 860 tl_att=att_init("DOMAIN_LOCAL",TRIM(td_mpp%c_dom)) 861 CALL mpp_add_att(td_mpp, tl_att) 862 863 tl_att=att_init("DOMAIN_I_number_total",td_mpp%i_niproc) 864 CALL mpp_add_att(td_mpp, tl_att) 865 866 tl_att=att_init("DOMAIN_J_number_total",td_mpp%i_njproc) 867 CALL mpp_add_att(td_mpp, tl_att) 868 869 tl_att=att_init("DOMAIN_size_global",td_mpp%t_dim(1:2)%i_len) 870 CALL mpp_add_att(td_mpp, tl_att) 871 872 CALL mpp__compute_halo(td_mpp) 827 873 ENDIF 828 874 … … 881 927 il_mask(:,:,:)=var_get_mask(td_var) 882 928 929 CALL logger_info("MPP INIT: mask compute from variable "//& 930 & TRIM(td_var%c_name)) 883 931 mpp__init_var=mpp_init( cd_file, il_mask(:,:,1), & 884 932 & id_niproc, id_njproc, id_nproc,& … … 908 956 !> - DOMAIN_halo_size_end 909 957 !> or the file is assume to be no mpp file. 910 !> 911 !> 912 !> 913 !> @ author J.Paul914 !> - November, 2013- Initial Version958 !> 959 !> @author J.Paul 960 !> @date November, 2013 - Initial Version 961 !> @date January, 2016 962 !> - mismatch with "halo" indices, use mpp__compute_halo 915 963 ! 916 964 !> @param[in] td_file file strcuture … … 930 978 931 979 ! local variable 932 TYPE(TMPP) :: tl_mpp 933 934 TYPE(TFILE) :: tl_file 935 936 TYPE(TDIM) :: tl_dim 937 938 TYPE(TATT) :: tl_att 939 940 INTEGER(i4) :: il_nproc 941 INTEGER(i4) :: il_attid 942 980 INTEGER(i4) :: il_nproc 981 INTEGER(i4) :: il_attid 943 982 INTEGER(i4), DIMENSION(2) :: il_shape 983 984 TYPE(TDIM) :: tl_dim 985 986 TYPE(TATT) :: tl_att 987 988 TYPE(TFILE) :: tl_file 989 990 TYPE(TMPP) :: tl_mpp 991 944 992 ! loop indices 945 993 INTEGER(i4) :: ji … … 957 1005 ! open file 958 1006 CALL iom_open(tl_file) 959 960 1007 ! read first file domain decomposition 961 1008 tl_mpp=mpp__init_file_cdf(tl_file) … … 1028 1075 ! create some attributes for domain decomposition (use with dimg file) 1029 1076 tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc ) 1030 CALL mpp_add_att(mpp__init_file, tl_att) 1031 1032 tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 1033 CALL mpp_add_att(mpp__init_file, tl_att) 1034 1035 tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 1036 CALL mpp_add_att(mpp__init_file, tl_att) 1037 1038 tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 1039 CALL mpp_add_att(mpp__init_file, tl_att) 1040 1041 tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 1042 CALL mpp_add_att(mpp__init_file, tl_att) 1043 1044 tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 1045 CALL mpp_add_att(mpp__init_file, tl_att) 1046 1047 tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 1048 CALL mpp_add_att(mpp__init_file, tl_att) 1049 1050 tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 1051 CALL mpp_add_att(mpp__init_file, tl_att) 1052 1053 tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 1054 CALL mpp_add_att(mpp__init_file, tl_att) 1055 1077 CALL mpp_move_att(mpp__init_file, tl_att) 1078 1079 CALL mpp__compute_halo(mpp__init_file) 1080 1056 1081 ! clean 1057 1082 CALL mpp_clean(tl_mpp) … … 1122 1147 CALL file_clean(tl_file) 1123 1148 1124 CALL logger_debug("MPP INIT READ: fin init_read ")1125 1149 END FUNCTION mpp__init_file 1126 1150 !------------------------------------------------------------------- … … 1131 1155 ! 1132 1156 !> @author J.Paul 1133 !> - November, 2013- Initial Version 1157 !> @date November, 2013 - Initial Version 1158 !> @date July, 2015 1159 !> - add only use dimension in MPP structure 1160 !> @date January, 2016 1161 !> - mismatch with "halo" indices, use mpp__read_halo 1134 1162 !> 1135 1163 !> @param[in] td_file file strcuture … … 1163 1191 IF( td_file%i_id == 0 )THEN 1164 1192 CALL logger_info(" id "//TRIM(fct_str(td_file%i_id))) 1165 CALL logger_error("MPP INIT READ: netcdf file "// TRIM(td_file%c_name)//&1166 &" not opened")1193 CALL logger_error("MPP INIT READ: netcdf file "//& 1194 & TRIM(td_file%c_name)//" not opened") 1167 1195 ELSE 1168 1196 … … 1191 1219 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1192 1220 ENDIF 1193 tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 1194 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1195 1196 tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 1197 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1221 1222 IF( td_file%t_dim(3)%l_use )THEN 1223 tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 1224 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1225 ENDIF 1226 1227 IF( td_file%t_dim(4)%l_use )THEN 1228 tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 1229 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1230 ENDIF 1198 1231 1199 1232 ! initialise file/processor … … 1214 1247 tl_proc%t_dim(:)=dim_copy(td_file%t_dim(:)) 1215 1248 1216 ! DOMAIN_position_first 1217 il_attid = 0 1218 IF( ASSOCIATED(td_file%t_att) )THEN 1219 il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" ) 1220 ENDIF 1221 IF( il_attid /= 0 )THEN 1222 tl_proc%i_impp = INT(td_file%t_att(il_attid)%d_value(1)) 1223 tl_proc%i_jmpp = INT(td_file%t_att(il_attid)%d_value(2)) 1224 ELSE 1225 tl_proc%i_impp = 1 1226 tl_proc%i_jmpp = 1 1227 ENDIF 1228 1229 ! DOMAIN_position_last 1230 il_attid = 0 1231 IF( ASSOCIATED(td_file%t_att) )THEN 1232 il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" ) 1233 ENDIF 1234 IF( il_attid /= 0 )THEN 1235 tl_proc%i_lci = INT(td_file%t_att(il_attid)%d_value(1)) + tl_proc%i_impp 1236 tl_proc%i_lcj = INT(td_file%t_att(il_attid)%d_value(2)) + tl_proc%i_jmpp 1237 ELSE 1238 tl_proc%i_lci = mpp__init_file_cdf%t_dim(1)%i_len 1239 tl_proc%i_lcj = mpp__init_file_cdf%t_dim(2)%i_len 1240 ENDIF 1241 1242 ! DOMAIN_halo_size_start 1243 il_attid = 0 1244 IF( ASSOCIATED(td_file%t_att) )THEN 1245 il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" ) 1246 ENDIF 1247 IF( il_attid /= 0 )THEN 1248 tl_proc%i_ldi = INT(td_file%t_att(il_attid)%d_value(1)) 1249 tl_proc%i_ldj = INT(td_file%t_att(il_attid)%d_value(2)) 1250 ELSE 1251 tl_proc%i_ldi = 1 1252 tl_proc%i_ldj = 1 1253 ENDIF 1254 1255 ! DOMAIN_halo_size_end 1256 il_attid = 0 1257 IF( ASSOCIATED(td_file%t_att) )THEN 1258 il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" ) 1259 ENDIF 1260 IF( il_attid /= 0 )THEN 1261 tl_proc%i_lei = INT(td_file%t_att(il_attid)%d_value(1)) 1262 tl_proc%i_lej = INT(td_file%t_att(il_attid)%d_value(2)) 1263 ELSE 1264 tl_proc%i_lei = mpp__init_file_cdf%t_dim(1)%i_len 1265 tl_proc%i_lej = mpp__init_file_cdf%t_dim(2)%i_len 1266 ENDIF 1249 CALL mpp__read_halo(tl_proc, mpp__init_file_cdf%t_dim(:) ) 1267 1250 1268 1251 ! add attributes … … 1274 1257 CALL file_move_att(tl_proc, tl_att) 1275 1258 1276 tl_att=att_init( "DOMAIN_position_first", &1277 & (/tl_proc%i_impp, tl_proc%i_jmpp /) )1278 CALL file_move_att(tl_proc, tl_att)1279 1280 tl_att=att_init( "DOMAIN_position_last", &1281 & (/tl_proc%i_lci, tl_proc%i_lcj /) )1282 CALL file_move_att(tl_proc, tl_att)1283 1284 tl_att=att_init( "DOMAIN_halo_size_start", &1285 & (/tl_proc%i_ldi, tl_proc%i_ldj /) )1286 CALL file_move_att(tl_proc, tl_att)1287 1288 tl_att=att_init( "DOMAIN_halo_size_end", &1289 & (/tl_proc%i_lei, tl_proc%i_lej /) )1290 CALL file_move_att(tl_proc, tl_att)1291 1292 1259 ! add processor to mpp structure 1293 1260 CALL mpp__add_proc(mpp__init_file_cdf, tl_proc) … … 1295 1262 ! clean 1296 1263 CALL file_clean(tl_proc) 1264 CALL dim_clean(tl_dim) 1297 1265 CALL att_clean(tl_att) 1298 1266 ENDIF … … 1303 1271 & " do not exist") 1304 1272 1305 ENDIF 1273 ENDIF 1274 1306 1275 END FUNCTION mpp__init_file_cdf 1307 1276 !------------------------------------------------------------------- … … 1312 1281 ! 1313 1282 !> @author J.Paul 1314 !> - November, 2013- Initial Version 1315 ! 1283 !> @date November, 2013 - Initial Version 1284 !> @date January, 2016 1285 !> - mismatch with "halo" indices, use mpp__compute_halo 1286 !> 1316 1287 !> @param[in] td_file file strcuture 1317 1288 !> @return mpp structure … … 1332 1303 INTEGER(i4) :: il_pni, il_pnj, il_pnij ! domain decomposition 1333 1304 INTEGER(i4) :: il_area ! domain index 1305 1306 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci 1307 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi 1308 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei 1309 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp 1310 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj 1311 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj 1312 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej 1313 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp 1334 1314 1335 1315 LOGICAL :: ll_exist … … 1385 1365 ALLOCATE( mpp__init_file_rstdimg%t_proc(il_pnij) , stat=il_status ) 1386 1366 1367 ALLOCATE(il_lci (il_pnij)) 1368 ALLOCATE(il_lcj (il_pnij)) 1369 ALLOCATE(il_ldi (il_pnij)) 1370 ALLOCATE(il_ldj (il_pnij)) 1371 ALLOCATE(il_lei (il_pnij)) 1372 ALLOCATE(il_lej (il_pnij)) 1373 ALLOCATE(il_impp(il_pnij)) 1374 ALLOCATE(il_jmpp(il_pnij)) 1375 1387 1376 tl_proc=file_copy(td_file) 1388 1377 ! remove dimension from file … … 1407 1396 & il_area, & 1408 1397 & il_iglo, il_jglo, & 1409 & mpp__init_file_rstdimg%t_proc(:)%i_lci, &1410 & mpp__init_file_rstdimg%t_proc(:)%i_lcj, &1411 & mpp__init_file_rstdimg%t_proc(:)%i_ldi, &1412 & mpp__init_file_rstdimg%t_proc(:)%i_ldj, &1413 & mpp__init_file_rstdimg%t_proc(:)%i_lei, &1414 & mpp__init_file_rstdimg%t_proc(:)%i_lej, &1415 & mpp__init_file_rstdimg%t_proc(:)%i_impp, &1416 & mpp__init_file_rstdimg%t_proc(:)%i_jmpp1398 & il_lci(1:il_pnij), & 1399 & il_lcj(1:il_pnij), & 1400 & il_ldi(1:il_pnij), & 1401 & il_ldj(1:il_pnij), & 1402 & il_lei(1:il_pnij), & 1403 & il_lej(1:il_pnij), & 1404 & il_impp(1:il_pnij), & 1405 & il_jmpp(1:il_pnij) 1417 1406 CALL fct_err(il_status) 1418 1407 IF( il_status /= 0 )THEN … … 1420 1409 & TRIM(td_file%c_name)) 1421 1410 ENDIF 1411 1412 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lci = il_lci (1:il_pnij) 1413 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lcj = il_lcj (1:il_pnij) 1414 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldi = il_ldi (1:il_pnij) 1415 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldj = il_ldj (1:il_pnij) 1416 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lei = il_lei (1:il_pnij) 1417 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lej = il_lej (1:il_pnij) 1418 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_impp= il_impp(1:il_pnij) 1419 mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_jmpp= il_jmpp(1:il_pnij) 1420 1421 DEALLOCATE(il_lci) 1422 DEALLOCATE(il_lcj) 1423 DEALLOCATE(il_ldi) 1424 DEALLOCATE(il_ldj) 1425 DEALLOCATE(il_lei) 1426 DEALLOCATE(il_lej) 1427 DEALLOCATE(il_impp) 1428 DEALLOCATE(il_jmpp) 1422 1429 1423 1430 ! global domain size … … 1431 1438 1432 1439 DO ji=1,mpp__init_file_rstdimg%i_nproc 1440 1433 1441 ! get file name 1434 1442 cl_file = file_rename(td_file%c_name,ji) … … 1441 1449 CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 1442 1450 1443 tl_att=att_init( "DOMAIN_position_first", &1444 & (/mpp__init_file_rstdimg%t_proc(ji)%i_impp, &1445 & mpp__init_file_rstdimg%t_proc(ji)%i_jmpp /) )1446 CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)1447 1448 tl_att=att_init( "DOMAIN_position_last", &1449 & (/mpp__init_file_rstdimg%t_proc(ji)%i_lci, &1450 & mpp__init_file_rstdimg%t_proc(ji)%i_lcj /) )1451 CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)1452 1453 tl_att=att_init( "DOMAIN_halo_size_start", &1454 & (/mpp__init_file_rstdimg%t_proc(ji)%i_ldi, &1455 & mpp__init_file_rstdimg%t_proc(ji)%i_ldj /) )1456 CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)1457 1458 tl_att=att_init( "DOMAIN_halo_size_end", &1459 & (/mpp__init_file_rstdimg%t_proc(ji)%i_lei, &1460 & mpp__init_file_rstdimg%t_proc(ji)%i_lej /) )1461 CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)1462 1451 ENDDO 1463 1452 … … 1482 1471 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1483 1472 1484 tl_att=att_init( "DOMAIN_I_position_first", & 1485 & mpp__init_file_rstdimg%t_proc(:)%i_impp ) 1486 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1487 1488 tl_att=att_init( "DOMAIN_J_position_first", & 1489 & mpp__init_file_rstdimg%t_proc(:)%i_jmpp ) 1490 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1491 1492 tl_att=att_init( "DOMAIN_I_position_last", & 1493 & mpp__init_file_rstdimg%t_proc(:)%i_lci ) 1494 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1495 1496 tl_att=att_init( "DOMAIN_J_position_last", & 1497 & mpp__init_file_rstdimg%t_proc(:)%i_lcj ) 1498 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1499 1500 tl_att=att_init( "DOMAIN_I_halo_size_start", & 1501 & mpp__init_file_rstdimg%t_proc(:)%i_ldi ) 1502 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1503 1504 tl_att=att_init( "DOMAIN_J_halo_size_start", & 1505 & mpp__init_file_rstdimg%t_proc(:)%i_ldj ) 1506 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1507 1508 tl_att=att_init( "DOMAIN_I_halo_size_end", & 1509 & mpp__init_file_rstdimg%t_proc(:)%i_lei ) 1510 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1511 1512 tl_att=att_init( "DOMAIN_J_halo_size_end", & 1513 & mpp__init_file_rstdimg%t_proc(:)%i_lej ) 1514 CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 1473 CALL mpp_get_dom( mpp__init_file_rstdimg ) 1474 1475 CALL mpp__compute_halo( mpp__init_file_rstdimg ) 1515 1476 1516 1477 ! clean … … 1532 1493 ! 1533 1494 !> @author J.Paul 1534 !> - Nov, 2013- Initial Version1495 !> @date November, 2013 - Initial Version 1535 1496 ! 1536 1497 !> @param[in] td_mpp mpp structure … … 1594 1555 ! Argument 1595 1556 TYPE(TMPP), INTENT(INOUT) :: td_mpp 1596 TYPE(TVAR), INTENT(IN ):: td_var1557 TYPE(TVAR), INTENT(INOUT) :: td_var 1597 1558 1598 1559 ! local variable … … 1624 1585 IF( il_varid /= 0 )THEN 1625 1586 1626 CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&1627 & ", standard name "//TRIM(td_var%c_stdname)//&1628 & ", already in mpp "//TRIM(td_mpp%c_name) )1629 1630 1587 DO ji=1,td_mpp%t_proc(1)%i_nvar 1631 1588 CALL logger_debug( " MPP ADD VAR: in mpp structure : & … … 1634 1591 & TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) ) 1635 1592 ENDDO 1593 CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//& 1594 & ", standard name "//TRIM(td_var%c_stdname)//& 1595 & ", already in mpp "//TRIM(td_mpp%c_name) ) 1636 1596 1637 1597 ELSE … … 1643 1603 ! check used dimension 1644 1604 IF( mpp__check_dim(td_mpp, td_var) )THEN 1605 1606 ! check variable dimension expected 1607 CALL var_check_dim(td_var) 1645 1608 1646 1609 ! update dimension if need be … … 1675 1638 ! 1676 1639 !> @author J.Paul 1677 !> - November, 2013- Initial Version1640 !> @date November, 2013 - Initial Version 1678 1641 ! 1679 1642 !> @param[in] td_mpp mpp structure … … 1840 1803 !> @author J.Paul 1841 1804 !> @date November, 2013 - Initial version 1805 !> @date February, 2015 1806 !> - define local variable structure to avoid mistake with pointer 1842 1807 ! 1843 1808 !> @param[inout] td_mpp mpp strcuture … … 1852 1817 ! local variable 1853 1818 INTEGER(i4) :: il_varid 1819 TYPE(TVAR) :: tl_var 1854 1820 !---------------------------------------------------------------- 1855 1821 ! check if mpp exist … … 1882 1848 ELSE 1883 1849 1884 CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid)) 1850 tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid)) 1851 CALL mpp_del_var(td_mpp, tl_var) 1885 1852 1886 1853 ENDIF … … 1908 1875 TYPE(TVAR) :: tl_var 1909 1876 !---------------------------------------------------------------- 1910 ! copy variabl e1877 ! copy variablie 1911 1878 tl_var=var_copy(td_var) 1912 1879 … … 1935 1902 !> - check proc type 1936 1903 !------------------------------------------------------------------- 1937 SUBROUTINE mpp__add_proc ( td_mpp, td_proc )1904 SUBROUTINE mpp__add_proc_unit( td_mpp, td_proc ) 1938 1905 IMPLICIT NONE 1939 1906 ! Argument … … 1950 1917 CHARACTER(LEN=lc) :: cl_name 1951 1918 !---------------------------------------------------------------- 1919 1920 ! ALLOCATE(tl_proc(1)) 1921 ! tl_proc(1)=file_copy(td_proc) 1922 ! 1923 ! CALL mpp__add_proc(td_mpp, tl_proc(:)) 1924 ! 1925 ! CALL file_clean(tl_proc(:)) 1926 ! DEALLOCATE(tl_proc) 1952 1927 1953 1928 ! check file name … … 2049 2024 2050 2025 ENDIF 2051 END SUBROUTINE mpp__add_proc 2026 2027 END SUBROUTINE mpp__add_proc_unit 2052 2028 !------------------------------------------------------------------- 2053 2029 !> @brief … … 2193 2169 !> 2194 2170 !> @author J.Paul 2195 !> - November, 2013- Initial Version 2171 !> @date November, 2013 - Initial Version 2172 !> @date July, 2015 2173 !> - rewrite the same as way var_add_dim 2196 2174 !> 2197 2175 !> @param[inout] td_mpp mpp structure … … 2208 2186 2209 2187 ! loop indices 2210 INTEGER(i4) :: ji2211 2188 !---------------------------------------------------------------- 2212 2189 IF( td_mpp%i_ndim <= ip_maxdim )THEN 2213 2190 2214 ! check if dimension already in mpp structure 2215 il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 2216 IF( il_ind /= 0 )THEN 2217 2218 IF( td_mpp%t_dim(il_ind)%l_use )THEN 2219 CALL logger_error( & 2220 & "MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 2221 & ", short name "//TRIM(td_dim%c_sname)//& 2222 & ", already used in mpp "//TRIM(td_mpp%c_name) ) 2223 ELSE 2224 ! replace dimension 2225 td_mpp%t_dim(il_ind)=dim_copy(td_dim) 2226 td_mpp%t_dim(il_ind)%i_id=il_ind 2227 td_mpp%t_dim(il_ind)%l_use=.TRUE. 2228 ENDIF 2229 2191 ! check if dimension already used in mpp structure 2192 il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 2193 IF( il_ind == 0 )THEN 2194 CALL logger_warn( & 2195 & " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 2196 & ", short name "//TRIM(td_dim%c_sname)//& 2197 & ", will not be added in mpp "//TRIM(td_mpp%c_name) ) 2198 ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN 2199 CALL logger_error( & 2200 & " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 2201 & ", short name "//TRIM(td_dim%c_sname)//& 2202 & ", already used in mpp "//TRIM(td_mpp%c_name) ) 2230 2203 ELSE 2231 2204 2232 IF( td_mpp%i_ndim == ip_maxdim )THEN 2233 CALL logger_error( & 2234 & "MPP ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//& 2235 & ", short name "//TRIM(td_dim%c_sname)//& 2236 & ", in mpp "//TRIM(td_mpp%c_name)//". Already "//& 2237 & TRIM(fct_str(ip_maxdim))//" dimensions." ) 2238 ELSE 2239 ! search empty dimension 2240 DO ji=1,ip_maxdim 2241 IF( td_mpp%t_dim(ji)%i_id == 0 )THEN 2242 il_ind=ji 2243 EXIT 2244 ENDIF 2245 ENDDO 2246 2247 ! add new dimension 2248 td_mpp%t_dim(il_ind)=dim_copy(td_dim) 2249 ! update number of attribute 2250 td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 2251 2252 td_mpp%t_dim(il_ind)%l_use=.TRUE. 2253 td_mpp%t_dim(il_ind)%i_id=td_mpp%i_ndim 2254 ENDIF 2205 ! back to disorder dimension array 2206 CALL dim_disorder(td_mpp%t_dim(:)) 2207 2208 ! add new dimension 2209 td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim) 2210 2211 ! update number of attribute 2212 td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 2255 2213 2256 2214 ENDIF 2215 ! reorder dimension to ('x','y','z','t') 2216 CALL dim_reorder(td_mpp%t_dim(:)) 2257 2217 2258 2218 ELSE … … 2268 2228 !> 2269 2229 !> @author J.Paul 2270 !> - November, 2013- Initial Version 2230 !> @date November, 2013 - Initial Version 2231 !> @date July, 2015 2232 !> - rewrite the same as way var_del_dim 2271 2233 !> 2272 2234 !> @param[inout] td_mpp mpp structure … … 2280 2242 2281 2243 ! local variable 2282 INTEGER(i4) :: il_status2283 2244 INTEGER(i4) :: il_ind 2284 TYPE(TDIM) , DIMENSION(:), ALLOCATABLE:: tl_dim2245 TYPE(TDIM) :: tl_dim 2285 2246 2286 2247 ! loop indices 2287 INTEGER(i4) :: ji 2288 !---------------------------------------------------------------- 2289 ! check if dimension already in mpp structure 2290 il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 2291 IF( il_ind == 0 )THEN 2292 2293 CALL logger_error( & 2294 & "MPP DEL DIM: no dimension "//TRIM(td_dim%c_name)//& 2248 !---------------------------------------------------------------- 2249 2250 2251 IF( td_mpp%i_ndim <= ip_maxdim )THEN 2252 2253 CALL logger_trace( & 2254 & " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 2295 2255 & ", short name "//TRIM(td_dim%c_sname)//& 2296 2256 & ", in mpp "//TRIM(td_mpp%c_name) ) 2257 2258 ! check if dimension already in variable structure 2259 il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 2260 2261 ! replace dimension by empty one 2262 td_mpp%t_dim(il_ind)=dim_copy(tl_dim) 2263 2264 ! update number of dimension 2265 td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 2266 2267 ! reorder dimension to ('x','y','z','t') 2268 CALL dim_reorder(td_mpp%t_dim) 2297 2269 2298 2270 ELSE 2299 2300 ALLOCATE( tl_dim(td_mpp%i_ndim-1), stat=il_status ) 2301 IF(il_status /= 0 )THEN 2302 2303 CALL logger_error( & 2304 & "MPP DEL DIM: not enough space to put dimensions from "//& 2305 & TRIM(td_mpp%c_name)//" in temporary dimension structure") 2306 2307 ELSE 2308 2309 ! save temporary dimension's mpp structure 2310 tl_dim( 1 : il_ind-1 ) = dim_copy(td_mpp%t_dim( 1 : il_ind-1 )) 2311 tl_dim( il_ind : td_mpp%i_ndim-1 ) = & 2312 & dim_copy(td_mpp%t_dim( il_ind+1 : td_mpp%i_ndim )) 2313 2314 ! remove dimension from file 2315 CALL dim_clean(td_mpp%t_dim(:)) 2316 ! copy dimension in file, except one 2317 td_mpp%t_dim(1:td_mpp%i_ndim)=dim_copy(tl_dim(:)) 2318 2319 ! update number of dimension 2320 td_mpp%i_ndim=td_mpp%i_ndim-1 2321 2322 ! update dimension id 2323 DO ji=1,td_mpp%i_ndim 2324 td_mpp%t_dim(ji)%i_id=ji 2325 ENDDO 2326 2327 ! clean 2328 CALL dim_clean(tl_dim(:)) 2329 DEALLOCATE(tl_dim) 2330 2331 ENDIF 2332 2271 CALL logger_error( & 2272 & " MPP DEL DIM: too much dimension in mpp "//& 2273 & TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")") 2333 2274 ENDIF 2334 2275 … … 2340 2281 !> 2341 2282 !> @author J.Paul 2342 !> - November, 2013- Initial Version2283 !> @date November, 2013 - Initial Version 2343 2284 !> 2344 2285 !> @param[inout] td_mpp mpp structure … … 2488 2429 & ", in mpp structure "//TRIM(td_mpp%c_name) ) 2489 2430 2490 IF( ASSOCIATED(td_mpp%t_proc(1)%t_ var) )THEN2431 IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN 2491 2432 DO ji=1,td_mpp%t_proc(1)%i_natt 2492 2433 CALL logger_debug( "MPP DEL ATT: in mpp structure : & 2493 & attribute : "//TRIM(td_mpp%t_proc(1)%t_ var(ji)%c_name) )2434 & attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) ) 2494 2435 ENDDO 2495 2436 ENDIF … … 2516 2457 !> @author J.Paul 2517 2458 !> @date November, 2013 - Initial version 2459 !> @date February, 2015 2460 !> - define local attribute structure to avoid mistake with pointer 2518 2461 ! 2519 2462 !> @param[inout] td_mpp mpp strcuture … … 2527 2470 2528 2471 ! local variable 2529 INTEGER(i4) :: il_attid 2472 INTEGER(i4) :: il_attid 2473 TYPE(TATT) :: tl_att 2530 2474 !---------------------------------------------------------------- 2531 2475 ! check if mpp exist … … 2551 2495 IF( il_attid == 0 )THEN 2552 2496 2553 CALL logger_ warn( &2497 CALL logger_debug( & 2554 2498 & "MPP DEL ATT : there is no attribute with "//& 2555 2499 & "name "//TRIM(cd_name)//" in mpp structure "//& … … 2558 2502 ELSE 2559 2503 2560 CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid)) 2504 tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid)) 2505 CALL mpp_del_att(td_mpp, tl_att) 2561 2506 2562 2507 ENDIF … … 2599 2544 !------------------------------------------------------------------- 2600 2545 !> @brief 2601 !> This subroutine compute domain decomposition for niproc and njproc 2602 !> processors following I and J. 2603 !> 2546 !> This function initialise domain layout 2547 !> 2604 2548 !> @detail 2605 !> To do so, it need to know : 2606 !> - global domain dimension 2607 !> - overlap region length 2608 !> - number of processors following I and J 2549 !> Domain layout is first compute, with domain dimension, overlap between subdomain, 2550 !> and the number of processors following I and J. 2551 !> Then the number of sea/land processors is compute with mask 2609 2552 ! 2610 2553 !> @author J.Paul 2611 !> @date November, 2013 - Initial version 2554 !> @date October, 2015 - Initial version 2555 ! 2556 !> @param[in] td_mpp mpp strcuture 2557 !> @param[in] id_mask sub domain mask (sea=1, land=0) 2558 !> @pâram[in] id_niproc number of processors following I 2559 !> @pâram[in] id_njproc number of processors following J 2560 !> @return domain layout structure 2561 !------------------------------------------------------------------- 2562 FUNCTION layout__init( td_mpp, id_mask, id_niproc, id_njproc ) RESULT(td_lay) 2563 IMPLICIT NONE 2564 ! Argument 2565 TYPE(TMPP) , INTENT(IN) :: td_mpp 2566 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 2567 INTEGER(i4) , INTENT(IN) :: id_niproc 2568 INTEGER(i4) , INTENT(IN) :: id_njproc 2569 2570 ! function 2571 TYPE(TLAY) :: td_lay 2572 2573 ! local variable 2574 INTEGER(i4) :: ii1, ii2 2575 INTEGER(i4) :: ij1, ij2 2576 2577 INTEGER(i4) :: il_ldi 2578 INTEGER(i4) :: il_ldj 2579 INTEGER(i4) :: il_lei 2580 INTEGER(i4) :: il_lej 2581 2582 INTEGER(i4) :: il_isize !< i-direction maximum sub domain size 2583 INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size 2584 INTEGER(i4) :: il_resti !< 2585 INTEGER(i4) :: il_restj !< 2586 2587 ! loop indices 2588 INTEGER(i4) :: ji 2589 INTEGER(i4) :: jj 2590 !---------------------------------------------------------------- 2591 2592 ! intialise 2593 td_lay%i_niproc=id_niproc 2594 td_lay%i_njproc=id_njproc 2595 2596 CALL logger_info( "MPP COMPUTE LAYOUT: compute domain layout with "//& 2597 & TRIM(fct_str(td_lay%i_niproc))//" x "//& 2598 & TRIM(fct_str(td_lay%i_njproc))//" processors") 2599 2600 ! maximum size of sub domain 2601 il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_lay%i_niproc-1))/ & 2602 & td_lay%i_niproc) + 2*td_mpp%i_preci 2603 il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_lay%i_njproc-1))/ & 2604 & td_lay%i_njproc) + 2*td_mpp%i_precj 2605 2606 il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_lay%i_niproc) 2607 il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_lay%i_njproc) 2608 IF( il_resti == 0 ) il_resti = td_lay%i_niproc 2609 IF( il_restj == 0 ) il_restj = td_lay%i_njproc 2610 2611 ! compute dimension of each sub domain 2612 ALLOCATE( td_lay%i_lci(td_lay%i_niproc,td_lay%i_njproc) ) 2613 ALLOCATE( td_lay%i_lcj(td_lay%i_niproc,td_lay%i_njproc) ) 2614 2615 td_lay%i_lci( 1 : il_resti , : ) = il_isize 2616 td_lay%i_lci( il_resti+1 : td_lay%i_niproc, : ) = il_isize-1 2617 2618 td_lay%i_lcj( : , 1 : il_restj ) = il_jsize 2619 td_lay%i_lcj( : , il_restj+1 : td_lay%i_njproc) = il_jsize-1 2620 2621 ! compute first index of each sub domain 2622 ALLOCATE( td_lay%i_impp(td_lay%i_niproc,td_lay%i_njproc) ) 2623 ALLOCATE( td_lay%i_jmpp(td_lay%i_niproc,td_lay%i_njproc) ) 2624 2625 td_lay%i_impp(:,:)=1 2626 td_lay%i_jmpp(:,:)=1 2627 2628 IF( td_lay%i_niproc > 1 )THEN 2629 DO jj=1,td_lay%i_njproc 2630 DO ji=2,td_lay%i_niproc 2631 td_lay%i_impp(ji,jj) = td_lay%i_impp(ji-1,jj) + & 2632 & td_lay%i_lci (ji-1,jj) - 2*td_mpp%i_preci 2633 ENDDO 2634 ENDDO 2635 ENDIF 2636 2637 IF( td_lay%i_njproc > 1 )THEN 2638 DO jj=2,td_lay%i_njproc 2639 DO ji=1,td_lay%i_niproc 2640 td_lay%i_jmpp(ji,jj) = td_lay%i_jmpp(ji,jj-1) + & 2641 & td_lay%i_lcj (ji,jj-1) - 2*td_mpp%i_precj 2642 ENDDO 2643 ENDDO 2644 ENDIF 2645 2646 ALLOCATE(td_lay%i_msk(td_lay%i_niproc,td_lay%i_njproc)) 2647 td_lay%i_msk(:,:)=0 2648 ! init number of sea/land proc 2649 td_lay%i_nsea=0 2650 td_lay%i_nland=td_lay%i_njproc*td_lay%i_niproc 2651 2652 ! check if processor is land or sea 2653 DO jj = 1,td_lay%i_njproc 2654 DO ji = 1,td_lay%i_niproc 2655 2656 ! compute first and last indoor indices 2657 ! west boundary 2658 IF( ji == 1 )THEN 2659 il_ldi = 1 2660 ELSE 2661 il_ldi = 1 + td_mpp%i_preci 2662 ENDIF 2663 2664 ! south boundary 2665 IF( jj == 1 )THEN 2666 il_ldj = 1 2667 ELSE 2668 il_ldj = 1 + td_mpp%i_precj 2669 ENDIF 2670 2671 ! east boundary 2672 IF( ji == td_mpp%i_niproc )THEN 2673 il_lei = td_lay%i_lci(ji,jj) 2674 ELSE 2675 il_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci 2676 ENDIF 2677 2678 ! north boundary 2679 IF( jj == td_mpp%i_njproc )THEN 2680 il_lej = td_lay%i_lcj(ji,jj) 2681 ELSE 2682 il_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj 2683 ENDIF 2684 2685 ii1=td_lay%i_impp(ji,jj) + il_ldi - 1 2686 ii2=td_lay%i_impp(ji,jj) + il_lei - 1 2687 2688 ij1=td_lay%i_jmpp(ji,jj) + il_ldj - 1 2689 ij2=td_lay%i_jmpp(ji,jj) + il_lej - 1 2690 2691 td_lay%i_msk(ji,jj)=SUM( id_mask(ii1:ii2,ij1:ij2) ) 2692 IF( td_lay%i_msk(ji,jj) > 0 )THEN ! sea 2693 td_lay%i_nsea =td_lay%i_nsea +1 2694 td_lay%i_nland=td_lay%i_nland-1 2695 ENDIF 2696 2697 ENDDO 2698 ENDDO 2699 2700 CALL logger_info( "MPP COMPUTE LAYOUT: sea proc "//TRIM(fct_str(td_lay%i_nsea))) 2701 CALL logger_info( "MPP COMPUTE LAYOUT: land proc "//TRIM(fct_str(td_lay%i_nland))) 2702 CALL logger_info( "MPP COMPUTE LAYOUT: sum "//TRIM(fct_str( SUM(td_lay%i_msk(:,:))))) 2703 2704 td_lay%i_mean= SUM(td_lay%i_msk(:,:)) / td_lay%i_nsea 2705 td_lay%i_min = MINVAL(td_lay%i_msk(:,:),td_lay%i_msk(:,:)/=0) 2706 td_lay%i_max = MAXVAL(td_lay%i_msk(:,:)) 2707 2708 IF( lm_layout )THEN 2709 ! print info 2710 WRITE(im_iumout,*) ' ' 2711 WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc 2712 WRITE(im_iumout,*) " jpi= ",il_isize," jpj= ",il_jsize 2713 WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj 2714 2715 2716 WRITE(im_iumout,*) ' nombre de processeurs ',td_lay%i_niproc*td_lay%i_njproc 2717 WRITE(im_iumout,*) ' nombre de processeurs mer ',td_lay%i_nsea 2718 WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland 2719 WRITE(im_iumout,*) ' moyenne de recouvrement ',td_lay%i_mean 2720 WRITE(im_iumout,*) ' minimum de recouvrement ',td_lay%i_min 2721 WRITE(im_iumout,*) ' maximum de recouvrement ',td_lay%i_max 2722 ENDIF 2723 2724 END FUNCTION layout__init 2725 !------------------------------------------------------------------- 2726 !> @brief 2727 !> This subroutine clean domain layout strcuture. 2728 !> 2729 !> @author J.Paul 2730 !> @date October, 2015 - Initial version 2731 !> 2732 !> @param[inout] td_lay domain layout strcuture 2733 !------------------------------------------------------------------- 2734 SUBROUTINE layout__clean( td_lay ) 2735 IMPLICIT NONE 2736 ! Argument 2737 TYPE(TLAY), INTENT(INOUT) :: td_lay 2738 !---------------------------------------------------------------- 2739 2740 IF( ASSOCIATED(td_lay%i_msk) )THEN 2741 DEALLOCATE(td_lay%i_msk) 2742 ENDIF 2743 IF( ASSOCIATED(td_lay%i_impp) )THEN 2744 DEALLOCATE(td_lay%i_impp) 2745 ENDIF 2746 IF( ASSOCIATED(td_lay%i_jmpp) )THEN 2747 DEALLOCATE(td_lay%i_jmpp) 2748 ENDIF 2749 IF( ASSOCIATED(td_lay%i_lci) )THEN 2750 DEALLOCATE(td_lay%i_lci) 2751 ENDIF 2752 IF( ASSOCIATED(td_lay%i_lcj) )THEN 2753 DEALLOCATE(td_lay%i_lcj) 2754 ENDIF 2755 2756 td_lay%i_niproc=0 2757 td_lay%i_njproc=0 2758 td_lay%i_nland =0 2759 td_lay%i_nsea =0 2760 2761 td_lay%i_mean =0 2762 td_lay%i_min =0 2763 td_lay%i_max =0 2764 2765 END SUBROUTINE layout__clean 2766 !------------------------------------------------------------------- 2767 !> @brief 2768 !> This subroutine copy domain layout structure in another one. 2769 !> 2770 !> @warning do not use on the output of a function who create or read a 2771 !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 2772 !> This will create memory leaks. 2773 !> @warning to avoid infinite loop, do not use any function inside 2774 !> this subroutine 2775 !> 2776 !> @author J.Paul 2777 !> @date October, 2015 - Initial Version 2778 ! 2779 !> @param[in] td_lay domain layout structure 2780 !> @return copy of input domain layout structure 2781 !------------------------------------------------------------------- 2782 FUNCTION layout__copy( td_lay ) 2783 IMPLICIT NONE 2784 ! Argument 2785 TYPE(TLAY), INTENT(IN) :: td_lay 2786 ! function 2787 TYPE(TLAY) :: layout__copy 2788 2789 ! local variable 2790 INTEGER(i4), DIMENSION(2) :: il_shape 2791 INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 2792 ! loop indices 2793 !---------------------------------------------------------------- 2794 2795 ! copy scalar 2796 layout__copy%i_niproc = td_lay%i_niproc 2797 layout__copy%i_njproc = td_lay%i_njproc 2798 layout__copy%i_nland = td_lay%i_nland 2799 layout__copy%i_nsea = td_lay%i_nsea 2800 layout__copy%i_mean = td_lay%i_mean 2801 layout__copy%i_min = td_lay%i_min 2802 layout__copy%i_max = td_lay%i_max 2803 2804 ! copy pointers 2805 IF( ASSOCIATED(layout__copy%i_msk) )THEN 2806 DEALLOCATE(layout__copy%i_msk) 2807 ENDIF 2808 IF( ASSOCIATED(td_lay%i_msk) )THEN 2809 il_shape(:)=SHAPE(td_lay%i_msk(:,:)) 2810 ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) ) 2811 layout__copy%i_msk(:,:)=td_lay%i_msk(:,:) 2812 ENDIF 2813 2814 IF( ASSOCIATED(layout__copy%i_msk) ) DEALLOCATE(layout__copy%i_msk) 2815 IF( ASSOCIATED(td_lay%i_msk) )THEN 2816 il_shape(:)=SHAPE(td_lay%i_msk(:,:)) 2817 ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 2818 il_tmp(:,:)=td_lay%i_msk(:,:) 2819 2820 ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) ) 2821 layout__copy%i_msk(:,:)=il_tmp(:,:) 2822 2823 DEALLOCATE(il_tmp) 2824 ENDIF 2825 2826 IF( ASSOCIATED(layout__copy%i_impp) ) DEALLOCATE(layout__copy%i_impp) 2827 IF( ASSOCIATED(td_lay%i_impp) )THEN 2828 il_shape(:)=SHAPE(td_lay%i_impp(:,:)) 2829 ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 2830 il_tmp(:,:)=td_lay%i_impp(:,:) 2831 2832 ALLOCATE( layout__copy%i_impp(il_shape(jp_I),il_shape(jp_J)) ) 2833 layout__copy%i_impp(:,:)=il_tmp(:,:) 2834 2835 DEALLOCATE(il_tmp) 2836 ENDIF 2837 2838 IF( ASSOCIATED(layout__copy%i_jmpp) ) DEALLOCATE(layout__copy%i_jmpp) 2839 IF( ASSOCIATED(td_lay%i_jmpp) )THEN 2840 il_shape(:)=SHAPE(td_lay%i_jmpp(:,:)) 2841 ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 2842 il_tmp(:,:)=td_lay%i_jmpp(:,:) 2843 2844 ALLOCATE( layout__copy%i_jmpp(il_shape(jp_I),il_shape(jp_J)) ) 2845 layout__copy%i_jmpp(:,:)=il_tmp(:,:) 2846 2847 DEALLOCATE(il_tmp) 2848 ENDIF 2849 2850 IF( ASSOCIATED(layout__copy%i_lci) ) DEALLOCATE(layout__copy%i_lci) 2851 IF( ASSOCIATED(td_lay%i_lci) )THEN 2852 il_shape(:)=SHAPE(td_lay%i_lci(:,:)) 2853 ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 2854 il_tmp(:,:)=td_lay%i_lci(:,:) 2855 2856 ALLOCATE( layout__copy%i_lci(il_shape(jp_I),il_shape(jp_J)) ) 2857 layout__copy%i_lci(:,:)=il_tmp(:,:) 2858 2859 DEALLOCATE(il_tmp) 2860 ENDIF 2861 2862 IF( ASSOCIATED(layout__copy%i_lcj) ) DEALLOCATE(layout__copy%i_lcj) 2863 IF( ASSOCIATED(td_lay%i_lcj) )THEN 2864 il_shape(:)=SHAPE(td_lay%i_lcj(:,:)) 2865 ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 2866 il_tmp(:,:)=td_lay%i_lcj(:,:) 2867 2868 ALLOCATE( layout__copy%i_lcj(il_shape(jp_I),il_shape(jp_J)) ) 2869 layout__copy%i_lcj(:,:)=il_tmp(:,:) 2870 2871 DEALLOCATE(il_tmp) 2872 ENDIF 2873 2874 END FUNCTION layout__copy 2875 !------------------------------------------------------------------- 2876 !> @brief 2877 !> This subroutine create mpp structure using domain layout 2878 !> 2879 !> @detail 2880 ! 2881 !> @author J.Paul 2882 !> @date October, 2015 - Initial version 2612 2883 ! 2613 2884 !> @param[inout] td_mpp mpp strcuture 2614 !------------------------------------------------------------------- 2615 SUBROUTINE mpp__compute( td_mpp ) 2885 !> @param[in] td_lay domain layout structure 2886 !------------------------------------------------------------------- 2887 SUBROUTINE mpp__create_layout( td_mpp, td_lay ) 2616 2888 IMPLICIT NONE 2617 2889 ! Argument 2618 2890 TYPE(TMPP), INTENT(INOUT) :: td_mpp 2891 TYPE(TLAY), INTENT(IN ) :: td_lay 2619 2892 2620 2893 ! local variable 2621 INTEGER(i4) :: il_isize !< i-direction maximum sub domain size2622 INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size2623 INTEGER(i4) :: il_resti !<2624 INTEGER(i4) :: il_restj !<2625 INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlci2626 INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlcj2627 INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_impp2628 INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_jmpp2629 2630 2894 CHARACTER(LEN=lc) :: cl_file 2631 2895 TYPE(TFILE) :: tl_proc … … 2641 2905 td_mpp%i_nproc=0 2642 2906 2643 CALL logger_trace( "MPP COMPUTE: compute domain decomposition with "//& 2644 & TRIM(fct_str(td_mpp%i_niproc))//" x "//& 2645 & TRIM(fct_str(td_mpp%i_njproc))//" processors") 2646 ! maximum size of sub domain 2647 il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_mpp%i_niproc-1))/ & 2648 & td_mpp%i_niproc) + 2*td_mpp%i_preci 2649 il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_mpp%i_njproc-1))/ & 2650 & td_mpp%i_njproc) + 2*td_mpp%i_precj 2651 2652 il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_mpp%i_niproc) 2653 il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_mpp%i_njproc) 2654 IF( il_resti == 0 ) il_resti = td_mpp%i_niproc 2655 IF( il_restj == 0 ) il_restj = td_mpp%i_njproc 2656 2657 ! compute dimension of each sub domain 2658 ALLOCATE( il_nlci(td_mpp%i_niproc,td_mpp%i_njproc) ) 2659 ALLOCATE( il_nlcj(td_mpp%i_niproc,td_mpp%i_njproc) ) 2660 2661 il_nlci( 1 : il_resti , : ) = il_isize 2662 il_nlci( il_resti+1 : td_mpp%i_niproc, : ) = il_isize-1 2663 2664 il_nlcj( : , 1 : il_restj ) = il_jsize 2665 il_nlcj( : , il_restj+1 : td_mpp%i_njproc) = il_jsize-1 2666 2667 ! compute first index of each sub domain 2668 ALLOCATE( il_impp(td_mpp%i_niproc,td_mpp%i_njproc) ) 2669 ALLOCATE( il_jmpp(td_mpp%i_niproc,td_mpp%i_njproc) ) 2670 2671 il_impp(:,:)=1 2672 il_jmpp(:,:)=1 2673 2674 DO jj=1,td_mpp%i_njproc 2675 DO ji=2,td_mpp%i_niproc 2676 il_impp(ji,jj)=il_impp(ji-1,jj)+il_nlci(ji-1,jj)-2*td_mpp%i_preci 2907 CALL logger_debug( "MPP CREATE LAYOUT: create domain decomposition with "//& 2908 & TRIM(fct_str(td_lay%i_niproc))//" x "//& 2909 & TRIM(fct_str(td_lay%i_njproc))//" = "//& 2910 & TRIM(fct_str(td_lay%i_nsea))//" processors") 2911 2912 IF( lm_layout )THEN 2913 WRITE(im_iumout,*) ' choix optimum' 2914 WRITE(im_iumout,*) ' =============' 2915 WRITE(im_iumout,*) 2916 ! print info 2917 WRITE(im_iumout,*) ' ' 2918 WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc 2919 WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj 2920 2921 2922 WRITE(im_iumout,*) ' nombre de processeurs ',td_lay%i_niproc*td_lay%i_njproc 2923 WRITE(im_iumout,*) ' nombre de processeurs mer ',td_lay%i_nsea 2924 WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland 2925 WRITE(im_iumout,*) ' moyenne de recouvrement ',td_lay%i_mean 2926 WRITE(im_iumout,*) ' minimum de recouvrement ',td_lay%i_min 2927 WRITE(im_iumout,*) ' maximum de recouvrement ',td_lay%i_max 2928 ENDIF 2929 2930 td_mpp%i_niproc=td_lay%i_niproc 2931 td_mpp%i_njproc=td_lay%i_njproc 2932 !td_mpp%i_nproc =td_lay%i_nsea 2933 2934 IF( td_mpp%i_niproc*td_mpp%i_njproc == td_lay%i_nsea )THEN 2935 IF( td_lay%i_nsea == 1 )THEN 2936 td_mpp%c_dom='full' 2937 ELSE 2938 td_mpp%c_dom='nooverlap' 2939 ENDIF 2940 ELSE 2941 td_mpp%c_dom='noextra' 2942 ENDIF 2943 2944 jk=0 2945 DO jj=1,td_lay%i_njproc 2946 DO ji=1,td_lay%i_niproc 2947 2948 IF( td_lay%i_msk(ji,jj) >= 1 )THEN 2949 2950 ! get processor file name 2951 cl_file=file_rename(td_mpp%c_name,jk) 2952 ! initialise file structure 2953 tl_proc=file_init(cl_file,td_mpp%c_type) 2954 2955 ! procesor id 2956 tl_proc%i_pid=jk 2957 2958 tl_att=att_init("DOMAIN_number",tl_proc%i_pid) 2959 CALL file_add_att(tl_proc, tl_att) 2960 2961 ! processor indices 2962 tl_proc%i_iind=ji 2963 tl_proc%i_jind=jj 2964 2965 ! fill processor dimension and first indices 2966 tl_proc%i_impp = td_lay%i_impp(ji,jj) 2967 tl_proc%i_jmpp = td_lay%i_jmpp(ji,jj) 2968 2969 tl_proc%i_lci = td_lay%i_lci(ji,jj) 2970 tl_proc%i_lcj = td_lay%i_lcj(ji,jj) 2971 2972 ! compute first and last indoor indices 2973 2974 ! west boundary 2975 IF( ji == 1 )THEN 2976 tl_proc%i_ldi = 1 2977 tl_proc%l_ctr = .TRUE. 2978 ELSE 2979 tl_proc%i_ldi = 1 + td_mpp%i_preci 2980 ENDIF 2981 2982 ! south boundary 2983 IF( jj == 1 )THEN 2984 tl_proc%i_ldj = 1 2985 tl_proc%l_ctr = .TRUE. 2986 ELSE 2987 tl_proc%i_ldj = 1 + td_mpp%i_precj 2988 ENDIF 2989 2990 ! east boundary 2991 IF( ji == td_mpp%i_niproc )THEN 2992 tl_proc%i_lei = td_lay%i_lci(ji,jj) 2993 tl_proc%l_ctr = .TRUE. 2994 ELSE 2995 tl_proc%i_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci 2996 ENDIF 2997 2998 ! north boundary 2999 IF( jj == td_mpp%i_njproc )THEN 3000 tl_proc%i_lej = td_lay%i_lcj(ji,jj) 3001 tl_proc%l_ctr = .TRUE. 3002 ELSE 3003 tl_proc%i_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj 3004 ENDIF 3005 3006 ! add processor to mpp structure 3007 CALL mpp__add_proc(td_mpp, tl_proc) 3008 3009 ! clean 3010 CALL att_clean(tl_att) 3011 CALL file_clean(tl_proc) 3012 3013 ! update proc number 3014 jk=jk+1 !ji+(jj-1)*td_lay%i_niproc 3015 3016 ENDIF 2677 3017 ENDDO 2678 3018 ENDDO 2679 3019 2680 DO jj=2,td_mpp%i_njproc 2681 DO ji=1,td_mpp%i_niproc 2682 il_jmpp(ji,jj)=il_jmpp(ji,jj-1)+il_nlcj(ji,jj-1)-2*td_mpp%i_precj 2683 ENDDO 2684 ENDDO 2685 2686 DO jj=1,td_mpp%i_njproc 2687 DO ji=1,td_mpp%i_niproc 2688 2689 jk=ji+(jj-1)*td_mpp%i_niproc 2690 2691 ! get processor file name 2692 cl_file=file_rename(td_mpp%c_name,jk) 2693 ! initialise file structure 2694 tl_proc=file_init(cl_file,td_mpp%c_type) 2695 2696 ! procesor id 2697 tl_proc%i_pid=jk 2698 2699 tl_att=att_init("DOMAIN_number",tl_proc%i_pid) 2700 CALL file_add_att(tl_proc, tl_att) 2701 2702 ! processor indices 2703 tl_proc%i_iind=ji 2704 tl_proc%i_jind=jj 2705 2706 ! fill processor dimension and first indices 2707 tl_proc%i_impp = il_impp(ji,jj) 2708 tl_proc%i_jmpp = il_jmpp(ji,jj) 2709 2710 tl_att=att_init( "DOMAIN_poistion_first", & 2711 & (/tl_proc%i_impp, tl_proc%i_jmpp/) ) 2712 CALL file_add_att(tl_proc, tl_att) 2713 2714 tl_proc%i_lci = il_nlci(ji,jj) 2715 tl_proc%i_lcj = il_nlcj(ji,jj) 2716 2717 tl_att=att_init( "DOMAIN_poistion_last", & 2718 & (/tl_proc%i_lci, tl_proc%i_lcj/) ) 2719 CALL file_add_att(tl_proc, tl_att) 2720 2721 ! compute first and last indoor indices 2722 2723 ! west boundary 2724 IF( ji == 1 )THEN 2725 tl_proc%i_ldi = 1 2726 tl_proc%l_ctr = .TRUE. 2727 ELSE 2728 tl_proc%i_ldi = 1 + td_mpp%i_preci 2729 ENDIF 2730 2731 ! south boundary 2732 IF( jj == 1 )THEN 2733 tl_proc%i_ldj = 1 2734 tl_proc%l_ctr = .TRUE. 2735 ELSE 2736 tl_proc%i_ldj = 1 + td_mpp%i_precj 2737 ENDIF 2738 2739 ! east boundary 2740 IF( ji == td_mpp%i_niproc )THEN 2741 tl_proc%i_lei = il_nlci(ji,jj) 2742 tl_proc%l_ctr = .TRUE. 2743 ELSE 2744 tl_proc%i_lei = il_nlci(ji,jj) - td_mpp%i_preci 2745 ENDIF 2746 2747 ! north boundary 2748 IF( jj == td_mpp%i_njproc )THEN 2749 tl_proc%i_lej = il_nlcj(ji,jj) 2750 tl_proc%l_ctr = .TRUE. 2751 ELSE 2752 tl_proc%i_lej = il_nlcj(ji,jj) - td_mpp%i_precj 2753 ENDIF 2754 2755 tl_att=att_init( "DOMAIN_halo_size_start", & 2756 & (/tl_proc%i_ldi, tl_proc%i_ldj/) ) 2757 CALL file_add_att(tl_proc, tl_att) 2758 tl_att=att_init( "DOMAIN_halo_size_end", & 2759 & (/tl_proc%i_ldi, tl_proc%i_ldj/) ) 2760 CALL file_add_att(tl_proc, tl_att) 2761 2762 ! add processor to mpp structure 2763 CALL mpp__add_proc(td_mpp, tl_proc) 2764 2765 ! clean 2766 CALL att_clean(tl_att) 2767 CALL file_clean(tl_proc) 2768 2769 ENDDO 2770 ENDDO 2771 2772 DEALLOCATE( il_impp, il_jmpp ) 2773 DEALLOCATE( il_nlci, il_nlcj ) 2774 2775 END SUBROUTINE mpp__compute 3020 END SUBROUTINE mpp__create_layout 2776 3021 !------------------------------------------------------------------- 2777 3022 !> @brief 2778 !> This subroutine remove land processor from domain decomposition. 2779 !> 3023 !> This subroutine optimize the number of sub domain to be used, given mask. 3024 !> @details 3025 !> Actually it get the domain decomposition with the most land 3026 !> processors removed. 3027 !> If no land processor could be removed, it get the decomposition with the 3028 !> most sea processors. 3029 ! 2780 3030 !> @author J.Paul 2781 3031 !> @date November, 2013 - Initial version 2782 !> 3032 !> @date October, 2015 3033 !> - improve way to compute domain layout 3034 !> @date February, 2016 3035 !> - new criteria for domain layout in case no land proc 3036 ! 2783 3037 !> @param[inout] td_mpp mpp strcuture 2784 !> @param[in] id_mask sub domain mask (sea=1, land=0) 2785 !------------------------------------------------------------------- 2786 SUBROUTINE mpp__del_land( td_mpp, id_mask ) 3038 !> @param[in] id_mask sub domain mask (sea=1, land=0) 3039 !> @pram[in] id_nproc maximum number of processor to be used 3040 !------------------------------------------------------------------- 3041 SUBROUTINE mpp__optimiz( td_mpp, id_mask, id_nproc ) 2787 3042 IMPLICIT NONE 2788 3043 ! Argument 2789 3044 TYPE(TMPP), INTENT(INOUT) :: td_mpp 2790 3045 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 2791 2792 ! loop indices 2793 INTEGER(i4) :: jk 2794 !---------------------------------------------------------------- 2795 2796 IF( ASSOCIATED(td_mpp%t_proc) )THEN 2797 jk=1 2798 DO WHILE( jk <= td_mpp%i_nproc ) 2799 IF( mpp__land_proc(td_mpp, jk, id_mask(:,:)) )THEN 2800 CALL mpp__del_proc(td_mpp, jk) 2801 ELSE 2802 jk=jk+1 2803 ENDIF 2804 ENDDO 2805 ELSE 2806 CALL logger_error("MPP DEL LAND: domain decomposition not define.") 2807 ENDIF 2808 2809 END SUBROUTINE mpp__del_land 2810 !------------------------------------------------------------------- 2811 !> @brief 2812 !> This subroutine optimize the number of sub domain to be used, given mask. 2813 !> @details 2814 !> Actually it get the domain decomposition with the most land 2815 !> processor removed. 2816 ! 2817 !> @author J.Paul 2818 !> @date November, 2013 - Initial version 2819 ! 2820 !> @param[inout] td_mpp mpp strcuture 2821 !> @param[in] id_mask sub domain mask (sea=1, land=0) 2822 !------------------------------------------------------------------- 2823 SUBROUTINE mpp__optimiz( td_mpp, id_mask ) 2824 IMPLICIT NONE 2825 ! Argument 2826 TYPE(TMPP), INTENT(INOUT) :: td_mpp 2827 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 3046 INTEGER(i4) , INTENT(IN) :: id_nproc 2828 3047 2829 3048 ! local variable 2830 TYPE(TMPP) :: tl_mpp 2831 INTEGER(i4) :: il_maxproc 2832 2833 TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc 3049 TYPE(TLAY) :: tl_lay 3050 TYPE(TLAY) :: tl_sav 3051 3052 REAL(dp) :: dl_min 3053 REAL(dp) :: dl_max 3054 REAL(dp) :: dl_ratio 3055 REAL(dp) :: dl_sav 3056 2834 3057 ! loop indices 2835 3058 INTEGER(i4) :: ji … … 2838 3061 2839 3062 CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition") 2840 tl_mpp=mpp_copy(td_mpp) 2841 2842 ! save maximum number of processor to be used 2843 il_maxproc=td_mpp%i_nproc 3063 dl_sav=0 2844 3064 ! 2845 td_mpp%i_nproc=0 2846 DO ji=1,il_maxproc 2847 DO jj=1,il_maxproc 2848 2849 ! clean mpp processor 2850 IF( ASSOCIATED(tl_mpp%t_proc) )THEN 2851 CALL file_clean(tl_mpp%t_proc(:)) 2852 DEALLOCATE(tl_mpp%t_proc) 2853 ENDIF 2854 2855 ! compute domain decomposition 2856 tl_mpp%i_niproc=ji 2857 tl_mpp%i_njproc=jj 2858 2859 CALL mpp__compute( tl_mpp ) 2860 2861 ! remove land sub domain 2862 CALL mpp__del_land( tl_mpp, id_mask ) 2863 2864 CALL logger_info("MPP OPTIMIZ: number of processor "//& 2865 & TRIM(fct_str(tl_mpp%i_nproc)) ) 2866 IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 2867 & tl_mpp%i_nproc <= il_maxproc )THEN 2868 ! save optimiz decomposition 2869 2870 ! clean mpp 2871 CALL mpp_clean(td_mpp) 2872 2873 ! save processor array 2874 ALLOCATE( tl_proc(tl_mpp%i_nproc) ) 2875 tl_proc(:)=file_copy(tl_mpp%t_proc(:)) 2876 2877 ! remove pointer on processor array 2878 CALL file_clean(tl_mpp%t_proc(:)) 2879 DEALLOCATE(tl_mpp%t_proc) 2880 2881 ! save data except processor array 2882 td_mpp=mpp_copy(tl_mpp) 2883 2884 ! save processor array 2885 ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc) ) 2886 td_mpp%t_proc(:)=file_copy(tl_proc(:)) 2887 2888 ! clean 2889 CALL file_clean( tl_proc(:) ) 2890 DEALLOCATE(tl_proc) 2891 2892 ENDIF 2893 3065 DO ji=1,id_nproc 3066 DO jj=1,id_nproc 3067 3068 ! compute domain layout 3069 tl_lay=layout__init( td_mpp, id_mask, ji,jj ) 3070 IF( tl_lay%i_nsea <= id_nproc )THEN 3071 3072 IF( ASSOCIATED(tl_sav%i_lci) )THEN 3073 IF( tl_sav%i_nland /= 0 )THEN 3074 ! look for layout with most land proc 3075 IF( tl_lay%i_nland > tl_sav%i_nland .OR. & 3076 & ( tl_lay%i_nland == tl_sav%i_nland .AND. & 3077 & tl_lay%i_min > tl_sav%i_min ) )THEN 3078 ! save optimiz layout 3079 CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 3080 & TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 3081 & TRIM(fct_str(tl_lay%i_nsea)) ) 3082 3083 tl_sav=layout__copy(tl_lay) 3084 ENDIF 3085 ELSE ! tl_sav%i_nland == 0 3086 ! look for layout with most sea proc 3087 ! and "square" cell 3088 dl_min=MIN(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1)) 3089 dl_max=MAX(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1)) 3090 dl_ratio=dl_min/dl_max 3091 IF( tl_lay%i_nsea > tl_sav%i_nsea .OR. & 3092 & ( tl_lay%i_nsea == tl_sav%i_nsea .AND. & 3093 & dl_ratio > dl_sav ) )THEN 3094 ! save optimiz layout 3095 CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 3096 & TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 3097 & TRIM(fct_str(tl_lay%i_nsea)) ) 3098 3099 tl_sav=layout__copy(tl_lay) 3100 dl_sav=dl_ratio 3101 ENDIF 3102 ENDIF 3103 ELSE 3104 ! init tl_sav 3105 tl_sav=layout__copy(tl_lay) 3106 3107 dl_min=MIN(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1)) 3108 dl_max=MAX(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1)) 3109 dl_sav=dl_min/dl_max 3110 ENDIF 3111 3112 ENDIF 3113 3114 ! clean 3115 CALL layout__clean( tl_lay ) 3116 2894 3117 ENDDO 2895 3118 ENDDO 2896 3119 3120 ! create mpp domain layout 3121 CALL mpp__create_layout(td_mpp, tl_sav) 3122 2897 3123 ! clean 2898 CALL mpp_clean(tl_mpp)3124 CALL layout__clean( tl_sav ) 2899 3125 2900 3126 END SUBROUTINE mpp__optimiz 2901 !-------------------------------------------------------------------2902 !> @brief2903 !> This function check if processor is a land processor.2904 !>2905 !> @author J.Paul2906 !> @date November, 2013 - Initial version2907 !>2908 !> @param[in] td_mpp mpp strcuture2909 !> @param[in] id_proc processor id2910 !> @param[in] id_mask sub domain mask (sea=1, land=0)2911 !-------------------------------------------------------------------2912 LOGICAL FUNCTION mpp__land_proc( td_mpp , id_proc, id_mask )2913 IMPLICIT NONE2914 ! Argument2915 TYPE(TMPP), INTENT(IN) :: td_mpp2916 INTEGER(i4), INTENT(IN) :: id_proc2917 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask2918 2919 ! local variable2920 INTEGER(i4), DIMENSION(2) :: il_shape2921 !----------------------------------------------------------------2922 2923 CALL logger_trace("MPP LAND PROC: check processor "//TRIM(fct_str(id_proc))//&2924 & " of mpp "//TRIM(td_mpp%c_name) )2925 mpp__land_proc=.FALSE.2926 IF( ASSOCIATED(td_mpp%t_proc) )THEN2927 2928 il_shape(:)=SHAPE(id_mask)2929 IF( il_shape(1) /= td_mpp%t_dim(1)%i_len .OR. &2930 & il_shape(2) /= td_mpp%t_dim(2)%i_len )THEN2931 CALL logger_debug("MPP LAND PROC: mask size ("//&2932 & TRIM(fct_str(il_shape(1)))//","//&2933 & TRIM(fct_str(il_shape(2)))//")")2934 CALL logger_debug("MPP LAND PROC: domain size ("//&2935 & TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&2936 & TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")")2937 CALL logger_error("MPP LAND PROC: mask and domain size differ")2938 ELSE2939 IF( ALL(id_mask( td_mpp%t_proc(id_proc)%i_impp + &2940 & td_mpp%t_proc(id_proc)%i_ldi - 1 : &2941 & td_mpp%t_proc(id_proc)%i_impp + &2942 & td_mpp%t_proc(id_proc)%i_lei - 1, &2943 & td_mpp%t_proc(id_proc)%i_jmpp + &2944 & td_mpp%t_proc(id_proc)%i_ldj - 1 : &2945 & td_mpp%t_proc(id_proc)%i_jmpp + &2946 & td_mpp%t_proc(id_proc)%i_lej - 1) &2947 & /= 1 ) )THEN2948 ! land domain2949 CALL logger_info("MPP LAND PROC: processor "//TRIM(fct_str(id_proc))//&2950 & " is land processor")2951 mpp__land_proc=.TRUE.2952 ENDIF2953 ENDIF2954 2955 ELSE2956 CALL logger_error("MPP LAND PROC: domain decomposition not define.")2957 ENDIF2958 2959 END FUNCTION mpp__land_proc2960 3127 !------------------------------------------------------------------- 2961 3128 !> @brief … … 3146 3313 !> 3147 3314 !> @author J.Paul 3148 !> @date November, 2013 3315 !> @date November, 2013 - Initial version 3149 3316 !> 3150 3317 !> @param[inout] td_mpp mpp strcuture … … 3184 3351 !> 3185 3352 !> @author J.Paul 3186 !> @date November, 2013 3353 !> @date November, 2013 - Initial version 3187 3354 !> 3188 3355 !> @param[in] td_mpp mpp strcuture … … 3214 3381 SELECT CASE(TRIM(td_mpp%c_dom)) 3215 3382 CASE('full') 3216 il_i1 = 1 ; il_i2 = td_mpp%t_dim(1)%i_len 3217 il_j1 = 1 ; il_j2 = td_mpp%t_dim(2)%i_len 3218 CASE('overlap') 3219 il_i1 = td_mpp%t_proc(id_procid)%i_impp 3220 il_j1 = td_mpp%t_proc(id_procid)%i_jmpp 3221 3222 il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1 3223 il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1 3383 il_i1 = 1 3384 il_j1 = 1 3385 3386 il_i2 = td_mpp%t_dim(1)%i_len 3387 il_j2 = td_mpp%t_dim(2)%i_len 3388 CASE('noextra') 3389 il_i1 = td_mpp%t_proc(id_procid)%i_impp 3390 il_j1 = td_mpp%t_proc(id_procid)%i_jmpp 3391 3392 il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1 3393 il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1 3224 3394 CASE('nooverlap') 3225 3395 il_i1 = td_mpp%t_proc(id_procid)%i_impp + & … … 3233 3403 & td_mpp%t_proc(id_procid)%i_lej - 1 3234 3404 CASE DEFAULT 3235 CALL logger_error("MPP GET PROC INDEX: invalid decomposition type.") 3405 CALL logger_error("MPP GET PROC INDEX: invalid "//& 3406 & "decomposition type.") 3236 3407 END SELECT 3237 3408 … … 3249 3420 ! 3250 3421 !> @author J.Paul 3251 !> @date November, 2013 3422 !> @date November, 2013 - Initial version 3252 3423 ! 3253 3424 !> @param[in] td_mpp mpp strcuture … … 3283 3454 il_jsize = td_mpp%t_dim(2)%i_len 3284 3455 3285 CASE(' overlap')3456 CASE('noextra') 3286 3457 3287 3458 il_isize = td_mpp%t_proc(id_procid)%i_lci … … 3311 3482 !> 3312 3483 !> @author J.Paul 3313 !> @date November, 2013 3484 !> @date November, 2013 - Initial version 3314 3485 !> 3315 3486 !> @param[inout] td_mpp mpp strcuture … … 3327 3498 IF( ASSOCIATED(td_mpp%t_proc) )THEN 3328 3499 3329 IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_n iproc == 0 )THEN3500 IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_njproc == 0 )THEN 3330 3501 CALL logger_info("MPP GET DOM: use indoor indices to get domain "//& 3331 3502 & "decomposition type.") … … 3342 3513 & td_mpp%t_proc(1)%i_lcj ) )THEN 3343 3514 3344 td_mpp%c_dom=' overlap'3515 td_mpp%c_dom='noextra' 3345 3516 3346 3517 ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len == & … … 3387 3558 td_mpp%c_dom='nooverlap' 3388 3559 ELSE 3389 td_mpp%c_dom=' overlap'3560 td_mpp%c_dom='noextra' 3390 3561 ENDIF 3391 3562 … … 3404 3575 !> 3405 3576 !> @author J.Paul 3406 !> - November, 2013- Initial Version 3577 !> @date November, 2013 - Initial Version 3578 !> @date September 2015 3579 !> - do not check used dimension here 3407 3580 !> 3408 3581 !> @param[in] td_mpp mpp structure … … 3417 3590 3418 3591 ! local variable 3419 INTEGER(i4) :: il_ndim 3592 CHARACTER(LEN=lc) :: cl_dim 3593 LOGICAL :: ll_error 3594 LOGICAL :: ll_warn 3595 3596 INTEGER(i4) :: il_ind 3420 3597 3421 3598 ! loop indices … … 3423 3600 !---------------------------------------------------------------- 3424 3601 mpp__check_var_dim=.TRUE. 3602 3425 3603 ! check used dimension 3426 IF( ANY( td_var%t_dim(:)%l_use .AND. & 3427 & td_var%t_dim(:)%i_len /= td_mpp%t_dim(:)%i_len) )THEN 3604 ll_error=.FALSE. 3605 ll_warn=.FALSE. 3606 DO ji=1,ip_maxdim 3607 il_ind=dim_get_index( td_mpp%t_dim(:), & 3608 & TRIM(td_var%t_dim(ji)%c_name), & 3609 & TRIM(td_var%t_dim(ji)%c_sname)) 3610 IF( il_ind /= 0 )THEN 3611 IF( td_var%t_dim(ji)%l_use .AND. & 3612 & td_mpp%t_dim(il_ind)%l_use .AND. & 3613 & td_var%t_dim(ji)%i_len /= td_mpp%t_dim(il_ind)%i_len )THEN 3614 IF( INDEX( TRIM(td_var%c_axis), & 3615 & TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN 3616 ll_warn=.TRUE. 3617 ELSE 3618 ll_error=.TRUE. 3619 ENDIF 3620 ENDIF 3621 ENDIF 3622 ENDDO 3623 3624 IF( ll_error )THEN 3625 3626 cl_dim='(/' 3627 DO ji = 1, td_mpp%i_ndim 3628 IF( td_mpp%t_dim(ji)%l_use )THEN 3629 cl_dim=TRIM(cl_dim)//& 3630 & TRIM(fct_upper(td_mpp%t_dim(ji)%c_sname))//':'//& 3631 & TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//',' 3632 ENDIF 3633 ENDDO 3634 cl_dim=TRIM(cl_dim)//'/)' 3635 CALL logger_debug( " mpp dimension: "//TRIM(cl_dim) ) 3636 3637 cl_dim='(/' 3638 DO ji = 1, td_var%i_ndim 3639 IF( td_var%t_dim(ji)%l_use )THEN 3640 cl_dim=TRIM(cl_dim)//& 3641 & TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//& 3642 & TRIM(fct_str(td_var%t_dim(ji)%i_len))//',' 3643 ENDIF 3644 ENDDO 3645 cl_dim=TRIM(cl_dim)//'/)' 3646 CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 3428 3647 3429 3648 mpp__check_var_dim=.FALSE. 3430 3649 3431 3650 CALL logger_error( & 3432 & " MPP CHECK DIM: variable and mppdimension differ"//&3651 & " MPP CHECK VAR DIM: variable and file dimension differ"//& 3433 3652 & " for variable "//TRIM(td_var%c_name)//& 3434 & " and mpp"//TRIM(td_mpp%c_name))3435 3436 CALL logger_debug( &3437 & " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//&3438 & " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) )3439 il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim )3440 DO ji = 1, il_ndim3441 CALL logger_debug( &3442 & "MPP CHECK DIM: for dimension "//&3443 & TRIM(td_mpp%t_dim(ji)%c_name)//& 3444 & ", mpp length: "//&3445 & TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//&3446 & ", variable length:"//&3447 & TRIM( fct_str(td_var%t_dim(ji)%i_len))//&3448 & ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use)))3449 ENDDO 3653 & " and file "//TRIM(td_mpp%c_name)) 3654 3655 ELSEIF( ll_warn )THEN 3656 CALL logger_warn( & 3657 & " MPP CHECK VAR DIM: variable and file dimension differ"//& 3658 & " for variable "//TRIM(td_var%c_name)//& 3659 & " and file "//TRIM(td_mpp%c_name)//". you should use"//& 3660 & " var_check_dim to remove useless dimension.") 3661 ELSE 3662 3663 IF( td_var%i_ndim > td_mpp%i_ndim )THEN 3664 CALL logger_info("MPP CHECK VAR DIM: variable "//& 3665 & TRIM(td_var%c_name)//" use more dimension than file "//& 3666 & TRIM(td_mpp%c_name)//" do until now.") 3667 ENDIF 3668 3450 3669 ENDIF 3451 3670 … … 3456 3675 ! 3457 3676 !> @author J.Paul 3458 !> - November, 2013- Initial Version3677 !> @date November, 2013 - Initial Version 3459 3678 ! 3460 3679 !> @param[in] td_file array of file structure … … 3496 3715 ! 3497 3716 !> @author J.Paul 3498 !> - Ocotber, 2014- Initial Version3717 !> @date Ocotber, 2014 - Initial Version 3499 3718 ! 3500 3719 !> @param[in] td_mpp mpp file structure … … 3603 3822 ENDIF 3604 3823 END FUNCTION mpp_recombine_var 3824 !------------------------------------------------------------------- 3825 !> @brief This subroutine read subdomain indices defined with halo 3826 !> (NEMO netcdf way) 3827 !> 3828 !> @author J.Paul 3829 !> @date January, 2016 - Initial Version 3830 !> 3831 !> @param[inout] td_file mpp structure 3832 !------------------------------------------------------------------- 3833 SUBROUTINE mpp__read_halo(td_file, td_dimglo) 3834 IMPLICIT NONE 3835 ! Argument 3836 TYPE(TFILE) , INTENT(INOUT) :: td_file 3837 TYPE(TDIM) , DIMENSION(:), INTENT(IN ) :: td_dimglo 3838 3839 ! local variable 3840 INTEGER(i4) :: il_attid 3841 INTEGER(i4) :: il_ifirst 3842 INTEGER(i4) :: il_jfirst 3843 INTEGER(i4) :: il_ilast 3844 INTEGER(i4) :: il_jlast 3845 INTEGER(i4) :: il_ihalostart 3846 INTEGER(i4) :: il_jhalostart 3847 INTEGER(i4) :: il_ihaloend 3848 INTEGER(i4) :: il_jhaloend 3849 3850 CHARACTER(LEN=lc) :: cl_dom 3851 !---------------------------------------------------------------- 3852 3853 ! DOMAIN_position_first 3854 il_attid = 0 3855 IF( ASSOCIATED(td_file%t_att) )THEN 3856 il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" ) 3857 ENDIF 3858 IF( il_attid /= 0 )THEN 3859 il_ifirst = INT(td_file%t_att(il_attid)%d_value(1)) 3860 il_jfirst = INT(td_file%t_att(il_attid)%d_value(2)) 3861 ELSE 3862 il_ifirst = 1 3863 il_jfirst = 1 3864 ENDIF 3865 3866 ! DOMAIN_position_last 3867 il_attid = 0 3868 IF( ASSOCIATED(td_file%t_att) )THEN 3869 il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" ) 3870 ENDIF 3871 IF( il_attid /= 0 )THEN 3872 il_ilast = INT(td_file%t_att(il_attid)%d_value(1)) 3873 il_jlast = INT(td_file%t_att(il_attid)%d_value(2)) 3874 ELSE 3875 il_ilast = td_file%t_dim(1)%i_len 3876 il_jlast = td_file%t_dim(2)%i_len 3877 ENDIF 3878 3879 ! DOMAIN_halo_size_start 3880 il_attid = 0 3881 IF( ASSOCIATED(td_file%t_att) )THEN 3882 il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" ) 3883 ENDIF 3884 IF( il_attid /= 0 )THEN 3885 il_ihalostart = INT(td_file%t_att(il_attid)%d_value(1)) 3886 il_jhalostart = INT(td_file%t_att(il_attid)%d_value(2)) 3887 ELSE 3888 il_ihalostart = 0 3889 il_jhalostart = 0 3890 ENDIF 3891 3892 ! DOMAIN_halo_size_end 3893 il_attid = 0 3894 IF( ASSOCIATED(td_file%t_att) )THEN 3895 il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" ) 3896 ENDIF 3897 IF( il_attid /= 0 )THEN 3898 il_ihaloend = INT(td_file%t_att(il_attid)%d_value(1)) 3899 il_jhaloend = INT(td_file%t_att(il_attid)%d_value(2)) 3900 ELSE 3901 il_ihaloend = 0 3902 il_jhaloend = 0 3903 ENDIF 3904 3905 IF( (td_dimglo(jp_I)%i_len == td_file%t_dim(jp_I)%i_len) .AND. & 3906 & (td_dimglo(jp_J)%i_len == td_file%t_dim(jp_J)%i_len) )THEN 3907 cl_dom='full' 3908 ELSEIF( il_ihalostart == 0 .AND. il_jhalostart == 0 .AND. & 3909 & il_ihaloend == 0 .AND. il_jhaloend == 0 )THEN 3910 cl_dom='nooverlap' 3911 ELSE 3912 cl_dom='noextra' 3913 ENDIF 3914 3915 SELECT CASE(TRIM(cl_dom)) 3916 CASE('full') 3917 td_file%i_impp = il_ifirst 3918 td_file%i_jmpp = il_jfirst 3919 td_file%i_lci = td_file%t_dim(jp_I)%i_len 3920 td_file%i_lcj = td_file%t_dim(jp_J)%i_len 3921 td_file%i_ldi = il_ihalostart + 1 3922 td_file%i_ldj = il_jhalostart + 1 3923 td_file%i_lei = td_file%t_dim(jp_I)%i_len - il_ihaloend 3924 td_file%i_lej = td_file%t_dim(jp_J)%i_len - il_jhaloend 3925 CASE('noextra') 3926 td_file%i_impp = il_ifirst 3927 td_file%i_jmpp = il_jfirst 3928 td_file%i_lci = td_file%t_dim(jp_I)%i_len 3929 td_file%i_lcj = td_file%t_dim(jp_J)%i_len 3930 td_file%i_ldi = il_ihalostart + 1 3931 td_file%i_ldj = il_jhalostart + 1 3932 td_file%i_lei = td_file%i_lci - il_ihaloend 3933 td_file%i_lej = td_file%i_lcj - il_jhaloend 3934 CASE('nooverlap') !!!????? 3935 td_file%i_impp = il_ifirst 3936 td_file%i_jmpp = il_jfirst 3937 td_file%i_lci = td_file%t_dim(jp_I)%i_len 3938 td_file%i_lcj = td_file%t_dim(jp_J)%i_len 3939 td_file%i_ldi = 1 3940 td_file%i_ldj = 1 3941 td_file%i_lei = td_file%t_dim(jp_I)%i_len 3942 td_file%i_lej = td_file%t_dim(jp_J)%i_len 3943 END SELECT 3944 3945 END SUBROUTINE mpp__read_halo 3946 !------------------------------------------------------------------- 3947 !> @brief This subroutine compute subdomain indices defined with halo 3948 !> (NEMO netcdf way) 3949 !> 3950 !> @author J.Paul 3951 !> @date January, 2016 - Initial Version 3952 !> 3953 !> @param[inout] td_mpp mpp structure 3954 !------------------------------------------------------------------- 3955 SUBROUTINE mpp__compute_halo(td_mpp) 3956 IMPLICIT NONE 3957 ! Argument 3958 TYPE(TMPP) , INTENT(INOUT) :: td_mpp 3959 3960 ! local variable 3961 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ifirst 3962 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jfirst 3963 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ilast 3964 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jlast 3965 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihalostart 3966 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhalostart 3967 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihaloend 3968 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhaloend 3969 3970 TYPE(TATT) :: tl_att 3971 3972 ! loop indices 3973 INTEGER(i4) :: ji 3974 !---------------------------------------------------------------- 3975 3976 ALLOCATE( il_ifirst (td_mpp%i_nproc) ) 3977 ALLOCATE( il_jfirst (td_mpp%i_nproc) ) 3978 3979 ALLOCATE( il_ilast (td_mpp%i_nproc) ) 3980 ALLOCATE( il_jlast (td_mpp%i_nproc) ) 3981 3982 ALLOCATE( il_ihalostart(td_mpp%i_nproc) ) 3983 ALLOCATE( il_jhalostart(td_mpp%i_nproc) ) 3984 3985 ALLOCATE( il_ihaloend (td_mpp%i_nproc) ) 3986 ALLOCATE( il_jhaloend (td_mpp%i_nproc) ) 3987 3988 SELECT CASE(TRIM(td_mpp%c_dom)) 3989 CASE('full') 3990 3991 il_ifirst(:)=td_mpp%t_proc(:)%i_impp 3992 il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp 3993 3994 il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%t_dim(jp_I)%i_len - 1 3995 il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%t_dim(jp_J)%i_len - 1 3996 3997 il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1 3998 il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1 3999 4000 il_ihaloend(:)=td_mpp%t_proc(:)%t_dim(jp_I)%i_len - td_mpp%t_proc(:)%i_lei 4001 il_jhaloend(:)=td_mpp%t_proc(:)%t_dim(jp_J)%i_len - td_mpp%t_proc(:)%i_lej 4002 4003 CASE('noextra') 4004 4005 il_ifirst(:)=td_mpp%t_proc(:)%i_impp 4006 il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp 4007 4008 il_ilast(:) =td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lci - 1 4009 il_jlast(:) =td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lcj - 1 4010 4011 il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1 4012 il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1 4013 4014 il_ihaloend(:)=td_mpp%t_proc(:)%i_lci - td_mpp%t_proc(:)%i_lei 4015 il_jhaloend(:)=td_mpp%t_proc(:)%i_lcj - td_mpp%t_proc(:)%i_lej 4016 4017 CASE('nooverlap') 4018 4019 il_ifirst(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_ldi - 1 4020 il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_ldj - 1 4021 4022 il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lei - 1 4023 il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lej - 1 4024 4025 il_ihalostart(:)=0 4026 il_jhalostart(:)=0 4027 4028 il_ihaloend(:)=0 4029 il_jhaloend(:)=0 4030 4031 CASE DEFAULT 4032 CALL logger_fatal("MPP INIT: invalid "//& 4033 & "decomposition type.") 4034 END SELECT 4035 4036 DO ji=1,td_mpp%i_nproc 4037 tl_att=att_init( "DOMAIN_position_first", & 4038 & (/ il_ifirst(ji), il_jfirst(ji) /) ) 4039 CALL file_move_att(td_mpp%t_proc(ji), tl_att) 4040 4041 tl_att=att_init( "DOMAIN_position_last", & 4042 & (/ il_ilast(ji), il_jlast(ji) /) ) 4043 CALL file_move_att(td_mpp%t_proc(ji), tl_att) 4044 4045 tl_att=att_init( "DOMAIN_halo_size_start", & 4046 & (/ il_ihalostart(ji), il_jhalostart(ji) /) ) 4047 CALL file_move_att( td_mpp%t_proc(ji), tl_att) 4048 4049 tl_att=att_init( "DOMAIN_halo_size_end", & 4050 & (/ il_ihaloend(ji), il_jhaloend(ji) /) ) 4051 CALL file_move_att( td_mpp%t_proc(ji), tl_att) 4052 ENDDO 4053 4054 DEALLOCATE( il_ifirst ) 4055 DEALLOCATE( il_jfirst ) 4056 4057 DEALLOCATE( il_ilast ) 4058 DEALLOCATE( il_jlast ) 4059 4060 DEALLOCATE( il_ihalostart) 4061 DEALLOCATE( il_jhalostart) 4062 4063 DEALLOCATE( il_ihaloend ) 4064 DEALLOCATE( il_jhaloend ) 4065 4066 !impp 4067 tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", td_mpp%t_proc(:)%i_impp) 4068 CALL mpp_move_att(td_mpp, tl_att) 4069 4070 tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", td_mpp%t_proc(:)%i_jmpp) 4071 CALL mpp_move_att(td_mpp, tl_att) 4072 4073 ! lci 4074 tl_att=att_init( "SUBDOMAIN_I_dimensions", td_mpp%t_proc(:)%i_lci) 4075 CALL mpp_move_att(td_mpp, tl_att) 4076 4077 tl_att=att_init( "SUBDOMAIN_J_dimensions", td_mpp%t_proc(:)%i_lcj) 4078 CALL mpp_move_att(td_mpp, tl_att) 4079 4080 ! ldi 4081 tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", td_mpp%t_proc(:)%i_ldi) 4082 CALL mpp_move_att(td_mpp, tl_att) 4083 4084 tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", td_mpp%t_proc(:)%i_ldj) 4085 CALL mpp_move_att(td_mpp, tl_att) 4086 4087 ! lei 4088 tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", td_mpp%t_proc(:)%i_lei) 4089 CALL mpp_move_att(td_mpp, tl_att) 4090 4091 tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", td_mpp%t_proc(:)%i_lej) 4092 CALL mpp_move_att(td_mpp, tl_att) 4093 4094 ! clean 4095 CALL att_clean(tl_att) 4096 4097 END SUBROUTINE mpp__compute_halo 3605 4098 END MODULE mpp 3606 4099
Note: See TracChangeset
for help on using the changeset viewer.
