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 4792 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2014-09-26T13:04:47+02:00 (10 years ago)
Author:
jamesharle
Message:

Updates to code after first successful test + merge with HEAD of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4328 r4792  
    170170      INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist 
    171171      INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist 
    172       INTEGER                      , INTENT(in   ) ::   kumond         ! logical unit for namelist output 
     172      INTEGER                      , INTENT(inout) ::   kumond         ! logical unit for namelist output 
    173173      INTEGER                      , INTENT(inout) ::   kstop          ! stop indicator 
    174174      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    … …  
    193193      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 
    194194902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 
    195       WRITE(kumond, nammpp)       
    196195 
    197196      !                              ! control print 
    … …  
    293292      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    294293      mynode = mpprank 
     294 
     295      IF( mynode == 0 ) THEN 
     296        CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     297        WRITE(kumond, nammpp)       
     298      ENDIF 
    295299      ! 
    296300      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
    … …  
    20222026      ijpjm1 = 3 
    20232027      ! 
     2028      znorthloc(:,:,:) = 0 
    20242029      DO jk = 1, jpk 
    20252030         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
    … …  
    20322037      itaille = jpi * jpk * ijpj 
    20332038 
    2034  
    20352039      IF ( l_north_nogather ) THEN 
    20362040         ! 
    20372041        ztabr(:,:,:) = 0 
     2042        ztabl(:,:,:) = 0 
     2043 
    20382044        DO jk = 1, jpk 
    20392045           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    20402046              ij = jj - nlcj + ijpj 
    2041               DO ji = 1, nlci 
     2047              DO ji = nfsloop, nfeloop 
    20422048                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 
    20432049              END DO 
    … …  
    20462052 
    20472053         DO jr = 1,nsndto 
    2048             IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 
     2054            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2055              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
     2056            ENDIF 
    20492057         END DO 
    20502058         DO jr = 1,nsndto 
    2051             iproc = isendto(jr) 
    2052             ildi = nldit (iproc) 
    2053             ilei = nleit (iproc) 
    2054             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2055             IF(isendto(jr) .ne. narea) THEN 
    2056               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2059            iproc = nfipproc(isendto(jr),jpnj) 
     2060            IF(iproc .ne. -1) THEN 
     2061               ilei = nleit (iproc+1) 
     2062               ildi = nldit (iproc+1) 
     2063               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2064            ENDIF 
     2065            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2066              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    20572067              DO jk = 1, jpk 
    20582068                 DO jj = 1, ijpj 
    2059                     DO ji = 1, ilei 
     2069                    DO ji = ildi, ilei 
    20602070                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 
    20612071                    END DO 
    20622072                 END DO 
    20632073              END DO 
    2064            ELSE 
     2074           ELSE IF (iproc .eq. (narea-1)) THEN 
    20652075              DO jk = 1, jpk 
    20662076                 DO jj = 1, ijpj 
    2067                     DO ji = 1, ilei 
     2077                    DO ji = ildi, ilei 
    20682078                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 
    20692079                    END DO 
    … …  
    20742084         IF (l_isend) THEN 
    20752085            DO jr = 1,nsndto 
    2076                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2086               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2087                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2088               ENDIF     
    20772089            END DO 
    20782090         ENDIF 
    20792091         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    2080          ! 
    20812092         DO jk = 1, jpk 
    20822093            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    … …  
    21262137      ! Either way the array may be folded by lbc_nfd and the result for the span of 
    21272138      ! this domain will be identical. 
    2128       ! 
    2129       CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition 
    2130       ! 
    2131       DO jk = 1, jpk 
    2132          DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    2133             ij = jj - nlcj + ijpj 
    2134             DO ji= 1, nlci 
    2135                pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk) 
    2136             END DO 
    2137         END DO 
    2138       END DO 
    21392139      ! 
    21402140      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 
    … …  
    21972197         ! 
    21982198         ztabr(:,:) = 0 
     2199         ztabl(:,:) = 0 
     2200 
    21992201         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    22002202            ij = jj - nlcj + ijpj 
    2201             DO ji = 1, nlci 
     2203              DO ji = nfsloop, nfeloop 
    22022204               ztabl(ji,ij) = pt2d(ji,jj) 
    22032205            END DO 
    … …  
    22052207 
    22062208         DO jr = 1,nsndto 
    2207             IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 
     2209            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2210               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 
     2211            ENDIF 
    22082212         END DO 
    22092213         DO jr = 1,nsndto 
    2210             iproc = isendto(jr) 
    2211             ildi = nldit (iproc) 
    2212             ilei = nleit (iproc) 
    2213             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2214             IF(isendto(jr) .ne. narea) THEN 
    2215               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2214            iproc = nfipproc(isendto(jr),jpnj) 
     2215            IF(iproc .ne. -1) THEN 
     2216               ilei = nleit (iproc+1) 
     2217               ildi = nldit (iproc+1) 
     2218               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2219            ENDIF 
     2220            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2221              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    22162222              DO jj = 1, ijpj 
    2217                  DO ji = 1, ilei 
     2223                 DO ji = ildi, ilei 
    22182224                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 
    22192225                 END DO 
    22202226              END DO 
    2221             ELSE 
     2227            ELSE IF (iproc .eq. (narea-1)) THEN 
    22222228              DO jj = 1, ijpj 
    2223                  DO ji = 1, ilei 
     2229                 DO ji = ildi, ilei 
    22242230                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 
    22252231                 END DO 
    … …  
    22292235         IF (l_isend) THEN 
    22302236            DO jr = 1,nsndto 
    2231                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2237               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2238                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2239               ENDIF 
    22322240            END DO 
    22332241         ENDIF 
    … …  
    29242932      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
    29252933      IF( .FALSE. )   ldtxt(:) = 'never done' 
     2934      CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    29262935   END FUNCTION mynode 
    29272936 
Note: See TracChangeset for help on using the changeset viewer.