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