-
Notifications
You must be signed in to change notification settings - Fork 0
/
ESMF_regridding.ncl
2825 lines (2558 loc) · 100 KB
/
ESMF_regridding.ncl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;----------------------------------------------------------------------
; Many of the following functions and procedures were written by:
; Mohammad Abouali, [email protected]
; May 22nd, July 30th, 2011
;
; http://sites.google.com/site/maboualihome/
;
; Many functions were updated, fixed, or added by Mary Haley.
; See notes below.
;
; A debt of gratitude is owed to the ESMF development team, and
; especially Robert Oehmke, for help in\ using the ESMF software.
;
; This script was added to the NCL trunk on 13 Oct 2011.
;
; Modifications:
; 20 Jun 2012:
; Fix the section that calculates the corner grid cells
; so that the appropriate algorithm is used depending
; on whether the lat values go to -90/90.
;
; 6 May 2012:
; Clean up error statements.
; Renamed RemoveDstGridFile, RemoveSrcGridFile, and
; RemoveGridFiles to RemoveDstFile, RemoveSrcFile,
; and RemoveFiles.
; Renamed ForceOverWrite and OverWrite to
; ForceOverwrite and Overwrite (lowercase 'w').
; Added check for duplicate options being set
; (like SrcOverwrite and Overwrite).
; Renamed DstGridFileName / SrcGridFileName to
; just DstFileName / SrcFileName.
;
; 2 May 2012:
; Changed default names of description files to
; source_grid_file.nc and
; destination_grid_file.nc
;
; 27 April 2012:
; Renamed CornerLat and CornerLon to GridCornerLat and
; GridCornerLon to make it more clear what these are.
;
; 26 April 2012:
; For "conserve" method, be sure to divide results by
; "frac_b". This also meant I had to modify "reshape"
; so I could use it to reshape *and* conform the frac_b
; array to the destination grid size.
;
; 22 April 2012:
; Renamed "method" and "pole" attributes to "InterpMethod"
; and "Pole" for consistency with other attributes. "method"
; and "pole" will still work.
; Added RemoveGridFiles, RemoveSrcGridFile, RemoveDstGridFile
; to ESMF_regrid_gen_weights.
;
; 13 April 2012:
; Removed ForcedCorners attribute. The user
; can just set CornerLat and CornerLon.
;
; 08 March 2012:
; Renamed this script to ESMF_regridding.ncl
;
; 06 March 2012:
; Renamed ESMF_gen_weights to ESMF_regrid_gen_weights
; Renamed ESMF_regrid to ESMF_regrid_with_weights
; Renamed ESMF_all to ESMF_regrid
;
; 08 Feb 2012:
; Added retrieve_ESMF_lat and retrieve_ESMF_lon.
; Added ESMF_all
; Added write_grid_description_file.
; Removed isbothvaratt_logical_true and made isatt_logical_true
; behave like it.
; Added isatt_logical_false.
; Set IgnoreMappedPoints to True by default.
; Set pole="none" if InterpMethod="conserve" (and pole not
; explicitly set by user).
;
; 23 Jan 2012:
; Removed BothRegional and BothESMF, since they might
; confuse users. Use Src/DstRegional and Src/DstESMF.
;
; 13 Jan 2012:
; Renamed this script to ESMFRegriddingTools.ncl
;
; 12 Jan 2012:
; Moved copy_VarAtts_Except to contributed.ncl and
; renamed to copy_VarAtts_except.
;
; 10 Jan 2012:
; Overhauled latlon_to_SCRIP to accept a grid type
; as input, like "1x1", "0.25", "G64", etc.
; Overhauled rectilinear_to_SCRIP, curvilinear_to_SCRIP
; latlon_to_SCRIP, and unstructured_to_ESMF to turn some
; of the input arguments (like a title) into "opt"
; attributes. Also removed "mask2d" as an input argument,
; and made it an "opt" attribute.
;
; 09 Jan 2012:
; Renamed cartesian_to_SCRIP to latlon_to_SCRIP
; Renamed some of the attributes in this function.
; Added PrintTimings to the xxxx_to_SCRIP, xxxx_to_ESMF,
; and ESMF_gen_weights functions.
;
; 01 Jan 2012:
; Changed behavior of ForceOverWrite. No longer
; requires OverWrite to be set. Removed
; ForceUnstructured since it's not really needed.
; Added get_start_time and print_elapsed_time.
;
; 22 Dec 2011:
; Renamed some more functions: changed "esmf" to "ESMF"
; and "scrip" to "SCRIP".
; Changed esmf_remap_weights to ESMF_gen_weights.
; Changed esmf_remap to ESMF_regrid
; Converted ESMF_gen_weights to a procedure.
; Other changes to clean up error statements, remove
; extraneous print statements, add more comments.
;
; 20 Dec 2011:
; Combined GenBox_with_LLURCorner and GenBox_with_Center_Dim
; into one script called "cartesian_to_SCRIP".
;
; 18 Dec 2011:
; Cleaned up Auto2SCRIP:
; - changed to procedure
; - renamed to auto_to_SCRIP
; - changed values for "coordType"
; - cleaned up "if-else-endif" statements
;
; 18 Dec 2011:
; Cleaned up this script to:
; - rename some functions and/or change to procedures
; - use better functions where appropriate
; - align code to make it easier to read
; - add routine names to error prints
;
; 15 Dec 2011:
; Added the "-i" flag to the ESMF_RegridWeightGen
; command to properly handle regional grids like WRF.
; The WRF regridding example wasn't working otherwise.
;
; 09 Nov 2011:
; Decided to completely remove "remove outlier" code.
; Cleaned up the sparse_matrix_mult code to correctly
; handle the case of the source grid being 1D.
;
; 06 Nov 2011:
; Made code faster by adding option
; ("RemoveOutliers", False by default) to not
; remove outliers. It turns out this code was
; added to fix bug in original SMM code in
; handling missing values. This code should no
; longer be needed.
;
; Added PrintTimings to time the sparse matrix multiply
; and the removing outliers code.
;
; 02 Nov 2011:
; Replaced the SMM call with the new sparse_matrix_mult
; function.
;
; 01 Nov 2011:
; Created a built-in version of "reshape" which doesn't
; copy any metadata. Removed the "reshape" that was in
; this file.
;
; 31 Oct 2011:
; Replaced "return(tointeger(1))" with just "return(1)"
; Removed SMM and squeeze, since they don't seemed to be
; used by anybody.
;
; 14 Oct 2011:
; Removed references to $ESMFBINDIR. This should be on
; user's search path. Also, executable had wrong name,
; changed to "ESMF_RegridWeightGen".
;======================================================================
; This function returns the start time, either in CPU or wall
; clock seconds, depending on your version of NCL. Use this function
; with print_elapsed_time, below.
;======================================================================
undef("get_start_time")
function get_start_time()
local s
begin
s = str_split(get_ncl_version(),".")
if(s(0).eq."5".or.(s(0).eq."6".and.s(1).eq."0")) then
return(systemfunc("date"))
else
return(get_cpu_time())
end if
end
;======================================================================
; This procedure prints the elapsed time, either in CPU or wall
; clock seconds, depending on your version of NCL. Use this procedure
; with get_start_time, above.
;======================================================================
undef("print_elapsed_time")
procedure print_elapsed_time(stime,title)
local s
begin
s = str_split(get_ncl_version(),".")
if(s(0).eq."5".or.(s(0).eq."6".and.s(1).eq."0")) then
wallClockElapseTime(stime, title, 0)
else
diff_time = get_cpu_time() - stime
print("=====> CPU Elapsed Time: " + title + ": " + diff_time + " <=====")
end if
end
;======================================================================
; This function receives a set of variable names and checks
; if their units attribute contains north or east
; If it contains:
; north, it returns "latitude"
; east, it returns "longitude"
; otherwise it returns "unknown"
;======================================================================
undef("isLatorLon")
function isLatorLon(fid,VarNames[*]:string)
local NumNames, OutPut, i
begin
NumNames = dimsizes(VarNames)
OutPut = new(NumNames,"string","No_FillValue")
OutPut = "unknown"
do i=0,NumNames-1
if (isfilevar(fid,VarNames(i)).and. \
isfilevaratt(fid,VarNames(i),"units")) then
if( isStrSubset(str_lower(fid->$VarNames(i)$@units),"north") ) then
OutPut(i)="latitude"
else if ( isStrSubset(str_lower(fid->$VarNames(i)$@units),"east") ) then
OutPut(i)="longitude"
end if
end if
end if
end do
return(OutPut)
end
;***********************************************************************;
; Function : get_att_value( ;
; opt[1] : logical ;
; attname : string ;
; default_val ;
; ;
; This function checks to see if the given attribute has been set, and ;
; if so, it returns its value. Otherwise, it returns the default value ;
; which is the 3rd argument. ;
;***********************************************************************;
undef("get_att_value")
function get_att_value(opt,attname:string,default_val)
local return_val
begin
if(islogical(opt).and.opt.and..not.any(ismissing(getvaratts(opt))).and.\
isatt(opt,attname)) then
return_val = opt@$attname$
else
return_val = default_val
end if
return(return_val)
end
;======================================================================
; This function will return True if Opt is True and the AttName
; attribute is a logical attribute that is set to True
;======================================================================
undef("isatt_logical_true")
function isatt_logical_true(Opt[1]:logical,AttName[1]:string)
begin
if (isatt(Opt,AttName).and.islogical(Opt@$AttName$)) then
return(Opt@$AttName$)
end if
return(False)
end ; of isatt_logical_true(...)
;======================================================================
; This function will return True if Opt is True and the AttName
; attribute is a logical attribute that is set to False
;======================================================================
undef("isatt_logical_false")
function isatt_logical_false(Opt[1]:logical,AttName[1]:string)
begin
if (isatt(Opt,AttName).and.islogical(Opt@$AttName$).and. \
.not.Opt@$AttName$) then
return(True)
end if
return(False)
end ; of isatt_logical_false(...)
;======================================================================
; This procedure checks if a file already exists, and removes if
; certain options are set.
;
; If opt=True and opt@Overwrite = True, then user will be prompted
; whether to remove file.
;
; Otherwise, if opt=True and opt@ForceOverwrite = True, then file
; will be removed with no prompting.
;======================================================================
undef("check_for_file")
procedure check_for_file(fname,opt)
local DEBUG
begin
DEBUG = isatt_logical_true(opt,"Debug")
if (isfilepresent(fname)) then
if(isatt_logical_true(opt,"Overwrite")) then
system("rm -rfi "+fname)
else if (isatt_logical_true(opt,"ForceOverwrite")) then
system("rm -rf "+fname)
else
print("check_for_file: the file '" + fname + "' already exists.")
print(" Set opt@Overwrite = True")
print(" or opt@ForceOverwrite = True")
print(" to override.")
exit
end if
end if
end if
end
;======================================================================
; This procedure checks if two attributes are set, and set to
; different values. If so, they will be set to the given value,
; and a warning printed.
;======================================================================
procedure check_both_atts(opt,att1,att2,attval)
begin
if (isatt(opt,att1).and.isatt(opt,att2).and.\
opt@$att1$.ne.opt@$att2$) then
print("check_both_atts: you have set " + att1 + " and")
print(" " + att2 + " to different values.")
print(" Setting them both to " + attval + " to be safe.")
opt@$att1$ = attval
opt@$att2$ = attval
end if
end
;======================================================================
; This function coerces the type of a variable to the given type.
; It will also copy the attributes.
;======================================================================
undef("totypeof")
function totypeof(inVar,outType)
begin
Err="OK"
if (outType.eq."double") then
outVar=todouble(inVar)
else if (outType.eq."float") then
outVar=tofloat(inVar)
else if (outType.eq."integer") then
outVar=tointeger(inVar)
else if (outType.eq."int64") then
outVar=toint64(inVar)
else if (outType.eq."uint64") then
outVar=touint64(inVar)
else if (outType.eq."long") then
outVar=tolong(inVar)
else if (outType.eq."ulong") then
outVar=toulong(inVar)
else if (outType.eq."uint") then
outVar=touint(inVar)
else if (outType.eq."short") then
outVar=toshort(inVar)
else if (outType.eq."ushort") then
outVar=toushort(inVar)
else if (outType.eq."byte") then
outVar=tobyte(inVar)
else if (outType.eq."ubyte") then
outVar=toubyte(inVar)
else if (outType.eq."string") then
outVar=tostring(inVar)
else if (outType.eq."character") then
outVar=tocharacter(inVar)
else
print("totypeof: Error: conversion to the provided type is not supported.")
exit
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
copy_VarAtts_except(inVar,outVar,"_FillValue")
return(outVar)
end ; of totypeof(...)
;======================================================================
; This procedure rotates the given lat/lon grid, given a rotation angle.
; It operates directly on the input lat/lon.
;======================================================================
undef("rotate_latlon")
procedure rotate_latlon(lat:snumeric,lon:snumeric,Rot[1]:numeric)
local d2r, tmpPoints, latlon_dims
begin
if ( any(dimsizes(lat).ne.dimsizes(lon) ) ) then
print("rotate_latlon: lat and lon must have the same dimensions.")
exit
end if
latlon_dims = dimsizes(lat)
d2r = atan(1)/45.0;
RotateMat = (/(/cos(Rot*d2r), -sin(Rot*d2r)/), \
(/sin(Rot*d2r), cos(Rot*d2r)/) /)
tmpPoints = new( (/2,product(latlon_dims)/),typeof(lat) )
tmpPoints(0,:) = ndtooned(lat)
tmpPoints(1,:) = ndtooned(lon)
tmpPoints = RotateMat#tmpPoints
lat = onedtond(tmpPoints(1,:),latlon_dims)
lon = onedtond(tmpPoints(0,:),latlon_dims)
end
;======================================================================
; This functions calculates the mirror of p1 with respect to po.
;======================================================================
undef("mirrorP2P")
function mirrorP2P(p1,po)
local dVec
begin
dVec = p1-po
MirrorP = po-dVec
return(MirrorP)
end ; of mirrorP2P(...)
;======================================================================
; This procedure is meant as a replacement for
; "calc_SCRIP_corners_noboundaries" (previously called
; "find_SCRIP_corners"). It takes the same arguments, but uses a
; different algorithm that was suggested by Bob Oehmke.
;
; After 6.1.0-beta, I realized that this algorithm really should only
; be used if any of the lat points are at the boundary. At this point,
; I decided to rename this function from "calc_SCRIP_corners" to
; "calc_SCRIP_corners_boundaries", and go back to using
; "calc_SCRIP_corners_noboundaries" as the regular algorithm.
;======================================================================
undef("calc_SCRIP_corners_boundaries")
procedure calc_SCRIP_corners_boundaries(lat2d[*][*],lon2d[*][*], \
grid_corner_lat, grid_corner_lon,\
opt)
local DEBUG, latlon_dims, grid_corner_lat2d, grid_corner_lon2d, \
nlat, nlon, nlatp1, nlonp1
begin
DEBUG = isatt_logical_true(opt,"Debug")
;---Check input dimension sizes.
if (any(dimsizes(lat2d).ne.dimsizes(lon2d))) then
print("calc_SCRIP_corners_boundaries: lat and lon must have the same dimensions.")
exit
end if
if (any(dimsizes(grid_corner_lat).ne.dimsizes(grid_corner_lon))) then
print("calc_SCRIP_corners_boundaries: lat and lon must have the same dimensions.")
exit
end if
;---Get dimension sizes
latlon_dims = dimsizes(lat2d)
cnr_latlon_dims = dimsizes(grid_corner_lat)
cnr_rank = dimsizes(cnr_latlon_dims)
nlat = latlon_dims(0)
nlon = latlon_dims(1)
nlatp1 = nlat+1
nlonp1 = nlon+1
if(cnr_rank.ne.2.or.cnr_latlon_dims(0).ne.(nlat*nlon).or. \
cnr_latlon_dims(1).ne.4) then
print("calc_SCRIP_corners_boundaries: grid_corner_lat/grid_corner_lon must be (nlat*nlon) x 4")
exit
end if
if(DEBUG) then
print("calc_SCRIP_corners_boundaries")
print(" min/max original lat: " + min(lat2d) + "/" + max(lat2d))
print(" min/max original lon: " + min(lon2d) + "/" + max(lon2d))
end if
;---Create array to hold a 2D array of lat/lon corners
grid_corner_lat2d = new((/nlatp1,nlonp1/),typeof(lat2d))
grid_corner_lon2d = new((/nlatp1,nlonp1/),typeof(lon2d))
;---Calculate interior locations of corner grid
do i=1,nlat-1
do j=1,nlon-1
grid_corner_lat2d(i,j) = avg((/lat2d(i-1,j-1),lat2d(i,j-1),\
lat2d(i-1,j), lat2d(i,j)/))
grid_corner_lon2d(i,j) = avg((/lon2d(i-1,j-1),lon2d(i,j-1),\
lon2d(i-1,j), lon2d(i,j)/))
end do
end do
;---Calculate bottom locations of corner grid
do j=1,nlon-1
grid_corner_lat2d(0,j) = avg((/lat2d(0,j),lat2d(0,j-1)/))
grid_corner_lon2d(0,j) = avg((/lon2d(0,j),lon2d(0,j-1)/))
end do
;---Calculate top locations of corner grid
do j=1,nlon-1
grid_corner_lat2d(nlat,j) = avg((/lat2d(nlat-1,j), \
lat2d(nlat-1,j-1)/))
grid_corner_lon2d(nlat,j) = avg((/lon2d(nlat-1,j), \
lon2d(nlat-1,j-1)/))
end do
;---Calculate left locations of corner grid
do i=1,nlat-1
grid_corner_lat2d(i,0) = avg((/lat2d(i,0),lat2d(i-1,0)/))
grid_corner_lon2d(i,0) = avg((/lon2d(i,0),lon2d(i-1,0)/))
end do
;---Calculate right locations of corner grid
do i=1,nlat-1
grid_corner_lat2d(i,nlon) = avg((/lat2d(i,nlon-1), \
lat2d(i-1,nlon-1)/))
grid_corner_lon2d(i,nlon) = avg((/lon2d(i,nlon-1), \
lon2d(i-1,nlon-1)/))
end do
;---Set four corners of corner grid
grid_corner_lat2d(0,0) = lat2d(0,0)
grid_corner_lon2d(0,0) = lon2d(0,0)
grid_corner_lat2d(0,nlon) = lat2d(0,nlon-1)
grid_corner_lon2d(0,nlon) = lon2d(0,nlon-1)
grid_corner_lat2d(nlat,nlon) = lat2d(nlat-1,nlon-1)
grid_corner_lon2d(nlat,nlon) = lon2d(nlat-1,nlon-1)
grid_corner_lat2d(nlat,0) = lat2d(nlat-1,0)
grid_corner_lon2d(nlat,0) = lon2d(nlat-1,0)
if(DEBUG) then
print("calc_SCRIP_corners_boundaries")
print(" min/max grid_corner_lat2d: " + \
min(grid_corner_lat2d) + "/" + max(grid_corner_lat2d))
print(" min/max grid_corner_lon2d: " + \
min(grid_corner_lon2d) + "/" + max(grid_corner_lon2d))
end if
n = 0
do i=0,nlat-1
do j=0,nlon-1
grid_corner_lat(n,0) = grid_corner_lat2d(i, j)
grid_corner_lat(n,1) = grid_corner_lat2d(i, j+1)
grid_corner_lat(n,2) = grid_corner_lat2d(i+1,j+1)
grid_corner_lat(n,3) = grid_corner_lat2d(i+1,j)
grid_corner_lon(n,0) = grid_corner_lon2d(i, j)
grid_corner_lon(n,1) = grid_corner_lon2d(i, j+1)
grid_corner_lon(n,2) = grid_corner_lon2d(i+1,j+1)
grid_corner_lon(n,3) = grid_corner_lon2d(i+1,j)
n=n+1
end do
end do
if(DEBUG) then
print("calc_SCRIP_corners_boundaries")
print(" min/max grid_corner_lat: " + min(grid_corner_lat) + \
"/" + max(grid_corner_lat))
print(" min/max grid_corner_lon: " + min(grid_corner_lon) + \
"/" + max(grid_corner_lon))
end if
end ; of calc_SCRIP_corners_boundaries(...)
;======================================================================
; This procedure is used within the curvilinear_to_SCRIP function.
; It used to be called "find_SCRIP_corners".
;
; Given a structured grid, it looks for the four corners surrounding
; each node. It returns the center of the cells for the corners.
;
; You have to be careful with this routine. It doesn't check if you
; are at or near the edge of the globe (i.e. lat=90, or lon=-180),
; and hence it might give you corners that fall outside -90/90 for lat
; and/or 0/360 for lon.
;
; Really, if the user has a special grid, he/she should input the
; corners via the GridCornerLat and GridCornerLon resources.
;======================================================================
undef("calc_SCRIP_corners_noboundaries")
procedure calc_SCRIP_corners_noboundaries(lat2d[*][*],lon2d[*][*], \
grid_corner_lat,grid_corner_lon,opt)
local latlon_dims, nlat, nlon, Extlon2d, Extlat2d, ExtGridCenter_lat, \
ExtGridCenter_lon, tmp, ii, jj, DEBUG
begin
DEBUG = isatt_logical_true(opt,"Debug")
if ( any(dimsizes(lat2d).ne.dimsizes(lon2d) ) ) then
print("calc_SCRIP_corners_noboundaries: lat and lon must have the same dimensions.")
exit
end if
latlon_dims = dimsizes(lat2d)
nlat = latlon_dims(0)
nlon = latlon_dims(1)
nlatp1 = nlat+1
nlonp1 = nlon+1
nlatp2 = nlat+2
nlonp2 = nlon+2
if(DEBUG) then
print("calc_SCRIP_corners_noboundaries")
print(" min/max original lat: " + min(lat2d) + "/" + max(lat2d))
print(" min/max original lon: " + min(lon2d) + "/" + max(lon2d))
end if
;
; Extend the lat/lon grid (needed to calculate the
; corners at the boundaries).
;
Extlat2d = new( (/nlatp2, nlonp2/),typeof(lat2d))
Extlon2d = new( (/nlatp2, nlonp2/),typeof(lon2d))
;---The middle grid is exactly the original lat2d/lon2d arrays
Extlat2d(1:nlat,1:nlon) = (/lat2d/)
Extlon2d(1:nlat,1:nlon) = (/lon2d/)
;---bottom row, minus corners
Extlat2d(0,1:nlon) = mirrorP2P(lat2d(1,:),lat2d(0,:))
Extlon2d(0,1:nlon) = mirrorP2P(lon2d(1,:),lon2d(0,:))
;---top, minus corners
Extlat2d(nlatp1,1:nlon) = mirrorP2P(lat2d(nlat-2,:),lat2d(nlat-1,:))
Extlon2d(nlatp1,1:nlon) = mirrorP2P(lon2d(nlat-2,:),lon2d(nlat-1,:))
;---left, minus corners
Extlat2d(1:nlat,0) = mirrorP2P(lat2d(:,1),lat2d(:,0))
Extlon2d(1:nlat,0) = mirrorP2P(lon2d(:,1),lon2d(:,0))
;---right, minus corners
Extlat2d(1:nlat,nlonp1) = mirrorP2P(lat2d(:,nlon-2),lat2d(:,nlon-1))
Extlon2d(1:nlat,nlonp1) = mirrorP2P(lon2d(:,nlon-2),lon2d(:,nlon-1))
;---lower left corner
Extlat2d(0,0) = mirrorP2P(lat2d(1,1),lat2d(0,0))
Extlon2d(0,0) = mirrorP2P(lon2d(1,1),lon2d(0,0))
;---upper right corner
Extlat2d(nlatp1,nlonp1) = mirrorP2P(lat2d(nlat-2,nlon-2), \
lat2d(nlat-1,nlon-1))
Extlon2d(nlatp1,nlonp1) = mirrorP2P(lon2d(nlat-2,nlon-2),\
lon2d(nlat-1,nlon-1))
;---lower right corner
Extlat2d(0,nlonp1) = mirrorP2P(lat2d(1,nlon-2),lat2d(0,nlon-1))
Extlon2d(0,nlonp1) = mirrorP2P(lon2d(1,nlon-2),lon2d(0,nlon-1))
;---upper left corner
Extlat2d(nlatp1,0) = mirrorP2P(lat2d(nlat-2,1),lat2d(nlat-1,0))
Extlon2d(nlatp1,0) = mirrorP2P(lon2d(nlat-2,1),lon2d(nlat-1,0))
;
; This kludge is commented out for now, because it's not a good one.
; We need a better way to fix the boundary corners if they go over.
;
;; if(DEBUG) then
;; print("calc_SCRIP_corners_noboundaries")
;; print(" Before kludge to fix lat/lon corners...")
;; print(" min/max Extlat2d: " + min(Extlat2d) + "/" + max(Extlat2d))
;; print(" min/max Extlon2d: " + min(Extlon2d) + "/" + max(Extlon2d))
;; end if
;;
;;;---Kludge to cap the latitudes at -90/90
;; Extlat2d = where(Extlat2d.lt. -90, -90,Extlat2d)
;; Extlat2d = where(Extlat2d.gt. 90, 90,Extlat2d)
;; Extlon2d = where(Extlon2d.lt. 0, 0,Extlon2d)
;; Extlon2d = where(Extlon2d.gt. 360, 360,Extlon2d)
;;
;; if(DEBUG) then
;; print("calc_SCRIP_corners_noboundaries")
;; print(" After kludge to fix lat/lon corners...")
;; print(" min/max Extlat2d: " + min(Extlat2d) + "/" + max(Extlat2d))
;; print(" min/max Extlon2d: " + min(Extlon2d) + "/" + max(Extlon2d))
;; end if
if(DEBUG) then
print("calc_SCRIP_corners_noboundaries")
print(" min/max Extlat2d: " + min(Extlat2d) + "/" + max(Extlat2d))
print(" min/max Extlon2d: " + min(Extlon2d) + "/" + max(Extlon2d))
end if
;
; Calculate the cell center of the extended grid, which
; would be the corner coordinates for the original grid.
;
tmp = Extlat2d(:,1:nlonp1)+Extlat2d(:,0:nlon)
ExtGridCenter_lat = ndtooned((tmp(1:nlatp1,:)+tmp(0:nlat,:))*0.25)
tmp = Extlon2d(:,1:nlonp1)+Extlon2d(:,0:nlon)
ExtGridCenter_lon = ndtooned((tmp(1:nlatp1,:)+tmp(0:nlat,:))*0.25)
delete(tmp)
if(DEBUG) then
print("calc_SCRIP_corners_noboundaries")
print(" min/max ExtGridCenter_lat: " + \
min(ExtGridCenter_lat) + "/" + max(ExtGridCenter_lat))
print(" min/max ExtGridCenter_lon: " + \
min(ExtGridCenter_lon) + "/" + max(ExtGridCenter_lon))
end if
;---Extract the grid cell corners
ii = ndtooned(conform_dims((/nlat,nlon/),ispan(0,nlon-1,1),1))
jj = ndtooned(conform_dims((/nlat,nlon/),ispan(0,nlat-1,1),0))
grid_corner_lat(:,0) = ExtGridCenter_lat(jj*(nlonp1)+ii)
grid_corner_lat(:,1) = ExtGridCenter_lat(jj*(nlonp1)+(ii+1))
grid_corner_lat(:,2) = ExtGridCenter_lat((jj+1)*(nlonp1)+(ii+1))
grid_corner_lat(:,3) = ExtGridCenter_lat((jj+1)*(nlonp1)+ii)
grid_corner_lon(:,0) = ExtGridCenter_lon(jj*(nlonp1)+ii)
grid_corner_lon(:,1) = ExtGridCenter_lon(jj*(nlonp1)+(ii+1))
grid_corner_lon(:,2) = ExtGridCenter_lon((jj+1)*(nlonp1)+(ii+1))
grid_corner_lon(:,3) = ExtGridCenter_lon((jj+1)*(nlonp1)+ii)
end ; of calc_SCRIP_corners_noboundaries(...)
;======================================================================
; This procedure generates an ESMF file for an unstructured grid.
; It is sometimes better to even store logically rectangular and
; structured grids as unstructured grids. (Refer to TriPolar - TGrid)
;======================================================================
undef("unstructured_to_ESMF")
procedure unstructured_to_ESMF(FName[1]:string,inLat,inLon,Opt[1]:logical)
local DEBUG, lat, lon, NodeMask, ElementVertices, title
begin
;---Check for options
PrintTimings = isatt_logical_true(Opt,"PrintTimings")
if(PrintTimings) then
start_time = get_start_time()
end if
DEBUG = isatt_logical_true(Opt,"Debug")
;---Check if the file already exists
check_for_file(FName,Opt)
;---Do we need to create a large file?
if (isatt_logical_true(Opt,"LargeFile")) then
setfileoption("nc","Format","LargeFile")
end if
lat = ndtooned(inLat)
lon = ndtooned(inLon)
if (dimsizes(lat).ne.dimsizes(lon)) then
print("unstructured_to_ESMF: latitude and longitude must have the same number of elements.")
exit
end if
;---Was a mask provided?
if(Opt.and.isatt(Opt,"Mask2D")) then
if(.not.all(product(dimsizes(Opt@Mask2D)).eq.dimsizes(lat))) then
print("unstructured_to_ESMF: Opt@Mask2D is not the correct dimensionality")
exit
else
NodeMask = ndtooned(Opt@Mask2D)
end if
else
;---No masking
NodeMask = new(dimsizes(lat), "integer","No_FillValue")
NodeMask = 1
end if
if(Opt.and.isatt(Opt,"InputFileName")) then
inputFName = Opt@InputFileName
else
inputFName = "none provided"
end if
;---Triangulate and get the element connectivity
if(DEBUG) then
print("unstructured_to_ESMF: triangulating the data ...")
end if
ElementVertices = csstri(lat,lon)
if(DEBUG) then
print("min/max ElementVertices = " + min(ElementVertices) + "/" + \
max(ElementVertices))
end if
ElementVertices_Dim = dimsizes(ElementVertices)
if(DEBUG) then
print("unstructured_to_ESMF: total number of elements created: "+ \
ElementVertices_Dim(0))
end if
;---Create the file
fid = addfile(FName,"c")
setfileoption(fid,"DefineMode",True)
;---Define the file attributes
FileAtt = True
FileAtt@gridType = "unstructured"
FileAtt@Conventions = "ESMF"
FileAtt@Createdby = "ESMF_regridding.ncl"
FileAtt@version = "0.9"
FileAtt@inputFile = inputFName
FileAtt@timeGenerated = systemfunc("date")
FileAtt@date_created = FileAtt@timeGenerated
fileattdef(fid,FileAtt)
;---Define the ESMF dimensions
nodeCount = dimsizes(lat)
elementCount = ElementVertices_Dim(0)
maxNodePElement = 3
coordDim = 2
; 0 1 2 3
FDimNames=(/ "nodeCount","elementCount","maxNodePElement","coordDim" /)
FDimSizes=(/ nodeCount , elementCount , maxNodePElement , coordDim /)
FDimUnlim=(/ False , False , False , False /)
filedimdef(fid,FDimNames,FDimSizes,FDimUnlim)
;---Define variables
filevardef(fid,"nodeCoords", "double", (/ FDimNames(0), FDimNames(3) /))
filevardef(fid,"elementConn", "integer",(/ FDimNames(1), FDimNames(2) /))
filevardef(fid,"numElementConn","byte", (/ FDimNames(1) /))
filevardef(fid,"centerCoords", "double", (/ FDimNames(1), FDimNames(3) /))
filevardef(fid,"elementArea", "double", (/ FDimNames(1) /))
filevardef(fid,"elementMask", "integer",(/ FDimNames(1) /))
;---Define the variables unit attribute
AttNodeCoords = 0
AttNodeCoords@units = "degrees"
AttElementConn = 0
AttElementConn@long_name = "Node Indices that define the element connectivity"
AttElementConn@_FillValue = -1
AttNumElementConn = 0
AttNumElementConn@long_name = "Number of nodes per element"
AttCenterCoords = 0
AttCenterCoords@units = "degrees"
AttElementArea = 0
AttElementArea@units = "radians^2"
AttElementArea@long_name = "area weights"
filevarattdef(fid,"nodeCoords", AttNodeCoords)
filevarattdef(fid,"elementConn", AttElementConn)
filevarattdef(fid,"numElementConn",AttNumElementConn)
filevarattdef(fid,"centerCoords", AttCenterCoords)
filevarattdef(fid,"elementArea", AttElementArea)
;---Prepare the file to store the values
setfileoption(fid,"DefineMode",False)
;---Store Node Coordinates
nodeCoords = new((/nodeCount,coordDim/),"double","No_FillValue")
nodeCoords(:,0) = lon
nodeCoords(:,1) = lat
fid->nodeCoords = (/nodeCoords/)
;---Store Element Connectivity
fid->elementConn = (/ElementVertices+1/)
;---Store numElementConn
numElementConn = new((/elementCount/),"byte","No_FillValue")
numElementConn = tobyte(3)
fid->numElementConn = (/numElementConn/)
;---Store center of each element, but first calculating the centeroids.
centerCoords = new((/elementCount,coordDim/),"double","No_FillValue")
centerCoords(:,0) = dim_avg(reshape(lon(ndtooned(ElementVertices)), \
(/elementCount,3/)))
centerCoords(:,1) = dim_avg(reshape(lat(ndtooned(ElementVertices)), \
(/elementCount,3/)))
fid->centerCoords = (/centerCoords/)
;---Store element area
d2r = atan(1)/45.0;
;; elementArea = new(elementCount,"double","No_FillValue")
;; Redundant? Maybe needed to remove _FillValue?
;; elementalLat = new((/elementCount,3/),"double","No_FillValue")
;; elementalLon = new((/elementCount,3/),"double","No_FillValue")
elementalLat = todouble(reshape(lat(ndtooned(ElementVertices)),(/elementCount,3/)))
elementalLon = todouble(reshape(lon(ndtooned(ElementVertices)),(/elementCount,3/)))
elementArea = todouble(gc_tarea(elementalLat,elementalLon))
delete(elementalLat)
delete(elementalLon)
if(DEBUG) then
print("unstructured_to_ESMF: Element Area: min:" + min(elementArea) + \
" max:" + max(elementArea))
end if
fid->elementArea = (/elementArea/)
;---Store the element Mask
elementMask = dim_sum(reshape(NodeMask(ndtooned(ElementVertices)), \
(/elementCount,3/)))
elementMask = where(elementMask.eq.3,1,0)
fid->elementMask = (/elementMask/)
if(PrintTimings) then
print_elapsed_time(start_time,"unstructured_to_ESMF")
end if
end ; of unstructured_to_ESMF(...)
;======================================================================
; This function receives a 2D curvilinear grid and mask and stores
; it in FName NetCDF file based on SCRIP standard.
; lat2d and lon2d must have (nlat,nlot) dimension.
; Opt controls the behavior of the function
; current attribute in Opt are:
; (1) Overwrite [Logical] if True, and if the out file already exists
; it will erase the file.
; (2) ForceOverwrite [Logical] If set to True, the user is not asked
; for removing an existing file. If set to false the user permission
; is required to remove an existing file. This is ineffective if
; Overwrite is set to False.
; (3) If GridCornerLat and GridCornerLon are set, then these will be used
; instead of calcuation the corner points for the lat/lon cells.
; The corner points are needed for the "conserve" method.
;======================================================================
undef("curvilinear_to_SCRIP")
procedure curvilinear_to_SCRIP(FName[1]:string,lat2d[*][*]:numeric,\
lon2d[*][*]:numeric,Opt[1]:logical)
local latlon_dims, nlat, nlon, fid, FileAtt, grid_siz, grid_corners, \
grid_rank, FDimNames, FDimSizes, FDimUnlim, DummyAtt1, DummyAtt2, \
GridCornerLat, GridCornerLon, grid_corner_lat, grid_corner_lon, mask2d, \
DEBUG
begin
;---Check for options
PrintTimings = isatt_logical_true(Opt,"PrintTimings")
if(PrintTimings) then
start_time = get_start_time()
end if
DEBUG = isatt_logical_true(Opt,"Debug")
;---Check if the file already exists
check_for_file(FName,Opt)
;---Do we need to create a large file?
if (isatt_logical_true(Opt,"LargeFile")) then
setfileoption("nc","Format","LargeFile")
end if
if ( any(dimsizes(lat2d).ne.dimsizes(lon2d)) ) then
print("curvilinear_to_SCRIP: latitude and longitude must have the same number of elements.")
exit
end if
latlon_dims = dimsizes(lat2d)
nlat = latlon_dims(0)
nlon = latlon_dims(1)
if(Opt.and.isatt(Opt,"Title")) then
FTitle = Opt@Title
else
FTitle = "curvilinear_to_SCRIP (" + nlat + "," + nlon + ")"
end if
;---Was a mask provided?
if(Opt.and.isatt(Opt,"Mask2D")) then
if(.not.all(dimsizes(Opt@Mask2D).eq.latlon_dims)) then
print("curvilinear_to_SCRIP: Opt@Mask2D is not the correct dimensionality")
exit
else
mask2d = Opt@Mask2D
end if
else
;---No masking
mask2d = new(latlon_dims, "integer","No_FillValue")
mask2d = 1
end if
;---Create the file
fid = addfile(FName,"c")
setfileoption(fid,"DefineMode",True)
;---Define the file attributes
FileAtt = True
FileAtt@title = FTitle
FileAtt@Conventions = "SCRIP"
FileAtt@Createdby = "ESMF_regridding.ncl"
FileAtt@date_created = systemfunc("date")
fileattdef(fid,FileAtt)
;---Define the SCRIP dimensions
grid_size = nlat*nlon ; This is number of data points (grid nodes)
grid_corners = 4
grid_rank = 2
FDimNames = (/ "grid_size","grid_corners","grid_rank" /)
FDimSizes = (/ grid_size,grid_corners,grid_rank /)
FDimUnlim = (/ False,False,False /)
filedimdef(fid,FDimNames,FDimSizes,FDimUnlim)
;---Define Variables
filevardef(fid,"grid_dims","integer","grid_rank")
filevardef(fid,"grid_center_lat","double","grid_size")
filevardef(fid,"grid_center_lon","double","grid_size")
filevardef(fid,"grid_imask","integer","grid_size")
filevardef(fid,"grid_corner_lat","double",(/ "grid_size", "grid_corners" /) )
filevardef(fid,"grid_corner_lon","double",(/ "grid_size", "grid_corners" /) )
;---Define the variables unit attribute