hydro/MPP/CPL_WRF.F

   1 !  Program Name:
   2 !  Author(s)/Contact(s):
   3 !  Abstract:
   4 !  History Log:
   5 !
   6 !  Usage:
   7 !  Parameters: <Specify typical arguments passed>
   8 !  Input Files:
   9 !        <list file names and briefly describe the data they include>
  10 !  Output Files:
  11 !        <list file names and briefly describe the information they include>
  12 !
  13 !  Condition codes:
  14 !        <list exit condition or error codes returned >
  15 !        If appropriate, descriptive troubleshooting instructions or
  16 !        likely causes for failures could be mentioned here with the
  17 !        appropriate error code
  18 !
  19 !  User controllable options: <if applicable>
  20
  21 !   This is used as a coupler with the WRF model.
  22 MODULE MODULE_CPL_LAND
  23
  24     use mpi
  25     use, intrinsic :: iso_fortran_env, only: error_unit
  26
  27   IMPLICIT NONE
  28
  29   integer, public :: HYDRO_COMM_WORLD = MPI_COMM_NULL
  30   integer my_global_id
  31
  32   integer total_pe_num
  33   integer global_ix,global_jx
  34
  35   integer,allocatable,dimension(:,:) :: node_info
  36
  37   logical initialized, cpl_land, time_step_read_rstart, &
  38            time_step_write_rstart, time_step_output
  39   character(len=19) cpl_outdate, cpl_rstdate
  40
  41   integer, public :: cartGridComm
  42   integer, public :: np_up_down, np_left_right
  43   integer, public :: p_up_down, p_left_right
  44
  45   contains
  46
  47   ! sets incoming communicator and then calls CPL_LAND_INIT
  48   !subroutine CPL_LAND_INIT_COMM(istart,iend,jstart,jend,hydroCommunicator)
  49   !  implicit none
  50   !
  51   !  integer :: istart,iend,jstart,jend
  52   !  integer :: hydroCommunicator
  53   !
  54   !  HYDRO_COMM_WORLD = hydroCommunicator
  55   !  call CPL_LAND_INIT(istart,iend,jstart,jend)
  56   !end subroutine
  57
  58   subroutine CPL_LAND_INIT(istart,iend,jstart,jend)
  59       implicit none
  60       integer ierr
  61       logical mpi_inited
  62       integer istart,iend,jstart,jend
  63
  64       integer :: xx, ndim
  65       integer, dimension(0:1) :: dims, coords
  66       logical cyclic(0:1), reorder
  67       data cyclic/.false.,.false./  ! not cyclic
  68       data reorder/.false./
  69
  70       CALL mpi_initialized( mpi_inited, ierr )
  71       if ( .NOT. mpi_inited ) then
  72         call mpi_init(ierr)
  73         if (ierr /= MPI_SUCCESS) call fatal_error_stop("MPI Error: MPI_INIT failed")
  74         call MPI_COMM_DUP(MPI_COMM_WORLD, HYDRO_COMM_WORLD, ierr)
  75         if (ierr /= MPI_SUCCESS) call fatal_error_stop("MPI Error: MPI_COMM_DUP failed")
  76       endif
  77
  78       call MPI_COMM_RANK( HYDRO_COMM_WORLD, my_global_id, ierr )
  79       call MPI_COMM_SIZE( HYDRO_COMM_WORLD, total_pe_num, ierr )
  80       if (ierr /= MPI_SUCCESS) call fatal_error_stop("MPI Error: MPI_COMM_RANK and/or MPI_COMM_SIZE failed")
  81
  82       allocate(node_info(9,total_pe_num))
  83
  84       node_info = -99
  85
  86 ! send node info to node 0
  87       node_info(1,my_global_id+1) = total_pe_num
  88       node_info(6,my_global_id+1) = istart
  89       node_info(7,my_global_id+1) = iend
  90       node_info(8,my_global_id+1) = jstart
  91       node_info(9,my_global_id+1) = jend
  92
  93
  94       call send_info()
  95       call find_left()
  96       call find_right()
  97       call find_up()
  98       call find_down()
  99
 100       call send_info()
 101
 102       ! initialize cartesian grid communicator
 103       dims(0) = 0
 104       dims(1) = 0
 105       do xx=1,total_pe_num
 106         if(node_info(2,xx) .eq. (-1)) then
 107           dims(0) = dims(0)+1
 108         endif
 109         if(node_info(4,xx) .eq. (-1)) then
 110           dims(1) = dims(1)+1
 111         endif
 112       enddo
 113
 114       ndim = 2
 115       np_up_down = dims(0)
 116       np_left_right = dims(1)
 117
 118       call MPI_Cart_create(HYDRO_COMM_WORLD, ndim, dims, &
 119                           cyclic, reorder, cartGridComm, ierr)
 120
 121       call MPI_CART_GET(cartGridComm, 2, dims, cyclic, coords, ierr)
 122
 123       p_up_down = coords(0)
 124       p_left_right = coords(1)
 125
 126       initialized = .false.  ! land model need to be initialized.
 127       return
 128   END subroutine CPL_LAND_INIT
 129
 130      subroutine send_info()
 131         implicit none
 132         integer,allocatable,dimension(:,:) :: tmp_info
 133         integer  ierr, i,size, tag
 134         integer mpp_status(MPI_STATUS_SIZE)
 135         tag  = 9
 136         size =  9
 137
 138         if(my_global_id .eq. 0) then
 139            do i = 1, total_pe_num-1
 140              call mpi_recv(node_info(:,i+1),size,MPI_INTEGER,  &
 141                 i,tag,HYDRO_COMM_WORLD,mpp_status,ierr)
 142            enddo
 143         else
 144            call mpi_send(node_info(:,my_global_id+1),size,   &
 145                MPI_INTEGER,0,tag,HYDRO_COMM_WORLD,ierr)
 146         endif
 147
 148         call MPI_barrier( HYDRO_COMM_WORLD ,ierr)
 149
 150         size = 9 * total_pe_num
 151         call mpi_bcast(node_info,size,MPI_INTEGER,   &
 152             0,HYDRO_COMM_WORLD,ierr)
 153
 154         call MPI_barrier( HYDRO_COMM_WORLD ,ierr)
 155
 156      return
 157      end  subroutine send_info
 158
 159      subroutine find_left()
 160           implicit none
 161           integer i
 162
 163           node_info(2,my_global_id+1) = -1
 164
 165           do i = 1, total_pe_num
 166                if( (node_info(8,i).eq.node_info(8,my_global_id+1)) .and. &
 167                    (node_info(9,i).eq.node_info(9,my_global_id+1)) .and. &
 168                    ((node_info(7,i)+1).eq.node_info(6,my_global_id+1)) ) then
 169                    node_info(2,my_global_id+1) = i - 1
 170                    return
 171                endif
 172           end do
 173      return
 174      end subroutine find_left
 175
 176      subroutine find_right()
 177           implicit none
 178           integer i
 179
 180           node_info(3,my_global_id+1) = -1
 181
 182           do i = 1, total_pe_num
 183                if( (node_info(8,i).eq.node_info(8,my_global_id+1)) .and. &
 184                    (node_info(9,i).eq.node_info(9,my_global_id+1)) .and. &
 185                    ((node_info(6,i)-1).eq.node_info(7,my_global_id+1)) ) then
 186                    node_info(3,my_global_id+1) = i - 1
 187                    return
 188                endif
 189           end do
 190      return
 191      end subroutine find_right
 192
 193      subroutine find_up()
 194           implicit none
 195           integer i
 196
 197           node_info(4,my_global_id+1) = -1
 198
 199           do i = 1, total_pe_num
 200                if( (node_info(6,i).eq.node_info(6,my_global_id+1)) .and. &
 201                    (node_info(7,i).eq.node_info(7,my_global_id+1)) .and. &
 202                    ((node_info(8,i)-1).eq.node_info(9,my_global_id+1)) ) then
 203                    node_info(4,my_global_id+1) = i - 1
 204                    return
 205                endif
 206           end do
 207      return
 208      end subroutine find_up
 209
 210      subroutine find_down()
 211           implicit none
 212           integer i
 213
 214           node_info(5,my_global_id+1) = -1
 215
 216           do i = 1, total_pe_num
 217                if( (node_info(6,i).eq.node_info(6,my_global_id+1)) .and. &
 218                    (node_info(7,i).eq.node_info(7,my_global_id+1)) .and. &
 219                    ((node_info(9,i)+1).eq.node_info(8,my_global_id+1)) ) then
 220                    node_info(5,my_global_id+1) = i - 1
 221                    return
 222                endif
 223           end do
 224      return
 225      end subroutine find_down
 226
 227     ! stop the job due to the fatal error.
 228     subroutine fatal_error_stop(msg)
 229         character(len=*) :: msg
 230         integer :: ierr
 231         write(error_unit,*) "The job is stoped due to the fatal error. ", trim(msg)
 232         call flush(error_unit)
 233         CALL MPI_Abort(HYDRO_COMM_WORLD, 1, ierr)
 234         call MPI_Finalize(ierr)
 235         return
 236     end  subroutine fatal_error_stop
 237 END MODULE MODULE_CPL_LAND