search.f90

Go to the documentation of this file.

 subroutine search (field, mask, idim, jdim, tile, field_name)

 use mpi
 use esmf

 implicit none

 character(len=*)                  :: field_name

 integer, intent(in)               :: idim, jdim, tile
 integer(esmf_kind_i4), intent(in) :: mask(idim,jdim)

 real(esmf_kind_r4), intent(inout) :: field(idim,jdim)

 integer                           :: i, j, krad, ii, jj
 integer                           :: istart, iend
 integer                           :: jstart, jend
 integer                           :: ierr

 real                              :: default_value
 real(esmf_kind_r4), allocatable   :: field_save(:,:)

!-----------------------------------------------------------------------
! Set default value.
!-----------------------------------------------------------------------

 select case (field_name)
   case ('substrate_temperature') ! soil substrate_temperature
     default_value = 280.0
   case ('vegetation_greenness') ! vegetation greenness
     default_value = 0.5
   case ('maximum_snow_albedo') ! maximum snow albedo
     default_value = 0.5
   case ('leaf_area_index') ! leaf area index
     default_value = 1.0
   case ('visible_black_sky_albedo') ! visible black sky albedo
     default_value = 0.1
   case ('visible_white_sky_albedo') ! visible white sky albedo
     default_value = 0.1
   case ('near_IR_black_sky_albedo') ! near IR black sky albedo
     default_value = 0.2
   case ('near_IR_white_sky_albedo') ! near IR white sky albedo
     default_value = 0.2
   case ('facsf') ! facsf
     default_value = 0.5
   case ('facwf') ! facwf
     default_value = 0.5
   case ('slope_type') ! slope type
     default_value = float(1)
   case ('soil_type') ! soil type
     default_value = float(2)
   case ('soil_color') ! soil color
     default_value = float(4)
   case ('vegetation_type') ! vegetation type
     default_value = float(3)
   case default
     print*,'- FATAL ERROR IN ROUTINE SEARCH.  UNIDENTIFIED FIELD : ', field_name
     call mpi_abort(mpi_comm_world, 77, ierr)
 end select

!-----------------------------------------------------------------------
! Perform search and replace.
!-----------------------------------------------------------------------

 allocate (field_save(idim,jdim))
 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) < -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. field_save(ii,jj) > -9999.0) then
                 field(i,j) = field_save(ii,jj)
!                write(6,100) tile,i,j,ii,jj,field(i,j)
                 cycle i_loop
               endif

           endif

         enddo ii_loop
         enddo jj_loop

       enddo krad_loop

       field(i,j) = default_value  ! Search failed.  Use default value.

       write(6,101) tile,i,j,field(i,j)

     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,". NEW VALUE IS: ",f8.3)
 101 format(1x,"- MISSING POINT TILE: ",i2," I/J: ",i5,i5," SET TO DEFAULT VALUE OF: ",f8.3)

 end subroutine search