@@ -20,7 +20,7 @@ module model_mod
20
20
get_close_state, get_close_obs, set_location, &
21
21
VERTISHEIGHT, get_location, is_vertical, &
22
22
convert_vertical_obs, convert_vertical_state
23
-
23
+ ! EL use only nc_check was here, deleted for now for testing
24
24
use utilities_mod, only : error_handler, E_ERR, E_WARN, E_MSG, &
25
25
logfileunit, get_unit, do_output, to_upper, &
26
26
find_namelist_in_file, check_namelist_read, &
@@ -56,7 +56,10 @@ module model_mod
56
56
get_index_start, get_index_end, &
57
57
get_dart_vector_index, get_num_variables, &
58
58
get_domain_size, &
59
- get_io_clamping_minval
59
+ get_io_clamping_minval, get_kind_index
60
+
61
+ use netcdf_utilities_mod, only : nc_open_file_readonly, nc_get_variable, &
62
+ nc_get_dimension_size, nc_close_file
60
63
61
64
use netcdf
62
65
@@ -255,9 +258,16 @@ module model_mod
255
258
! standard MITgcm namelist and filled in here.
256
259
257
260
integer :: Nx=- 1 , Ny=- 1 , Nz=- 1 ! grid counts for each field
261
+ integer :: comp2d = - 1 , comp3d=- 1 , comp3dU = - 1 , comp3dV = - 1 ! size of commpressed variables
258
262
259
263
! locations of cell centers (C) and edges (G) for each axis.
260
264
real (r8 ), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:)
265
+ real (r4 ), allocatable :: XC_sq(:), YC_sq(:), XG_sq(:), YG_sq(:)
266
+ real (r8 ), allocatable :: ZC_sq(:)
267
+
268
+ integer , allocatable :: Xc_Ti(:), Yc_Ti(:), Zc_Ti(:)
269
+ integer , allocatable :: Xc_Ui(:), Yc_Ui(:), Zc_Ui(:)
270
+ integer , allocatable :: Xc_Vi(:), Yc_Vi(:), Zc_Vi(:)
261
271
262
272
real (r8 ) :: ocean_dynamics_timestep = 900.0_r4
263
273
integer :: timestepcount = 0
@@ -277,7 +287,6 @@ module model_mod
277
287
integer , parameter :: NUM_STATE_TABLE_COLUMNS = 5
278
288
character (len= vtablenamelength) :: mitgcm_variables(NUM_STATE_TABLE_COLUMNS, MAX_STATE_VARIABLES ) = ' '
279
289
280
-
281
290
character (len= 256 ) :: model_shape_file = ' '
282
291
integer :: assimilation_period_days = 7
283
292
integer :: assimilation_period_seconds = 0
@@ -292,8 +301,9 @@ module model_mod
292
301
logical :: go_to_dart = .false.
293
302
logical :: do_bgc = .false.
294
303
logical :: log_transform = .false.
304
+ logical :: compress = .false.
295
305
296
- namelist / trans_mitdart_nml/ go_to_dart, do_bgc, log_transform
306
+ namelist / trans_mitdart_nml/ go_to_dart, do_bgc, log_transform, compress
297
307
298
308
! /pkg/mdsio/mdsio_write_meta.F writes the .meta files
299
309
type MIT_meta_type
@@ -327,6 +337,7 @@ subroutine static_init_model()
327
337
328
338
integer :: i, iunit, io
329
339
integer :: ss, dd
340
+ integer :: ncid ! for reading compressed coordinates
330
341
331
342
! The Plan:
332
343
!
@@ -528,13 +539,62 @@ subroutine static_init_model()
528
539
domain_id = add_domain(model_shape_file, nvars, &
529
540
var_names, quantity_list, clamp_vals, update_list )
530
541
542
+ if (compress) then ! read in compressed coordinates
543
+
544
+ ncid = nc_open_file_readonly(model_shape_file)
545
+ comp2d = nc_get_dimension_size(ncid, ' comp2d' , ' static_init_model' , model_shape_file)
546
+ comp3d = nc_get_dimension_size(ncid, ' comp3d' , ' static_init_model' , model_shape_file)
547
+ comp3dU = nc_get_dimension_size(ncid, ' comp3dU' , ' static_init_model' , model_shape_file)
548
+ comp3dV = nc_get_dimension_size(ncid, ' comp3dV' , ' static_init_model' , model_shape_file)
549
+
550
+ allocate (XC_sq(comp3d))
551
+ allocate (YC_sq(comp3d))
552
+ allocate (ZC_sq(comp3d)) ! ZC is r8
553
+
554
+ allocate (XG_sq(comp3d))
555
+ allocate (YG_sq(comp3d))
556
+
557
+ allocate (Xc_Ti(comp3d))
558
+ allocate (Yc_Ti(comp3d))
559
+ allocate (Zc_Ti(comp3d))
560
+
561
+ allocate (Xc_Ui(comp3dU))
562
+ allocate (Yc_Ui(comp3dU))
563
+ allocate (Zc_Ui(comp3dU))
564
+
565
+ allocate (Xc_Vi(comp3dV))
566
+ allocate (Yc_Vi(comp3dV))
567
+ allocate (Zc_Vi(comp3dV))
568
+
569
+ call nc_get_variable(ncid, ' XCcomp' , XC_sq)
570
+ call nc_get_variable(ncid, ' YCcomp' , YC_sq)
571
+ call nc_get_variable(ncid, ' ZCcomp' , ZC_sq)
572
+
573
+ call nc_get_variable(ncid, ' XGcomp' , XG_sq)
574
+ call nc_get_variable(ncid, ' YGcomp' , YG_sq)
575
+
576
+ call nc_get_variable(ncid, ' Xcomp_ind' , Xc_Ti)
577
+ call nc_get_variable(ncid, ' Ycomp_ind' , Yc_Ti)
578
+ call nc_get_variable(ncid, ' Zcomp_ind' , Zc_Ti)
579
+
580
+ call nc_get_variable(ncid, ' Xcomp_indU' , Xc_Ui)
581
+ call nc_get_variable(ncid, ' Ycomp_indU' , Yc_Ui)
582
+ call nc_get_variable(ncid, ' Zcomp_indU' , Zc_Ui)
583
+
584
+ call nc_get_variable(ncid, ' Xcomp_indV' , Xc_Vi)
585
+ call nc_get_variable(ncid, ' Ycomp_indV' , Yc_Vi)
586
+ call nc_get_variable(ncid, ' Zcomp_indV' , Zc_Vi)
587
+
588
+ call nc_close_file(ncid)
589
+
590
+ endif
591
+
531
592
model_size = get_domain_size(domain_id)
532
593
533
594
if (do_output()) write (* ,* ) ' model_size = ' , model_size
534
595
535
596
end subroutine static_init_model
536
597
537
-
538
598
function get_model_size ()
539
599
!- -----------------------------------------------------------------
540
600
!
@@ -954,6 +1014,63 @@ function lon_dist(lon1, lon2)
954
1014
end function lon_dist
955
1015
956
1016
1017
+ function get_compressed_dart_vector_index (iloc , jloc , kloc , dom_id , var_id )
1018
+ ! =======================================================================
1019
+ !
1020
+
1021
+ ! returns the dart vector index for the compressed state
1022
+
1023
+ integer , intent (in ) :: iloc, jloc, kloc
1024
+ integer , intent (in ) :: dom_id, var_id
1025
+ integer (i8) :: get_compressed_dart_vector_index
1026
+
1027
+ integer :: i ! loop counter
1028
+ integer :: qty
1029
+ integer (i8) :: offset
1030
+
1031
+ offset = get_index_start(dom_id, var_id)
1032
+
1033
+ qty = get_kind_index(dom_id, var_id)
1034
+
1035
+ get_compressed_dart_vector_index = - 1
1036
+
1037
+ ! MEG: Using the already established compressed indices
1038
+ !
1039
+ ! 2D compressed variables
1040
+ if (qty == QTY_SEA_SURFACE_HEIGHT .or. qty == QTY_SURFACE_CHLOROPHYLL ) then
1041
+ do i = 1 , comp2d
1042
+ if (Xc_Ti(i) == iloc .and. Yc_Ti(i) == jloc .and. Zc_Ti(i) == 1 ) then
1043
+ get_compressed_dart_vector_index = offset + i - 1
1044
+ endif
1045
+ enddo
1046
+ return
1047
+ endif
1048
+
1049
+ ! 3D compressed variables
1050
+ if (qty == QTY_U_CURRENT_COMPONENT) then
1051
+ do i = 1 , comp3dU
1052
+ if (Xc_Ui(i) == iloc .and. Yc_Ui(i) == jloc .and. Zc_Ui(i) == kloc) then
1053
+ get_compressed_dart_vector_index = offset + i - 1
1054
+ endif
1055
+ enddo
1056
+ elseif (qty == QTY_V_CURRENT_COMPONENT) then
1057
+ do i = 1 , comp3dV
1058
+ if (Xc_Vi(i) == iloc .and. Yc_Vi(i) == jloc .and. Zc_Vi(i) == kloc) then
1059
+ get_compressed_dart_vector_index = offset + i - 1
1060
+ endif
1061
+ enddo
1062
+ else
1063
+ do i = 1 , comp3d
1064
+ if (Xc_Ti(i) == iloc .and. Yc_Ti(i) == jloc .and. Zc_Ti(i) == kloc) then
1065
+ get_compressed_dart_vector_index = offset + i - 1
1066
+ endif
1067
+ enddo
1068
+ endif
1069
+
1070
+
1071
+ end function get_compressed_dart_vector_index
1072
+
1073
+
957
1074
function get_val (lon_index , lat_index , level , var_id , state_handle ,ens_size , masked )
958
1075
! =======================================================================
959
1076
!
@@ -971,24 +1088,28 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas
971
1088
972
1089
if ( .not. module_initialized ) call static_init_model
973
1090
974
- state_index = get_dart_vector_index(lon_index, lat_index, level, domain_id, var_id)
975
- get_val = get_state(state_index,state_handle)
1091
+ masked = .false.
976
1092
977
- ! Masked returns false if the value is masked
978
- ! A grid variable is assumed to be masked if its value is FVAL.
979
- ! Just to maintain legacy, we also assume that A grid variable is assumed
980
- ! to be masked if its value is exactly 0.
981
- ! See discussion in lat_lon_interpolate.
1093
+ if (compress) then
982
1094
983
- ! MEG CAUTION: THE ABOVE STATEMENT IS INCORRECT
984
- ! trans_mitdart already looks for 0.0 and makes them FVAL
985
- ! So, in the condition below we don't need to check for zeros
986
- ! The only mask is FVAL
987
- masked = .false.
988
- do i= 1 ,ens_size
989
- ! if(get_val(i) == FVAL .or. get_val(i) == 0.0_r8 ) masked = .true.
990
- if (get_val(i) == FVAL) masked = .true.
991
- enddo
1095
+ state_index = get_compressed_dart_vector_index(lon_index, lat_index, level, domain_id, var_id)
1096
+
1097
+ if (state_index .ne. - 1 ) then
1098
+ get_val = get_state(state_index,state_handle)
1099
+ else
1100
+ masked = .true.
1101
+ endif
1102
+
1103
+ else
1104
+
1105
+ state_index = get_dart_vector_index(lon_index, lat_index, level, domain_id, var_id)
1106
+ get_val = get_state(state_index,state_handle)
1107
+
1108
+ do i= 1 ,ens_size ! HK this is checking the whole ensemble, can you have different masks for each ensemble member?
1109
+ if (get_val(i) == FVAL) masked = .true.
1110
+ enddo
1111
+
1112
+ endif
992
1113
993
1114
end function get_val
994
1115
@@ -1079,16 +1200,28 @@ subroutine get_state_meta_data(index_in, location, qty)
1079
1200
1080
1201
call get_model_variable_indices(index_in, iloc, jloc, kloc, kind_index = qty)
1081
1202
1082
- lon = XC(iloc)
1083
- lat = YC(jloc)
1084
- depth = ZC(kloc)
1203
+ if (compress) then ! all variables ae 1D
1204
+ lon = XC_sq(iloc)
1205
+ lat = YC_sq(iloc)
1206
+ depth = ZC_sq(iloc)
1207
+ ! Acounting for variables those on staggered grids
1208
+ if (qty == QTY_U_CURRENT_COMPONENT) lon = XG_sq(iloc)
1209
+ if (qty == QTY_V_CURRENT_COMPONENT) lat = YG_sq(iloc)
1210
+ else
1211
+
1212
+ lon = XC(iloc)
1213
+ lat = YC(jloc)
1214
+ depth = ZC(kloc)
1215
+
1216
+ ! Acounting for variables those on staggered grids
1217
+ if (qty == QTY_U_CURRENT_COMPONENT) lon = XG(iloc)
1218
+ if (qty == QTY_V_CURRENT_COMPONENT) lat = YG(jloc)
1219
+
1220
+ endif
1085
1221
1086
- ! Acounting for surface variables and those on staggered grids
1087
1222
! MEG: check chl's depth here
1088
1223
if (qty == QTY_SEA_SURFACE_HEIGHT .or. &
1089
1224
qty == QTY_SURFACE_CHLOROPHYLL) depth = 0.0_r8
1090
- if (qty == QTY_U_CURRENT_COMPONENT) lon = XG(iloc)
1091
- if (qty == QTY_V_CURRENT_COMPONENT) lat = YG(jloc)
1092
1225
1093
1226
location = set_location(lon, lat, depth, VERTISHEIGHT)
1094
1227
@@ -1297,6 +1430,8 @@ end subroutine nc_write_model_atts
1297
1430
!- -----------------------------------------------------------------
1298
1431
! Create an ensemble of states from a single state.
1299
1432
1433
+ ! Note if you perturb a compressed state, this will not be bitwise
1434
+ ! with perturbing a non-compressed state.
1300
1435
subroutine pert_model_copies (state_ens_handle , ens_size , pert_amp , interf_provided )
1301
1436
1302
1437
type (ensemble_type), intent (inout ) :: state_ens_handle
0 commit comments