- Timestamp:
- 2017-04-13T05:46:23+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 edited
-
LBC/lib_mpp.F90 (modified) (22 diffs)
-
SBC/sbcwave.F90 (modified) (1 diff)
-
stpctl.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7897 r7901 147 147 ! variables used for zonal integration 148 148 INTEGER, PUBLIC :: ncomm_znl !: communicator made by the processors on the same zonal average 149 LOGICAL, PUBLIC :: l_znl_root ! 149 LOGICAL, PUBLIC :: l_znl_root !: True on the 'left'most processor on the same row 150 150 INTEGER :: ngrp_znl ! group ID for the znl processors 151 151 INTEGER :: ndim_rank_znl ! number of processors on the same zonal average … … 163 163 164 164 ! Type of send : standard, buffered, immediate 165 CHARACTER(len=1), PUBLIC :: cn_mpi_send 166 LOGICAL , PUBLIC :: l_isend = .FALSE. 167 INTEGER , PUBLIC :: nn_buffer 165 CHARACTER(len=1), PUBLIC :: cn_mpi_send !: type od mpi send/recieve (S=standard, B=bsend, I=isend) 166 LOGICAL , PUBLIC :: l_isend = .FALSE. !: isend use indicator (T if cn_mpi_send='I') 167 INTEGER , PUBLIC :: nn_buffer !: size of the buffer in case of mpi_bsend 168 168 169 169 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend … … 266 266 END SELECT 267 267 ! 268 ELSE 268 ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN 269 269 WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator ' ; ii = ii + 1 270 270 WRITE(ldtxt(ii),*) ' without calling MPI_Init before ! ' ; ii = ii + 1 … … 336 336 !! ** Method : Use mppsend and mpprecv function for passing mask 337 337 !! between processors following neighboring subdomains. 338 !! domain parameters338 !! domain parameters 339 339 !! nlci : first dimension of the local subdomain 340 340 !! nlcj : second dimension of the local subdomain … … 446 446 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 447 447 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 448 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )448 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err ) 449 449 END SELECT 450 450 ! … … 487 487 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 488 488 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 489 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )489 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err ) 490 490 CASE ( 0 ) 491 491 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) … … 493 493 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 494 494 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 495 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )496 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err )495 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err ) 496 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err ) 497 497 CASE ( 1 ) 498 498 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) … … 759 759 !!--------------------------------------------------------------------- 760 760 REAL(wp) , DIMENSION(:,:), TARGET, INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied 761 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt abarray grid-points761 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt2d array grid-points 762 762 REAL(wp) , INTENT(in ) :: psgn ! sign used across the north fold boundary 763 763 TYPE(arrayptr) , DIMENSION(:) , INTENT(inout) :: pt2d_array ! … … 793 793 INTEGER :: kfld 794 794 TYPE(arrayptr) , DIMENSION(9) :: pt2d_array 795 CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of pt abarray grid-points795 CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of pt2d array grid-points 796 796 REAL(wp) , DIMENSION(9) :: psgn_array ! sign used across the north fold boundary 797 797 !!--------------------------------------------------------------------- … … 837 837 !!---------------------------------------------------------------------- 838 838 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied 839 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt abarray grid-points839 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt2d array grid-points 840 840 REAL(wp) , INTENT(in ) :: psgn ! sign used across the north fold boundary 841 841 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only … … 1989 1989 !! 1990 1990 !!---------------------------------------------------------------------- 1991 INTEGER , INTENT(in ) :: kdim1992 REAL(wp), INTENT(inout), DIMENSION(kdim) :: ptab1993 INTEGER , INTENT(in ), OPTIONAL:: kcom1991 REAL(wp), DIMENSION(kdim), INTENT(inout) :: ptab 1992 INTEGER , INTENT(in ) :: kdim 1993 INTEGER , OPTIONAL , INTENT(in ) :: kcom 1994 1994 ! 1995 1995 INTEGER :: ierror, localcomm … … 2041 2041 !! 2042 2042 INTEGER :: ierror, localcomm 2043 REAL(wp), DIMENSION(kdim) :: zwork 2043 2044 !!---------------------------------------------------------------------- 2044 2045 ! … … 2046 2047 IF( PRESENT(kcom) ) localcomm = kcom 2047 2048 ! 2048 CALL mpi_allreduce( pt ab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )2049 pt ab(:) = zwork(:)2049 CALL mpi_allreduce( pt1d, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror ) 2050 pt1d(:) = zwork(:) 2050 2051 ! 2051 2052 END SUBROUTINE mppmax_real_multiple … … 2212 2213 REAL(wp), DIMENSION (jpi,jpj), INTENT(in ) :: pmask ! Local mask 2213 2214 REAL(wp) , INTENT( out) :: pmin ! Global minimum of ptab 2214 INTEGER , INTENT( out) :: ki, kj 2215 INTEGER , INTENT( out) :: ki, kj ! index of minimum in global frame 2215 2216 ! 2216 2217 INTEGER :: ierror … … 2716 2717 2717 2718 DO jr = 1,nsndto 2718 IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN2719 IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 2719 2720 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 2720 2721 ENDIF … … 2727 2728 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2728 2729 ENDIF 2729 IF( (iproc /= (narea-1)) .and. (iproc /= -1)) THEN2730 IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 2730 2731 CALL mpprecv(5, zfoldwk, itaille, iproc) 2731 2732 DO jk = 1, ipk … … 2748 2749 IF (l_isend) THEN 2749 2750 DO jr = 1,nsndto 2750 IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN2751 CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err)2751 IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 2752 CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err ) 2752 2753 ENDIF 2753 2754 END DO … … 2870 2871 2871 2872 DO jr = 1,nsndto 2872 IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN2873 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))2873 IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 2874 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 2874 2875 ENDIF 2875 2876 END DO 2876 2877 DO jr = 1,nsndto 2877 2878 iproc = nfipproc(isendto(jr),jpnj) 2878 IF( iproc /= -1) THEN2879 IF( iproc /= -1 ) THEN 2879 2880 ilei = nleit (iproc+1) 2880 2881 ildi = nldit (iproc+1) … … 2888 2889 END DO 2889 2890 END DO 2890 ELSE 2891 ELSEIF( iproc == narea-1 ) THEN 2891 2892 DO jj = 1, ijpj 2892 2893 DO ji = ildi, ilei … … 2896 2897 ENDIF 2897 2898 END DO 2898 IF 2899 IF(l_isend) THEN 2899 2900 DO jr = 1,nsndto 2900 IF ((nfipproc(isendto(jr),jpnj) /= (narea-1)) .and. (nfipproc(isendto(jr),jpnj) /= -1)) THEN2901 IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 2901 2902 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2902 2903 ENDIF … … 3019 3020 DO jr = 1, nsndto 3020 3021 iproc = nfipproc(isendto(jr),jpnj) 3021 IF( iproc /= -1) THEN3022 IF( iproc /= -1 ) THEN 3022 3023 ilei = nleit (iproc+1) 3023 3024 ildi = nldit (iproc+1) … … 3562 3563 SELECT CASE ( nbondj_bdy(ib_bdy) ) 3563 3564 CASE ( -1 ) 3564 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err)3565 CASE ( 0 ) 3566 IF(l_isend) CALL mpi_wait (ml_req1, ml_stat, ml_err)3567 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err)3568 CASE ( 1 ) 3569 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err)3565 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 3566 CASE ( 0 ) 3567 IF(l_isend) CALL mpi_wait (ml_req1, ml_stat, ml_err ) 3568 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 3569 CASE ( 1 ) 3570 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 3570 3571 END SELECT 3571 3572 ! -
branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r7646 r7901 132 132 zda_v = EXP( -2.0_wp*zkh_v ) / ( 1.0_wp + 8.0_wp*zkh_v ) 133 133 ! 134 usd(ji,jj,jk) = zda_u * z k_u(ji,jj) * umask(ji,jj,jk)135 vsd(ji,jj,jk) = zda_v * z k_v(ji,jj) * vmask(ji,jj,jk)134 usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk) 135 vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk) 136 136 END DO 137 137 END DO -
branches/2017/dev_r7832_HPC08_lbclnk_3rd_dim/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r7897 r7901 10 10 !! 2.0 ! 2009-07 (G. Madec) Add statistic for time-spliting 11 11 !! 3.7 ! 2016-09 (G. Madec) Remove solver 12 !! 4.0 ! 2017-04 (G. Madec) regroup 12 !! 4.0 ! 2017-04 (G. Madec) regroup global communications 13 13 !!---------------------------------------------------------------------- 14 14 … … 44 44 !! - Print it each 50 time steps 45 45 !! - Stop the run IF problem encountered by setting indic=-3 46 !! Problems checked: U max>10 m/s and SSS min < 0 46 !! Problems checked: |U| and |ssh| maximum larger than 10 m/s 47 !! sea surface salinity (SSS) minimum < 0 47 48 !! 48 49 !! ** Actions : 'time.step' file containing the last ocean time-step … … 54 55 INTEGER :: ji, jj, jk ! dummy loop indices 55 56 INTEGER :: ii, ij, ik ! local integers 57 REAL(wp) :: zzt ! local real 56 58 INTEGER , DIMENSION(3) :: ilocu ! 57 59 INTEGER , DIMENSION(2) :: ilocs ! … … 69 71 ENDIF 70 72 ! 71 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !== current time step ==! ("time.step" file) 72 IF(lwp) REWIND( numstp ) 73 IF(lwp) THEN !== current time step ==! ("time.step" file) 74 WRITE ( numstp, '(1x, i8)' ) kt 75 REWIND( numstp ) 76 ENDIF 73 77 ! 74 78 ! !== test of extrema ==! … … 80 84 ! 81 85 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 82 WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U)max: ', zmax(1), ' SSS min:', - zmax(2)86 WRITE(numout,*) ' ==>> time-step= ',kt,' |U| max: ', zmax(1), ' SSS min:', - zmax(2) 83 87 ENDIF 84 88 ! … … 106 110 IF( -zmax(2) < 0._wp ) THEN !* negative salinity 107 111 IF( lk_mpp ) THEN 108 CALL mpp_minloc( tsn(:,:,1,jp_sal),tmask(:,:,1), - zmax(2), ii, ij )112 CALL mpp_minloc( tsn(:,:,1,jp_sal),tmask(:,:,1), zzt, ii, ij ) 109 113 ELSE 110 114 ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1._wp )
Note: See TracChangeset
for help on using the changeset viewer.
