LCOV - code coverage report
Current view: | top level - dynamics/se/dycore - bndry_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 155 | 307 | 50.5 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 7 | 17 | 41.2 %

              Line data    Source code
           1             : module bndry_mod
           2             :   use shr_kind_mod,   only: r8=>shr_kind_r8, i8=>shr_kind_i8
           3             :   use parallel_mod,   only: HME_BNDRY_A2A, HME_BNDRY_A2AO
           4             :   use thread_mod,     only: omp_in_parallel, omp_get_thread_num
           5             :   use gbarrier_mod,   only: gbarrier
           6             :   use cam_abortutils, only: endrun
           7             :   use cam_logfile,     only: iulog
           8             :
           9             :
          10             :   implicit none
          11             :   private
          12             :
          13             :   interface bndry_exchange
          14             :      module procedure bndry_exchange_threaded
          15             :      module procedure bndry_exchange_nonthreaded
          16             :      module procedure long_bndry_exchange_nonth
          17             :   end interface
          18             :   public :: bndry_exchange
          19             :
          20             :   interface ghost_exchange
          21             :      module procedure ghost_exchange_threaded
          22             :      module procedure ghost_exchange_nonthreaded
          23             :   end interface
          24             :   public :: ghost_exchange
          25             :
          26             :   interface bndry_exchange_start
          27             :      module procedure bndry_exchange_threaded_start
          28             :      module procedure bndry_exchange_nonthreaded_start
          29             :   end interface
          30             :   public :: bndry_exchange_start
          31             :
          32             :   interface bndry_exchange_finish
          33             :      module procedure bndry_exchange_threaded_finish
          34             :      module procedure bndry_exchange_nonthreaded_finish
          35             :   end interface
          36             :   public :: bndry_exchange_finish
          37             :
          38             :
          39             :   public :: compute_ghost_corner_orientation
          40             :   public :: ghost_exchangeVfull
          41             :   public :: copyBuffer
          42             :
          43             : contains
          44             :
          45           0 :   subroutine bndry_exchange_a2a(par,nthreads,ithr,buffer,location)
          46             :     use edgetype_mod,  only: Edgebuffer_t
          47             :     use schedtype_mod, only: schedule_t, cycle_t, schedule
          48             :     use thread_mod,    only: omp_in_parallel, omp_get_thread_num
          49             :     use perf_mod,      only: t_startf, t_stopf
          50             :     use spmd_utils,    only: mpi_real8, mpi_success
          51             :     use parallel_mod,  only: parallel_t
          52             :     use perf_mod,      only: t_startf, t_stopf
          53             :
          54             :     type (parallel_t)            :: par
          55             :     integer, intent(in)          :: nthreads
          56             :     integer                      :: ithr ! The OpenMP thread ID
          57             :     type (EdgeBuffer_t)          :: buffer
          58             :     character(len=*),  optional  :: location
          59             :
          60             :     type (Schedule_t), pointer   :: pSchedule
          61             :     type (Cycle_t),    pointer   :: pCycle
          62             :     integer                      :: icycle,ierr
          63             :     integer                      :: length
          64             :     integer                      :: iptr,source,nlyr
          65             :     integer                      :: nSendCycles,nRecvCycles
          66             :     integer                      :: errorcode,errorlen
          67             :     character*(80)               :: errorstring
          68             :     character(len=*),  parameter :: subname = 'bndry_exchange_a2a'
          69             :     character(len=80)            :: locstring
          70             :     logical                      :: ompthreadMissmatch
          71             :
          72             :     integer                      :: i,j
          73             :     integer                      :: request
          74             :
          75             : ! Neighborhood collectives are only in MPI3 and up
          76             : #ifdef SPMD
          77             : #if MPI_VERSION >= 3
          78             :
          79             :    if(ithr == 0) then
          80             :
          81             :       call MPI_Ineighbor_Alltoallv(buffer%buf,buffer%scountsFull,buffer%sdisplsFull,Mpi_real8, &
          82             :                      buffer%receive,buffer%rcountsFull,buffer%rdisplsFull,Mpi_real8,par%commGraphFull,request,ierr)
          83             :       if(ierr .ne. MPI_SUCCESS) then
          84             :         errorcode=ierr
          85             :         call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
          86             :         write(iulog,*) subname,': Error after call to MPI_Ineighbor_alltoallv: ',errorstring
          87             :       endif
          88             :
          89             :       if(present(location)) then
          90             :         locstring = TRIM(subname) // ': ' // TRIM(location)
          91             :       else
          92             :         locstring = TRIM(subname)
          93             :       endif
          94             :       ! location 1 for copyBuffer
          95             :       call copyBuffer(nthreads,ithr,buffer,locstring)
          96             :
          97             :       call MPI_wait(request,lstatus,ierr)
          98             :       call t_stopf('bndry_a2a')
          99             :    else
         100             :
         101             :       if(present(location)) then
         102             :         locstring = TRIM(subname) // ': ' // TRIM(location)
         103             :       else
         104             :         locstring = TRIM(subname)
         105             :       endif
         106             :       call copyBuffer(nthreads,ithr,buffer,locstring)
         107             :
         108             :    endif
         109             : #else
         110           0 :     call endrun('bndry_exchange_a2a requires MPI-3 feature support')
         111             : #endif
         112             : #endif
         113             :
         114           0 :   end subroutine bndry_exchange_a2a
         115             :
         116    37704960 :   subroutine copyBuffer(nthreads,ithr,buffer,location)
         117           0 :     use edgetype_mod, only : Edgebuffer_t
         118             :     integer :: nthreads
         119             :     integer :: ithr
         120             :     type (EdgeBuffer_t)          :: buffer
         121             :     character(len=80)            :: location
         122             :     logical ::  ompThreadMissmatch
         123             :     integer lenMovePtr, iptr,length,i,j
         124             :
         125    37704960 :     ompThreadMissmatch = .false.
         126    37704960 :     lenMovePtr = size(buffer%moveptr)
         127    37704960 :     if ( lenMOveptr .ne. nthreads) then
         128           0 :       ompthreadMissmatch = .true.
         129           0 :       write(*,30) TRIM(location), lenMoveptr, nthreads
         130             :     endif
         131             :
         132             :     if (.not. ompthreadMissmatch) then
         133    37704960 :       iptr   = buffer%moveptr(ithr+1)
         134    37704960 :       length = buffer%moveLength(ithr+1)
         135    37704960 :       if(length>0) then
         136 >16338*10^8 :         do i=0,length-1
         137 >16338*10^8 :            buffer%receive(iptr+i) = buffer%buf(iptr+i)
         138             :         enddo
         139             :       endif
         140           0 :     else if(ompthreadMissmatch .and. ithr == 0) then
         141           0 :        do j=1,lenMovePtr
         142           0 :           iptr   = buffer%moveptr(j)
         143           0 :           length = buffer%moveLength(j)
         144           0 :           if(length>0) then
         145           0 :              do i=0,length-1
         146           0 :                 buffer%receive(iptr+i) = buffer%buf(iptr+i)
         147             :              enddo
         148             :           endif
         149             :        enddo
         150             :     endif
         151             : 30  format(a,'Potential perf issue: ',a,'LenMoveptr,nthreads: ',2(i3))
         152    37704960 :   end subroutine copyBuffer
         153             :
         154           0 :   subroutine bndry_exchange_a2ao(par,nthreads,ithr,buffer,location)
         155             :     use edgetype_mod, only : Edgebuffer_t
         156             :     use schedtype_mod, only : schedule_t, cycle_t, schedule
         157             :     use thread_mod, only : omp_in_parallel, omp_get_thread_num
         158             :     use perf_mod, only : t_startf, t_stopf
         159             :     use spmd_utils,   only: mpi_real8, mpi_success, mpi_status_size
         160             :     use parallel_mod, only: parallel_t
         161             :     use perf_mod, only : t_startf, t_stopf
         162             :
         163             :     type (parallel_t)                 :: par
         164             :     integer, intent(in)               :: nthreads
         165             :     integer                           :: ithr  ! The OpenMP thread ID
         166             :     type (EdgeBuffer_t)               :: buffer
         167             :     character(len=*), optional        :: location
         168             :
         169             :     integer                           :: ierr
         170             :     integer                           :: errorcode,errorlen
         171             :     character(len=80)                 :: errorstring
         172             :     character(len=*),       parameter :: subname = 'bndry_exchange_a2ao'
         173             :     character(len=80)                 :: locstring
         174             :
         175             :     integer :: requestIntra,requestInter
         176             :     integer :: lstatus(MPI_status_size)
         177             :
         178             : ! Neighborhood collectives are only in MPI3 and up
         179             : #ifdef SPMD
         180             : #if MPI_VERSION >= 3
         181             :
         182             :    if(ithr == 0) then
         183             :
         184             :       call t_startf('bndry_a2ao')
         185             :       ! Start Inter-node communication
         186             :       call MPI_Ineighbor_Alltoallv(buffer%buf,buffer%scountsInter,buffer%sdisplsInter,MPI_real8, &
         187             :            buffer%receive,buffer%rcountsInter,buffer%rdisplsInter,MPI_real8,par%commGraphInter,requestInter,ierr)
         188             :       if(ierr .ne. MPI_SUCCESS) then
         189             :         errorcode=ierr
         190             :         call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         191             :         write(iulog,*) subname,': Error after call to MPI_Ineighbor_alltoallv: ',errorstring
         192             :       endif
         193             :       ! Start Intra-node communication
         194             :       call MPI_Ineighbor_Alltoallv(buffer%buf,buffer%scountsIntra,buffer%sdisplsIntra,MPI_real8, &
         195             :            buffer%receive,buffer%rcountsIntra,buffer%rdisplsIntra,MPI_real8,par%commGraphIntra,requestIntra,ierr)
         196             :       if(ierr .ne. MPI_SUCCESS) then
         197             :         errorcode=ierr
         198             :         call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         199             :         write(iulog,*) subname,': Error after call to MPI_Ineighbor_alltoallv: ',errorstring
         200             :       endif
         201             :
         202             :       if(present(location)) then
         203             :         locstring = TRIM(subname) // ': ' // TRIM(location)
         204             :       else
         205             :         locstring = TRIM(subname)
         206             :       endif
         207             :       ! Finish the Intra-node communication
         208             :       call MPI_wait(requestIntra,lstatus,ierr)
         209             :
         210             :       ! location 3 for copyBuffer
         211             :       call copyBuffer(nthreads,ithr,buffer,locstring)
         212             :
         213             :       ! Finish the Inter-node communication
         214             :       call MPI_wait(requestInter,lstatus,ierr)
         215             :       call t_stopf('bndry_a2ao')
         216             :
         217             :    else
         218             :
         219             :       if(present(location)) then
         220             :         locstring = TRIM(subname) // ': ' // TRIM(location)
         221             :       else
         222             :         locstring = TRIM(subname)
         223             :       endif
         224             :       !Copy buffer for ithr!=0
         225             :       call copyBuffer(nthreads,ithr,buffer,locstring)
         226             :
         227             :    endif
         228             : #else
         229           0 :     call endrun('bndry_exchange_a2ao requires MPI-3 feature support')
         230             : #endif
         231             : #endif
         232             :
         233           0 :   end subroutine bndry_exchange_a2ao
         234             :
         235    37704960 :   subroutine bndry_exchange_p2p(par,nthreads,ithr,buffer,location)
         236           0 :     use edgetype_mod,  only: Edgebuffer_t
         237             :     use schedtype_mod, only: schedule_t, cycle_t, schedule
         238             :     use thread_mod,    only: omp_in_parallel, omp_get_thread_num
         239             :     use spmd_utils,    only: mpi_real8, mpi_success
         240             :     use parallel_mod,  only: parallel_t
         241             :     use perf_mod,      only: t_startf, t_stopf
         242             :
         243             :     type (parallel_t)                 :: par
         244             :     integer, intent(in)               :: nthreads
         245             :     integer                           :: ithr
         246             :     type (EdgeBuffer_t)               :: buffer
         247             :     character(len=*), optional        :: location
         248             :
         249             :     type (Schedule_t),pointer         :: pSchedule
         250             :     type (Cycle_t),pointer            :: pCycle
         251             :     integer                           :: dest,length,tag
         252             :     integer                           :: icycle,ierr
         253             :     integer                           :: iptr,source,nlyr
         254             :     integer                           :: nSendCycles,nRecvCycles
         255             :     integer                           :: errorcode,errorlen
         256             :     character*(80)                    :: errorstring
         257             :     character(len=*), parameter       :: subname = 'bndry_exchange_p2p'
         258             :     character(len=80)                 :: locstring
         259             :     logical, parameter :: Debug=.FALSE.
         260             :
         261             :     integer                           :: i,j
         262             :     logical :: ompthreadMissmatch
         263             :     integer :: lenMovePtr
         264             :
         265    37704960 :     pSchedule => Schedule(1)
         266    37704960 :     nlyr = buffer%nlyr
         267    37704960 :     ompthreadMissmatch = .FALSE.
         268             :
         269    37704960 :     lenMovePtr = size(buffer%moveptr)
         270             :
         271    37704960 :   if(ithr == 0) then
         272    37704960 :     nSendCycles = pSchedule%nSendCycles
         273    37704960 :     nRecvCycles = pSchedule%nRecvCycles
         274             :
         275             :
         276             :     !==================================================
         277             :     !  Fire off the sends
         278             :     !==================================================
         279             :
         280   280528830 :     do icycle=1,nSendCycles
         281   242823870 :        pCycle      => pSchedule%SendCycle(icycle)
         282   242823870 :        dest            = pCycle%dest - 1
         283   242823870 :        length          = buffer%scountsFull(icycle)
         284   242823870 :        tag             = buffer%tag
         285   242823870 :        iptr            = buffer%sdisplsFull(icycle) + 1
         286             :        if(Debug) write(iulog,*) subname,': MPI_Isend: DEST:',dest,'LENGTH:',length,'TAG: ',tag
         287   242823870 :        call MPI_Isend(buffer%buf(iptr),length,Mpi_real8,dest,tag,par%comm,buffer%Srequest(icycle),ierr)
         288   280528830 :        if(ierr .ne. MPI_SUCCESS) then
         289           0 :           errorcode=ierr
         290           0 :           call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         291           0 :           write(iulog,*) subname,': Error after call to MPI_Isend: ',errorstring
         292             :        endif
         293             :     end do    ! icycle
         294             :
         295             :     !==================================================
         296             :     !  Post the Receives
         297             :     !==================================================
         298   280528830 :     do icycle=1,nRecvCycles
         299   242823870 :        pCycle         => pSchedule%RecvCycle(icycle)
         300   242823870 :        source          = pCycle%source - 1
         301   242823870 :        length          = buffer%rcountsFull(icycle)
         302   242823870 :        tag             = buffer%tag
         303   242823870 :        iptr            = buffer%rdisplsFull(icycle) + 1
         304             :        if(Debug) write(iulog,*) subname,': MPI_Irecv: SRC:',source,'LENGTH:',length,'TAG: ',tag
         305           0 :        call MPI_Irecv(buffer%receive(iptr),length,Mpi_real8, &
         306   242823870 :             source,tag,par%comm,buffer%Rrequest(icycle),ierr)
         307   280528830 :        if(ierr .ne. MPI_SUCCESS) then
         308           0 :           errorcode=ierr
         309           0 :           call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         310           0 :           write(iulog,*) subname,': Error after call to MPI_Irecv: ',errorstring
         311             :        endif
         312             :     end do    ! icycle
         313    37704960 :     if(present(location)) then
         314    37704960 :       locstring = TRIM(subname) // ': ' // TRIM(location)
         315             :     else
         316           0 :       locstring = TRIM(subname)
         317             :     endif
         318    37704960 :     call copyBuffer(nthreads,ithr,buffer,locstring)
         319    37704960 :     if (nSendCycles>0) call MPI_Waitall(nSendCycles,buffer%Srequest,buffer%status,ierr)
         320    37704960 :     if (nRecvCycles>0) call MPI_Waitall(nRecvCycles,buffer%Rrequest,buffer%status,ierr)
         321             :   else
         322           0 :     if(present(location)) then
         323           0 :       locstring = TRIM(subname) // ': ' // TRIM(location)
         324             :     else
         325           0 :       locstring = TRIM(subname)
         326             :     endif
         327           0 :     call copyBuffer(nthreads,ithr,buffer,locstring)
         328             :   endif
         329             :
         330    37704960 :   end subroutine bndry_exchange_p2p
         331             :
         332           0 :   subroutine bndry_exchange_p2p_start(par,nthreads,ithr,buffer,location)
         333             :
         334    37704960 :     use edgetype_mod,  only: Edgebuffer_t
         335             :     use schedtype_mod, only: schedule_t, cycle_t, schedule
         336             :     use thread_mod,    only: omp_in_parallel, omp_get_thread_num
         337             :     use spmd_utils,    only: mpi_real8, mpi_success
         338             :     use parallel_mod,  only: parallel_t
         339             :
         340             :     type (parallel_t)                 :: par
         341             :     integer, intent(in)               :: nthreads
         342             :     integer                           :: ithr
         343             :     type (EdgeBuffer_t)               :: buffer
         344             :     character (len=*), optional :: location
         345             :
         346             :     type (Schedule_t),pointer         :: pSchedule
         347             :     type (Cycle_t),pointer            :: pCycle
         348             :     integer                           :: dest,length,tag
         349             :     integer                           :: icycle,ierr
         350             :     integer                           :: iptr,source,nlyr
         351             :     integer                           :: nSendCycles,nRecvCycles
         352             :     integer                           :: errorcode,errorlen
         353             :     character*(80)                    :: errorstring
         354             :     character(len=*),       parameter :: subname = 'bndry_exchange_p2p_start'
         355             :     logical,                parameter :: Debug=.FALSE.
         356             :
         357             :     integer                           :: i,j, lenMovePtr
         358             :     logical :: ompthreadMissmatch
         359             :
         360           0 :     pSchedule => Schedule(1)
         361           0 :     nlyr = buffer%nlyr
         362           0 :     ompthreadMissmatch = .FALSE.
         363             :
         364           0 :     lenMovePtr = size(buffer%moveptr)
         365             :
         366           0 :   if(ithr == 0) then
         367           0 :     nSendCycles = pSchedule%nSendCycles
         368           0 :     nRecvCycles = pSchedule%nRecvCycles
         369             :
         370             :     !==================================================
         371             :     !  Fire off the sends
         372             :     !==================================================
         373             :
         374           0 :     do icycle=1,nSendCycles
         375           0 :        pCycle      => pSchedule%SendCycle(icycle)
         376           0 :        dest            = pCycle%dest - 1
         377           0 :        length          = buffer%scountsFull(icycle)
         378           0 :        tag             = buffer%tag
         379           0 :        iptr            = buffer%sdisplsFull(icycle) + 1
         380             :        if(Debug) write(iulog,*) subname,': MPI_Isend: DEST:',dest,'LENGTH:',length,'TAG: ',tag
         381           0 :        call MPI_Isend(buffer%buf(iptr),length,Mpi_real8,dest,tag,par%comm,buffer%Srequest(icycle),ierr)
         382           0 :        if(ierr .ne. MPI_SUCCESS) then
         383           0 :           errorcode=ierr
         384           0 :           call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         385           0 :           write(iulog,*) subname,': Error after call to MPI_Isend: ',errorstring
         386             :        endif
         387             :     end do    ! icycle
         388             :
         389             :     !==================================================
         390             :     !  Post the Receives
         391             :     !==================================================
         392           0 :     do icycle=1,nRecvCycles
         393           0 :        pCycle         => pSchedule%RecvCycle(icycle)
         394           0 :        source          = pCycle%source - 1
         395           0 :        length          = buffer%rcountsFull(icycle)
         396           0 :        tag             = buffer%tag
         397           0 :        iptr            = buffer%rdisplsFull(icycle) + 1
         398             :        if(Debug) write(iulog,*) subname,': MPI_Irecv: SRC:',source,'LENGTH:',length,'TAG: ',tag
         399           0 :        call MPI_Irecv(buffer%receive(iptr),length,Mpi_real8, &
         400           0 :             source,tag,par%comm,buffer%Rrequest(icycle),ierr)
         401           0 :        if(ierr .ne. MPI_SUCCESS) then
         402           0 :           errorcode=ierr
         403           0 :           call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         404           0 :           write(iulog,*) subname,': Error after call to MPI_Irecv: ',errorstring
         405             :        endif
         406             :     end do    ! icycle
         407             :   endif
         408             :
         409           0 :   end subroutine bndry_exchange_p2p_start
         410             :
         411           0 :   subroutine bndry_exchange_p2p_finish(par,nthreads,ithr,buffer,location)
         412             :     use edgetype_mod,  only: Edgebuffer_t
         413             :     use schedtype_mod, only: schedule_t, cycle_t, schedule
         414             :     use thread_mod,    only: omp_in_parallel, omp_get_thread_num
         415             :     use parallel_mod,  only: parallel_t
         416             :     use perf_mod,      only: t_startf, t_stopf
         417             :
         418             :
         419             :     type (parallel_t)            :: par
         420             :     integer, intent(in)          :: nthreads
         421             :     integer                      :: ithr
         422             :     type (EdgeBuffer_t)          :: buffer
         423             :     character(len=*),  optional  :: location
         424             :
         425             :     type (Schedule_t), pointer   :: pSchedule
         426             :     type (Cycle_t),    pointer   :: pCycle
         427             :     integer                      :: dest,length,tag
         428             :     integer                      :: icycle,ierr
         429             :     integer                      :: iptr,source,nlyr
         430             :     integer                      :: nSendCycles,nRecvCycles
         431             :     integer                      :: errorcode,errorlen
         432             :     character*(80)               :: errorstring
         433             :     character(len=*),  parameter :: subname = 'bndry_exchange_p2p_finish'
         434             :     character(len=80)            :: locstring
         435             :
         436             :     integer                      :: i,j
         437             :     logical                      :: ompthreadMissmatch
         438             :     integer                      :: lenMovePtr
         439             :
         440             :
         441           0 :   pSchedule => Schedule(1)
         442           0 :   if(present(location)) then
         443           0 :     locstring = TRIM(subname) // ': ' // TRIM(location)
         444             :   else
         445           0 :     locstring = TRIM(subname)
         446             :   endif
         447           0 :   call copyBuffer(nthreads,ithr,buffer,locstring)
         448             :
         449           0 :   if(ithr == 0) then
         450             :
         451           0 :     nSendCycles = pSchedule%nSendCycles
         452           0 :     nRecvCycles = pSchedule%nRecvCycles
         453             :
         454           0 :     if (nSendCycles>0) call MPI_Waitall(nSendCycles,buffer%Srequest,buffer%status,ierr)
         455           0 :     if (nRecvCycles>0) call MPI_Waitall(nRecvCycles,buffer%Rrequest,buffer%status,ierr)
         456             :
         457             :   endif
         458             :
         459           0 :   end subroutine bndry_exchange_p2p_finish
         460             :
         461        1536 :   subroutine long_bndry_exchange_nonth(par,buffer)
         462           0 :     use edgetype_mod,  only: LongEdgebuffer_t
         463             :     use schedtype_mod, only: schedule_t, cycle_t, schedule
         464             :     use thread_mod,    only: omp_in_parallel
         465             :     use parallel_mod,  only: parallel_t, status, srequest, rrequest
         466             :     use spmd_utils,    only: mpi_integer, mpi_success
         467             :
         468             :     type (parallel_t)            :: par
         469             :     type (LongEdgeBuffer_t)      :: buffer
         470             :
         471             :     type (Schedule_t), pointer   :: pSchedule
         472             :     type (Cycle_t),    pointer   :: pCycle
         473             :     integer                      :: dest,length,tag
         474             :     integer                      :: icycle,ierr
         475             :     integer                      :: iptr,source,nlyr
         476             :     integer                      :: nSendCycles,nRecvCycles
         477             :     integer                      :: errorcode,errorlen
         478             :     character*(80)               :: errorstring
         479             :     character(len=*),  parameter :: subname = 'long_bndry_exchange_nonth'
         480             :
         481             :     integer                      :: i
         482             :
         483             : #ifdef SPMD
         484        1536 :     if(omp_in_parallel()) then
         485           0 :        print *,subname,': Warning you are calling a non-thread safe'
         486           0 :        print *,'         routine inside a threaded region....     '
         487           0 :        print *,'                Results are not predictable!!            '
         488             :     endif
         489             :
         490             :
         491             :     ! Setup the pointer to proper Schedule
         492        1536 :     pSchedule => Schedule(1)
         493        1536 :     nlyr = buffer%nlyr
         494             :
         495        1536 :     nSendCycles = pSchedule%nSendCycles
         496        1536 :     nRecvCycles = pSchedule%nRecvCycles
         497             :
         498             :
         499             :     !==================================================
         500             :     !  Fire off the sends
         501             :     !==================================================
         502             :
         503       11428 :     do icycle=1,nSendCycles
         504        9892 :        pCycle      => pSchedule%SendCycle(icycle)
         505        9892 :        dest            = pCycle%dest - 1
         506        9892 :        length      = nlyr * pCycle%lengthP
         507        9892 :        tag             = pCycle%tag
         508        9892 :        iptr            = pCycle%ptrP
         509             :
         510        9892 :        call MPI_Isend(buffer%buf(1,iptr),length,Mpi_integer,dest,tag,par%comm,Srequest(icycle),ierr)
         511       11428 :        if(ierr .ne. MPI_SUCCESS) then
         512           0 :           errorcode=ierr
         513           0 :           call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         514           0 :           write(iulog,*) subname,': Error after call to MPI_Isend: ',errorstring
         515             :        endif
         516             :     end do    ! icycle
         517             :
         518             :     !==================================================
         519             :     !  Post the Receives
         520             :     !==================================================
         521       11428 :     do icycle=1,nRecvCycles
         522        9892 :        pCycle         => pSchedule%RecvCycle(icycle)
         523        9892 :        source          = pCycle%source - 1
         524        9892 :        length      = nlyr * pCycle%lengthP
         525        9892 :        tag             = pCycle%tag
         526        9892 :        iptr            = pCycle%ptrP
         527             :
         528           0 :        call MPI_Irecv(buffer%receive(1,iptr),length,Mpi_integer, &
         529        9892 :             source,tag,par%comm,Rrequest(icycle),ierr)
         530       11428 :        if(ierr .ne. MPI_SUCCESS) then
         531           0 :           errorcode=ierr
         532           0 :           call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         533           0 :           write(iulog,*) subname,': Error after call to MPI_Irecv: ',errorstring
         534             :        endif
         535             :     end do    ! icycle
         536             :
         537             :
         538             :     !==================================================
         539             :     !  Wait for all the receives to complete
         540             :     !==================================================
         541             :
         542        1536 :     if (nSendCycles>0) call MPI_Waitall(nSendCycles,Srequest,status,ierr)
         543        1536 :     if (nRecvCycles>0) call MPI_Waitall(nRecvCycles,Rrequest,status,ierr)
         544       11428 :     do icycle=1,nRecvCycles
         545        9892 :        pCycle         => pSchedule%RecvCycle(icycle)
         546        9892 :        length             = pCycle%lengthP
         547        9892 :        iptr            = pCycle%ptrP
         548      117504 :        do i=0,length-1
         549      222044 :           buffer%buf(1:nlyr,iptr+i) = buffer%receive(1:nlyr,iptr+i)
         550             :        enddo
         551             :     end do   ! icycle
         552             :
         553             : #endif
         554             :
         555        1536 :   end subroutine long_bndry_exchange_nonth
         556             :   !********************************************************************************
         557             :   !
         558             :   !********************************************************************************
         559             :
         560             :
         561     3329280 :  subroutine ghost_exchange_threaded(hybrid,buffer,location)
         562             :     use hybrid_mod,   only : hybrid_t
         563             :     use edgetype_mod, only : Edgebuffer_t
         564             :
         565             :     implicit none
         566             :
         567             :     type (hybrid_t)             :: hybrid
         568             :     type (EdgeBuffer_t)         :: buffer
         569             :     character(len=*), optional :: location
         570             :
         571     3329280 :     call bndry_exchange_threaded(hybrid,buffer,location)
         572     3329280 :  end subroutine ghost_exchange_threaded
         573             :
         574    37327104 :  subroutine bndry_exchange_threaded(hybrid,buffer,location)
         575             :     use hybrid_mod, only : hybrid_t
         576             :     use edgetype_mod, only : Edgebuffer_t
         577             :     use perf_mod, only: t_startf, t_stopf, t_adj_detailf
         578             :     implicit none
         579             :
         580             :     type (hybrid_t)             :: hybrid
         581             :     type (EdgeBuffer_t)         :: buffer
         582             :     character(len=*), optional  :: location
         583             :
         584             :     character(len=*), parameter :: subname = 'bndry_exchange_threaded'
         585             : !VERBOSE
         586             : !    if(present(location)) then
         587             : !       print *,subname,' ',location
         588             : !    else
         589             : !       print *,subname,' somewhere'
         590             : !    endif
         591             :
         592    37327104 :     call gbarrier(buffer%gbarrier, hybrid%ithr)
         593    37327104 :     if(buffer%bndry_type == HME_BNDRY_A2A) then
         594           0 :        call bndry_exchange_a2a(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location)
         595    37327104 :     else if (buffer%bndry_type == HME_BNDRY_A2AO) then
         596           0 :        call bndry_exchange_a2ao(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location)
         597             :     else
         598    37327104 :        call bndry_exchange_p2p(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location)
         599             :     endif
         600    37327104 :     call gbarrier(buffer%gbarrier, hybrid%ithr)
         601             :
         602    37327104 :  end subroutine bndry_exchange_threaded
         603             :
         604           0 :  subroutine bndry_exchange_threaded_start(hybrid,buffer,location)
         605    37327104 :     use hybrid_mod, only : hybrid_t
         606             :     use edgetype_mod, only : Edgebuffer_t
         607             :     use perf_mod, only: t_startf, t_stopf, t_adj_detailf
         608             :     implicit none
         609             :
         610             :     type (hybrid_t)             :: hybrid
         611             :     type (EdgeBuffer_t)         :: buffer
         612             :     character(len=*), optional  :: location
         613             :
         614             :     character(len=*), parameter :: subname = 'bndry_exchange_threaded_start'
         615             :
         616           0 :     call gbarrier(buffer%gbarrier, hybrid%ithr)
         617           0 :     call bndry_exchange_p2p_start(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location)
         618             :
         619           0 :  end subroutine bndry_exchange_threaded_start
         620             :
         621           0 :  subroutine bndry_exchange_threaded_finish(hybrid,buffer,location)
         622           0 :     use hybrid_mod, only : hybrid_t
         623             :     use edgetype_mod, only : Edgebuffer_t
         624             :     use perf_mod, only: t_startf, t_stopf, t_adj_detailf
         625             :     implicit none
         626             :
         627             :     type (hybrid_t)             :: hybrid
         628             :     type (EdgeBuffer_t)         :: buffer
         629             :     character(len=*), optional  :: location
         630             :
         631             :     character(len=*), parameter :: subname = 'bndry_exchange_threaded_finish'
         632             :
         633           0 :     call bndry_exchange_p2p_finish(hybrid%par,hybrid%nthreads,hybrid%ithr,buffer,location)
         634           0 :     call gbarrier(buffer%gbarrier, hybrid%ithr)
         635             :
         636           0 :  end subroutine bndry_exchange_threaded_finish
         637             :
         638           0 :  subroutine ghost_exchange_nonthreaded(par,buffer,location)
         639           0 :     use parallel_mod,   only : parallel_t
         640             :     use edgetype_mod, only : Edgebuffer_t
         641             :     type (parallel_t)          :: par
         642             :     type (EdgeBUffer_t)        :: buffer
         643             :     character(len=*), optional :: location
         644           0 :     call bndry_exchange_nonthreaded(par,buffer,location)
         645           0 :  end subroutine ghost_exchange_nonthreaded
         646             :
         647      377856 :  subroutine bndry_exchange_nonthreaded(par,buffer,location)
         648             :     use parallel_mod, only : parallel_t
         649             :     use edgetype_mod, only : Edgebuffer_t
         650             :     use perf_mod, only: t_startf, t_stopf, t_adj_detailf
         651             :     implicit none
         652             :
         653             :     type (parallel_t)           :: par
         654             :     type (EdgeBuffer_t)         :: buffer
         655             :     character(len=*), optional  :: location
         656             :
         657             :     integer                     :: ithr
         658             :     integer                     :: nthreads
         659             :     character(len=*), parameter :: subname = 'bndry_exchange_nonthreaded'
         660             :
         661             :     !$OMP BARRIER
         662      377856 :     ithr=0
         663      377856 :     nthreads = 1
         664      377856 :     if(buffer%bndry_type == HME_BNDRY_A2A) then
         665           0 :        call bndry_exchange_a2a(par,nthreads,ithr,buffer,location)
         666      377856 :     else if (buffer%bndry_type == HME_BNDRY_A2AO) then
         667           0 :        call bndry_exchange_a2ao(par,nthreads,ithr,buffer,location)
         668             :     else
         669      377856 :        call bndry_exchange_p2p(par,nthreads,ithr,buffer,location)
         670             :     endif
         671             :     !$OMP BARRIER
         672             :
         673      377856 :   end subroutine bndry_exchange_nonthreaded
         674             :
         675           0 :  subroutine bndry_exchange_nonthreaded_start(par,buffer,location)
         676      377856 :     use parallel_mod, only : parallel_t
         677             :     use edgetype_mod, only : Edgebuffer_t
         678             :     use perf_mod, only: t_startf, t_stopf, t_adj_detailf
         679             :     implicit none
         680             :
         681             :     type (parallel_t)           :: par
         682             :     type (EdgeBuffer_t)         :: buffer
         683             :     character (len=*), optional :: location
         684             :
         685             :     integer                     :: ithr
         686             :     integer                     :: nthreads
         687             :     character(len=*), parameter :: subname = 'bndry_exchange_nonthreaded_start'
         688             :
         689             :     !$OMP BARRIER
         690           0 :     ithr=0
         691           0 :     nthreads=1
         692           0 :     call bndry_exchange_p2p_start(par,nthreads,ithr,buffer,location)
         693             :
         694           0 :  end subroutine bndry_exchange_nonthreaded_start
         695             :
         696           0 :  subroutine bndry_exchange_nonthreaded_finish(par,buffer,location)
         697           0 :     use parallel_mod, only : parallel_t
         698             :     use edgetype_mod, only : Edgebuffer_t
         699             :     use perf_mod, only: t_startf, t_stopf, t_adj_detailf
         700             :     implicit none
         701             :
         702             :     type (parallel_t)                 :: par
         703             :     integer                           :: ithr
         704             :     type (EdgeBuffer_t)               :: buffer
         705             :     character (len=*), optional :: location
         706             :     integer :: nthreads
         707             :
         708             :     character(len=*), parameter :: subname = 'bndry_exchange_nonthreaded_finish'
         709             :
         710           0 :     ithr=0
         711           0 :     nthreads=1
         712           0 :     call bndry_exchange_p2p_finish(par,nthreads,ithr,buffer,location)
         713             :     !$OMP BARRIER
         714             :
         715           0 :   end subroutine bndry_exchange_nonthreaded_finish
         716             :
         717        1536 :   subroutine compute_ghost_corner_orientation(hybrid,elem,nets,nete)
         718             : !
         719             : !  this routine can NOT be called in a threaded region because then each thread
         720             : !  will have its on ghostbuffer.   initghostbufer3D() should detect this and abort.
         721             : !
         722           0 :   use dimensions_mod, only: nelemd, np
         723             :   use parallel_mod, only : syncmp
         724             :   use hybrid_mod, only : hybrid_t
         725             :   use element_mod, only : element_t
         726             :   use edgetype_mod, only : edgebuffer_t
         727             :   use edge_mod, only : ghostpack, ghostunpack, &
         728             :        initghostbuffer,freeghostbuffer
         729             :
         730             :   use control_mod, only : north,south,east,west,neast, nwest, seast, swest
         731             :
         732             :   type (hybrid_t)      , intent(in) :: hybrid
         733             :   type (element_t)     , intent(inout), target :: elem(:)
         734             :   integer :: nets,nete
         735        1536 :   type (edgeBuffer_t)    :: ghostbuf_cv
         736             :
         737        3072 :   real (kind=r8) :: cin(-1:4,-1:4,1,nets:nete)  !CE: fvm tracer
         738        3072 :   real (kind=r8) :: cout(-1:4,-1:4,1,nets:nete)  !CE: fvm tracer
         739             :   integer :: i,j,ie,kptr,np1,np2,nc,nc1,nc2,k,nlev
         740             :   logical :: fail,fail1,fail2
         741             :   real (kind=r8) :: tol = 0.1_r8
         742        1536 :   call syncmp(hybrid%par)
         743             :
         744             :
         745             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         746             :   ! first test on the Gauss Grid with same number of ghost cells:
         747             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         748        1536 :   nc=2   ! test using GLL interior points
         749        1536 :   nc1=-1
         750        1536 :   nc2=4
         751             :
         752        1536 :   nlev=1
         753             :
         754        1536 :   if (hybrid%nthreads > 1) then
         755           0 :      call endrun('ERROR: compute_ghost_corner_orientation must be called before threaded region')
         756             :   endif
         757        1536 :   call initghostbuffer(hybrid%par,ghostbuf_cv,elem,nlev,nc,nc,nthreads=1)
         758             :
         759             :
         760      476736 :   cin = 0._r8
         761       12336 :   do ie=nets,nete
         762       10800 :      cin(1,1,1,ie)=  elem(ie)%gdofp(1,1)
         763       10800 :      cin(nc,nc,1,ie)=  elem(ie)%gdofp(np,np)
         764       10800 :      cin(1,nc,1,ie)=   elem(ie)%gdofp(1,np)
         765       12336 :      cin(nc,1,1,ie)=  elem(ie)%gdofp(np,1)
         766             :   enddo
         767      476736 :   cout=0
         768             :
         769             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         770             : !  run ghost exchange on c array to get corner orientation
         771             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         772       12336 :   do ie=nets,nete
         773       10800 :      kptr=0
         774       12336 :      call ghostpack(ghostbuf_cv, cin(:,:,:,ie),nlev,kptr,ie)
         775             :   end do
         776        1536 :   call ghost_exchange(hybrid,ghostbuf_cv,location='compute_ghost_corner_orientation')
         777       12336 :   do ie=nets,nete
         778       10800 :      kptr=0
         779       12336 :      call ghostunpack(ghostbuf_cv, cout(:,:,:,ie),nlev,kptr,ie)
         780             :   enddo
         781             :
         782             : !       nc +--------+
         783             : !        ^ | nw  ne |
         784             : !     j  | |        |
         785             : !        1 | sw  se |
         786             : !          +--------+
         787             : !           1 --> nc
         788             : !              i
         789             :
         790             : ! check SW corner
         791       12336 :   do ie=nets,nete
         792       10800 :      fail1=.false.
         793       10800 :      fail2=.false.
         794       10800 :      if ( elem(ie)%desc%putmapP_ghost(swest) /= -1) then
         795       10788 :         if (abs(cout(nc1,1,1,ie)-cout(nc1,0,1,ie)) .gt. tol )  fail1=.true.
         796       10788 :         if (abs(cout(1,nc1,1,ie)-cout(0,nc1,1,ie)).gt.tol) fail2=.true.
         797             :      endif
         798       10788 :      if (fail1 .neqv. fail2 ) call endrun( 'ghost exchange SW orientation failure')
         799       12336 :      if (fail1) then
         800         232 :         elem(ie)%desc%reverse(swest)=.true.
         801             :      endif
         802             :   enddo
         803             : ! check SE corner
         804       12336 :   do ie=nets,nete
         805       10800 :      fail1=.false.
         806       10800 :      fail2=.false.
         807       10800 :      if ( elem(ie)%desc%putmapP_ghost(seast) /= -1) then
         808       10788 :         if (abs(cout(nc2,1,1,ie)-cout(nc2,0,1,ie)) .gt. tol )  fail1=.true.
         809       10788 :         if (abs(cout(nc+1,nc1,1,ie)-cout(nc,nc1,1,ie)).gt.tol) fail2=.true.
         810             :      endif
         811       10788 :      if (fail1 .neqv. fail2 ) call endrun('ghost exchange SE orientation failure')
         812       12336 :      if (fail1) then
         813         232 :         elem(ie)%desc%reverse(seast)=.true.
         814             :      endif
         815             :   enddo
         816             : ! check NW corner
         817       12336 :   do ie=nets,nete
         818       10800 :      fail1=.false.
         819       10800 :      fail2=.false.
         820       10800 :      if ( elem(ie)%desc%putmapP_ghost(nwest) /= -1) then
         821       10788 :         if (abs(cout(nc1,nc+1,1,ie)-cout(nc1,nc,1,ie)) .gt. tol )  fail1=.true.
         822       10788 :         if (abs(cout(1,nc2,1,ie)-cout(0,nc2,1,ie)).gt.tol) fail2=.true.
         823             :      endif
         824       10788 :      if (fail1 .neqv. fail2 ) call endrun( 'ghost exchange NW orientation failure')
         825       12336 :      if (fail1) then
         826         232 :         elem(ie)%desc%reverse(nwest)=.true.
         827             :      endif
         828             :   enddo
         829             : ! check NE corner
         830       12336 :   do ie=nets,nete
         831       10800 :      fail1=.false.
         832       10800 :      fail2=.false.
         833       10800 :      if ( elem(ie)%desc%putmapP_ghost(neast) /= -1) then
         834       10788 :         if (abs(cout(nc2,nc+1,1,ie)-cout(nc2,nc,1,ie)) .gt. tol )  fail1=.true.
         835       10788 :         if (abs(cout(nc+1,nc2,1,ie)-cout(nc,nc2,1,ie)).gt.tol) fail2=.true.
         836             :      endif
         837       10788 :      if (fail1 .neqv. fail2 ) call endrun( 'ghost exchange NE orientation failure')
         838       12336 :      if (fail1) then
         839         232 :         elem(ie)%desc%reverse(neast)=.true.
         840             :      endif
         841             :   enddo
         842        1536 :   call freeghostbuffer(ghostbuf_cv)
         843             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         844             : !  end ghost exchange corner orientation
         845             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         846        1536 :   end subroutine
         847           0 :   subroutine ghost_exchangeVfull(par,ithr,buffer)
         848             : !
         849             : !   MT 2011:  derived from bndry_exchange, but copies an entire
         850             : !             element of ghost cell information, including corner
         851             : !             elements.  Requres cubed-sphere grid
         852             : !
         853        1536 :     use hybrid_mod, only : hybrid_t
         854             :     use edgetype_mod,   only: Ghostbuffer3D_t
         855             :     use schedtype_mod, only : schedule_t, cycle_t, schedule
         856             :     use dimensions_mod, only: nelemd
         857             :     use parallel_mod, only : status, srequest, rrequest, parallel_t
         858             :     use spmd_utils,  only: mpi_integer, mpi_success,mpi_real8
         859             :
         860             :     implicit none
         861             :     type (parallel_t)                :: par
         862             :     integer                          :: ithr     ! hybrid%ithr 0 if called outside threaded region
         863             :
         864             :     type (GhostBuffer3D_t)           :: buffer
         865             :
         866             :     type (Schedule_t),pointer        :: pSchedule
         867             :     type (Cycle_t),pointer           :: pCycle
         868             :     integer                          :: dest,length,tag
         869             :     integer                          :: icycle,ierr
         870             :     integer                          :: iptr,source,nlyr
         871             :     integer                          :: nSendCycles,nRecvCycles
         872             :     integer                          :: errorcode,errorlen
         873             :     character(len=*), parameter      :: subname = 'ghost_exchangeVfull'
         874             :     character*(80) errorstring
         875             :
         876             :     integer                          :: i,i1,i2
         877             :
         878             :     !$OMP BARRIER
         879           0 :     if(ithr == 0) then
         880             :
         881             :
         882             : #ifdef SPMD
         883             :        ! Setup the pointer to proper Schedule
         884           0 :        pSchedule => Schedule(1)
         885           0 :        nlyr = buffer%nlyr
         886             :
         887           0 :        nSendCycles = pSchedule%nSendCycles
         888           0 :        nRecvCycles = pSchedule%nRecvCycles
         889             :
         890             :        !==================================================
         891             :        !  Fire off the sends
         892             :        !==================================================
         893           0 :        do icycle=1,nSendCycles
         894           0 :           pCycle      => pSchedule%SendCycle(icycle)
         895           0 :           dest            = pCycle%dest - 1
         896           0 :           length      = nlyr * pCycle%lengthP_ghost * buffer%elem_size
         897           0 :           tag             = pCycle%tag
         898           0 :           iptr            = pCycle%ptrP_ghost
         899             :
         900           0 :           call MPI_Isend(buffer%buf(1,1,1,iptr),length,MPI_real8,dest,tag,par%comm,Srequest(icycle),ierr)
         901           0 :           if(ierr .ne. MPI_SUCCESS) then
         902           0 :              errorcode=ierr
         903           0 :              call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         904           0 :              print *,subname,': Error after call to MPI_Isend: ',errorstring
         905             :           endif
         906             :        end do    ! icycle
         907             :
         908             :        !==================================================
         909             :        !  Post the Receives
         910             :        !==================================================
         911           0 :        do icycle=1,nRecvCycles
         912           0 :           pCycle         => pSchedule%RecvCycle(icycle)
         913           0 :           source          = pCycle%source - 1
         914           0 :           length      = nlyr * pCycle%lengthP_ghost * buffer%elem_size
         915           0 :           tag             = pCycle%tag
         916           0 :           iptr            = pCycle%ptrP_ghost
         917             :
         918           0 :           call MPI_Irecv(buffer%receive(1,1,1,iptr),length,MPI_real8, &
         919           0 :                source,tag,par%comm,Rrequest(icycle),ierr)
         920           0 :           if(ierr .ne. MPI_SUCCESS) then
         921           0 :              errorcode=ierr
         922           0 :              call MPI_Error_String(errorcode,errorstring,errorlen,ierr)
         923           0 :              print *,subname,': Error after call to MPI_Irecv: ',errorstring
         924             :           endif
         925             :        end do    ! icycle
         926             :
         927             :
         928             :        !==================================================
         929             :        !  Wait for all the receives to complete
         930             :        !==================================================
         931             :
         932           0 :        call MPI_Waitall(nSendCycles,Srequest,status,ierr)
         933           0 :        call MPI_Waitall(nRecvCycles,Rrequest,status,ierr)
         934             :
         935           0 :        do icycle=1,nRecvCycles
         936           0 :           pCycle         => pSchedule%RecvCycle(icycle)
         937           0 :           length             = pCycle%lengthP_ghost
         938           0 :           iptr            = pCycle%ptrP_ghost
         939           0 :           do i=0,length-1
         940           0 :              buffer%buf(:,:,1:nlyr,iptr+i) = buffer%receive(:,:,1:nlyr,iptr+i)
         941             :           enddo
         942             :        end do   ! icycle
         943             :
         944             :
         945             : #endif
         946             :     endif  ! if (hybrid%ithr == 0)
         947             :     !$OMP BARRIER
         948             :
         949           0 :   end subroutine ghost_exchangeVfull
         950             :
         951             :
         952             : end module bndry_mod

Generated by: LCOV version 1.14