search_frac_cats.f90

Go to the documentation of this file.

 
 
 subroutine search_frac_cats (field, mask, idim, jdim, num_categories, tile, field_name)
 
 use mpi
 use esmf
 
 implicit none
 
 integer, intent(in)               :: idim, jdim, tile, num_categories
 integer(esmf_kind_i4), intent(in) :: mask(idim,jdim)
 
 real(esmf_kind_r4), intent(inout) :: field(idim,jdim,num_categories)
 
 character(len=*)                  :: field_name
 
 integer                           :: i, j, krad, ii, jj
 integer                           :: istart, iend
 integer                           :: jstart, jend
 integer                           :: ierr
 integer                           :: default_category
 
 real(esmf_kind_r4), allocatable   :: field_save(:,:,:)
 
!-----------------------------------------------------------------------
! Set default category.
!-----------------------------------------------------------------------
 
 select case (field_name)
   case ('soil_type') ! soil type
     default_category = 3
   case ('vegetation_type') ! vegetation type
     default_category = 3
   case default
     print*,'- FATAL ERROR IN ROUTINE SEARCH.  UNIDENTIFIED FIELD : ', field
     call mpi_abort(mpi_comm_world, 77, ierr)
 end select
 
!-----------------------------------------------------------------------
! Perform search and replace.
!-----------------------------------------------------------------------
 
 allocate (field_save(idim,jdim,num_categories))
 field_save = field
 
 j_loop : do j = 1, jdim
   i_loop : do i = 1, idim
 
     if (mask(i,j) == 1 .and. field_save(i,j,1) < -9999.0) then
 
       krad_loop : do krad = 1, 100
 
         istart = i - krad
         iend   = i + krad
         jstart = j - krad
         jend   = j + krad
 
         jj_loop : do jj = jstart, jend
         ii_loop : do ii = istart, iend
 
!-----------------------------------------------------------------------
!          Search only along outer square.
!-----------------------------------------------------------------------
 
           if ((jj == jstart) .or. (jj == jend) .or.   &
               (ii == istart) .or. (ii == iend)) then
 
             if (jj < 1 .or. jj > jdim) cycle jj_loop
             if (ii < 1 .or. ii > idim) cycle ii_loop
 
               if (mask(ii,jj) == 1 .and. maxval(field_save(ii,jj,:)) > 0.0) then
                 field(i,j,:) = field_save(ii,jj,:)
                 write(6,100) tile,i,j,ii,jj
                 cycle i_loop
               endif
 
           endif
 
         enddo ii_loop
         enddo jj_loop
 
       enddo krad_loop
 
       field(i,j,:) = 0.0
       field(i,j,default_category) = 1.0  ! Search failed.  Use 100% of default category.
 
       write(6,101) tile,i,j,default_category
 
     endif
   enddo i_loop
 enddo j_loop
 
 deallocate(field_save)
 
 100 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO VALUE AT: ",i5,i5)
 101 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",i3)
 
 end subroutine search_frac_cats