- Timestamp:
- 2015-11-13T08:01:08+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r5836 r5883 23 23 !! the mppobc routine to optimize the BDY and OBC communications 24 24 !! 3.5 ! 2013 ( C. Ethe, G. Madec ) message passing arrays as local variables 25 !! 3.5 ! 2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations25 !! 3.5 ! 2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 26 26 !!---------------------------------------------------------------------- 27 27 … … 2662 2662 END SUBROUTINE mpp_lbc_north_e 2663 2663 2664 SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy ) 2664 2665 SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy ) 2665 2666 !!---------------------------------------------------------------------- 2666 2667 !! *** routine mpp_lnk_bdy_3d *** … … 2683 2684 !! 2684 2685 !!---------------------------------------------------------------------- 2685 2686 USE lbcnfd ! north fold2687 2688 INCLUDE 'mpif.h'2689 2690 2686 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied 2691 2687 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points … … 2694 2690 ! ! = 1. , the sign is kept 2695 2691 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 2692 ! 2696 2693 INTEGER :: ji, jj, jk, jl ! dummy loop indices 2697 INTEGER :: imigr, iihom, ijhom ! temporaryintegers2694 INTEGER :: imigr, iihom, ijhom ! local integers 2698 2695 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 2699 REAL(wp) :: zland 2696 REAL(wp) :: zland ! local scalar 2700 2697 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 2701 2698 ! 2702 2699 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 2703 2700 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 2704 2705 !!---------------------------------------------------------------------- 2706 2701 !!---------------------------------------------------------------------- 2702 ! 2707 2703 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 2708 2704 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 2709 2705 2710 zland = 0. e02706 zland = 0.-WP 2711 2707 2712 2708 ! 1. standard boundary treatment 2713 2709 ! ------------------------------ 2714 2715 2710 ! ! East-West boundaries 2716 2711 ! !* Cyclic east-west 2717 2718 2712 IF( nbondi == 2) THEN 2719 IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN2720 ptab( 1 ,:,:) = ptab(jpim1,:,:)2721 ptab(jpi,:,:) = ptab( 2 ,:,:)2722 ELSE2723 IF( .NOT. cd_type == 'F' ) ptab( 1:jpreci,:,:) = zland ! south except F-point2724 ptab(nlci-jpreci+1:jpi,:,:) = zland ! north2725 ENDIF2713 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 2714 ptab( 1 ,:,:) = ptab(jpim1,:,:) 2715 ptab(jpi,:,:) = ptab( 2 ,:,:) 2716 ELSE 2717 IF( .NOT. cd_type == 'F' ) ptab(1:jpreci,:,:) = zland ! south except F-point 2718 ptab(nlci-jpreci+1:jpi,:,:) = zland ! north 2719 ENDIF 2726 2720 ELSEIF(nbondi == -1) THEN 2727 IF( .NOT. cd_type == 'F' ) ptab( 1:jpreci,:,:) = zland ! south except F-point2721 IF( .NOT. cd_type == 'F' ) ptab(1:jpreci,:,:) = zland ! south except F-point 2728 2722 ELSEIF(nbondi == 1) THEN 2729 ptab(nlci-jpreci+1:jpi,:,:) = zland ! north2723 ptab(nlci-jpreci+1:jpi,:,:) = zland ! north 2730 2724 ENDIF !* closed 2731 2725 2732 2726 IF (nbondj == 2 .OR. nbondj == -1) THEN 2733 IF( .NOT. cd_type == 'F' ) ptab(:, 1:jprecj,:) = zland ! south except F-point2727 IF( .NOT. cd_type == 'F' ) ptab(:,1:jprecj,:) = zland ! south except F-point 2734 2728 ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 2735 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 2736 ENDIF 2737 2738 ! 2739 2729 ptab(:,nlcj-jprecj+1:jpj,:) = zland ! north 2730 ENDIF 2731 ! 2740 2732 ! 2. East and west directions exchange 2741 2733 ! ------------------------------------ … … 2794 2786 CASE ( 0 ) 2795 2787 DO jl = 1, jpreci 2796 ptab( jl,:,:) = zt3we(:,jl,:,2)2788 ptab( jl,:,:) = zt3we(:,jl,:,2) 2797 2789 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 2798 2790 END DO 2799 2791 CASE ( 1 ) 2800 2792 DO jl = 1, jpreci 2801 ptab( jl,:,:) = zt3we(:,jl,:,2)2793 ptab( jl,:,:) = zt3we(:,jl,:,2) 2802 2794 END DO 2803 2795 END SELECT … … 2885 2877 END SUBROUTINE mpp_lnk_bdy_3d 2886 2878 2887 SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy ) 2879 2880 SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy ) 2888 2881 !!---------------------------------------------------------------------- 2889 2882 !! *** routine mpp_lnk_bdy_2d *** … … 2906 2899 !! 2907 2900 !!---------------------------------------------------------------------- 2908 2909 USE lbcnfd ! north fold 2910 2911 INCLUDE 'mpif.h' 2912 2913 REAL(wp), DIMENSION(jpi,jpj) , INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied 2914 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 2915 ! ! = T , U , V , F , W points 2916 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 2917 ! ! = 1. , the sign is kept 2918 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 2901 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied 2902 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 2903 ! ! = T , U , V , F , W points 2904 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 2905 ! ! = 1. , the sign is kept 2906 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 2907 ! 2919 2908 INTEGER :: ji, jj, jl ! dummy loop indices 2920 INTEGER :: imigr, iihom, ijhom ! temporaryintegers2909 INTEGER :: imigr, iihom, ijhom ! local integers 2921 2910 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 2922 2911 REAL(wp) :: zland … … 2925 2914 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 2926 2915 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 2927 2928 2916 !!---------------------------------------------------------------------- 2929 2917 … … 2931 2919 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 2932 2920 2933 zland = 0. e02921 zland = 0._wp 2934 2922 2935 2923 ! 1. standard boundary treatment 2936 2924 ! ------------------------------ 2937 2938 2925 ! ! East-West boundaries 2939 ! !* Cyclic east-west 2940 2941 IF( nbondi == 2) THEN 2942 IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 2943 ptab( 1 ,:) = ptab(jpim1,:) 2944 ptab(jpi,:) = ptab( 2 ,:) 2945 ELSE 2946 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:) = zland ! south except F-point 2947 ptab(nlci-jpreci+1:jpi ,:) = zland ! north 2948 ENDIF 2926 ! !* Cyclic east-west 2927 IF( nbondi == 2 ) THEN 2928 IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 2929 ptab( 1 ,:) = ptab(jpim1,:) 2930 ptab(jpi,:) = ptab( 2 ,:) 2931 ELSE 2932 IF(.NOT.cd_type == 'F' ) ptab( 1 :jpreci,:) = zland ! south except F-point 2933 ptab(nlci-jpreci+1:jpi ,:) = zland ! north 2934 ENDIF 2949 2935 ELSEIF(nbondi == -1) THEN 2950 IF( .NOT. cd_type == 'F' )ptab( 1 :jpreci,:) = zland ! south except F-point2936 IF( .NOT.cd_type == 'F' ) ptab( 1 :jpreci,:) = zland ! south except F-point 2951 2937 ELSEIF(nbondi == 1) THEN 2952 ptab(nlci-jpreci+1:jpi ,:) = zland ! north2953 ENDIF !* closed2954 2955 IF (nbondj == 2 .OR. nbondj == -1) THEN2956 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj) = zland! south except F-point2938 ptab(nlci-jpreci+1:jpi ,:) = zland ! north 2939 ENDIF 2940 ! !* closed 2941 IF( nbondj == 2 .OR. nbondj == -1 ) THEN 2942 IF( .NOT.cd_type == 'F' ) ptab(:, 1 :jprecj) = zland ! south except F-point 2957 2943 ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 2958 ptab(:,nlcj-jprecj+1:jpj) = zland ! north 2959 ENDIF 2960 2961 ! 2962 2944 ptab(:,nlcj-jprecj+1:jpj ) = zland ! north 2945 ENDIF 2946 ! 2963 2947 ! 2. East and west directions exchange 2964 2948 ! ------------------------------------ … … 3107 3091 ! 3108 3092 END SUBROUTINE mpp_lnk_bdy_2d 3093 3109 3094 3110 3095 SUBROUTINE mpi_init_opa( ldtxt, ksft, code ) … … 3196 3181 END SUBROUTINE DDPDD_MPI 3197 3182 3183 3198 3184 SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj) 3199 3185 !!--------------------------------------------------------------------- … … 3218 3204 !! ! north fold, = 1. otherwise 3219 3205 INTEGER, OPTIONAL , INTENT(in ) :: pr2dj 3206 ! 3220 3207 INTEGER :: ji, jj, jr 3221 3208 INTEGER :: ierr, itaille, ildi, ilei, iilb … … 3224 3211 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 3225 3212 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 3226 3227 3213 !!---------------------------------------------------------------------- 3228 3214 ! … … 3234 3220 ENDIF 3235 3221 ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) ) 3236 3237 ! 3238 ztab_e(:,:) = 0.e0 3239 3240 ij=0 3222 ! 3223 ztab_e(:,:) = 0._wp 3224 ! 3225 ij = 0 3241 3226 ! put in znorthloc_e the last 4 jlines of pt2d 3242 3227 DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj … … 3280 3265 ! 3281 3266 END SUBROUTINE mpp_lbc_north_icb 3267 3282 3268 3283 3269 SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj ) … … 3300 3286 !! noso : number for local neighboring processors 3301 3287 !! nono : number for local neighboring processors 3302 !!3303 3288 !!---------------------------------------------------------------------- 3304 3289 INTEGER , INTENT(in ) :: jpri … … 3459 3444 3460 3445 END SUBROUTINE mpp_lnk_2d_icb 3446 3461 3447 #else 3462 3448 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
