Changeset 9279


Ignore:
Timestamp:
2018-01-24T10:51:42+01:00 (2 years ago)
Author:
frrh
Message:

Tidy up 0D field coupling.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r9218 r9279  
    477477   END SUBROUTINE cpl_rcv 
    478478 
    479    SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, items, kinfo ) 
     479   SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 
    480480      !!--------------------------------------------------------------------- 
    481481      !!              ***  ROUTINE cpl_rcv_1d  *** 
    482482      !! 
    483483      !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 
    484       !! 1D fields. The one dimension in this sense does not represent any spatial 
    485       !! dimension, it merely represents an arbitrary number of single values 
    486       !! i.e. the fields recieved are simply an array (which may be of size 1) 
    487       !! of 0 dimensional fields.   
     484      !! receipt of 0D fields.  
     485      !! The fields are recieved into a 1D array buffer which is simply a  
     486      !! dynamically sized sized array (which may be of size 1) 
     487      !! of 0 dimensional fields. This allows us to pass miltiple 0D  
     488      !! fields via a single put/get operation.   
    488489      !!---------------------------------------------------------------------- 
    489       INTEGER , INTENT(in   ) ::   items       ! variable index in the array 
    490       INTEGER , INTENT(in   ) ::   kid         ! variable index in the array 
     490      INTEGER , INTENT(in   ) ::   nitems      ! Number of 0D items to recieve  
     491                                               ! during this get operation. i.e. 
     492                                               ! The size of the 1D array in which 
     493                                               ! 0D items are passed.    
     494      INTEGER , INTENT(in   ) ::   kid         ! ID index of the incoming 
     495                                               ! data.   
    491496      INTEGER , INTENT(in   ) ::   kstep       ! ocean time-step in seconds 
    492       REAL(wp), INTENT(inout) ::   pdata(1:items)    ! IN to keep the value if nothing is done 
     497      REAL(wp), INTENT(inout) ::   pdata(1:nitems) ! The original value(s),   
     498                                                   ! unchanged if nothing is  
     499                                                   ! received 
    493500      INTEGER , INTENT(  out) ::   kinfo       ! OASIS3 info argument 
    494501      !!  
    495       REAL(wp) ::   recvfld(1:items)   ! Received field  
    496       INTEGER                                   ::   jc,jm     ! local loop index 
    497       INTEGER :: ierr 
    498       LOGICAL                                   ::   llaction, llfisrt 
     502      REAL(wp) ::   recvfld(1:nitems)          ! Local receive field buffer 
     503      INTEGER  ::   jc,jm     ! local loop index 
     504      INTEGER  ::  ierr 
     505      LOGICAL  ::   llaction 
    499506      !!-------------------------------------------------------------------- 
    500507      ! 
     
    503510      kinfo = OASIS_idle 
    504511      ! 
     512      ! 0D fields won't have categories or any other form of "pseudo level"  
     513      ! so we only cater for a single set of values and thus don't bother  
     514      ! with a loop over the jc index  
    505515      jc = 1 
    506516 
    507          DO jm = 1, srcv(kid)%ncplmodel 
    508  
    509             IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    510  
    511  
    512                IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN 
    513                  ! Zero dimension fields must only be exchanged through the master PE.  
    514                  ! In normal 2D cases, every PE is involved.  
    515  
    516                  CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )    
     517      DO jm = 1, srcv(kid)%ncplmodel 
     518 
     519         IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
     520 
     521            IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN 
     522               ! Since there is no concept of data decomposition for zero  
     523               ! dimension fields, they must only be exchanged through the master PE,  
     524               ! unlike "normal" 2D field cases where every PE is involved.  
     525 
     526               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )    
    517527                
    518                  llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    519                   &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     528               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     529                           kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    520530                
    521                  IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     531               IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 
     532                                     llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    522533                
    523                  IF ( llaction ) THEN 
     534               IF ( llaction ) THEN 
    524535                   
    525536                  kinfo = OASIS_Rcv 
    526                   pdata(1:items) = recvfld(1:items)  
     537                  pdata(1:nitems) = recvfld(1:nitems)  
    527538                   
    528539                  IF ( ln_ctl ) THEN         
     
    537548                  ENDIF 
    538549                   
    539                  ENDIF 
    540               ENDIF    
    541             ENDIF 
     550               ENDIF 
     551            ENDIF    
     552          ENDIF 
    542553             
    543          ENDDO 
    544 write(numout,*) "RSRH call bcast for 0D size",items;flush(numout) 
    545  
    546          ! There are no halos to deal with but we do have to broadcast values from PE 0 to all the 
    547          ! others.  
    548          CALL mpi_bcast( pdata, items, MPI_Real, localRoot, mpi_comm_opa, ierr ) 
    549 write(numout,*) "RSRH done bcast for 0D";flush(numout) 
     554       ENDDO 
     555 
     556       ! We have to broadcast (potentially) received values from PE 0 to all  
     557       ! the others. If no new data has been received we're just  
     558       ! broadcasting the existing values but there's no more efficient way  
     559       ! to deal with that w/o NEMO adopting a UM-style test mechanism 
     560       ! to determine active put/get timesteps.  
     561       CALL mpi_bcast( pdata, nitems, MPI_Real, localRoot, mpi_comm_opa, ierr ) 
    550562 
    551563      ! 
Note: See TracChangeset for help on using the changeset viewer.