Changeset 9279 for branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

Timestamp:

2018-01-24T10:51:42+01:00 (6 years ago)

Author:

frrh

Message:

Tidy up 0D field coupling.

File:

• branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 (modified) (3 diffs)

branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

@@ -477 +477 @@
    END SUBROUTINE cpl_rcv
 
-   SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, items, kinfo )
+   SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo )
       !!---------------------------------------------------------------------
       !!              ***  ROUTINE cpl_rcv_1d  ***
       !!
       !! ** Purpose : - A special version of cpl_rcv to deal exclusively with
-      !! 1D fields. The one dimension in this sense does not represent any spatial
-      !! dimension, it merely represents an arbitrary number of single values
-      !! i.e. the fields recieved are simply an array (which may be of size 1)
-      !! of 0 dimensional fields.  
+      !! receipt of 0D fields. 
+      !! The fields are recieved into a 1D array buffer which is simply a 
+      !! dynamically sized sized array (which may be of size 1)
+      !! of 0 dimensional fields. This allows us to pass miltiple 0D 
+      !! fields via a single put/get operation.  
       !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   ) ::   items       ! variable index in the array
-      INTEGER , INTENT(in   ) ::   kid         ! variable index in the array
+      INTEGER , INTENT(in   ) ::   nitems      ! Number of 0D items to recieve 
+                                               ! during this get operation. i.e.
+                                               ! The size of the 1D array in which
+                                               ! 0D items are passed.   
+      INTEGER , INTENT(in   ) ::   kid         ! ID index of the incoming
+                                               ! data.  
       INTEGER , INTENT(in   ) ::   kstep       ! ocean time-step in seconds
-      REAL(wp), INTENT(inout) ::   pdata(1:items)    ! IN to keep the value if nothing is done
+      REAL(wp), INTENT(inout) ::   pdata(1:nitems) ! The original value(s),  
+                                                   ! unchanged if nothing is 
+                                                   ! received
       INTEGER , INTENT(  out) ::   kinfo       ! OASIS3 info argument
       !! 
-      REAL(wp) ::   recvfld(1:items)   ! Received field 
-      INTEGER                                   ::   jc,jm     ! local loop index
-      INTEGER :: ierr
-      LOGICAL                                   ::   llaction, llfisrt
+      REAL(wp) ::   recvfld(1:nitems)          ! Local receive field buffer
+      INTEGER  ::   jc,jm     ! local loop index
+      INTEGER  ::   ierr
+      LOGICAL  ::   llaction
       !!--------------------------------------------------------------------
       !
@@ -503 +510 @@
       kinfo = OASIS_idle
       !
+      ! 0D fields won't have categories or any other form of "pseudo level" 
+      ! so we only cater for a single set of values and thus don't bother 
+      ! with a loop over the jc index 
       jc = 1
 
-         DO jm = 1, srcv(kid)%ncplmodel
-
-            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
-
-
-               IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN
-                 ! Zero dimension fields must only be exchanged through the master PE. 
-                 ! In normal 2D cases, every PE is involved. 
-
-                 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )   
+      DO jm = 1, srcv(kid)%ncplmodel
+
+         IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
+
+            IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN
+               ! Since there is no concept of data decomposition for zero 
+               ! dimension fields, they must only be exchanged through the master PE, 
+               ! unlike "normal" 2D field cases where every PE is involved. 
+
+               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )   
                
-                 llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   &
-                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
+               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   &
+                           kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
                
-                 IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
+               IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , &
+                                     llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
                
-                 IF ( llaction ) THEN
+               IF ( llaction ) THEN
                   
                   kinfo = OASIS_Rcv
-                  pdata(1:items) = recvfld(1:items) 
+                  pdata(1:nitems) = recvfld(1:nitems) 
                   
                   IF ( ln_ctl ) THEN        
@@ -537 +548 @@
                   ENDIF
                   
-                 ENDIF
-              ENDIF   
-            ENDIF
+               ENDIF
+            ENDIF   
+          ENDIF
             
-         ENDDO
-write(numout,*) "RSRH call bcast for 0D size",items;flush(numout)
-
-         ! There are no halos to deal with but we do have to broadcast values from PE 0 to all the
-         ! others. 
-         CALL mpi_bcast( pdata, items, MPI_Real, localRoot, mpi_comm_opa, ierr )
-write(numout,*) "RSRH done bcast for 0D";flush(numout)
+       ENDDO
+
+       ! We have to broadcast (potentially) received values from PE 0 to all 
+       ! the others. If no new data has been received we're just 
+       ! broadcasting the existing values but there's no more efficient way 
+       ! to deal with that w/o NEMO adopting a UM-style test mechanism
+       ! to determine active put/get timesteps. 
+       CALL mpi_bcast( pdata, nitems, MPI_Real, localRoot, mpi_comm_opa, ierr )
 
       !