|
Oasis3 4.0.2
|
|
Oasis3 4.0.2
|
00001 C**** 00002 C ************************ 00003 C * OASIS MODULE * 00004 C * ------------ * 00005 C ************************ 00006 C**** 00007 C*********************************************************************** 00008 C This module belongs to the SCRIP library. It is modified to run 00009 C within OASIS. 00010 C Modifications: 00011 C - Added CASE for GAUSWGT 00012 C 00013 C Modified by D. Declat, CERFACS 27.06.2002 00014 C*********************************************************************** 00015 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00016 ! 00017 ! This module contains routines for writing the remapping data to 00018 ! a file. Before writing the data for each mapping, the links are 00019 ! sorted by destination grid address. 00020 ! 00021 !----------------------------------------------------------------------- 00022 ! 00023 ! CVS:$Id: remap_write.f 2826 2010-12-10 11:14:21Z valcke $ 00024 ! 00025 ! Copyright (c) 1997, 1998 the Regents of the University of 00026 ! California. 00027 ! 00028 ! This software and ancillary information (herein called software) 00029 ! called SCRIP is made available under the terms described here. 00030 ! The software has been approved for release with associated 00031 ! LA-CC Number 98-45. 00032 ! 00033 ! Unless otherwise indicated, this software has been authored 00034 ! by an employee or employees of the University of California, 00035 ! operator of the Los Alamos National Laboratory under Contract 00036 ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 00037 ! Government has rights to use, reproduce, and distribute this 00038 ! software. The public may copy and use this software without 00039 ! charge, provided that this Notice and any statement of authorship 00040 ! are reproduced on all copies. Neither the Government nor the 00041 ! University makes any warranty, express or implied, or assumes 00042 ! any liability or responsibility for the use of this software. 00043 ! 00044 ! If software is modified to produce derivative works, such modified 00045 ! software should be clearly marked, so as not to confuse it with 00046 ! the version available from Los Alamos National Laboratory. 00047 ! 00048 !*********************************************************************** 00049 00050 module remap_write 00051 00052 !----------------------------------------------------------------------- 00053 00054 use kinds_mod ! defines common data types 00055 use constants ! defines common scalar constants 00056 use grids ! module containing grid information 00057 use remap_vars ! module containing remap information 00058 use netcdf_mod ! module with netCDF stuff 00059 00060 implicit none 00061 00062 !----------------------------------------------------------------------- 00063 ! 00064 ! module variables 00065 ! 00066 !----------------------------------------------------------------------- 00067 00068 character(char_len), private :: 00069 & map_method ! character string for map_type 00070 &, normalize_opt ! character string for normalization option 00071 &, history ! character string for history information 00072 &, convention ! character string for output convention 00073 00074 character(8), private :: 00075 & cdate ! character date string 00076 00077 integer (kind=int_kind), dimension(:), allocatable, private :: 00078 & src_mask_int ! integer masks to determine 00079 &, dst_mask_int ! cells that participate in map 00080 00081 !----------------------------------------------------------------------- 00082 ! 00083 ! various netCDF identifiers used by output routines 00084 ! 00085 !----------------------------------------------------------------------- 00086 00087 integer (kind=int_kind), private :: 00088 & ncstat ! error flag for netCDF calls 00089 &, nc_file_id ! id for netCDF file 00090 &, nc_srcgrdsize_id ! id for source grid size 00091 &, nc_dstgrdsize_id ! id for destination grid size 00092 &, nc_srcgrdcorn_id ! id for number of source grid corners 00093 &, nc_dstgrdcorn_id ! id for number of dest grid corners 00094 &, nc_srcgrdrank_id ! id for source grid rank 00095 &, nc_dstgrdrank_id ! id for dest grid rank 00096 &, nc_numlinks_id ! id for number of links in mapping 00097 &, nc_numwgts_id ! id for number of weights for mapping 00098 &, nc_srcgrddims_id ! id for source grid dimensions 00099 &, nc_dstgrddims_id ! id for dest grid dimensions 00100 &, nc_srcgrdcntrlat_id ! id for source grid center latitude 00101 &, nc_dstgrdcntrlat_id ! id for dest grid center latitude 00102 &, nc_srcgrdcntrlon_id ! id for source grid center longitude 00103 &, nc_dstgrdcntrlon_id ! id for dest grid center longitude 00104 &, nc_srcgrdimask_id ! id for source grid mask 00105 integer (kind=int_kind), private :: 00106 & nc_dstgrdimask_id ! id for dest grid mask 00107 &, nc_srcgrdcrnrlat_id ! id for latitude of source grid corners 00108 &, nc_srcgrdcrnrlon_id ! id for longitude of source grid corners 00109 &, nc_dstgrdcrnrlat_id ! id for latitude of dest grid corners 00110 &, nc_dstgrdcrnrlon_id ! id for longitude of dest grid corners 00111 &, nc_srcgrdarea_id ! id for area of source grid cells 00112 &, nc_dstgrdarea_id ! id for area of dest grid cells 00113 &, nc_srcgrdfrac_id ! id for area fraction on source grid 00114 &, nc_dstgrdfrac_id ! id for area fraction on dest grid 00115 &, nc_srcadd_id ! id for map source address 00116 &, nc_dstadd_id ! id for map destination address 00117 &, nc_rmpmatrix_id ! id for remapping matrix 00118 00119 integer (kind=int_kind), dimension(2), private :: 00120 & nc_dims2_id ! netCDF ids for 2d array dims 00121 00122 !*********************************************************************** 00123 00124 contains 00125 00126 !*********************************************************************** 00127 00128 subroutine write_remap(map1_name, map2_name, 00129 & interp_file1, interp_file2, output_opt) 00130 00131 !----------------------------------------------------------------------- 00132 ! 00133 ! calls correct output routine based on output format choice 00134 ! 00135 !----------------------------------------------------------------------- 00136 00137 !----------------------------------------------------------------------- 00138 ! 00139 ! input variables 00140 ! 00141 !----------------------------------------------------------------------- 00142 00143 character(char_len), intent(in) :: 00144 & map1_name, ! name for mapping grid1 to grid2 00145 & map2_name, ! name for mapping grid2 to grid1 00146 & interp_file1, ! filename for map1 remap data 00147 & interp_file2, ! filename for map2 remap data 00148 & output_opt ! option for output conventions 00149 00150 !----------------------------------------------------------------------- 00151 ! 00152 ! local variables 00153 ! 00154 !----------------------------------------------------------------------- 00155 !----------------------------------------------------------------------- 00156 ! 00157 ! define some common variables to be used in all routines 00158 ! 00159 !----------------------------------------------------------------------- 00160 IF (nlogprt .GE. 2) THEN 00161 WRITE (UNIT = nulou,FMT = *)' ' 00162 WRITE (UNIT = nulou,FMT = *)'Entering routine write_remap ' 00163 CALL FLUSH(nulou) 00164 ENDIF 00165 select case(norm_opt) 00166 case (norm_opt_none) 00167 normalize_opt = 'none' 00168 case (norm_opt_frcarea) 00169 normalize_opt = 'fracarea' 00170 case (norm_opt_dstarea) 00171 normalize_opt = 'destarea' 00172 case (norm_opt_nonorm) 00173 normalize_opt = 'no norm' 00174 end select 00175 select case(map_type) 00176 case(map_type_conserv) 00177 map_method = 'Conservative remapping' 00178 case(map_type_bilinear) 00179 map_method = 'Bilinear remapping' 00180 case(map_type_distwgt) 00181 map_method = 'Distance weighted avg of nearest neighbors' 00182 case(map_type_gauswgt) 00183 map_method = 'Gaussian weighted avg of nearest neighbors' 00184 case(map_type_bicubic) 00185 map_method = 'Bicubic remapping' 00186 case default 00187 stop 'Invalid Map Type' 00188 end select 00189 00190 call date_and_time(date=cdate) 00191 write (history,1000) cdate(5:6),cdate(7:8),cdate(1:4) 00192 1000 format('Created: ',a2,'-',a2,'-',a4) 00193 00194 !----------------------------------------------------------------------- 00195 ! 00196 ! call appropriate output routine 00197 ! 00198 !----------------------------------------------------------------------- 00199 00200 select case(output_opt) 00201 case ('scrip') 00202 call write_remap_scrip(map1_name, interp_file1, 1) 00203 case ('ncar-csm') 00204 call write_remap_csm (map1_name, interp_file1, 1) 00205 case default 00206 stop 'unknown output file convention' 00207 end select 00208 00209 !----------------------------------------------------------------------- 00210 ! 00211 ! call appropriate output routine for second mapping if required 00212 ! 00213 !----------------------------------------------------------------------- 00214 00215 if (num_maps > 1) then 00216 select case(output_opt) 00217 case ('scrip') 00218 call write_remap_scrip(map2_name, interp_file2, 2) 00219 case ('ncar-csm') 00220 call write_remap_csm (map2_name, interp_file2, 2) 00221 case default 00222 stop 'unknown output file convention' 00223 end select 00224 endif 00225 00226 !----------------------------------------------------------------------- 00227 IF (nlogprt .GE. 2) THEN 00228 WRITE (UNIT = nulou,FMT = *)' ' 00229 WRITE (UNIT = nulou,FMT = *)'Leaving routine write_remap ' 00230 CALL FLUSH(nulou) 00231 ENDIF 00232 00233 end subroutine write_remap 00234 00235 !*********************************************************************** 00236 00237 subroutine write_remap_scrip(map_name, interp_file, direction) 00238 00239 !----------------------------------------------------------------------- 00240 ! 00241 ! writes remap data to a netCDF file using SCRIP conventions 00242 ! 00243 !----------------------------------------------------------------------- 00244 00245 !----------------------------------------------------------------------- 00246 ! 00247 ! input variables 00248 ! 00249 !----------------------------------------------------------------------- 00250 00251 character(char_len), intent(in) :: 00252 & map_name ! name for mapping 00253 &, interp_file ! filename for remap data 00254 00255 integer (kind=int_kind), intent(in) :: 00256 & direction ! direction of map (1=grid1 to grid2 00257 ! 2=grid2 to grid1) 00258 00259 !----------------------------------------------------------------------- 00260 ! 00261 ! local variables 00262 ! 00263 !----------------------------------------------------------------------- 00264 00265 character(char_len) :: 00266 & grid1_ctmp ! character temp for grid1 names 00267 &, grid2_ctmp ! character temp for grid2 names 00268 00269 integer (kind=int_kind) :: 00270 & itmp1 ! integer temp 00271 &, itmp2 ! integer temp 00272 &, itmp3 ! integer temp 00273 &, itmp4 ! integer temp 00274 00275 integer (kind=int_kind) :: il_nftype 00276 !----------------------------------------------------------------------- 00277 IF (nlogprt .GE. 2) THEN 00278 WRITE (UNIT = nulou,FMT = *)' ' 00279 WRITE (UNIT = nulou,FMT = *)'Entering routine write_remap_scrip ' 00280 CALL FLUSH(nulou) 00281 ENDIF 00282 !----------------------------------------------------------------------- 00283 ! 00284 ! create netCDF file for mapping and define some global attributes 00285 ! 00286 !----------------------------------------------------------------------- 00287 ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id) 00288 call netcdf_error_handler(ncstat) 00289 !*** 00290 !*** map name 00291 !*** 00292 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', 00293 & len_trim(map_name), map_name) 00294 call netcdf_error_handler(ncstat) 00295 00296 !*** 00297 !*** normalization option 00298 !*** 00299 ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', 00300 & len_trim(normalize_opt), normalize_opt) 00301 call netcdf_error_handler(ncstat) 00302 00303 !*** 00304 !*** map method 00305 !*** 00306 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', 00307 & len_trim(map_method), map_method) 00308 call netcdf_error_handler(ncstat) 00309 00310 !*** 00311 !*** history 00312 !*** 00313 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', 00314 & len_trim(history), history) 00315 call netcdf_error_handler(ncstat) 00316 00317 !*** 00318 !*** file convention 00319 !*** 00320 convention = 'SCRIP' 00321 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', 00322 & len_trim(convention), convention) 00323 call netcdf_error_handler(ncstat) 00324 00325 !*** 00326 !*** source and destination grid names 00327 !*** 00328 00329 if (direction == 1) then 00330 grid1_ctmp = 'source_grid' 00331 grid2_ctmp = 'dest_grid' 00332 else 00333 grid1_ctmp = 'dest_grid' 00334 grid2_ctmp = 'source_grid' 00335 endif 00336 00337 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), 00338 & len_trim(grid1_name), grid1_name) 00339 call netcdf_error_handler(ncstat) 00340 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), 00341 & len_trim(grid2_name), grid2_name) 00342 call netcdf_error_handler(ncstat) 00343 00344 !----------------------------------------------------------------------- 00345 ! 00346 ! prepare netCDF dimension info 00347 ! 00348 !----------------------------------------------------------------------- 00349 00350 !*** 00351 !*** define grid size dimensions 00352 !*** 00353 00354 if (direction == 1) then 00355 itmp1 = grid1_size 00356 itmp2 = grid2_size 00357 else 00358 itmp1 = grid2_size 00359 itmp2 = grid1_size 00360 endif 00361 00362 ncstat = nf_def_dim (nc_file_id, 'src_grid_size', itmp1, 00363 & nc_srcgrdsize_id) 00364 call netcdf_error_handler(ncstat) 00365 00366 ncstat = nf_def_dim (nc_file_id, 'dst_grid_size', itmp2, 00367 & nc_dstgrdsize_id) 00368 call netcdf_error_handler(ncstat) 00369 00370 !*** 00371 !*** define grid corner dimension 00372 !*** 00373 00374 if (direction == 1) then 00375 itmp1 = grid1_corners 00376 itmp2 = grid2_corners 00377 else 00378 itmp1 = grid2_corners 00379 itmp2 = grid1_corners 00380 endif 00381 00382 ncstat = nf_def_dim (nc_file_id, 'src_grid_corners', 00383 & itmp1, nc_srcgrdcorn_id) 00384 call netcdf_error_handler(ncstat) 00385 00386 ncstat = nf_def_dim (nc_file_id, 'dst_grid_corners', 00387 & itmp2, nc_dstgrdcorn_id) 00388 call netcdf_error_handler(ncstat) 00389 !*** 00390 !*** define grid rank dimension 00391 !*** 00392 00393 if (direction == 1) then 00394 itmp1 = grid1_rank 00395 itmp2 = grid2_rank 00396 else 00397 itmp1 = grid2_rank 00398 itmp2 = grid1_rank 00399 endif 00400 00401 ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 00402 & itmp1, nc_srcgrdrank_id) 00403 call netcdf_error_handler(ncstat) 00404 00405 ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 00406 & itmp2, nc_dstgrdrank_id) 00407 call netcdf_error_handler(ncstat) 00408 !*** 00409 !*** define map size dimensions 00410 !*** 00411 00412 if (direction == 1) then 00413 itmp1 = num_links_map1 00414 else 00415 itmp1 = num_links_map2 00416 endif 00417 00418 ncstat = nf_def_dim (nc_file_id, 'num_links', 00419 & itmp1, nc_numlinks_id) 00420 call netcdf_error_handler(ncstat) 00421 ncstat = nf_def_dim (nc_file_id, 'num_wgts', 00422 & num_wts, nc_numwgts_id) 00423 call netcdf_error_handler(ncstat) 00424 !*** 00425 !*** define grid dimensions 00426 !*** 00427 00428 ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, 00429 & 1, nc_srcgrdrank_id, nc_srcgrddims_id) 00430 call netcdf_error_handler(ncstat) 00431 ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, 00432 & 1, nc_dstgrdrank_id, nc_dstgrddims_id) 00433 call netcdf_error_handler(ncstat) 00434 !----------------------------------------------------------------------- 00435 ! 00436 ! define all arrays for netCDF descriptors 00437 ! 00438 !----------------------------------------------------------------------- 00439 00440 !*** 00441 !*** define grid center latitude array 00442 !*** 00443 00444 il_nftype = NF_DOUBLE 00445 IF (ll_single) il_nftype = NF_REAL 00446 00447 ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat', 00448 & il_nftype, 1, nc_srcgrdsize_id, 00449 & nc_srcgrdcntrlat_id) 00450 call netcdf_error_handler(ncstat) 00451 ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat', 00452 & il_nftype, 1, nc_dstgrdsize_id, 00453 & nc_dstgrdcntrlat_id) 00454 call netcdf_error_handler(ncstat) 00455 !*** 00456 !*** define grid center longitude array 00457 !*** 00458 00459 ncstat = nf_def_var (nc_file_id, 'src_grid_center_lon', 00460 & il_nftype, 1, nc_srcgrdsize_id, 00461 & nc_srcgrdcntrlon_id) 00462 call netcdf_error_handler(ncstat) 00463 ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon', 00464 & il_nftype, 1, nc_dstgrdsize_id, 00465 & nc_dstgrdcntrlon_id) 00466 call netcdf_error_handler(ncstat) 00467 !*** 00468 !*** define grid corner lat/lon arrays 00469 !*** 00470 00471 nc_dims2_id(1) = nc_srcgrdcorn_id 00472 nc_dims2_id(2) = nc_srcgrdsize_id 00473 00474 ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lat', 00475 & il_nftype, 2, nc_dims2_id, 00476 & nc_srcgrdcrnrlat_id) 00477 call netcdf_error_handler(ncstat) 00478 ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon', 00479 & il_nftype, 2, nc_dims2_id, 00480 & nc_srcgrdcrnrlon_id) 00481 call netcdf_error_handler(ncstat) 00482 00483 nc_dims2_id(1) = nc_dstgrdcorn_id 00484 nc_dims2_id(2) = nc_dstgrdsize_id 00485 00486 ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lat', 00487 & il_nftype, 2, nc_dims2_id, 00488 & nc_dstgrdcrnrlat_id) 00489 call netcdf_error_handler(ncstat) 00490 ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon', 00491 & il_nftype, 2, nc_dims2_id, 00492 & nc_dstgrdcrnrlon_id) 00493 call netcdf_error_handler(ncstat) 00494 00495 !*** 00496 !*** define units for all coordinate arrays 00497 !*** 00498 00499 if (direction == 1) then 00500 grid1_ctmp = grid1_units 00501 grid2_ctmp = grid2_units 00502 else 00503 grid1_ctmp = grid2_units 00504 grid2_ctmp = grid1_units 00505 endif 00506 00507 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 00508 & 'units', 7, grid1_ctmp) 00509 call netcdf_error_handler(ncstat) 00510 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 00511 & 'units', 7, grid2_ctmp) 00512 call netcdf_error_handler(ncstat) 00513 00514 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 00515 & 'units', 7, grid1_ctmp) 00516 call netcdf_error_handler(ncstat) 00517 00518 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 00519 & 'units', 7, grid2_ctmp) 00520 call netcdf_error_handler(ncstat) 00521 00522 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 00523 & 'units', 7, grid1_ctmp) 00524 call netcdf_error_handler(ncstat) 00525 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 00526 & 'units', 7, grid1_ctmp) 00527 call netcdf_error_handler(ncstat) 00528 00529 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 00530 & 'units', 7, grid2_ctmp) 00531 call netcdf_error_handler(ncstat) 00532 00533 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 00534 & 'units', 7, grid2_ctmp) 00535 call netcdf_error_handler(ncstat) 00536 00537 !*** 00538 !*** define grid mask 00539 !*** 00540 00541 ncstat = nf_def_var (nc_file_id, 'src_grid_imask', NF_INT, 00542 & 1, nc_srcgrdsize_id, nc_srcgrdimask_id) 00543 call netcdf_error_handler(ncstat) 00544 00545 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 00546 & 'units', 8, 'unitless') 00547 call netcdf_error_handler(ncstat) 00548 ncstat = nf_def_var (nc_file_id, 'dst_grid_imask', NF_INT, 00549 & 1, nc_dstgrdsize_id, nc_dstgrdimask_id) 00550 call netcdf_error_handler(ncstat) 00551 00552 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 00553 & 'units', 8, 'unitless') 00554 call netcdf_error_handler(ncstat) 00555 !*** 00556 !*** define grid area arrays 00557 !*** 00558 00559 ncstat = nf_def_var (nc_file_id, 'src_grid_area', 00560 & il_nftype, 1, nc_srcgrdsize_id, 00561 & nc_srcgrdarea_id) 00562 call netcdf_error_handler(ncstat) 00563 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 00564 & 'units', 14, 'square radians') 00565 call netcdf_error_handler(ncstat) 00566 00567 ncstat = nf_def_var (nc_file_id, 'dst_grid_area', 00568 & il_nftype, 1, nc_dstgrdsize_id, 00569 & nc_dstgrdarea_id) 00570 call netcdf_error_handler(ncstat) 00571 00572 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 00573 & 'units', 14, 'square radians') 00574 call netcdf_error_handler(ncstat) 00575 00576 !*** 00577 !*** define grid fraction arrays 00578 !*** 00579 00580 ncstat = nf_def_var (nc_file_id, 'src_grid_frac', 00581 & il_nftype, 1, nc_srcgrdsize_id, 00582 & nc_srcgrdfrac_id) 00583 call netcdf_error_handler(ncstat) 00584 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 00585 & 'units', 8, 'unitless') 00586 call netcdf_error_handler(ncstat) 00587 00588 ncstat = nf_def_var (nc_file_id, 'dst_grid_frac', 00589 & il_nftype, 1, nc_dstgrdsize_id, 00590 & nc_dstgrdfrac_id) 00591 call netcdf_error_handler(ncstat) 00592 00593 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 00594 & 'units', 8, 'unitless') 00595 call netcdf_error_handler(ncstat) 00596 !*** 00597 !*** define mapping arrays 00598 !*** 00599 00600 ncstat = nf_def_var (nc_file_id, 'src_address', 00601 & NF_INT, 1, nc_numlinks_id, 00602 & nc_srcadd_id) 00603 call netcdf_error_handler(ncstat) 00604 00605 ncstat = nf_def_var (nc_file_id, 'dst_address', 00606 & NF_INT, 1, nc_numlinks_id, 00607 & nc_dstadd_id) 00608 call netcdf_error_handler(ncstat) 00609 00610 nc_dims2_id(1) = nc_numwgts_id 00611 nc_dims2_id(2) = nc_numlinks_id 00612 00613 ncstat = nf_def_var (nc_file_id, 'remap_matrix', 00614 & il_nftype, 2, nc_dims2_id, 00615 & nc_rmpmatrix_id) 00616 call netcdf_error_handler(ncstat) 00617 00618 !*** 00619 !*** end definition stage 00620 !*** 00621 00622 ncstat = nf_enddef(nc_file_id) 00623 call netcdf_error_handler(ncstat) 00624 !----------------------------------------------------------------------- 00625 ! 00626 ! compute integer masks 00627 ! 00628 !----------------------------------------------------------------------- 00629 00630 if (direction == 1) then 00631 allocate (src_mask_int(grid1_size), 00632 & dst_mask_int(grid2_size)) 00633 00634 where (grid2_mask) 00635 dst_mask_int = 1 00636 elsewhere 00637 dst_mask_int = 0 00638 endwhere 00639 00640 where (grid1_mask) 00641 src_mask_int = 1 00642 elsewhere 00643 src_mask_int = 0 00644 endwhere 00645 else 00646 allocate (src_mask_int(grid2_size), 00647 & dst_mask_int(grid1_size)) 00648 00649 where (grid1_mask) 00650 dst_mask_int = 1 00651 elsewhere 00652 dst_mask_int = 0 00653 endwhere 00654 00655 where (grid2_mask) 00656 src_mask_int = 1 00657 elsewhere 00658 src_mask_int = 0 00659 endwhere 00660 endif 00661 00662 !----------------------------------------------------------------------- 00663 ! 00664 ! change units of lat/lon coordinates if input units different 00665 ! from radians 00666 ! 00667 !----------------------------------------------------------------------- 00668 00669 if (grid1_units(1:7) == 'degrees' .and. direction == 1) then 00670 grid1_center_lat = grid1_center_lat/deg2rad 00671 grid1_center_lon = grid1_center_lon/deg2rad 00672 grid1_corner_lat = grid1_corner_lat/deg2rad 00673 grid1_corner_lon = grid1_corner_lon/deg2rad 00674 endif 00675 00676 if (grid2_units(1:7) == 'degrees' .and. direction == 1) then 00677 grid2_center_lat = grid2_center_lat/deg2rad 00678 grid2_center_lon = grid2_center_lon/deg2rad 00679 grid2_corner_lat = grid2_corner_lat/deg2rad 00680 grid2_corner_lon = grid2_corner_lon/deg2rad 00681 endif 00682 00683 !----------------------------------------------------------------------- 00684 ! 00685 ! write mapping data 00686 ! 00687 !----------------------------------------------------------------------- 00688 00689 if (direction == 1) then 00690 itmp1 = nc_srcgrddims_id 00691 itmp2 = nc_dstgrddims_id 00692 else 00693 itmp2 = nc_srcgrddims_id 00694 itmp1 = nc_dstgrddims_id 00695 endif 00696 00697 ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims) 00698 call netcdf_error_handler(ncstat) 00699 00700 ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims) 00701 call netcdf_error_handler(ncstat) 00702 00703 ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 00704 & src_mask_int) 00705 call netcdf_error_handler(ncstat) 00706 ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, 00707 & dst_mask_int) 00708 call netcdf_error_handler(ncstat) 00709 00710 deallocate(src_mask_int, dst_mask_int) 00711 00712 if (direction == 1) then 00713 itmp1 = nc_srcgrdcntrlat_id 00714 itmp2 = nc_srcgrdcntrlon_id 00715 itmp3 = nc_srcgrdcrnrlat_id 00716 itmp4 = nc_srcgrdcrnrlon_id 00717 else 00718 itmp1 = nc_dstgrdcntrlat_id 00719 itmp2 = nc_dstgrdcntrlon_id 00720 itmp3 = nc_dstgrdcrnrlat_id 00721 itmp4 = nc_dstgrdcrnrlon_id 00722 endif 00723 IF (ll_single) THEN 00724 ncstat=nf_put_var_real(nc_file_id, itmp1, grid1_center_lat) 00725 ELSE 00726 ncstat=nf_put_var_double(nc_file_id, itmp1, grid1_center_lat) 00727 ENDIF 00728 call netcdf_error_handler(ncstat) 00729 00730 IF (ll_single) THEN 00731 ncstat=nf_put_var_real(nc_file_id, itmp2, grid1_center_lon) 00732 ELSE 00733 ncstat=nf_put_var_double(nc_file_id, itmp2, grid1_center_lon) 00734 ENDIF 00735 call netcdf_error_handler(ncstat) 00736 00737 if (.not. luse_grid_centers) THEN 00738 IF (ll_single) THEN 00739 ncstat = nf_put_var_real(nc_file_id, itmp3, 00740 $ grid1_corner_lat) 00741 ELSE 00742 ncstat = nf_put_var_double(nc_file_id, itmp3, 00743 $ grid1_corner_lat) 00744 ENDIF 00745 call netcdf_error_handler(ncstat) 00746 IF (ll_single) THEN 00747 ncstat = nf_put_var_real(nc_file_id, itmp4, 00748 $ grid1_corner_lon) 00749 ELSE 00750 ncstat = nf_put_var_double(nc_file_id, itmp4, 00751 $ grid1_corner_lon) 00752 ENDIF 00753 call netcdf_error_handler(ncstat) 00754 endif 00755 00756 if (direction == 1) then 00757 itmp1 = nc_dstgrdcntrlat_id 00758 itmp2 = nc_dstgrdcntrlon_id 00759 itmp3 = nc_dstgrdcrnrlat_id 00760 itmp4 = nc_dstgrdcrnrlon_id 00761 else 00762 itmp1 = nc_srcgrdcntrlat_id 00763 itmp2 = nc_srcgrdcntrlon_id 00764 itmp3 = nc_srcgrdcrnrlat_id 00765 itmp4 = nc_srcgrdcrnrlon_id 00766 endif 00767 00768 IF (ll_single) THEN 00769 ncstat=nf_put_var_real(nc_file_id, itmp1, grid2_center_lat) 00770 ELSE 00771 ncstat=nf_put_var_double(nc_file_id, itmp1, grid2_center_lat) 00772 ENDIF 00773 call netcdf_error_handler(ncstat) 00774 00775 IF (ll_single) THEN 00776 ncstat=nf_put_var_real(nc_file_id, itmp2, grid2_center_lon) 00777 ELSE 00778 ncstat=nf_put_var_double(nc_file_id, itmp2, grid2_center_lon) 00779 ENDIF 00780 call netcdf_error_handler(ncstat) 00781 00782 if (.not. luse_grid_centers) THEN 00783 IF (ll_single) THEN 00784 ncstat = nf_put_var_real(nc_file_id, itmp3, 00785 $ grid2_corner_lat) 00786 ELSE 00787 ncstat = nf_put_var_double(nc_file_id, itmp3, 00788 $ grid2_corner_lat) 00789 ENDIF 00790 call netcdf_error_handler(ncstat) 00791 00792 IF (ll_single) THEN 00793 ncstat = nf_put_var_real(nc_file_id, itmp4, 00794 $ grid2_corner_lon) 00795 ELSE 00796 ncstat = nf_put_var_double(nc_file_id, itmp4, 00797 $ grid2_corner_lon) 00798 ENDIF 00799 call netcdf_error_handler(ncstat) 00800 00801 endif 00802 if (direction == 1) then 00803 itmp1 = nc_srcgrdarea_id 00804 itmp2 = nc_srcgrdfrac_id 00805 itmp3 = nc_dstgrdarea_id 00806 itmp4 = nc_dstgrdfrac_id 00807 else 00808 itmp1 = nc_dstgrdarea_id 00809 itmp2 = nc_dstgrdfrac_id 00810 itmp3 = nc_srcgrdarea_id 00811 itmp4 = nc_srcgrdfrac_id 00812 endif 00813 00814 if (luse_grid1_area) THEN 00815 IF (ll_single) THEN 00816 ncstat=nf_put_var_real(nc_file_id, itmp1, grid1_area_in) 00817 ELSE 00818 ncstat=nf_put_var_double(nc_file_id, itmp1, grid1_area_in) 00819 ENDIF 00820 ELSE 00821 IF (ll_single) THEN 00822 ncstat = nf_put_var_real(nc_file_id, itmp1, grid1_area) 00823 ELSE 00824 ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area) 00825 ENDIF 00826 endif 00827 call netcdf_error_handler(ncstat) 00828 00829 IF (ll_single) THEN 00830 ncstat = nf_put_var_real(nc_file_id, itmp2, grid1_frac) 00831 ELSE 00832 ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac) 00833 ENDIF 00834 call netcdf_error_handler(ncstat) 00835 00836 if (luse_grid2_area) THEN 00837 IF (ll_single) THEN 00838 ncstat = nf_put_var_real 00839 $ (nc_file_id, itmp3, grid2_area_in) 00840 ELSE 00841 ncstat = nf_put_var_double 00842 $ (nc_file_id, itmp3, grid2_area_in) 00843 ENDIF 00844 ELSE 00845 IF (ll_single) THEN 00846 ncstat = nf_put_var_real(nc_file_id, itmp3, grid2_area) 00847 ELSE 00848 ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area) 00849 ENDIF 00850 endif 00851 call netcdf_error_handler(ncstat) 00852 00853 IF (ll_single) THEN 00854 ncstat = nf_put_var_real(nc_file_id, itmp4, grid2_frac) 00855 ELSE 00856 ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac) 00857 ENDIF 00858 call netcdf_error_handler(ncstat) 00859 if (direction == 1) then 00860 ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 00861 & grid1_add_map1) 00862 call netcdf_error_handler(ncstat) 00863 00864 ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 00865 & grid2_add_map1) 00866 call netcdf_error_handler(ncstat) 00867 IF (ll_single) THEN 00868 ncstat = nf_put_var_real(nc_file_id, nc_rmpmatrix_id, 00869 & wts_map1) 00870 ELSE 00871 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 00872 & wts_map1) 00873 ENDIF 00874 call netcdf_error_handler(ncstat) 00875 else 00876 ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 00877 & grid2_add_map2) 00878 call netcdf_error_handler(ncstat) 00879 00880 ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 00881 & grid1_add_map2) 00882 call netcdf_error_handler(ncstat) 00883 IF (ll_single) THEN 00884 ncstat = nf_put_var_real(nc_file_id, nc_rmpmatrix_id, 00885 & wts_map2) 00886 ELSE 00887 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 00888 & wts_map2) 00889 ENDIF 00890 call netcdf_error_handler(ncstat) 00891 endif 00892 00893 ncstat = nf_close(nc_file_id) 00894 call netcdf_error_handler(ncstat) 00895 ! 00896 IF (nlogprt .GE. 2) THEN 00897 WRITE (UNIT = nulou,FMT = *)' ' 00898 WRITE (UNIT = nulou,FMT = *)'Leaving routine write_remap_scrip ' 00899 CALL FLUSH(nulou) 00900 ENDIF 00901 !----------------------------------------------------------------------- 00902 00903 end subroutine write_remap_scrip 00904 00905 !*********************************************************************** 00906 00907 subroutine write_remap_csm(map_name, interp_file, direction) 00908 00909 !----------------------------------------------------------------------- 00910 ! 00911 ! writes remap data to a netCDF file using NCAR-CSM conventions 00912 ! 00913 !----------------------------------------------------------------------- 00914 00915 !----------------------------------------------------------------------- 00916 ! 00917 ! input variables 00918 ! 00919 !----------------------------------------------------------------------- 00920 00921 character(char_len), intent(in) :: 00922 & map_name ! name for mapping 00923 &, interp_file ! filename for remap data 00924 00925 integer (kind=int_kind), intent(in) :: 00926 & direction ! direction of map (1=grid1 to grid2 00927 ! 2=grid2 to grid1) 00928 00929 !----------------------------------------------------------------------- 00930 ! 00931 ! local variables 00932 ! 00933 !----------------------------------------------------------------------- 00934 00935 character(char_len) :: 00936 & grid1_ctmp ! character temp for grid1 names 00937 &, grid2_ctmp ! character temp for grid2 names 00938 00939 integer (kind=int_kind) :: 00940 & itmp1 ! integer temp 00941 &, itmp2 ! integer temp 00942 &, itmp3 ! integer temp 00943 &, itmp4 ! integer temp 00944 &, nc_numwgts1_id ! extra netCDF id for additional weights 00945 &, nc_src_isize_id ! extra netCDF id for ni_a 00946 &, nc_src_jsize_id ! extra netCDF id for nj_a 00947 &, nc_dst_isize_id ! extra netCDF id for ni_b 00948 &, nc_dst_jsize_id ! extra netCDF id for nj_b 00949 &, nc_rmpmatrix2_id ! extra netCDF id for high-order remap matrix 00950 00951 integer (kind=int_kind) :: il_nftype 00952 00953 real (kind=dbl_kind), dimension(:),allocatable :: 00954 & wts1 ! CSM wants single array for 1st-order wts 00955 00956 real (kind=dbl_kind), dimension(:,:),allocatable :: 00957 & wts2 ! write remaining weights in different array 00958 00959 !----------------------------------------------------------------------- 00960 ! 00961 ! create netCDF file for mapping and define some global attributes 00962 ! 00963 !----------------------------------------------------------------------- 00964 00965 ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id) 00966 call netcdf_error_handler(ncstat) 00967 00968 !*** 00969 !*** map name 00970 !*** 00971 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', 00972 & len_trim(map_name), map_name) 00973 call netcdf_error_handler(ncstat) 00974 00975 !*** 00976 !*** normalization option 00977 !*** 00978 ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', 00979 & len_trim(normalize_opt), normalize_opt) 00980 call netcdf_error_handler(ncstat) 00981 00982 !*** 00983 !*** map method 00984 !*** 00985 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', 00986 & len_trim(map_method), map_method) 00987 call netcdf_error_handler(ncstat) 00988 00989 !*** 00990 !*** history 00991 !*** 00992 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', 00993 & len_trim(history), history) 00994 call netcdf_error_handler(ncstat) 00995 00996 !*** 00997 !*** file convention 00998 !*** 00999 convention = 'NCAR-CSM' 01000 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', 01001 & len_trim(convention), convention) 01002 call netcdf_error_handler(ncstat) 01003 01004 !*** 01005 !*** source and destination grid names 01006 !*** 01007 01008 if (direction == 1) then 01009 grid1_ctmp = 'domain_a' 01010 grid2_ctmp = 'domain_b' 01011 else 01012 grid1_ctmp = 'domain_b' 01013 grid2_ctmp = 'domain_a' 01014 endif 01015 01016 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), 01017 & len_trim(grid1_name), grid1_name) 01018 call netcdf_error_handler(ncstat) 01019 01020 ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), 01021 & len_trim(grid2_name), grid2_name) 01022 call netcdf_error_handler(ncstat) 01023 01024 !----------------------------------------------------------------------- 01025 ! 01026 ! prepare netCDF dimension info 01027 ! 01028 !----------------------------------------------------------------------- 01029 01030 !*** 01031 !*** define grid size dimensions 01032 !*** 01033 01034 if (direction == 1) then 01035 itmp1 = grid1_size 01036 itmp2 = grid2_size 01037 else 01038 itmp1 = grid2_size 01039 itmp2 = grid1_size 01040 endif 01041 01042 ncstat = nf_def_dim (nc_file_id, 'n_a', itmp1, nc_srcgrdsize_id) 01043 call netcdf_error_handler(ncstat) 01044 01045 ncstat = nf_def_dim (nc_file_id, 'n_b', itmp2, nc_dstgrdsize_id) 01046 call netcdf_error_handler(ncstat) 01047 01048 !*** 01049 !*** define grid corner dimension 01050 !*** 01051 01052 if (direction == 1) then 01053 itmp1 = grid1_corners 01054 itmp2 = grid2_corners 01055 else 01056 itmp1 = grid2_corners 01057 itmp2 = grid1_corners 01058 endif 01059 01060 ncstat = nf_def_dim (nc_file_id, 'nv_a', itmp1, nc_srcgrdcorn_id) 01061 call netcdf_error_handler(ncstat) 01062 01063 ncstat = nf_def_dim (nc_file_id, 'nv_b', itmp2, nc_dstgrdcorn_id) 01064 call netcdf_error_handler(ncstat) 01065 01066 !*** 01067 !*** define grid rank dimension 01068 !*** 01069 01070 if (direction == 1) then 01071 itmp1 = grid1_rank 01072 itmp2 = grid2_rank 01073 else 01074 itmp1 = grid2_rank 01075 itmp2 = grid1_rank 01076 endif 01077 01078 ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 01079 & itmp1, nc_srcgrdrank_id) 01080 call netcdf_error_handler(ncstat) 01081 01082 ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 01083 & itmp2, nc_dstgrdrank_id) 01084 call netcdf_error_handler(ncstat) 01085 01086 !*** 01087 !*** define first two dims as if 2-d cartesian domain 01088 !*** 01089 01090 if (direction == 1) then 01091 itmp1 = grid1_dims(1) 01092 if (grid1_rank > 1) then 01093 itmp2 = grid1_dims(2) 01094 else 01095 itmp2 = 0 01096 endif 01097 itmp3 = grid2_dims(1) 01098 if (grid2_rank > 1) then 01099 itmp4 = grid2_dims(2) 01100 else 01101 itmp4 = 0 01102 endif 01103 else 01104 itmp1 = grid2_dims(1) 01105 if (grid2_rank > 1) then 01106 itmp2 = grid2_dims(2) 01107 else 01108 itmp2 = 0 01109 endif 01110 itmp3 = grid1_dims(1) 01111 if (grid1_rank > 1) then 01112 itmp4 = grid1_dims(2) 01113 else 01114 itmp4 = 0 01115 endif 01116 endif 01117 01118 ncstat = nf_def_dim (nc_file_id, 'ni_a', itmp1, nc_src_isize_id) 01119 call netcdf_error_handler(ncstat) 01120 01121 ncstat = nf_def_dim (nc_file_id, 'nj_a', itmp2, nc_src_jsize_id) 01122 call netcdf_error_handler(ncstat) 01123 01124 ncstat = nf_def_dim (nc_file_id, 'ni_b', itmp3, nc_dst_isize_id) 01125 call netcdf_error_handler(ncstat) 01126 01127 ncstat = nf_def_dim (nc_file_id, 'nj_b', itmp4, nc_dst_jsize_id) 01128 call netcdf_error_handler(ncstat) 01129 01130 !*** 01131 !*** define map size dimensions 01132 !*** 01133 01134 if (direction == 1) then 01135 itmp1 = num_links_map1 01136 else 01137 itmp1 = num_links_map2 01138 endif 01139 01140 ncstat = nf_def_dim (nc_file_id, 'n_s', itmp1, nc_numlinks_id) 01141 call netcdf_error_handler(ncstat) 01142 01143 ncstat = nf_def_dim (nc_file_id, 'num_wgts', 01144 & num_wts, nc_numwgts_id) 01145 call netcdf_error_handler(ncstat) 01146 01147 if (num_wts > 1) then 01148 ncstat = nf_def_dim (nc_file_id, 'num_wgts1', 01149 & num_wts-1, nc_numwgts1_id) 01150 call netcdf_error_handler(ncstat) 01151 endif 01152 01153 !*** 01154 !*** define grid dimensions 01155 !*** 01156 01157 ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, 01158 & 1, nc_srcgrdrank_id, nc_srcgrddims_id) 01159 call netcdf_error_handler(ncstat) 01160 01161 ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, 01162 & 1, nc_dstgrdrank_id, nc_dstgrddims_id) 01163 call netcdf_error_handler(ncstat) 01164 01165 !----------------------------------------------------------------------- 01166 ! 01167 ! define all arrays for netCDF descriptors 01168 ! 01169 !----------------------------------------------------------------------- 01170 01171 !*** 01172 !*** define grid center latitude array 01173 !*** 01174 01175 il_nftype = NF_DOUBLE 01176 IF (ll_single) il_nftype = NF_REAL 01177 01178 ncstat = nf_def_var (nc_file_id, 'yc_a', 01179 & il_nftype, 1, nc_srcgrdsize_id, 01180 & nc_srcgrdcntrlat_id) 01181 call netcdf_error_handler(ncstat) 01182 01183 ncstat = nf_def_var (nc_file_id, 'yc_b', 01184 & il_nftype, 1, nc_dstgrdsize_id, 01185 & nc_dstgrdcntrlat_id) 01186 call netcdf_error_handler(ncstat) 01187 01188 !*** 01189 !*** define grid center longitude array 01190 !*** 01191 01192 ncstat = nf_def_var (nc_file_id, 'xc_a', 01193 & il_nftype, 1, nc_srcgrdsize_id, 01194 & nc_srcgrdcntrlon_id) 01195 call netcdf_error_handler(ncstat) 01196 01197 ncstat = nf_def_var (nc_file_id, 'xc_b', 01198 & il_nftype, 1, nc_dstgrdsize_id, 01199 & nc_dstgrdcntrlon_id) 01200 call netcdf_error_handler(ncstat) 01201 01202 !*** 01203 !*** define grid corner lat/lon arrays 01204 !*** 01205 01206 nc_dims2_id(1) = nc_srcgrdcorn_id 01207 nc_dims2_id(2) = nc_srcgrdsize_id 01208 01209 ncstat = nf_def_var (nc_file_id, 'yv_a', 01210 & il_nftype, 2, nc_dims2_id, 01211 & nc_srcgrdcrnrlat_id) 01212 call netcdf_error_handler(ncstat) 01213 01214 ncstat = nf_def_var (nc_file_id, 'xv_a', 01215 & il_nftype, 2, nc_dims2_id, 01216 & nc_srcgrdcrnrlon_id) 01217 call netcdf_error_handler(ncstat) 01218 01219 nc_dims2_id(1) = nc_dstgrdcorn_id 01220 nc_dims2_id(2) = nc_dstgrdsize_id 01221 01222 ncstat = nf_def_var (nc_file_id, 'yv_b', 01223 & il_nftype, 2, nc_dims2_id, 01224 & nc_dstgrdcrnrlat_id) 01225 call netcdf_error_handler(ncstat) 01226 01227 ncstat = nf_def_var (nc_file_id, 'xv_b', 01228 & il_nftype, 2, nc_dims2_id, 01229 & nc_dstgrdcrnrlon_id) 01230 call netcdf_error_handler(ncstat) 01231 01232 !*** 01233 !*** CSM wants all in degrees 01234 !*** 01235 01236 grid1_units = 'degrees' 01237 grid2_units = 'degrees' 01238 01239 if (direction == 1) then 01240 grid1_ctmp = grid1_units 01241 grid2_ctmp = grid2_units 01242 else 01243 grid1_ctmp = grid2_units 01244 grid2_ctmp = grid1_units 01245 endif 01246 01247 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 01248 & 'units', 7, grid1_ctmp) 01249 call netcdf_error_handler(ncstat) 01250 01251 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 01252 & 'units', 7, grid2_ctmp) 01253 call netcdf_error_handler(ncstat) 01254 01255 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 01256 & 'units', 7, grid1_ctmp) 01257 call netcdf_error_handler(ncstat) 01258 01259 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 01260 & 'units', 7, grid2_ctmp) 01261 call netcdf_error_handler(ncstat) 01262 01263 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 01264 & 'units', 7, grid1_ctmp) 01265 call netcdf_error_handler(ncstat) 01266 01267 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 01268 & 'units', 7, grid1_ctmp) 01269 call netcdf_error_handler(ncstat) 01270 01271 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 01272 & 'units', 7, grid2_ctmp) 01273 call netcdf_error_handler(ncstat) 01274 01275 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 01276 & 'units', 7, grid2_ctmp) 01277 call netcdf_error_handler(ncstat) 01278 01279 !*** 01280 !*** define grid mask 01281 !*** 01282 01283 ncstat = nf_def_var (nc_file_id, 'mask_a', NF_INT, 01284 & 1, nc_srcgrdsize_id, nc_srcgrdimask_id) 01285 call netcdf_error_handler(ncstat) 01286 01287 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 01288 & 'units', 8, 'unitless') 01289 call netcdf_error_handler(ncstat) 01290 01291 ncstat = nf_def_var (nc_file_id, 'mask_b', NF_INT, 01292 & 1, nc_dstgrdsize_id, nc_dstgrdimask_id) 01293 call netcdf_error_handler(ncstat) 01294 01295 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 01296 & 'units', 8, 'unitless') 01297 call netcdf_error_handler(ncstat) 01298 01299 !*** 01300 !*** define grid area arrays 01301 !*** 01302 01303 ncstat = nf_def_var (nc_file_id, 'area_a', 01304 & il_nftype, 1, nc_srcgrdsize_id, 01305 & nc_srcgrdarea_id) 01306 call netcdf_error_handler(ncstat) 01307 01308 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 01309 & 'units', 14, 'square radians') 01310 call netcdf_error_handler(ncstat) 01311 01312 ncstat = nf_def_var (nc_file_id, 'area_b', 01313 & il_nftype, 1, nc_dstgrdsize_id, 01314 & nc_dstgrdarea_id) 01315 call netcdf_error_handler(ncstat) 01316 01317 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 01318 & 'units', 14, 'square radians') 01319 call netcdf_error_handler(ncstat) 01320 01321 !*** 01322 !*** define grid fraction arrays 01323 !*** 01324 01325 ncstat = nf_def_var (nc_file_id, 'frac_a', 01326 & il_nftype, 1, nc_srcgrdsize_id, 01327 & nc_srcgrdfrac_id) 01328 call netcdf_error_handler(ncstat) 01329 01330 ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 01331 & 'units', 8, 'unitless') 01332 call netcdf_error_handler(ncstat) 01333 01334 ncstat = nf_def_var (nc_file_id, 'frac_b', 01335 & il_nftype, 1, nc_dstgrdsize_id, 01336 & nc_dstgrdfrac_id) 01337 call netcdf_error_handler(ncstat) 01338 01339 ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 01340 & 'units', 8, 'unitless') 01341 call netcdf_error_handler(ncstat) 01342 01343 !*** 01344 !*** define mapping arrays 01345 !*** 01346 01347 ncstat = nf_def_var (nc_file_id, 'col', 01348 & NF_INT, 1, nc_numlinks_id, 01349 & nc_srcadd_id) 01350 call netcdf_error_handler(ncstat) 01351 01352 ncstat = nf_def_var (nc_file_id, 'row', 01353 & NF_INT, 1, nc_numlinks_id, 01354 & nc_dstadd_id) 01355 call netcdf_error_handler(ncstat) 01356 01357 ncstat = nf_def_var (nc_file_id, 'S', 01358 & il_nftype, 1, nc_numlinks_id, 01359 & nc_rmpmatrix_id) 01360 call netcdf_error_handler(ncstat) 01361 01362 if (num_wts > 1) then 01363 nc_dims2_id(1) = nc_numwgts1_id 01364 nc_dims2_id(2) = nc_numlinks_id 01365 01366 ncstat = nf_def_var (nc_file_id, 'S2', 01367 & il_nftype, 2, nc_dims2_id, 01368 & nc_rmpmatrix2_id) 01369 call netcdf_error_handler(ncstat) 01370 endif 01371 01372 !*** 01373 !*** end definition stage 01374 !*** 01375 01376 ncstat = nf_enddef(nc_file_id) 01377 call netcdf_error_handler(ncstat) 01378 01379 !----------------------------------------------------------------------- 01380 ! 01381 ! compute integer masks 01382 ! 01383 !----------------------------------------------------------------------- 01384 01385 if (direction == 1) then 01386 allocate (src_mask_int(grid1_size), 01387 & dst_mask_int(grid2_size)) 01388 01389 where (grid2_mask) 01390 dst_mask_int = 1 01391 elsewhere 01392 dst_mask_int = 0 01393 endwhere 01394 01395 where (grid1_mask) 01396 src_mask_int = 1 01397 elsewhere 01398 src_mask_int = 0 01399 endwhere 01400 else 01401 allocate (src_mask_int(grid2_size), 01402 & dst_mask_int(grid1_size)) 01403 01404 where (grid1_mask) 01405 dst_mask_int = 1 01406 elsewhere 01407 dst_mask_int = 0 01408 endwhere 01409 01410 where (grid2_mask) 01411 src_mask_int = 1 01412 elsewhere 01413 src_mask_int = 0 01414 endwhere 01415 endif 01416 01417 !----------------------------------------------------------------------- 01418 ! 01419 ! change units of lat/lon coordinates if input units different 01420 ! from radians. if this is the second mapping, the conversion has 01421 ! alread been done. 01422 ! 01423 !----------------------------------------------------------------------- 01424 01425 if (grid1_units(1:7) == 'degrees' .and. direction == 1) then 01426 grid1_center_lat = grid1_center_lat/deg2rad 01427 grid1_center_lon = grid1_center_lon/deg2rad 01428 grid1_corner_lat = grid1_corner_lat/deg2rad 01429 grid1_corner_lon = grid1_corner_lon/deg2rad 01430 endif 01431 01432 if (grid2_units(1:7) == 'degrees' .and. direction == 1) then 01433 grid2_center_lat = grid2_center_lat/deg2rad 01434 grid2_center_lon = grid2_center_lon/deg2rad 01435 grid2_corner_lat = grid2_corner_lat/deg2rad 01436 grid2_corner_lon = grid2_corner_lon/deg2rad 01437 endif 01438 01439 !----------------------------------------------------------------------- 01440 ! 01441 ! write mapping data 01442 ! 01443 !----------------------------------------------------------------------- 01444 01445 if (direction == 1) then 01446 itmp1 = nc_srcgrddims_id 01447 itmp2 = nc_dstgrddims_id 01448 else 01449 itmp2 = nc_srcgrddims_id 01450 itmp1 = nc_dstgrddims_id 01451 endif 01452 01453 ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims) 01454 call netcdf_error_handler(ncstat) 01455 01456 ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims) 01457 call netcdf_error_handler(ncstat) 01458 01459 ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 01460 & src_mask_int) 01461 call netcdf_error_handler(ncstat) 01462 01463 ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, 01464 & dst_mask_int) 01465 call netcdf_error_handler(ncstat) 01466 01467 deallocate(src_mask_int, dst_mask_int) 01468 01469 if (direction == 1) then 01470 itmp1 = nc_srcgrdcntrlat_id 01471 itmp2 = nc_srcgrdcntrlon_id 01472 itmp3 = nc_srcgrdcrnrlat_id 01473 itmp4 = nc_srcgrdcrnrlon_id 01474 else 01475 itmp1 = nc_dstgrdcntrlat_id 01476 itmp2 = nc_dstgrdcntrlon_id 01477 itmp3 = nc_dstgrdcrnrlat_id 01478 itmp4 = nc_dstgrdcrnrlon_id 01479 endif 01480 01481 ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat) 01482 call netcdf_error_handler(ncstat) 01483 01484 ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon) 01485 call netcdf_error_handler(ncstat) 01486 01487 ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat) 01488 call netcdf_error_handler(ncstat) 01489 01490 ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon) 01491 call netcdf_error_handler(ncstat) 01492 01493 if (direction == 1) then 01494 itmp1 = nc_dstgrdcntrlat_id 01495 itmp2 = nc_dstgrdcntrlon_id 01496 itmp3 = nc_dstgrdcrnrlat_id 01497 itmp4 = nc_dstgrdcrnrlon_id 01498 else 01499 itmp1 = nc_srcgrdcntrlat_id 01500 itmp2 = nc_srcgrdcntrlon_id 01501 itmp3 = nc_srcgrdcrnrlat_id 01502 itmp4 = nc_srcgrdcrnrlon_id 01503 endif 01504 01505 ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat) 01506 call netcdf_error_handler(ncstat) 01507 01508 ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon) 01509 call netcdf_error_handler(ncstat) 01510 01511 ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat) 01512 call netcdf_error_handler(ncstat) 01513 01514 ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon) 01515 call netcdf_error_handler(ncstat) 01516 01517 if (direction == 1) then 01518 itmp1 = nc_srcgrdarea_id 01519 itmp2 = nc_srcgrdfrac_id 01520 itmp3 = nc_dstgrdarea_id 01521 itmp4 = nc_dstgrdfrac_id 01522 else 01523 itmp1 = nc_dstgrdarea_id 01524 itmp2 = nc_dstgrdfrac_id 01525 itmp3 = nc_srcgrdarea_id 01526 itmp4 = nc_srcgrdfrac_id 01527 endif 01528 01529 if (luse_grid1_area) then 01530 ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in) 01531 else 01532 ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area) 01533 endif 01534 call netcdf_error_handler(ncstat) 01535 01536 ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac) 01537 call netcdf_error_handler(ncstat) 01538 01539 if (luse_grid2_area) then 01540 ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area) 01541 else 01542 ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area) 01543 endif 01544 call netcdf_error_handler(ncstat) 01545 01546 ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac) 01547 call netcdf_error_handler(ncstat) 01548 01549 if (direction == 1) then 01550 ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 01551 & grid1_add_map1) 01552 call netcdf_error_handler(ncstat) 01553 01554 ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 01555 & grid2_add_map1) 01556 call netcdf_error_handler(ncstat) 01557 01558 if (num_wts == 1) then 01559 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 01560 & wts_map1) 01561 call netcdf_error_handler(ncstat) 01562 else 01563 allocate(wts1(num_links_map1),wts2(num_wts-1,num_links_map1)) 01564 01565 wts1 = wts_map1(1,:) 01566 wts2 = wts_map1(2:,:) 01567 01568 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 01569 & wts1) 01570 call netcdf_error_handler(ncstat) 01571 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 01572 & wts2) 01573 call netcdf_error_handler(ncstat) 01574 deallocate(wts1,wts2) 01575 endif 01576 else 01577 ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 01578 & grid2_add_map2) 01579 call netcdf_error_handler(ncstat) 01580 01581 ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 01582 & grid1_add_map2) 01583 call netcdf_error_handler(ncstat) 01584 01585 if (num_wts == 1) then 01586 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 01587 & wts_map2) 01588 call netcdf_error_handler(ncstat) 01589 else 01590 allocate(wts1(num_links_map2),wts2(num_wts-1,num_links_map2)) 01591 01592 wts1 = wts_map2(1,:) 01593 wts2 = wts_map2(2:,:) 01594 01595 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 01596 & wts1) 01597 call netcdf_error_handler(ncstat) 01598 ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 01599 & wts2) 01600 call netcdf_error_handler(ncstat) 01601 deallocate(wts1,wts2) 01602 endif 01603 endif 01604 01605 ncstat = nf_close(nc_file_id) 01606 call netcdf_error_handler(ncstat) 01607 01608 !----------------------------------------------------------------------- 01609 01610 end subroutine write_remap_csm 01611 01612 !*********************************************************************** 01613 01614 end module remap_write 01615 01616 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 01617
1.7.4 
