if (k==26 .and. j>=113) k = 29! Split forest tundra (62, 63) into needleleaf evergreen forest tundra (62) ! and needleleaf deciduous forest tundra (63) based on longitude           if (k==63) k = 62           if (k==62 .and. i>=490) k = 63   ! Error check           if (k>100 .or. k<0) then              write (6,*) 'ERROR: Olson surface type = ',k,' is undefined for lon,lat = ',i,j              Stop           end if! Save modified OLSON type            surftyp_i(i,j) = k        end do     end do! Assign each of the OLSON surface types to an LSM surface type.! This mapping from OLSON to LSM is based on the BATS dataset code.! Note: in2lsm(i) = OLSON type i     in2lsm(1:19) = miss     in2lsm(20) = 3      in2lsm(21) = 3                                                          in2lsm(22) = 3       in2lsm(23) = 6      in2lsm(24) = 8      in2lsm(25) = 9                                                    in2lsm(26) = 9                                                    in2lsm(27) = 7            in2lsm(28) = 10                                                    in2lsm(29) = 10                                                    in2lsm(30) = 24                                                    in2lsm(31) = 26                                                    in2lsm(32) = 12                                                    in2lsm(33) = 10                                                    in2lsm(34) = miss                                                in2lsm(35) = miss                                                in2lsm(36) = 28                                                   in2lsm(37) = 25                                                   in2lsm(38) = 23                                                   in2lsm(39) = 23                                                   in2lsm(40) = 17                                                    in2lsm(41) = 18                                                    in2lsm(42) = 17                                                    in2lsm(43) = 12                                                    in2lsm(44) = 28                                                   in2lsm(45) = 28                                                   in2lsm(46) = 20                                                   in2lsm(47) = 20                                                   in2lsm(48) = 20        in2lsm(49) = 22                                                   in2lsm(50) = 2                                                    in2lsm(51) = 22                                                   in2lsm(52) = 22        in2lsm(53) = 19                                                    in2lsm(54) = 19                                                    in2lsm(55) = 15         in2lsm(56) = 16        in2lsm(57) = 15        in2lsm(58) = 16         in2lsm(59) = 21                                                   in2lsm(60) = 6                                                   in2lsm(61) = 4                                                    in2lsm(62) = 13         in2lsm(63) = 14                                                   in2lsm(64) = 20                                                   in2lsm(65) = 0        in2lsm(66) = 0        in2lsm(67) = 0        in2lsm(68) = 0        in2lsm(69) = 2                                                    in2lsm(70) = 1                                                  in2lsm(71) = 22                                                   in2lsm(72) = 27                                                   in2lsm(73) = 0        in2lsm(74:100) = miss  endif! -----------------------------------------------------------------! LSM input data : 1:1 correspondence between surface types! -----------------------------------------------------------------  if (nvegmax == nlsm) then     do i = 1, nlsm        in2lsm(i) = i     end do  end if! -----------------------------------------------------------------! Transform input surface types to LSM surface types! -----------------------------------------------------------------  surftyp_o(:,:) = miss   do j = 1 , nlat                                                      do i = 1, nlon                                                         if (surftyp_i(i,j) == 0) then           surftyp_o(i,j) = 0        else           k = surftyp_i(i,j)           surftyp_o(i,j) = in2lsm(k)        end if        if (surftyp_o(i,j)>nlsm .or. surftyp_o(i,j)<0) then           write (6,*) 'ERROR: LSM surface type = ',surftyp_o(i,j),' is undefined for lon,lat = ',i,j           stop        end if     end do  end do! Write output variables  call wrap_put_var_realx (ncid, lon_id    , lon)  call wrap_put_var_realx (ncid, lat_id    , lat)  call wrap_put_var_realx (ncid, longxy_id , longxy)  call wrap_put_var_realx (ncid, latixy_id , latixy)  call wrap_put_var_realx (ncid, edgen_id  , edge(1))  call wrap_put_var_realx (ncid, edgen_id  , edge(1))  call wrap_put_var_realx (ncid, edgee_id  , edge(2))  call wrap_put_var_realx (ncid, edges_id  , edge(3))  call wrap_put_var_realx (ncid, edgew_id  , edge(4))  call wrap_put_var_int   (ncid, surftyp_id, surftyp_o)  call wrap_close(ncid)end program make_surftype!===============================================================================subroutine wrap_create (path, cmode, ncid)  implicit none  include 'netcdf.inc'  integer, parameter :: r8 = selected_real_kind(12)  character(len=*) path  integer cmode, ncid, ret  ret = nf_create (path, cmode, ncid)  if (ret.ne.NF_NOERR) call handle_error (ret)end subroutine wrap_create!===============================================================================subroutine wrap_def_dim (nfid, dimname, len, dimid)  implicit none  include 'netcdf.inc'  integer, parameter :: r8 = selected_real_kind(12)  integer :: nfid, len, dimid  character(len=*) :: dimname  integer ret  ret = nf_def_dim (nfid, dimname, len, dimid)  if (ret.ne.NF_NOERR) call handle_error (ret)end subroutine wrap_def_dim!===============================================================================subroutine wrap_def_var (nfid, name, xtype, nvdims, vdims, varid)  implicit none  include 'netcdf.inc'  integer, parameter :: r8 = selected_real_kind(12)  integer :: nfid, xtype, nvdims, varid  integer :: vdims(nvdims)  character(len=*) :: name  integer ret  ret = nf_def_var (nfid, name, xtype, nvdims, vdims, varid)  if (ret.ne.NF_NOERR) call handle_error (ret)end subroutine wrap_def_var!===============================================================================subroutine wrap_put_att_text (nfid, varid, attname, atttext)  implicit none  include 'netcdf.inc'  integer, parameter :: r8 = selected_real_kind(12)  integer :: nfid, varid  character(len=*) :: attname, atttext  integer :: ret, siz  siz = len_trim(atttext)  ret = nf_put_att_text (nfid, varid, attname, siz, atttext)  if (ret.ne.NF_NOERR) call handle_error (ret)end subroutine wrap_put_att_text!===============================================================================subroutine wrap_put_var_realx (nfid, varid, arr)  implicit none  include 'netcdf.inc'  integer, parameter :: r8 = selected_real_kind(12)  integer :: nfid, varid  real(r8) :: arr(*)  integer :: ret#ifdef CRAY  ret = nf_put_var_real (nfid, varid, arr)#else  ret = nf_put_var_double (nfid, varid, arr)#endif  if (ret.ne.NF_NOERR) call handle_error (ret)end subroutine wrap_put_var_realx!===============================================================================subroutine wrap_put_var_int (nfid, varid, arr)  implicit none  include 'netcdf.inc'  integer, parameter :: r8 = selected_real_kind(12)  integer :: nfid, varid  integer :: arr(*)  integer :: ret  ret = nf_put_var_int (nfid, varid, arr)  if (ret.ne.NF_NOERR) call handle_error (ret)end subroutine wrap_put_var_int  !===============================================================================subroutine wrap_close (ncid)  implicit none  include 'netcdf.inc'  integer, parameter :: r8 = selected_real_kind(12)  integer :: ncid  integer :: ret  ret = nf_close (ncid)  if (ret.ne.NF_NOERR) then     write(6,*)'WRAP_CLOSE: nf_close failed for id ',ncid     call handle_error (ret)  end ifend subroutine wrap_close!===============================================================================subroutine handle_error(ret)  implicit none  include 'netcdf.inc'  integer :: ret  if (ret .ne. nf_noerr) then     write(6,*) 'NCDERR: ERROR: ',nf_strerror(ret)     call abort  endifend subroutine handle_error!===============================================================================