1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027 |
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! This routine reads remapping information from files written
- ! by remap_setup. If remapping in both directions are required,
- ! two input files must be specified.
- !
- !-----------------------------------------------------------------------
- !
- ! CVS:$Id: remap_read.f,v 1.6 2000/04/19 21:56:26 pwjones Exp $
- !
- ! Copyright (c) 1997, 1998 the Regents of the University of
- ! California.
- !
- ! This software and ancillary information (herein called software)
- ! called SCRIP is made available under the terms described here.
- ! The software has been approved for release with associated
- ! LA-CC Number 98-45.
- !
- ! Unless otherwise indicated, this software has been authored
- ! by an employee or employees of the University of California,
- ! operator of the Los Alamos National Laboratory under Contract
- ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S.
- ! Government has rights to use, reproduce, and distribute this
- ! software. The public may copy and use this software without
- ! charge, provided that this Notice and any statement of authorship
- ! are reproduced on all copies. Neither the Government nor the
- ! University makes any warranty, express or implied, or assumes
- ! any liability or responsibility for the use of this software.
- !
- ! If software is modified to produce derivative works, such modified
- ! software should be clearly marked, so as not to confuse it with
- ! the version available from Los Alamos National Laboratory.
- !
- !***********************************************************************
- module remap_read
- !-----------------------------------------------------------------------
- !
- ! contains routines for reading a remap file
- !
- !-----------------------------------------------------------------------
- use kinds_mod ! defines common data types
- use constants ! defines useful constants
- use grids ! includes all grid information
- use netcdf_mod ! module with netcdf vars and utilities
- use remap_vars ! module for all required remapping variables
- implicit none
- !-----------------------------------------------------------------------
- !
- ! module variables
- !
- !-----------------------------------------------------------------------
- !-----------------------------------------------------------------------
- !
- ! various netCDF ids for files variables
- !
- !-----------------------------------------------------------------------
- integer (kind=int_kind), private :: ! netCDF ids
- & ncstat, nc_file_id,
- & nc_srcgrdsize_id, nc_dstgrdsize_id,
- & nc_srcgrdcorn_id, nc_dstgrdcorn_id,
- & nc_srcgrdrank_id, nc_dstgrdrank_id,
- & nc_srcgrddims_id, nc_dstgrddims_id,
- & nc_numlinks_id, nc_numwgts_id,
- & nc_srcgrdimask_id, nc_dstgrdimask_id,
- & nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
- & nc_srcgrdcrnrlat_id, nc_srcgrdcrnrlon_id,
- & nc_srcgrdarea_id, nc_srcgrdfrac_id,
- & nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
- & nc_dstgrdcrnrlat_id, nc_dstgrdcrnrlon_id,
- & nc_dstgrdarea_id, nc_dstgrdfrac_id,
- & nc_srcgrdadd_id, nc_dstgrdadd_id, nc_rmpmatrix_id
- !***********************************************************************
- contains
- !***********************************************************************
- subroutine read_remap(map_name, interp_file)
- !-----------------------------------------------------------------------
- !
- ! this driver routine reads some global attributes and then
- ! calls a specific read routine based on file conventions
- !
- !-----------------------------------------------------------------------
- !-----------------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------------
- character(char_len), intent(in) ::
- & interp_file ! filename for remap data
- !-----------------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------------
- character(char_len), intent(out) ::
- & map_name ! name for mapping
- !-----------------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------------
- character(char_len) ::
- & map_method ! character string for map_type
- &, normalize_opt ! character string for normalization option
- &, convention ! character string for output convention
- !-----------------------------------------------------------------------
- !
- ! open file and read some global information
- !
- !-----------------------------------------------------------------------
- ncstat = nf_open(interp_file, NF_NOWRITE, nc_file_id)
- call netcdf_error_handler(ncstat)
- !***
- !*** map name
- !***
- map_name = ' '
- ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'title',
- & map_name)
- call netcdf_error_handler(ncstat)
- print *,'Reading remapping:',trim(map_name)
- print *,'From file:',trim(interp_file)
- !***
- !*** normalization option
- !***
- normalize_opt = ' '
- ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'normalization',
- & normalize_opt)
- call netcdf_error_handler(ncstat)
- select case(normalize_opt)
- case ('none')
- norm_opt = norm_opt_none
- case ('fracarea')
- norm_opt = norm_opt_frcarea
- case ('destarea')
- norm_opt = norm_opt_dstarea
- case default
- print *,'normalize_opt = ',normalize_opt
- stop 'Invalid normalization option'
- end select
- !***
- !*** map method
- !***
- map_method = ' '
- ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'map_method',
- & map_method)
- call netcdf_error_handler(ncstat)
- select case(map_method)
- case('Conservative remapping')
- map_type = map_type_conserv
- case('Bilinear remapping')
- map_type = map_type_bilinear
- case('Distance weighted avg of nearest neighbors')
- map_type = map_type_distwgt
- case('Bicubic remapping')
- map_type = map_type_bicubic
- case default
- print *,'map_type = ',map_method
- stop 'Invalid Map Type'
- end select
- !***
- !*** file convention
- !***
- convention = ' '
- ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'conventions',
- & convention)
- call netcdf_error_handler(ncstat)
- !-----------------------------------------------------------------------
- !
- ! call appropriate read routine based on output convention
- !
- !-----------------------------------------------------------------------
- select case(convention)
- case ('SCRIP')
- call read_remap_scrip
- case ('NCAR-CSM')
- call read_remap_csm
- case default
- print *,'convention = ',convention
- stop 'unknown output file convention'
- end select
- !-----------------------------------------------------------------------
- end subroutine read_remap
- !***********************************************************************
- subroutine read_remap_scrip
- !-----------------------------------------------------------------------
- !
- ! the routine reads a netCDF file to extract remapping info
- ! in SCRIP format
- !
- !-----------------------------------------------------------------------
- !-----------------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------------
- character (char_len) ::
- & grid1_name ! grid name for source grid
- &, grid2_name ! grid name for dest grid
- integer (kind=int_kind) ::
- & n ! dummy index
- integer (kind=int_kind), dimension(:), allocatable ::
- & grid1_mask_int, ! integer masks to determine
- & grid2_mask_int ! cells that participate in map
- !-----------------------------------------------------------------------
- !
- ! read some additional global attributes
- !
- !-----------------------------------------------------------------------
- !***
- !*** source and destination grid names
- !***
- grid1_name = ' '
- grid2_name = ' '
- ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'source_grid',
- & grid1_name)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'dest_grid',
- & grid2_name)
- call netcdf_error_handler(ncstat)
- print *,' '
- print *,'Remapping between:',trim(grid1_name)
- print *,'and ',trim(grid2_name)
- print *,' '
- !-----------------------------------------------------------------------
- !
- ! read dimension information
- !
- !-----------------------------------------------------------------------
- ncstat = nf_inq_dimid(nc_file_id, 'src_grid_size',
- & nc_srcgrdsize_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_size',
- & nc_dstgrdsize_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'src_grid_corners',
- & nc_srcgrdcorn_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,
- & grid1_corners)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_corners',
- & nc_dstgrdcorn_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,
- & grid2_corners)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',
- & nc_srcgrdrank_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,
- & grid1_rank)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',
- & nc_dstgrdrank_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,
- & grid2_rank)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'num_links',
- & nc_numlinks_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,
- & num_links_map1)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',
- & nc_numwgts_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
- call netcdf_error_handler(ncstat)
- !-----------------------------------------------------------------------
- !
- ! allocate arrays
- !
- !-----------------------------------------------------------------------
- allocate( grid1_dims (grid1_rank),
- & grid1_center_lat(grid1_size),
- & grid1_center_lon(grid1_size),
- & grid1_area (grid1_size),
- & grid1_frac (grid1_size),
- & grid1_mask (grid1_size),
- & grid1_mask_int (grid1_size),
- & grid1_corner_lat(grid1_corners, grid1_size),
- & grid1_corner_lon(grid1_corners, grid1_size) )
- allocate( grid2_dims (grid2_rank),
- & grid2_center_lat(grid2_size),
- & grid2_center_lon(grid2_size),
- & grid2_area (grid2_size),
- & grid2_frac (grid2_size),
- & grid2_mask (grid2_size),
- & grid2_mask_int (grid2_size),
- & grid2_corner_lat(grid2_corners, grid2_size),
- & grid2_corner_lon(grid2_corners, grid2_size) )
- allocate( grid1_add_map1(num_links_map1),
- & grid2_add_map1(num_links_map1),
- & wts_map1(num_wts,num_links_map1) )
- !-----------------------------------------------------------------------
- !
- ! get variable ids
- !
- !-----------------------------------------------------------------------
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',
- & nc_srcgrddims_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_imask',
- & nc_srcgrdimask_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lat',
- & nc_srcgrdcntrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lon',
- & nc_srcgrdcntrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lat',
- & nc_srcgrdcrnrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lon',
- & nc_srcgrdcrnrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_area',
- & nc_srcgrdarea_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_frac',
- & nc_srcgrdfrac_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',
- & nc_dstgrddims_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_imask',
- & nc_dstgrdimask_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lat',
- & nc_dstgrdcntrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lon',
- & nc_dstgrdcntrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lat',
- & nc_dstgrdcrnrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lon',
- & nc_dstgrdcrnrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_area',
- & nc_dstgrdarea_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_frac',
- & nc_dstgrdfrac_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'src_address',
- & nc_srcgrdadd_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_address',
- & nc_dstgrdadd_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'remap_matrix',
- & nc_rmpmatrix_id)
- call netcdf_error_handler(ncstat)
- !-----------------------------------------------------------------------
- !
- ! read all variables
- !
- !-----------------------------------------------------------------------
- ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,
- & grid1_dims)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,
- & grid1_mask_int)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,
- & grid1_center_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,
- & grid1_center_lon)
- call netcdf_error_handler(ncstat)
- grid1_units = ' '
- ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
- & grid1_units)
- call netcdf_error_handler(ncstat)
- select case (grid1_units(1:7))
- case ('degrees')
- grid1_center_lat = grid1_center_lat*deg2rad
- grid1_center_lon = grid1_center_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid1 center lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,
- & grid1_corner_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,
- & grid1_corner_lon)
- call netcdf_error_handler(ncstat)
- grid1_units = ' '
- ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
- & grid1_units)
- call netcdf_error_handler(ncstat)
- select case (grid1_units(1:7))
- case ('degrees')
- grid1_corner_lat = grid1_corner_lat*deg2rad
- grid1_corner_lon = grid1_corner_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid1 corner lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,
- & grid1_area)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,
- & grid1_frac)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,
- & grid2_dims)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,
- & grid2_mask_int)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,
- & grid2_center_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,
- & grid2_center_lon)
- call netcdf_error_handler(ncstat)
- grid2_units = ' '
- ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
- & grid2_units)
- call netcdf_error_handler(ncstat)
- select case (grid2_units(1:7))
- case ('degrees')
- grid2_center_lat = grid2_center_lat*deg2rad
- grid2_center_lon = grid2_center_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid2 center lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,
- & grid2_corner_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,
- & grid2_corner_lon)
- call netcdf_error_handler(ncstat)
- grid2_units = ' '
- ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
- & grid2_units)
- call netcdf_error_handler(ncstat)
- select case (grid2_units(1:7))
- case ('degrees')
- grid2_corner_lat = grid2_corner_lat*deg2rad
- grid2_corner_lon = grid2_corner_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid2 corner lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,
- & grid2_area)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,
- & grid2_frac)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,
- & grid1_add_map1)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,
- & grid2_add_map1)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,
- & wts_map1)
- call netcdf_error_handler(ncstat)
- !-----------------------------------------------------------------------
- !
- ! initialize logical mask
- !
- !-----------------------------------------------------------------------
- where (grid1_mask_int == 1)
- grid1_mask = .true.
- elsewhere
- grid1_mask = .false.
- endwhere
- where (grid2_mask_int == 1)
- grid2_mask = .true.
- elsewhere
- grid2_mask = .false.
- endwhere
- deallocate(grid1_mask_int, grid2_mask_int)
- !-----------------------------------------------------------------------
- !
- ! close input file
- !
- !-----------------------------------------------------------------------
- ncstat = nf_close(nc_file_id)
- call netcdf_error_handler(ncstat)
- !-----------------------------------------------------------------------
- end subroutine read_remap_scrip
- !***********************************************************************
- subroutine read_remap_csm
- !-----------------------------------------------------------------------
- !
- ! the routine reads a netCDF file to extract remapping info
- ! in NCAR-CSM format
- !
- !-----------------------------------------------------------------------
- !-----------------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------------
- character (char_len) ::
- & grid1_name ! grid name for source grid
- &, grid2_name ! grid name for dest grid
- integer (kind=int_kind) ::
- & nc_numwgts1_id ! extra netCDF id for num_wgts > 1
- &, nc_rmpmatrix2_id ! extra netCDF id for high-order remap matrix
- real (kind=dbl_kind), dimension(:),allocatable ::
- & wts1 ! CSM wants single array for 1st-order wts
- real (kind=dbl_kind), dimension(:,:),allocatable ::
- & wts2 ! write remaining weights in different array
- integer (kind=int_kind) ::
- & n ! dummy index
- integer (kind=int_kind), dimension(:), allocatable ::
- & grid1_mask_int, ! integer masks to determine
- & grid2_mask_int ! cells that participate in map
- !-----------------------------------------------------------------------
- !
- ! read some additional global attributes
- !
- !-----------------------------------------------------------------------
- !***
- !*** source and destination grid names
- !***
- grid1_name = ' '
- grid2_name = ' '
- ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_a',
- & grid1_name)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_b',
- & grid2_name)
- call netcdf_error_handler(ncstat)
- print *,' '
- print *,'Remapping between:',trim(grid1_name)
- print *,'and ',trim(grid2_name)
- print *,' '
- !-----------------------------------------------------------------------
- !
- ! read dimension information
- !
- !-----------------------------------------------------------------------
- ncstat = nf_inq_dimid(nc_file_id, 'n_a', nc_srcgrdsize_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'n_b', nc_dstgrdsize_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'nv_a', nc_srcgrdcorn_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,
- & grid1_corners)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'nv_b', nc_dstgrdcorn_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,
- & grid2_corners)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',
- & nc_srcgrdrank_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,
- & grid1_rank)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',
- & nc_dstgrdrank_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,
- & grid2_rank)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'n_s',
- & nc_numlinks_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,
- & num_links_map1)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',
- & nc_numwgts_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
- call netcdf_error_handler(ncstat)
- if (num_wts > 1) then
- ncstat = nf_inq_dimid(nc_file_id, 'num_wgts1',
- & nc_numwgts1_id)
- call netcdf_error_handler(ncstat)
- endif
- !-----------------------------------------------------------------------
- !
- ! allocate arrays
- !
- !-----------------------------------------------------------------------
- allocate( grid1_dims (grid1_rank),
- & grid1_center_lat(grid1_size),
- & grid1_center_lon(grid1_size),
- & grid1_area (grid1_size),
- & grid1_frac (grid1_size),
- & grid1_mask (grid1_size),
- & grid1_mask_int (grid1_size),
- & grid1_corner_lat(grid1_corners, grid1_size),
- & grid1_corner_lon(grid1_corners, grid1_size) )
- allocate( grid2_dims (grid2_rank),
- & grid2_center_lat(grid2_size),
- & grid2_center_lon(grid2_size),
- & grid2_area (grid2_size),
- & grid2_frac (grid2_size),
- & grid2_mask (grid2_size),
- & grid2_mask_int (grid2_size),
- & grid2_corner_lat(grid2_corners, grid2_size),
- & grid2_corner_lon(grid2_corners, grid2_size) )
- allocate( grid1_add_map1(num_links_map1),
- & grid2_add_map1(num_links_map1),
- & wts_map1(num_wts,num_links_map1),
- & wts1(num_links_map1),
- & wts2(num_wts-1,num_links_map1) )
- !-----------------------------------------------------------------------
- !
- ! get variable ids
- !
- !-----------------------------------------------------------------------
- ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',
- & nc_srcgrddims_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'mask_a',
- & nc_srcgrdimask_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'yc_a', nc_srcgrdcntrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'xc_a', nc_srcgrdcntrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'yv_a', nc_srcgrdcrnrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'xv_a', nc_srcgrdcrnrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'area_a', nc_srcgrdarea_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'frac_a', nc_srcgrdfrac_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',
- & nc_dstgrddims_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'mask_b',
- & nc_dstgrdimask_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'yc_b', nc_dstgrdcntrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'xc_b', nc_dstgrdcntrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'yv_b', nc_dstgrdcrnrlat_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'xv_b', nc_dstgrdcrnrlon_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'area_b', nc_dstgrdarea_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'frac_b', nc_dstgrdfrac_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'col', nc_srcgrdadd_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'row', nc_dstgrdadd_id)
- call netcdf_error_handler(ncstat)
- ncstat = nf_inq_varid(nc_file_id, 'S', nc_rmpmatrix_id)
- call netcdf_error_handler(ncstat)
- if (num_wts > 1) then
- ncstat = nf_inq_varid(nc_file_id, 'S2', nc_rmpmatrix2_id)
- call netcdf_error_handler(ncstat)
- endif
- !-----------------------------------------------------------------------
- !
- ! read all variables
- !
- !-----------------------------------------------------------------------
- ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,
- & grid1_dims)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,
- & grid1_mask_int)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,
- & grid1_center_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,
- & grid1_center_lon)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
- & grid1_units)
- call netcdf_error_handler(ncstat)
- select case (grid1_units(1:7))
- case ('degrees')
- grid1_center_lat = grid1_center_lat*deg2rad
- grid1_center_lon = grid1_center_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid1 center lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,
- & grid1_corner_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,
- & grid1_corner_lon)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
- & grid1_units)
- call netcdf_error_handler(ncstat)
- select case (grid1_units(1:7))
- case ('degrees')
- grid1_corner_lat = grid1_corner_lat*deg2rad
- grid1_corner_lon = grid1_corner_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid1 corner lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,
- & grid1_area)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,
- & grid1_frac)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,
- & grid2_dims)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,
- & grid2_mask_int)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,
- & grid2_center_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,
- & grid2_center_lon)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
- & grid2_units)
- call netcdf_error_handler(ncstat)
- select case (grid2_units(1:7))
- case ('degrees')
- grid2_center_lat = grid2_center_lat*deg2rad
- grid2_center_lon = grid2_center_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid2 center lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,
- & grid2_corner_lat)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,
- & grid2_corner_lon)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
- & grid2_units)
- call netcdf_error_handler(ncstat)
- select case (grid2_units(1:7))
- case ('degrees')
- grid2_corner_lat = grid2_corner_lat*deg2rad
- grid2_corner_lon = grid2_corner_lon*deg2rad
- case ('radians')
- !*** no conversion necessary
- case default
- print *,'unknown units supplied for grid2 corner lat/lon: '
- print *,'proceeding assuming radians'
- end select
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,
- & grid2_area)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,
- & grid2_frac)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,
- & grid1_add_map1)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,
- & grid2_add_map1)
- call netcdf_error_handler(ncstat)
- ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,
- & wts1)
- wts_map1(1,:) = wts1
- deallocate(wts1)
- if (num_wts > 1) then
- ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix2_id,
- & wts2)
- wts_map1(2:,:) = wts2
- deallocate(wts2)
- endif
- call netcdf_error_handler(ncstat)
- !-----------------------------------------------------------------------
- !
- ! initialize logical mask
- !
- !-----------------------------------------------------------------------
- where (grid1_mask_int == 1)
- grid1_mask = .true.
- elsewhere
- grid1_mask = .false.
- endwhere
- where (grid2_mask_int == 1)
- grid2_mask = .true.
- elsewhere
- grid2_mask = .false.
- endwhere
- deallocate(grid1_mask_int, grid2_mask_int)
- !-----------------------------------------------------------------------
- !
- ! close input file
- !
- !-----------------------------------------------------------------------
- ncstat = nf_close(nc_file_id)
- call netcdf_error_handler(ncstat)
- !-----------------------------------------------------------------------
- end subroutine read_remap_csm
- !***********************************************************************
- end module remap_read
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|