Changeset 3918 for trunk/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2013-06-13T12:50:37+02:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3799 r3918 162 162 163 163 ! Arrays used in mpp_lbc_north_3d() 164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: ztab, znorthloc165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: znorthgloio166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: zfoldwk ! Workspace for message transfers avoiding mpi_allgather164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tab_3d, xnorthloc 165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: xnorthgloio 166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: foldwk ! Workspace for message transfers avoiding mpi_allgather 167 167 168 168 ! Arrays used in mpp_lbc_north_2d() 169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_2d, znorthloc_2d170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_2d171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: zfoldwk_2d ! Workspace for message transfers avoiding mpi_allgather169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_2d, xnorthloc_2d 170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_2d 171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: foldwk_2d ! Workspace for message transfers avoiding mpi_allgather 172 172 173 173 ! Arrays used in mpp_lbc_north_e() 174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_e, znorthloc_e175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_e174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_e, xnorthloc_e 175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_e 176 176 177 177 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public … … 207 207 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , & 208 208 ! 209 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , &210 & zfoldwk(jpi,4,jpk) , &211 ! 212 & ztab_2d(jpiglo,4) , znorthloc_2d(jpi,4) , znorthgloio_2d(jpi,4,jpni) , &213 & zfoldwk_2d(jpi,4) , &214 ! 215 & ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) , &209 & tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) , & 210 & foldwk(jpi,4,jpk) , & 211 ! 212 & tab_2d(jpiglo,4) , xnorthloc_2d(jpi,4) , xnorthgloio_2d(jpi,4,jpni) , & 213 & foldwk_2d(jpi,4) , & 214 ! 215 & tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) , & 216 216 ! 217 217 & STAT=lib_mpp_alloc ) … … 2598 2598 ityp = -1 2599 2599 ijpjm1 = 3 2600 ztab(:,:,:) = 0.e02601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d2600 tab_3d(:,:,:) = 0.e0 2601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d 2603 2603 ij = jj - nlcj + ijpj 2604 znorthloc(:,ij,:) = pt3d(:,jj,:)2604 xnorthloc(:,ij,:) = pt3d(:,jj,:) 2605 2605 END DO 2606 2606 ! 2607 ! ! Build in procs of ncomm_north the znorthgloio2607 ! ! Build in procs of ncomm_north the xnorthgloio 2608 2608 itaille = jpi * jpk * ijpj 2609 2609 IF ( l_north_nogather ) THEN … … 2615 2615 ij = jj - nlcj + ijpj 2616 2616 DO ji = 1, nlci 2617 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)2617 tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2618 2618 END DO 2619 2619 END DO … … 2640 2640 2641 2641 DO jr = 1,nsndto(ityp) 2642 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )2642 CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2643 2643 END DO 2644 2644 DO jr = 1,nsndto(ityp) 2645 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))2645 CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp)) 2646 2646 iproc = isendto(jr,ityp) + 1 2647 2647 ildi = nldit (iproc) … … 2650 2650 DO jj = 1, ijpj 2651 2651 DO ji = ildi, ilei 2652 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)2652 tab_3d(ji+iilb-1,jj,:) = foldwk(ji,jj,:) 2653 2653 END DO 2654 2654 END DO … … 2665 2665 2666 2666 IF ( ityp .lt. 0 ) THEN 2667 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, &2668 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2667 CALL MPI_ALLGATHER( xnorthloc , itaille, MPI_DOUBLE_PRECISION, & 2668 & xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2669 2669 ! 2670 2670 DO jr = 1, ndim_rank_north ! recover the global north array … … 2675 2675 DO jj = 1, ijpj 2676 2676 DO ji = ildi, ilei 2677 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)2677 tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr) 2678 2678 END DO 2679 2679 END DO … … 2681 2681 ENDIF 2682 2682 ! 2683 ! The ztabarray has been either:2683 ! The tab_3d array has been either: 2684 2684 ! a. Fully populated by the mpi_allgather operation or 2685 2685 ! b. Had the active points for this domain and northern neighbours populated … … 2688 2688 ! this domain will be identical. 2689 2689 ! 2690 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition2690 CALL lbc_nfd( tab_3d, cd_type, psgn ) ! North fold boundary condition 2691 2691 ! 2692 2692 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d 2693 2693 ij = jj - nlcj + ijpj 2694 2694 DO ji= 1, nlci 2695 pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)2695 pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:) 2696 2696 END DO 2697 2697 END DO … … 2730 2730 ityp = -1 2731 2731 ijpjm1 = 3 2732 ztab_2d(:,:) = 0.e02733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc_2d the last 4 jlines of pt2d2732 tab_2d(:,:) = 0.e0 2733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in xnorthloc_2d the last 4 jlines of pt2d 2735 2735 ij = jj - nlcj + ijpj 2736 znorthloc_2d(:,ij) = pt2d(:,jj)2736 xnorthloc_2d(:,ij) = pt2d(:,jj) 2737 2737 END DO 2738 2738 2739 ! ! Build in procs of ncomm_north the znorthgloio_2d2739 ! ! Build in procs of ncomm_north the xnorthgloio_2d 2740 2740 itaille = jpi * ijpj 2741 2741 IF ( l_north_nogather ) THEN … … 2747 2747 ij = jj - nlcj + ijpj 2748 2748 DO ji = 1, nlci 2749 ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)2749 tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 2750 2750 END DO 2751 2751 END DO … … 2773 2773 2774 2774 DO jr = 1,nsndto(ityp) 2775 CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )2775 CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2776 2776 END DO 2777 2777 DO jr = 1,nsndto(ityp) 2778 CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp))2778 CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp)) 2779 2779 iproc = isendto(jr,ityp) + 1 2780 2780 ildi = nldit (iproc) … … 2783 2783 DO jj = 1, ijpj 2784 2784 DO ji = ildi, ilei 2785 ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj)2785 tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj) 2786 2786 END DO 2787 2787 END DO … … 2798 2798 2799 2799 IF ( ityp .lt. 0 ) THEN 2800 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, &2801 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2800 CALL MPI_ALLGATHER( xnorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2801 & xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2802 2802 ! 2803 2803 DO jr = 1, ndim_rank_north ! recover the global north array … … 2808 2808 DO jj = 1, ijpj 2809 2809 DO ji = ildi, ilei 2810 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)2810 tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr) 2811 2811 END DO 2812 2812 END DO … … 2814 2814 ENDIF 2815 2815 ! 2816 ! The ztab array has been either:2816 ! The tab array has been either: 2817 2817 ! a. Fully populated by the mpi_allgather operation or 2818 2818 ! b. Had the active points for this domain and northern neighbours populated … … 2821 2821 ! this domain will be identical. 2822 2822 ! 2823 CALL lbc_nfd( ztab_2d, cd_type, psgn ) ! North fold boundary condition2823 CALL lbc_nfd( tab_2d, cd_type, psgn ) ! North fold boundary condition 2824 2824 ! 2825 2825 ! … … 2827 2827 ij = jj - nlcj + ijpj 2828 2828 DO ji = 1, nlci 2829 pt2d(ji,jj) = ztab_2d(ji+nimpp-1,ij)2829 pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij) 2830 2830 END DO 2831 2831 END DO … … 2860 2860 ! 2861 2861 ijpj=4 2862 ztab_e(:,:) = 0.e02862 tab_e(:,:) = 0.e0 2863 2863 2864 2864 ij=0 2865 ! put in znorthloc_e the last 4 jlines of pt2d2865 ! put in xnorthloc_e the last 4 jlines of pt2d 2866 2866 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 2867 2867 ij = ij + 1 2868 2868 DO ji = 1, jpi 2869 znorthloc_e(ji,ij)=pt2d(ji,jj)2869 xnorthloc_e(ji,ij)=pt2d(ji,jj) 2870 2870 END DO 2871 2871 END DO 2872 2872 ! 2873 2873 itaille = jpi * ( ijpj + 2 * jpr2dj ) 2874 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &2875 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2874 CALL MPI_ALLGATHER( xnorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2875 & xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2876 2876 ! 2877 2877 DO jr = 1, ndim_rank_north ! recover the global north array … … 2882 2882 DO jj = 1, ijpj+2*jpr2dj 2883 2883 DO ji = ildi, ilei 2884 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)2884 tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr) 2885 2885 END DO 2886 2886 END DO … … 2890 2890 ! 2. North-Fold boundary conditions 2891 2891 ! ---------------------------------- 2892 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )2892 CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 2893 2893 2894 2894 ij = jpr2dj … … 2897 2897 ij = ij +1 2898 2898 DO ji= 1, nlci 2899 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)2899 pt2d(ji,jj) = tab_e(ji+nimpp-1,ij) 2900 2900 END DO 2901 2901 END DO
Note: See TracChangeset
for help on using the changeset viewer.