New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2899 for branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2011-10-07T18:26:05+02:00 (13 years ago)
Author:
acc
Message:

Branch 2011/dev_r2855_NOCS_mppsca. Applied full coding conventions and added manual entry (Chap_MISC.tex). See #679

Location:
branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2883 r2899  
    22332233      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    22342234      INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2235       INTEGER, DIMENSION (jpmaxngh)          ::   ml_req5            ! for mpi_isend when avoiding mpi_allgather 
     2235      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          ! for mpi_isend when avoiding mpi_allgather 
    22362236      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
    22372237      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    … …  
    22512251      itaille = jpi * jpk * ijpj 
    22522252      IF ( l_north_nogather ) THEN 
    2253 ! 
    2254 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified (in nemo_northcomms) 
    2255 ! as being  involved in this process' northern boundary exchange 
    2256 ! 
    2257 ! First put local values into the global arraay 
    2258          DO jj = nlcj-ijpj+1, nlcj 
    2259            ij = jj - nlcj + ijpj 
    2260            DO ji = 1, nlci 
    2261              ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 
    2262            END DO 
    2263          END DO 
    2264  
    2265 ! 
    2266 ! Set the exchange type in order to access the correct list of active neighbours 
    2267 ! 
     2253         ! 
     2254         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2255         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
     2256         ! 
     2257         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
     2258            ij = jj - nlcj + ijpj 
     2259            DO ji = 1, nlci 
     2260               ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 
     2261            END DO 
     2262         END DO 
     2263 
     2264         ! 
     2265         ! Set the exchange type in order to access the correct list of active neighbours 
     2266         ! 
    22682267         SELECT CASE ( cd_type ) 
    22692268            CASE ( 'T' , 'W' ) 
    2270              ityp = 1 
     2269               ityp = 1 
    22712270            CASE ( 'U' ) 
    2272              ityp = 2 
     2271               ityp = 2 
    22732272            CASE ( 'V' ) 
    2274              ityp = 3 
     2273               ityp = 3 
    22752274            CASE ( 'F' ) 
    2276              ityp = 4 
     2275               ityp = 4 
    22772276            CASE ( 'I' ) 
    2278              ityp = 5 
     2277               ityp = 5 
    22792278            CASE DEFAULT 
    2280 ! 
    2281 ! Set a default value for unsupported types which will cause a fallback to 
    2282 ! the mpi_allgather method 
    2283 ! 
    2284              ityp = -1 
    2285           END SELECT 
    2286           IF ( ityp .gt. 0 ) THEN 
    2287  
    2288            DO jr = 1,nsndto(ityp) 
    2289             CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req5(jr) ) 
    2290            END DO 
    2291            DO jr = 1,nsndto(ityp) 
    2292             CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 
    2293             iproc = isendto(jr,ityp) + 1 
    2294             ildi=nldit (iproc) 
    2295             ilei=nleit (iproc) 
    2296             iilb=nimppt(iproc) 
    2297             DO jj = 1, 4 
    2298                DO ji = ildi, ilei 
    2299                   ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 
     2279               ityp = -1                    ! Set a default value for unsupported types which  
     2280                                            ! will cause a fallback to the mpi_allgather method 
     2281         END SELECT 
     2282         IF ( ityp .gt. 0 ) THEN 
     2283 
     2284            DO jr = 1,nsndto(ityp) 
     2285               CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 
     2286            END DO 
     2287            DO jr = 1,nsndto(ityp) 
     2288               CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 
     2289               iproc = isendto(jr,ityp) + 1 
     2290               ildi = nldit (iproc) 
     2291               ilei = nleit (iproc) 
     2292               iilb = nimppt(iproc) 
     2293               DO jj = 1, ijpj 
     2294                  DO ji = ildi, ilei 
     2295                     ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 
     2296                  END DO 
    23002297               END DO 
    23012298            END DO 
    2302            END DO 
    2303            IF(l_isend) THEN 
    2304               DO jr = 1,nsndto(ityp) 
    2305                 CALL mpi_wait(ml_req5(jr), ml_stat, ml_err) 
    2306               END DO 
    2307            ENDIF 
    2308  
    2309           ENDIF 
     2299            IF (l_isend) THEN 
     2300               DO jr = 1,nsndto(ityp) 
     2301                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2302               END DO 
     2303            ENDIF 
     2304 
     2305         ENDIF 
    23102306 
    23112307      ENDIF 
    … …  
    23142310         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                & 
    23152311            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    2316       ! 
    2317       !                                     ! recover the global north array 
    2318          DO jr = 1, ndim_rank_north 
     2312         ! 
     2313         DO jr = 1, ndim_rank_north         ! recover the global north array 
    23192314            iproc = nrank_north(jr) + 1 
    23202315            ildi  = nldit (iproc) 
    23212316            ilei  = nleit (iproc) 
    23222317            iilb  = nimppt(iproc) 
    2323             DO jj = 1, 4 
     2318            DO jj = 1, ijpj 
    23242319               DO ji = ildi, ilei 
    23252320                  ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 
    … …  
    23702365      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    23712366      INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2372       INTEGER, DIMENSION (jpmaxngh)      ::   ml_req5            ! for mpi_isend when avoiding mpi_allgather 
     2367      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          ! for mpi_isend when avoiding mpi_allgather 
    23732368      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
    23742369      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    … …  
    23882383      itaille = jpi * ijpj 
    23892384      IF ( l_north_nogather ) THEN 
    2390 ! 
    2391 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified (in nemo_northcomms)  
    2392 ! as being  involved in this process' northern boundary exchange 
    2393 ! 
    2394 ! First put local values into the global array 
    2395 ! 
    2396          DO jj = nlcj-ijpj+1, nlcj 
    2397            ij = jj - nlcj + ijpj 
    2398            DO ji = 1, nlci 
    2399              ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 
    2400            END DO 
    2401          END DO 
    2402  
    2403 ! 
    2404 ! Set the exchange type in order to access the correct list of active neighbours 
    2405 ! 
     2385         ! 
     2386         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2387         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
     2388         ! 
     2389         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
     2390            ij = jj - nlcj + ijpj 
     2391            DO ji = 1, nlci 
     2392               ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 
     2393            END DO 
     2394         END DO 
     2395 
     2396         ! 
     2397         ! Set the exchange type in order to access the correct list of active neighbours 
     2398         ! 
    24062399         SELECT CASE ( cd_type ) 
    24072400            CASE ( 'T' , 'W' ) 
    2408              ityp = 1 
     2401               ityp = 1 
    24092402            CASE ( 'U' ) 
    2410              ityp = 2 
     2403               ityp = 2 
    24112404            CASE ( 'V' ) 
    2412              ityp = 3 
     2405               ityp = 3 
    24132406            CASE ( 'F' ) 
    2414              ityp = 4 
     2407               ityp = 4 
    24152408            CASE ( 'I' ) 
    2416              ityp = 5 
     2409               ityp = 5 
    24172410            CASE DEFAULT 
    2418 ! 
    2419 ! Set a default value for unsupported types which will cause a fallback to 
    2420 ! the mpi_allgather method 
    2421 ! 
    2422              ityp = -1 
    2423           END SELECT 
    2424  
    2425           IF ( ityp .gt. 0 ) THEN 
    2426  
    2427            DO jr = 1,nsndto(ityp) 
    2428             CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req5(jr) ) 
    2429            END DO 
    2430            DO jr = 1,nsndto(ityp) 
    2431             CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp)) 
    2432             iproc = isendto(jr,ityp) + 1 
    2433             ildi=nldit (iproc) 
    2434             ilei=nleit (iproc) 
    2435             iilb=nimppt(iproc) 
    2436             DO jj = 1, 4 
    2437                DO ji = ildi, ilei 
    2438                   ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj) 
     2411               ityp = -1                    ! Set a default value for unsupported types which  
     2412                                            ! will cause a fallback to the mpi_allgather method 
     2413         END SELECT 
     2414 
     2415         IF ( ityp .gt. 0 ) THEN 
     2416 
     2417            DO jr = 1,nsndto(ityp) 
     2418               CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 
     2419            END DO 
     2420            DO jr = 1,nsndto(ityp) 
     2421               CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp)) 
     2422               iproc = isendto(jr,ityp) + 1 
     2423               ildi = nldit (iproc) 
     2424               ilei = nleit (iproc) 
     2425               iilb = nimppt(iproc) 
     2426               DO jj = 1, ijpj 
     2427                  DO ji = ildi, ilei 
     2428                     ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj) 
     2429                  END DO 
    24392430               END DO 
    24402431            END DO 
    2441            END DO 
    2442            IF(l_isend) THEN 
    2443               DO jr = 1,nsndto(ityp) 
    2444                 CALL mpi_wait(ml_req5(jr), ml_stat, ml_err) 
    2445               END DO 
    2446            ENDIF 
    2447  
    2448           ENDIF 
     2432            IF (l_isend) THEN 
     2433               DO jr = 1,nsndto(ityp) 
     2434                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2435               END DO 
     2436            ENDIF 
     2437 
     2438         ENDIF 
    24492439 
    24502440      ENDIF 
    24512441 
    24522442      IF ( ityp .lt. 0 ) THEN 
    2453        CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        & 
    2454           &                znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    2455       ! 
    2456        DO jr = 1, ndim_rank_north            ! recover the global north array 
    2457           iproc = nrank_north(jr) + 1 
    2458           ildi=nldit (iproc) 
    2459           ilei=nleit (iproc) 
    2460           iilb=nimppt(iproc) 
    2461           DO jj = 1, 4 
    2462              DO ji = ildi, ilei 
    2463                 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 
    2464              END DO 
    2465           END DO 
    2466        END DO 
     2443         CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        & 
     2444            &                znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     2445         ! 
     2446         DO jr = 1, ndim_rank_north            ! recover the global north array 
     2447            iproc = nrank_north(jr) + 1 
     2448            ildi = nldit (iproc) 
     2449            ilei = nleit (iproc) 
     2450            iilb = nimppt(iproc) 
     2451            DO jj = 1, ijpj 
     2452               DO ji = ildi, ilei 
     2453                  ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 
     2454               END DO 
     2455            END DO 
     2456         END DO 
    24672457      ENDIF 
    24682458      ! 

  • branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2883 r2899  
    652652      isendto = -1 
    653653      ijpj   = 4 
    654 ! 
    655 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 
    656 ! However, these first few exchanges have to use the mpi_allgather method to 
    657 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 
    658 ! Consequently, set l_north_nogather to be false here and set it true only after 
    659 ! the lists have been established. 
    660 ! 
     654      ! 
     655      ! This routine has been called because ln_nnogather has been set true ( nammpp ) 
     656      ! However, these first few exchanges have to use the mpi_allgather method to 
     657      ! establish the neighbour lists to use in subsequent peer to peer exchanges. 
     658      ! Consequently, set l_north_nogather to be false here and set it true only after 
     659      ! the lists have been established. 
     660      ! 
    661661      l_north_nogather = .FALSE. 
    662662      ! 
    663 ! Exchange and store ranks on northern rows 
    664  
    665      DO jtyp = 1,4 
    666  
    667         lrankset = .FALSE. 
    668         znnbrs = narea 
    669         SELECT CASE (jtyp) 
    670         CASE(1) 
    671            ! 
    672            ! Type 1: T,W-points 
    673            ! 
    674            CALL lbc_lnk( znnbrs, 'T', 1. ) 
    675         CASE(2) 
    676            ! 
    677            ! Type 2: U-point 
    678            ! 
    679            CALL lbc_lnk( znnbrs, 'U', 1. ) 
    680         CASE(3) 
    681            ! 
    682            ! Type 3: V-point 
    683            ! 
    684            CALL lbc_lnk( znnbrs, 'V', 1. ) 
    685         CASE(4) 
    686            ! 
    687            ! Type 5: F-point 
    688            ! 
    689            CALL lbc_lnk( znnbrs, 'F', 1. ) 
    690         END SELECT 
    691  
    692         IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 
    693           do jj = nlcj-ijpj+1, nlcj 
    694            ij = jj - nlcj + ijpj 
    695            do ji = 1,jpi 
    696             if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 
    697          &         lrankset(int(znnbrs(ji,jj))) = .true. 
    698            end do 
    699           end do 
    700  
    701           do jj = 1,jpnij 
    702            IF (lrankset(jj)) THEN 
    703             nsndto(jtyp) = nsndto(jtyp) + 1 
    704             IF(nsndto(jtyp) .gt. jpmaxngh ) THEN 
    705              CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
    706            &                ' jpmaxngh will need to be increased ') 
    707             ENDIF 
    708             isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
    709            ENDIF 
    710           end do 
    711         ENDIF 
    712  
    713      END DO 
    714  
    715 ! 
    716 ! Type 5: I-point 
    717 ! 
    718 ! ICE point exchanges may involve some averaging. The neighbours list is 
    719 ! built up using two exchanges to ensure that the whole stencil is covered. 
    720 ! lrankset should not be reset between these 'J' and 'K' point exchanges 
     663      ! Exchange and store ranks on northern rows 
     664 
     665      DO jtyp = 1,4 
     666 
     667         lrankset = .FALSE. 
     668         znnbrs = narea 
     669         SELECT CASE (jtyp) 
     670            CASE(1) 
     671               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points 
     672            CASE(2) 
     673               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point 
     674            CASE(3) 
     675               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point 
     676            CASE(4) 
     677               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point 
     678         END SELECT 
     679 
     680         IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
     681            DO jj = nlcj-ijpj+1, nlcj 
     682               ij = jj - nlcj + ijpj 
     683               DO ji = 1,jpi 
     684                  IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
     685               &     lrankset(INT(znnbrs(ji,jj))) = .true. 
     686               END DO 
     687            END DO 
     688 
     689            DO jj = 1,jpnij 
     690               IF ( lrankset(jj) ) THEN 
     691                  nsndto(jtyp) = nsndto(jtyp) + 1 
     692                  IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
     693                     CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
     694                  &                 ' jpmaxngh will need to be increased ') 
     695                  ENDIF 
     696                  isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
     697               ENDIF 
     698            END DO 
     699         ENDIF 
     700 
     701      END DO 
     702 
     703      ! 
     704      ! Type 5: I-point 
     705      ! 
     706      ! ICE point exchanges may involve some averaging. The neighbours list is 
     707      ! built up using two exchanges to ensure that the whole stencil is covered. 
     708      ! lrankset should not be reset between these 'J' and 'K' point exchanges 
    721709 
    722710      jtyp = 5 
    … …  
    725713      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 
    726714 
    727       IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 
    728         do jj = nlcj-ijpj+1, nlcj 
    729          ij = jj - nlcj + ijpj 
    730          do ji = 1,jpi 
    731           if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 
    732          &       lrankset(int(znnbrs(ji,jj))) = .true. 
    733          end do 
    734         end do 
     715      IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
     716         DO jj = nlcj-ijpj+1, nlcj 
     717            ij = jj - nlcj + ijpj 
     718            DO ji = 1,jpi 
     719               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
     720            &     lrankset(INT(znnbrs(ji,jj))) = .true. 
     721         END DO 
     722        END DO 
    735723      ENDIF 
    736724 
    … …  
    738726      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 
    739727 
    740       IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 
    741         do jj = nlcj-ijpj+1, nlcj 
    742          ij = jj - nlcj + ijpj 
    743          do ji = 1,jpi 
    744           if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 
    745          &       lrankset(int(znnbrs(ji,jj))) = .true. 
    746          end do 
    747         end do 
    748  
    749         do jj = 1,jpnij 
    750          IF (lrankset(jj)) THEN 
    751           nsndto(jtyp) = nsndto(jtyp) + 1 
    752           IF(nsndto(jtyp) .gt. jpmaxngh ) THEN 
    753            CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
    754            &              ' jpmaxngh will need to be increased ') 
    755           ENDIF 
    756           isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
    757          ENDIF 
    758         end do 
    759 ! 
    760 ! For northern row areas, set l_north_nogather so that all subsequent exchanges can use 
    761 ! peer to peer communications at the north fold 
    762 ! 
    763         l_north_nogather = .TRUE. 
    764 ! 
     728      IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 
     729         DO jj = nlcj-ijpj+1, nlcj 
     730            ij = jj - nlcj + ijpj 
     731            DO ji = 1,jpi 
     732               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) & 
     733            &       lrankset( INT(znnbrs(ji,jj))) = .true. 
     734            END DO 
     735         END DO 
     736 
     737         DO jj = 1,jpnij 
     738            IF ( lrankset(jj) ) THEN 
     739               nsndto(jtyp) = nsndto(jtyp) + 1 
     740               IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
     741                  CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
     742               &                 ' jpmaxngh will need to be increased ') 
     743               ENDIF 
     744               isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
     745            ENDIF 
     746         END DO 
     747         ! 
     748         ! For northern row areas, set l_north_nogather so that all subsequent exchanges  
     749         ! can use peer to peer communications at the north fold 
     750         ! 
     751         l_north_nogather = .TRUE. 
     752         ! 
    765753      ENDIF 
    766754      DEALLOCATE( znnbrs ) 
Note: See TracChangeset for help on using the changeset viewer.