Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:38:27 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
bf4be02920 Jean*0001 !=======================================================================
                0002       subroutine comprecv_r4( dataname, Ni,Oi,Nj,Oj, arr )
                0003       implicit none
                0004 ! Arguments
                0005       character*(*) dataname
                0006       integer Ni,Oi,Nj,Oj,Io,Jo
                0007       real*4 arr(1-Oi:Ni+Oi,1-Oj:Nj+Oj)
                0008 ! Predefined constants/arrays
                0009 #include "CPLR_SIG.h"
                0010 ! MPI variables
                0011 #include "mpif.h"
                0012       integer count,dtype,rank,tag,comm,ierr
                0013       integer stat(MPI_STATUS_SIZE)
                0014 ! Functions
                0015       integer generate_tag
                0016 ! Local
                0017       integer i,j,ij,nx,ny
                0018       character*(MAXLEN_COMP_NAME) recvdname
                0019 !     ------------------------------------------------------------------
                0020 
                0021       if (HEADER_SIZE+Ni*Nj.gt.MAX_R4_BUFLEN)
                0022      &    stop 'comprecv_r4: Nx*Ny too big'
                0023 
                0024 ! Receive message
                0025       count=HEADER_SIZE+MAX_R4_BUFLEN
                0026       dtype=MPI_REAL
                0027       tag=generate_tag(121,my_rank_in_global,dataname)
                0028       rank=my_coupler_rank
                0029       comm=MPI_COMM_myglobal
                0030 
                0031       if (VERB) then
                0032        write(LogUnit,*) 'comprecv_r4: calling MPI_Recv rank=',rank
                0033        write(LogUnit,*) 'comprecv_r4: dataname=',dataname
                0034        call flush(LogUnit)
                0035       endif
                0036       call MPI_Recv(r4buf, count, dtype, rank, tag, comm, stat, ierr)
                0037       if (VERB) then
                0038        write(LogUnit,*) 'comprecv_r4: returned ierr=',ierr
                0039        call flush(LogUnit)
                0040       endif
                0041 
                0042       if (ierr.ne.0) then
                0043        write(LogUnit,*) 'comprecv_r4tiles: rank(W,G)=',
                0044      &            my_rank_in_world,my_rank_in_global,
                0045      &            ' ierr=',ierr
                0046        stop 'comprecv_r4: MPI_Recv failed'
                0047       endif
                0048 
                0049 ! Extract buffer
                0050       Io=int(0.5+r4buf(1))
                0051       Jo=int(0.5+r4buf(2))
                0052       nx=int(0.5+r4buf(3))
                0053       ny=int(0.5+r4buf(4))
                0054       call mitcplr_real2char( r4buf(9), recvdname )
                0055 
                0056       if (Io.ne.my_tile_i0(1)) stop 'comprecv_r4: bad Io'
                0057       if (Jo.ne.my_tile_j0(1)) stop 'comprecv_r4: bad Jo'
                0058       if (nx.ne.my_tile_nx(1)) stop 'comprecv_r4: bad nx'
                0059       if (ny.ne.my_tile_ny(1)) stop 'comprecv_r4: bad ny'
                0060       if (recvdname .ne. dataname) then
                0061        write(LogUnit,*) 'comprecv_r4: recvdname = ',recvdname
                0062        write(LogUnit,*) 'comprecv_r4:  dataname = ',dataname
                0063        stop 'comprecv_r4: recvdname != dataname'
                0064       endif
                0065 
                0066 ! Copy buffer to interior of tile
                0067       do j=1,Nj
                0068        do i=1,Ni
                0069         ij=HEADER_SIZE+i+Ni*(j-1)
                0070         arr(i,j)=r4buf(ij)
                0071        enddo
                0072       enddo
                0073 
                0074 !     ------------------------------------------------------------------
                0075       return
                0076       end
                0077 !=======================================================================