From 6547eaa09fbe70737b6cd3adc4dfffaee27d078e Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 12 Apr 2024 10:48:42 -0400 Subject: [PATCH 01/23] cice-scm work from Molly Wieringa summer visit cice single colum model work from: Molly Wieringa Chris Riedel Cecilia Bitz This reverts commit 0932d47638f406707ae7adca25cf9c0b471ef249. --- models/cice-scm2/dart_cice_mod.f90 | 216 ++++ models/cice-scm2/dart_to_cice.f90 | 578 ++++++++++ models/cice-scm2/model_mod.f90 | 1071 ++++++++++++++++++ models/cice-scm2/readme.rst | 5 + models/cice-scm2/work/algorithm_info_mod.f90 | 215 ++++ models/cice-scm2/work/input.nml | 220 ++++ models/cice-scm2/work/quickbuild.sh | 60 + 7 files changed, 2365 insertions(+) create mode 100644 models/cice-scm2/dart_cice_mod.f90 create mode 100644 models/cice-scm2/dart_to_cice.f90 create mode 100644 models/cice-scm2/model_mod.f90 create mode 100644 models/cice-scm2/readme.rst create mode 100644 models/cice-scm2/work/algorithm_info_mod.f90 create mode 100644 models/cice-scm2/work/input.nml create mode 100755 models/cice-scm2/work/quickbuild.sh diff --git a/models/cice-scm2/dart_cice_mod.f90 b/models/cice-scm2/dart_cice_mod.f90 new file mode 100644 index 0000000000..5abe47e686 --- /dev/null +++ b/models/cice-scm2/dart_cice_mod.f90 @@ -0,0 +1,216 @@ +! DART software - Copyright UCAR. This open source software is provided +! by UCAR, "as is", without charge, subject to all terms of use at +! http://www.image.ucar.edu/DAReS/DART/DART_download +! +! $Id$ + +module dart_cice_mod + +use types_mod, only : r8, rad2deg, PI, SECPERDAY, digits12 +use time_manager_mod, only : time_type, get_date, set_date, get_time, set_time, & + set_calendar_type, get_calendar_string, & + print_date, print_time, operator(==), operator(-) +use utilities_mod, only : get_unit, open_file, close_file, file_exist, & + register_module, error_handler, & + find_namelist_in_file, check_namelist_read, & + E_ERR, E_MSG, find_textfile_dims + +use netcdf_utilities_mod, only : nc_check + + +use typesizes +use netcdf + +implicit none +private + +public :: set_model_time_step,get_horiz_grid_dims, & + get_ncat_dim, read_horiz_grid + +character(len=*), parameter :: source = "$URL$" +character(len=*), parameter :: revision = "$Revision$" +character(len=*), parameter :: revdate = "$Date$" + +character(len=512) :: msgstring +logical, save :: module_initialized = .false. + +character(len=256) :: ic_filename = 'cice.r.nc' + +contains + +subroutine initialize_module + +integer :: iunit, io + +! Read calendar information +! In 'restart' mode, this is primarily the calendar type and 'stop' +! information. The time attributes of the restart file override +! the namelist time information. + +! FIXME : Real observations are always GREGORIAN dates ... +! but stomping on that here gets in the way of running +! a perfect_model experiment for pre-1601 AD cases. +call set_calendar_type('gregorian') + +! Make sure we have a cice restart file (for grid dims) +if ( .not. file_exist(ic_filename) ) then + msgstring = 'dart_cice_mod: '//trim(ic_filename)//' not found' + call error_handler(E_ERR,'initialize_module', & + msgstring, source, revision, revdate) +endif + +module_initialized = .true. + +! Print module information to log file and stdout. +call register_module(source, revision, revdate) + +end subroutine initialize_module +!!!!!!!!!!!!!!!! +function set_model_time_step() + +! the initialize_module ensures that the cice namelists are read. +! The restart times in the cice_in&restart_nml are used to define +! appropriate assimilation timesteps. +! +type(time_type) :: set_model_time_step + +if ( .not. module_initialized ) call initialize_module + +! Check the 'restart_option' and 'restart_n' to determine +! when we can stop the model +! CMB not sure if nday is actually different than ndays, no matter here though +!if ( (trim(restart_option) == 'ndays') .or. (trim(restart_option) == 'nday' ) ) then +! set_model_time_step = set_time(0, restart_n) ! (seconds, days) +!else if ( trim(restart_option) == 'nyears' ) then + ! FIXME ... CMB I guess we ignore it and make the freq 1 day anyway? + set_model_time_step = set_time(0, 1) ! (seconds, days) +!else +! call error_handler(E_ERR,'set_model_time_step', & +! 'restart_option must be ndays or nday', source, revision, revdate) +!endif + +end function set_model_time_step +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine get_horiz_grid_dims(Nx) + +! +! Read the lon, lat grid size from the restart netcdf file. +! The actual grid file is a binary file with no header information. +! +! The file name comes from module storage ... namelist. + +integer, intent(out) :: Nx ! Number of Longitudes + +integer :: grid_id, dimid, nc_rc + +if ( .not. module_initialized ) call initialize_module + +call nc_check(nf90_open(trim(ic_filename), nf90_nowrite, grid_id), & + 'get_horiz_grid_dims','open '//trim(ic_filename)) + +! Longitudes : get dimid for 'ni' or 'nlon', and then get value +nc_rc = nf90_inq_dimid(grid_id, 'ni', dimid) +if (nc_rc /= nf90_noerr) then + msgstring = "unable to find either 'ni' or 'nlon' in file "//trim(ic_filename) + call error_handler(E_ERR, 'get_horiz_grid_dims', msgstring, & + source,revision,revdate) +endif + +call nc_check(nf90_inquire_dimension(grid_id, dimid, len=Nx), & + 'get_horiz_grid_dims','inquire_dimension ni '//trim(ic_filename)) + +call nc_check(nf90_close(grid_id), & + 'get_horiz_grid_dims','close '//trim(ic_filename) ) + +end subroutine get_horiz_grid_dims +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine get_ncat_dim(Ncat) + +! +! Read the ncat size from the restart netcdf file. + +integer, intent(out) :: Ncat ! Number of categories in ice-thick dist + +integer :: grid_id, dimid, nc_rc + +if ( .not. module_initialized ) call initialize_module + +call nc_check(nf90_open(trim(ic_filename), nf90_nowrite, grid_id), & + 'get_ncat_dim','open '//trim(ic_filename)) + +! ncat : get dimid for 'ncat' and then get value +nc_rc = nf90_inq_dimid(grid_id, 'ncat', dimid) +if (nc_rc /= nf90_noerr) then + nc_rc = nf90_inq_dimid(grid_id, 'Ncat', dimid) + if (nc_rc /= nf90_noerr) then + msgstring = "unable to find either 'ncat' or 'Ncat' in file "//trim(ic_filename) + call error_handler(E_ERR, 'get_horiz_grid_dims', msgstring, & + source,revision,revdate) + endif +endif + +call nc_check(nf90_inquire_dimension(grid_id, dimid, len=Ncat), & + 'get_ncat_dim','inquire_dimension ni '//trim(ic_filename)) + +! tidy up + +call nc_check(nf90_close(grid_id), & + 'get_ncat_dim','close '//trim(ic_filename) ) + +end subroutine get_ncat_dim +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine read_horiz_grid(nx, TLAT, TLON) + +integer, intent(in) :: nx +real(r8), dimension(nx), intent(out) :: TLAT, TLON + +integer :: grid_id, reclength,VarId,status + +if ( .not. module_initialized ) call initialize_module + +! Check to see that the file exists. + +if ( .not. file_exist(ic_filename) ) then + msgstring = 'cice grid '//trim(ic_filename)//' not found' + call error_handler(E_ERR,'read_horiz_grid', & + msgstring, source, revision, revdate) +endif + +! Open it and read them in the EXPECTED order. +! Actually, we only need the first two, so I'm skipping the rest. + +call nc_check(nf90_open(trim(ic_filename), nf90_nowrite, grid_id), & + 'read_horiz_grid','open '//trim(ic_filename)) +! Latitude +call nc_check(nf90_inq_varid(grid_id, 'tlat', VarId), & + 'read_horiz_grid','inquiring tlat from '//trim(ic_filename)) +call nc_check(nf90_get_var(grid_id, VarId, TLAT, & + start=(/1/), & + count=(/nx/)), & +'read_horiz_grid','getting tlat from '//trim(ic_filename)) +!Longitude +call nc_check(nf90_inq_varid(grid_id, 'tlon', VarId), & +'read_horiz_grid','inquiring tlon from '//trim(ic_filename)) +call nc_check(nf90_get_var(grid_id, VarId, TLON, & + start=(/1/), & + count=(/nx/)), & + 'read_horiz_grid','getting tlon from '//trim(ic_filename)) + +call nc_check(nf90_close(grid_id), & + 'read_horiz_grid','close '//trim(ic_filename) ) + +TLAT = TLAT * rad2deg +TLON = TLON * rad2deg + +! ensure [0,360) [-90,90] + +where (TLON < 0.0_r8) TLON = TLON + 360.0_r8 +where (TLON > 360.0_r8) TLON = TLON - 360.0_r8 + +where (TLAT < -90.0_r8) TLAT = -90.0_r8 +where (TLAT > 90.0_r8) TLAT = 90.0_r8 + +end subroutine read_horiz_grid + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +end module dart_cice_mod diff --git a/models/cice-scm2/dart_to_cice.f90 b/models/cice-scm2/dart_to_cice.f90 new file mode 100644 index 0000000000..3882e2fd7c --- /dev/null +++ b/models/cice-scm2/dart_to_cice.f90 @@ -0,0 +1,578 @@ +! DART software - Copyright UCAR. This open source software is provided +! by UCAR, "as is", without charge, subject to all terms of use at +! http://www.image.ucar.edu/DAReS/DART/DART_download +! +! $Id$ + +program dart_to_cice + +!---------------------------------------------------------------------- +! purpose: implement a 'partition function' to modify the cice state +! to be consistent with the states from assimilation +! +! method: Read in restart (restart with prior) and out restart (restart +! with posterior) written by DART after filter. +! +! author: C Bitz June 2016 +!---------------------------------------------------------------------- + +use types_mod, only : r8 +use utilities_mod, only : initialize_utilities, finalize_utilities, & + find_namelist_in_file, check_namelist_read, & + file_exist, error_handler, E_ERR, E_MSG, to_upper +use netcdf_utilities_mod, only : nc_check +use netcdf + + +implicit none + +! version controlled file description for error handling, do not edit +character(len=*), parameter :: source = & + "$URL$" +character(len=*), parameter :: revision = "$Revision$" +character(len=*), parameter :: revdate = "$Date$" + +!------------------------------------------------------------------ + +character(len=256) :: dart_to_cice_input_file = 'dart_restart.nc' +character(len=256) :: original_cice_input_file = 'cice_restart.nc' +character(len=256) :: previous_cice_input_file = 'pre_restart.nc' +character(len=128) :: balance_method = 'simple_squeeze' +character(len=15) :: r_snw_name = 'r_snw' +integer :: gridpt_oi = 3 + +namelist /dart_to_cice_nml/ dart_to_cice_input_file, & + original_cice_input_file, & + previous_cice_input_file, & + balance_method, & + r_snw_name, & + gridpt_oi + +character(len=512) :: string1, string2, msgstring +character(len=15) :: varname +character(len=128) :: method + +integer :: Nx +integer :: Ncat ! number of categories in ice-thickness dist +integer, parameter :: Nilyr = 8 ! number of layers in ice, hardwired +integer, parameter :: Nslyr = 3 ! number of layers in snow, hardwired + +real(r8), allocatable :: aicen_original(:) +real(r8), allocatable :: vicen_original(:) +real(r8), allocatable :: vsnon_original(:) +!real(r8), allocatable :: aice_original(:,:) +!real(r8), allocatable :: hicen_original(:) +!real(r8), allocatable :: hsnon_original(:) +logical :: sst_present = .true. +logical :: sst_org_present = .true. + +real(r8) :: sst,sst_original +real(r8), allocatable :: aicen(:) +real(r8), allocatable :: vicen(:) +real(r8), allocatable :: vsnon(:) +real(r8), allocatable :: Tsfcn(:) +real(r8), allocatable :: qice(:,:) +real(r8), allocatable :: sice(:,:) +real(r8), allocatable :: qsno(:,:) + +character (len=3) :: nchar +integer :: iunit,io,ncid,dimid,l,n,VarID +real(r8) :: aice,aice_temp +real(r8) :: vice,vice_temp +real(r8) :: vsno,vsno_temp +real(r8), parameter :: Tsmelt = 0._r8 +real(r8), parameter :: c1 = 1.0_r8 +real(r8), parameter :: & + phi_init = 0.75_r8, & + dSin0_frazil = 3.0_r8 +real(r8), parameter :: sss = 34.7_r8 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +real(r8) :: squeeze,cc1,cc2,cc3,x1,Si0new,Ti,qsno_hold,qi0new +real(r8), allocatable :: hin_max(:) +real(r8), allocatable :: hcat_midpoint(:) + +call initialize_utilities(progname='dart_to_cice') + +call find_namelist_in_file("input.nml", "dart_to_cice_nml", iunit) +read(iunit, nml = dart_to_cice_nml, iostat = io) +call check_namelist_read(iunit, io, "dart_to_cice_nml") + +method = balance_method +call to_upper(method) + +! check on namelist stuff, and whether files exist +write(string1,*) 'converting DART output file "'// & + &trim(dart_to_cice_input_file)//'" to one CICE will like' +write(string2,*) 'using the "'//trim(balance_method)//'" method.' +call error_handler(E_MSG,'dart_to_cice',string1,text2=string2) + +if ( .not. file_exist(dart_to_cice_input_file) ) then + write(string1,*) 'cannot open "', trim(dart_to_cice_input_file),'" for updating.' + call error_handler(E_ERR,'dart_to_cice:filename not found ',trim(dart_to_cice_input_file)) +endif + +if ( .not. file_exist(original_cice_input_file) ) then + write(string1,*) 'cannot open "', trim(original_cice_input_file),'" for reading.' + call error_handler(E_ERR,'dart_to_cice:filename not found ',trim(original_cice_input_file)) +endif + + +call nc_check( nf90_open(trim(original_cice_input_file), NF90_NOWRITE, ncid), & + 'dart_to_cice', 'open "'//trim(original_cice_input_file)//'"') + +call nc_check(nf90_inq_dimid(ncid,"ncat",dimid), & + 'dart_to_cice', 'inquire ncat dimid from "'//trim(original_cice_input_file)//'"') +call nc_check(nf90_inquire_dimension(ncid,dimid,len=Ncat), & + 'dart_to_cice', 'inquire ncat from "'//trim(original_cice_input_file)//'"') +call nc_check(nf90_inq_dimid(ncid,"ni",dimid), & + 'dart_to_cice', 'inquire ni dimid from "'//trim(original_cice_input_file)//'"') +call nc_check(nf90_inquire_dimension(ncid,dimid,len=Nx),& + 'dart_to_cice', 'inquire ni from "'//trim(original_cice_input_file)//'"') + +allocate(aicen_original(NCAT),vicen_original(NCAT),vsnon_original(NCAT),Tsfcn(NCAT),qice(Nilyr,NCAT),sice(Nilyr,NCAT),qsno(Nslyr,NCAT)) +call get_variable(ncid,'aicen',aicen_original,original_cice_input_file,gridpt_oi,Ncat) +call get_variable(ncid,'vicen',vicen_original,original_cice_input_file,gridpt_oi,Ncat) +call get_variable(ncid,'vsnon',vsnon_original,original_cice_input_file,gridpt_oi,Ncat) +call get_variable(ncid,'Tsfcn',Tsfcn,dart_to_cice_input_file,gridpt_oi,Ncat) +call get_variable1d(ncid,'sst',sst_original,dart_to_cice_input_file,gridpt_oi,sst_org_present) +do l=1, Nilyr + write(nchar,'(i3.3)') l + call get_variable(ncid,'qice'//trim(nchar),qice(l,:),dart_to_cice_input_file,gridpt_oi,Ncat) + call get_variable(ncid,'sice'//trim(nchar),sice(l,:),dart_to_cice_input_file,gridpt_oi,Ncat) +enddo +do l=1, Nslyr + write(nchar,'(i3.3)') l + call get_variable(ncid,'qsno'//trim(nchar),qsno(l,:),dart_to_cice_input_file,gridpt_oi,Ncat) +enddo +call nc_check(nf90_close(ncid),'dart_to_cice', 'close '//trim(original_cice_input_file)) +!!!!!!!!! +call nc_check( nf90_open(trim(dart_to_cice_input_file), NF90_NOWRITE, ncid), & + 'dart_to_cice', 'open "'//trim(dart_to_cice_input_file)//'"') +allocate(aicen(NCAT),vicen(NCAT),vsnon(NCAT)) +call get_variable(ncid,'aicen',aicen,dart_to_cice_input_file,gridpt_oi,Ncat) +call get_variable(ncid,'vicen',vicen,dart_to_cice_input_file,gridpt_oi,Ncat) +call get_variable(ncid,'vsnon',vsnon,dart_to_cice_input_file,gridpt_oi,Ncat) +call get_variable1d(ncid,'sst',sst,dart_to_cice_input_file,gridpt_oi,sst_present) +call nc_check(nf90_close(ncid),'dart_to_cice', 'close '//trim(dart_to_cice_input_file)) +!!!!!!!!!!!!!!!!!!!!!!!!! +qice = min(0.0_r8,qice) +sice = max(0.0_r8,sice) +qsno = min(0.0_r8,qsno) +aicen = min(1.0_r8,aicen) +Tsfcn = min(Tsmelt,Tsfcn) +!!!!!! +aice = sum(aicen) +vice = sum(vicen) +vsno = sum(vsnon) +!!!!!! +aicen = max(0.0_r8,aicen) +vicen = max(0.0_r8,vicen) +vsnon = max(0.0_r8,vsnon) +!!!!! +aice_temp = sum(aicen) +vice_temp = sum(vicen) +vsno_temp = sum(vsnon) +!!!!! +if (aice<0.0_r8) then + aicen(:) = 0.0_r8 + vicen(:) = 0.0_r8 + vsnon(:) = 0.0_r8 +endif +!!!!! +do n=1,NCAT + if (aice_temp > 0._r8 .and. aice>0._r8) then + aicen(n) = aicen(n) - (aice_temp-aice)*aicen(n)/aice_temp + endif + if (vice_temp > 0._r8 .and. vice>0._r8) then + vicen(n) = vicen(n) - (vice_temp-vice)*vicen(n)/vice_temp + endif + if (vsno_temp > 0._r8 .and. vsno > 0._r8) then + vsnon(n) = vsnon(n) - (vsno_temp-vsno)*vsnon(n)/vsno_temp + endif +enddo +!!!! +if (aice>1.0_r8) then + squeeze = 1.0_r8/aice + aicen(:) = aicen(:)*squeeze +endif +!!!!!! +if (sst_present) then + if (aice == 0.0_r8) sst = 0.0_r8 +endif +where(aicen==-999) aicen = 0.0_r8 +!!!!!! +cc1 = 3._r8/real(Ncat,kind=r8) +cc2 = 15.0_r8*cc1 +cc3 = 3._r8 +allocate( hin_max(0:Ncat) ) +allocate( hcat_midpoint(Ncat) ) +hin_max(0) = 0._r8 +do n = 1, NCAT + x1 = real(n-1,kind=r8) / real(Ncat,kind=r8) + hin_max(n) = hin_max(n-1) & + + cc1 + cc2*(c1 + tanh(cc3*(x1-c1))) + hcat_midpoint(n)=0.5_r8*(hin_max(n-1)+hin_max(n)) +enddo +!!!!!!! +do n=1,NCAT + if (aicen(n) > 0.0_r8 .and. aicen_original(n) > 0.0_r8) then + if (vicen(n) == 0.0_r8) then + vicen(n) = aicen(n)*hcat_midpoint(n) + endif + endif + if (aicen(n) == 0.0_r8 .and. aicen_original(n) > 0.0_r8) then + vicen(n) = 0.0_r8 + qice(:,n) = 0.0_r8 + sice(:,n) = 0.0_r8 + qsno(:,n) = 0.0_r8 + vsnon(n) = 0.0_r8 + Tsfcn(n) = -1.8_r8 + else if (aicen(n)>0.0_r8 .and. aicen_original(n) == 0.0_r8) then + if (vicen(n) == 0.0_r8) vicen(n) = aicen(n) * hcat_midpoint(n) + Si0new = sss - dSin0_frazil + sice(:,n) = Si0new + Ti = min(liquidus_temperature_mush(Si0new/phi_init), -0.1_r8) + qi0new = enthalpy_mush(Ti, Si0new) + qice(:,n) = qi0new + if (vsnon(n) == 0.0_r8 .and. vsnon_original(n) > 0.0_r8) then + qsno(:,n) = 0.0_r8 + else if (vsnon(n) > 0.0_r8 .and. vsnon_original(n) == 0.0_r8) then + qsno_hold = snow_enthaply(Ti) + qsno(:,n) = qsno_hold + endif + Tsfcn(n) = Ti + endif + if (aicen(n) == 0.0_r8) then + vicen(n) = 0.0_r8 + vsnon(n) = 0.0_r8 + endif +enddo +!!!!!!!! +call nc_check( nf90_open(trim(original_cice_input_file), NF90_WRITE, ncid), & + 'dart_to_cice', 'open "'//trim(original_cice_input_file)//'"') +varname='aicen' +io = nf90_inq_varid(ncid, trim(varname), VarID) +call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) +io = nf90_put_var(ncid, VarID, aicen,start=(/gridpt_oi,1/),count=(/1,NCAT/)) +call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) +!!!! +varname='vicen' +io = nf90_inq_varid(ncid, trim(varname), VarID) +call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) +io = nf90_put_var(ncid, VarID, vicen,start=(/gridpt_oi,1/),count=(/1,NCAT/)) +call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) +!!!! +varname='vsnon' +io = nf90_inq_varid(ncid, trim(varname), VarID) +call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) +io = nf90_put_var(ncid, VarID, vsnon,start=(/gridpt_oi,1/),count=(/1,NCAT/)) +call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) +!!!! +varname='Tsfcn' +io = nf90_inq_varid(ncid, trim(varname), VarID) +call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) +io = nf90_put_var(ncid, VarID, Tsfcn,start=(/gridpt_oi,1/),count=(/1,NCAT/)) +call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) +!!!!! +if (sst_present) then + varname='sst' + io = nf90_inq_varid(ncid, trim(varname), VarID) + call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) + io = nf90_put_var(ncid, VarID, sst,start=(/gridpt_oi/))!,count=(/1/)) + call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) +endif +!!!!! +do l=1, Nilyr + write(nchar,'(i3.3)') l + varname='qice'//trim(nchar) + io = nf90_inq_varid(ncid, trim(varname), VarID) + call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) + io = nf90_put_var(ncid, VarID, qice(l,:),start=(/gridpt_oi,1/),count=(/1,NCAT/)) + call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) + !!!!!!!!!! + varname='sice'//trim(nchar) + io = nf90_inq_varid(ncid, trim(varname), VarID) + call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) + io = nf90_put_var(ncid, VarID, sice(l,:),start=(/gridpt_oi,1/),count=(/1,NCAT/)) + call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) +enddo +!!!! +do l=1, Nslyr + write(nchar,'(i3.3)') l + varname='qsno'//trim(nchar) + io = nf90_inq_varid(ncid, trim(varname), VarID) + call nc_check(io, 'dart_to_cice', & + 'inq_varid '//trim(varname)//' '//trim(original_cice_input_file)) + io = nf90_put_var(ncid, VarID, qsno(l,:),start=(/gridpt_oi,1/),count=(/1,NCAT/)) + call nc_check(io, 'dart_to_cice', & + 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) +enddo + +call nc_check(nf90_close(ncid),'dart_to_cice', 'close '//trim(original_cice_input_file)) + +deallocate( aicen, vicen, vsnon, Tsfcn) +deallocate( qice, sice, qsno ) + + +call finalize_utilities('dart_to_cice') + + +contains + +subroutine get_variable(ncid,varname,var,filename,space_index,ncat) +integer, intent(in) :: ncid,ncat +character(len=*), intent(in) :: varname +real(r8), intent(out) :: var(ncat) +character(len=*), intent(in) :: filename +integer, intent(in) :: space_index + +integer :: VarID, ndims, dimIDs +real(r8) :: holder(4,ncat) + +write(6,*) 'Getting data for ',trim(varname) + +io = nf90_inq_varid(ncid, trim(varname), VarID) +call nc_check(io, 'dart_to_cice', 'inq_varid '//trim(msgstring)) + +call nc_check(nf90_get_var(ncid, VarID, holder), 'dart_to_cice', & + 'get_var '//trim(msgstring)) + + +var(:) = holder(gridpt_oi,:) + +end subroutine get_variable +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine get_variable1d(ncid,varname,var,filename,space_index,var_present) +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(r8), intent(out) :: var +character(len=*), intent(in) :: filename +integer, intent(in) :: space_index +logical, intent(inout) :: var_present + +integer :: VarID, ndims, dimIDs +real(r8) :: holder(4) + +write(6,*) 'Getting data for ',trim(varname) + +io = nf90_inq_varid(ncid, trim(varname), VarID) +if(io /= nf90_NoErr) then + write(6,*) "No netcdf ID for ",trim(varname) + var_present = .false. + return +endif +call nc_check(io, 'dart_to_cice', 'inq_varid '//trim(msgstring)) + +call nc_check(nf90_get_var(ncid, VarID, holder), 'dart_to_cice', & + 'get_var '//trim(msgstring)) + + +var = holder(gridpt_oi) + +end subroutine get_variable1d +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +function enthalpy_mush(zTin, zSin) result(zqin) + + ! enthalpy of mush from mush temperature and bulk salinity + + real(r8), intent(in) :: & + zTin, & ! ice layer temperature (C) + zSin ! ice layer bulk salinity (ppt) + + real(r8) :: & + zqin ! ice layer enthalpy (J m-3) + + real(r8) :: & + phi ! ice liquid fraction + +! from shr_const_mod.F90 + real(r8),parameter :: SHR_CONST_CPSW = 3.996e3_R8 ! specific heat of sea water ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPICE = 2.11727e3_R8 ! specific heat of fresh ice ~ J/kg/K + real(R8),parameter :: SHR_CONST_RHOSW = 1.026e3_R8 ! density of sea water ~ kg/m^3 + real(R8),parameter :: SHR_CONST_RHOICE= 0.917e3_R8 ! density of ice ~ kg/m^3 + real(R8),parameter :: SHR_CONST_LATICE= 3.337e5_R8 ! latent heat of fusion ~ J/kg + + +! from cice/src/drivers/cesm/ice_constants.F90 + real(r8) :: cp_ocn, cp_ice, rhoi, rhow, Lfresh + + cp_ice = SHR_CONST_CPICE ! specific heat of fresh ice (J/kg/K) + cp_ocn = SHR_CONST_CPSW ! specific heat of ocn (J/kg/K) + rhoi = SHR_CONST_RHOICE ! density of ice (kg/m^3) + rhow = SHR_CONST_RHOSW ! density of seawater (kg/m^3) + Lfresh = SHR_CONST_LATICE ! latent heat of melting of fresh ice (J/kg) + + phi = liquid_fraction(zTin, zSin) + + zqin = phi * (cp_ocn * rhow - cp_ice * rhoi) * zTin + & + rhoi * cp_ice * zTin - (1._r8 - phi) * rhoi * Lfresh + + end function enthalpy_mush +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +function liquid_fraction(zTin, zSin) result(phi) + + ! liquid fraction of mush from mush temperature and bulk salinity + + real(r8), intent(in) :: & + zTin, & ! ice layer temperature (C) + zSin ! ice layer bulk salinity (ppt) + + real(r8) :: & + phi , & ! liquid fraction + Sbr ! brine salinity (ppt) + + real (r8), parameter :: puny = 1.0e-11_r8 ! cice/src/drivers/cesm/ice_constants.F90 + + Sbr = max(liquidus_brine_salinity_mush(zTin),puny) + phi = zSin / max(Sbr, zSin) + + end function liquid_fraction +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +function snow_enthaply(Ti) result(qsno) + real(r8), intent(in) :: Ti + + real(r8),parameter :: rhos = 330.0_r8, & + Lfresh = 2.835e6_r8 - 2.501e6_r8, & + cp_ice = 2106._r8 + real(r8) :: qsno + + qsno = -rhos*(Lfresh - cp_ice*min(0.0_r8,Ti)) + end function snow_enthaply +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +function liquidus_brine_salinity_mush(zTin) result(Sbr) + + ! liquidus relation: equilibrium brine salinity as function of temperature + ! based on empirical data from Assur (1958) + + real(r8), intent(in) :: & + zTin ! ice layer temperature (C) + + real(r8) :: & + Sbr ! ice brine salinity (ppt) + + real(r8) :: & + t_high , & ! mask for high temperature liquidus region + lsubzero ! mask for sub-zero temperatures + + !constant numbers from ice_constants.F90 + real(r8), parameter :: & + c1 = 1.0_r8 , & + c1000 = 1000_r8 + + ! liquidus relation - higher temperature region + real(r8), parameter :: & + az1_liq = -18.48_r8 ,& + bz1_liq = 0.0_r8 + + ! liquidus relation - lower temperature region + real(r8), parameter :: & + az2_liq = -10.3085_r8, & + bz2_liq = 62.4_r8 + + ! liquidus break + real(r8), parameter :: & + Tb_liq = -7.6362968855167352_r8 + + ! basic liquidus relation constants + real(r8), parameter :: & + az1p_liq = az1_liq / c1000, & + bz1p_liq = bz1_liq / c1000, & + az2p_liq = az2_liq / c1000, & + bz2p_liq = bz2_liq / c1000 + + ! temperature to brine salinity + real(r8), parameter :: & + J1_liq = bz1_liq / az1_liq , & + K1_liq = c1 / c1000 , & + L1_liq = (c1 + bz1p_liq) / az1_liq , & + J2_liq = bz2_liq / az2_liq , & + K2_liq = c1 / c1000 , & + L2_liq = (c1 + bz2p_liq) / az2_liq + + t_high = merge(1._r8, 0._r8, (zTin > Tb_liq)) + lsubzero = merge(1._r8, 0._r8, (zTin <= 1._r8)) + + Sbr = ((zTin + J1_liq) / (K1_liq * zTin + L1_liq)) * t_high + & + ((zTin + J2_liq) / (K2_liq * zTin + L2_liq)) * (1._r8 - t_high) + + Sbr = Sbr * lsubzero + + end function liquidus_brine_salinity_mush +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +function liquidus_temperature_mush(Sbr) result(zTin) + + ! liquidus relation: equilibrium temperature as function of brine salinity + ! based on empirical data from Assur (1958) + + real(r8), intent(in) :: & + Sbr ! ice brine salinity (ppt) + + real(r8) :: & + zTin ! ice layer temperature (C) + + real(r8) :: & + t_high ! mask for high temperature liquidus region + + ! liquidus break + real(r8), parameter :: & + Sb_liq = 123.66702800276086_r8 ! salinity of liquidus break + + ! constant numbers from ice_constants.F90 + real(r8), parameter :: & + c1 = 1.0_r8 , & + c1000 = 1000_r8 + + ! liquidus relation - higher temperature region + real(r8), parameter :: & + az1_liq = -18.48_r8 ,& + bz1_liq = 0.0_r8 + + ! liquidus relation - lower temperature region + real(r8), parameter :: & + az2_liq = -10.3085_r8, & + bz2_liq = 62.4_r8 + + ! basic liquidus relation constants + real(r8), parameter :: & + az1p_liq = az1_liq / c1000, & + bz1p_liq = bz1_liq / c1000, & + az2p_liq = az2_liq / c1000, & + bz2p_liq = bz2_liq / c1000 + + ! brine salinity to temperature + real(r8), parameter :: & + M1_liq = az1_liq , & + N1_liq = -az1p_liq , & + O1_liq = -bz1_liq / az1_liq , & + M2_liq = az2_liq , & + N2_liq = -az2p_liq , & + O2_liq = -bz2_liq / az2_liq + + t_high = merge(1._r8, 0._r8, (Sbr <= Sb_liq)) + + zTin = ((Sbr / (M1_liq + N1_liq * Sbr)) + O1_liq) * t_high + & + ((Sbr / (M2_liq + N2_liq * Sbr)) + O2_liq) * (1._r8 - t_high) + + end function liquidus_temperature_mush +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +end program dart_to_cice + +! +! $URL$ +! $Id$ +! $Revision$ +! $Date$ diff --git a/models/cice-scm2/model_mod.f90 b/models/cice-scm2/model_mod.f90 new file mode 100644 index 0000000000..a2c1b617ed --- /dev/null +++ b/models/cice-scm2/model_mod.f90 @@ -0,0 +1,1071 @@ +! DART software - Copyright UCAR. This open source software is provided +! by UCAR, "as is", without charge, subject to all terms of use at +! http://www.image.ucar.edu/DAReS/DART/DART_download +! +! $Id$ + +module model_mod + +! This is a template showing the interfaces required for a model to be compliant +! with the DART data assimilation infrastructure. The public interfaces listed +! must all be supported with the argument lists as indicated. Many of the interfaces +! are not required for minimal implementation (see the discussion of each +! interface and look for NULL INTERFACE). + +! Modules that are absolutely required for use are listed +use types_mod, only : i4, r8, i8, MISSING_R8, metadatalength +use time_manager_mod, only : time_type, set_time, set_time_missing,set_calendar_type,get_time, & + set_date, get_date +use location_mod, only : location_type, get_close_type, & + get_close_obs, get_dist,& + convert_vertical_obs, convert_vertical_state, & + set_location, set_location_missing,VERTISLEVEL, & + get_location, & + loc_get_close_state => get_close_state +use utilities_mod, only : register_module, error_handler, & + E_ERR, E_MSG, logfileunit, & + nmlfileunit, do_output, do_nml_file, do_nml_term, & + find_namelist_in_file, check_namelist_read,to_upper, & + file_exist +use netcdf_utilities_mod, only : nc_add_global_attribute, nc_synchronize_file, & + nc_add_global_creation_time, & + nc_begin_define_mode, nc_end_define_mode, & + nc_check +use state_structure_mod, only : add_domain, get_domain_size +use ensemble_manager_mod, only : ensemble_type +use distributed_state_mod, only : get_state +use default_model_mod, only : pert_model_copies, nc_write_model_vars, init_conditions, & + init_time, adv_1step +use dart_cice_mod, only : set_model_time_step,get_horiz_grid_dims, & + get_ncat_dim, read_horiz_grid +use state_structure_mod, only : state_structure_info,get_index_start, get_num_variables, & + get_dart_vector_index, get_model_variable_indices +use obs_kind_mod, only : QTY_SEAICE_AGREG_CONCENTR , & + QTY_SEAICE_AGREG_VOLUME , & + QTY_SEAICE_AGREG_SNOWVOLUME, & + QTY_SEAICE_AGREG_THICKNESS , & + QTY_SEAICE_AGREG_SNOWDEPTH , & + QTY_SEAICE_CATEGORY , & + QTY_U_SEAICE_COMPONENT , & + QTY_V_SEAICE_COMPONENT , & + QTY_SEAICE_ALBEDODIRVIZ , & + QTY_SEAICE_ALBEDODIRNIR , & + QTY_SEAICE_ALBEDOINDVIZ , & + QTY_SEAICE_ALBEDOINDNIR , & + QTY_SEAICE_CONCENTR , & + QTY_SEAICE_VOLUME , & + QTY_SEAICE_SNOWVOLUME , & + QTY_SEAICE_SURFACETEMP , & + QTY_SEAICE_FIRSTYEARAREA , & + QTY_SEAICE_ICEAGE , & + QTY_SEAICE_LEVELAREA , & + QTY_SEAICE_LEVELVOLUME , & + QTY_SEAICE_MELTPONDAREA , & + QTY_SEAICE_MELTPONDDEPTH , & + QTY_SEAICE_MELTPONDLID , & + QTY_SEAICE_MELTPONDSNOW , & + QTY_SEAICE_SALINITY001 , & + QTY_SEAICE_SALINITY002 , & + QTY_SEAICE_SALINITY003 , & + QTY_SEAICE_SALINITY004 , & + QTY_SEAICE_SALINITY005 , & + QTY_SEAICE_SALINITY006 , & + QTY_SEAICE_SALINITY007 , & + QTY_SEAICE_SALINITY008 , & + QTY_SEAICE_ICEENTHALPY001 , & + QTY_SEAICE_ICEENTHALPY002 , & + QTY_SEAICE_ICEENTHALPY003 , & + QTY_SEAICE_ICEENTHALPY004 , & + QTY_SEAICE_ICEENTHALPY005 , & + QTY_SEAICE_ICEENTHALPY006 , & + QTY_SEAICE_ICEENTHALPY007 , & + QTY_SEAICE_ICEENTHALPY008 , & + QTY_SEAICE_SNOWENTHALPY001 , & + QTY_SEAICE_SNOWENTHALPY002 , & + QTY_SEAICE_SNOWENTHALPY003 , & + QTY_DRY_LAND , & + QTY_SOM_TEMPERATURE , & + QTY_SEAICE_FY , & + QTY_SEAICE_AGREG_FY , & + QTY_SEAICE_AGREG_SURFACETEMP,& + get_index_for_quantity , & + get_name_for_quantity + +use netcdf + +implicit none +private + +! required by DART code - will be called from filter and other +! DART executables. interfaces to these routines are fixed and +! cannot be changed in any way. +public :: get_model_size, & + adv_1step, & + get_state_meta_data, & + model_interpolate, & + shortest_time_between_assimilations, & + end_model, & + static_init_model, & + nc_write_model_atts, & + init_time, & + init_conditions, & + check_sfctemp_var + +! public but in another module +public :: nc_write_model_vars, & + pert_model_copies, & + get_close_obs, & + get_close_state, & + convert_vertical_obs, & + convert_vertical_state, & + read_model_time, & + write_model_time + + +! version controlled file description for error handling, do not edit +character(len=256), parameter :: source = & + "$URL$" +character(len=32 ), parameter :: revision = "$Revision$" +character(len=128), parameter :: revdate = "$Date$" +character(len=512) :: string1 +character(len=512) :: string2 +character(len=512) :: string3 + +type(location_type), allocatable :: state_loc(:) ! state locations, compute once and store for speed + +type(time_type) :: assimilation_time_step + +! DART state vector contents are specified in the input.nml:&model_nml namelist. +integer, parameter :: max_state_variables = 10 +integer, parameter :: num_state_table_columns = 3 +character(len=NF90_MAX_NAME) :: variable_table( max_state_variables, num_state_table_columns ) +integer :: state_kinds_list( max_state_variables ) +logical :: update_var_list( max_state_variables ) + +integer, parameter :: VAR_NAME_INDEX = 1 +integer, parameter :: VAR_QTY_INDEX = 2 +integer, parameter :: VAR_UPDATE_INDEX = 3 + +! EXAMPLE: perhaps a namelist here for anything you want to/can set at runtime. +! this is optional! only add things which can be changed at runtime. +integer :: model_size +integer :: assimilation_period_days = 0 +integer :: assimilation_period_seconds = 3600 + +real(r8) :: model_perturbation_amplitude = 0.01 + +character(len=metadatalength) :: model_state_variables(max_state_variables * num_state_table_columns ) = ' ' +integer :: debug = 100 +integer :: grid_oi = 3 +logical, save :: module_initialized = .false. + +real(r8), allocatable :: TLAT(:), TLON(:) + +type(time_type) :: model_time, model_timestep + +integer :: Nx=-1 +integer :: Ncat=-1 +integer :: domain_id,nfields +! uncomment this, the namelist related items in the 'use utilities' section above, +! and the namelist related items below in static_init_model() to enable the +! run-time namelist settings. +!namelist /model_nml/ model_size, assimilation_time_step_days, assimilation_time_step_seconds + +namelist /model_nml/ & + assimilation_period_days, & ! for now, this is the timestep + assimilation_period_seconds, & + model_perturbation_amplitude, & + model_state_variables, & + debug, & + grid_oi + +contains + +!------------------------------------------------------------------ +! +! Called to do one time initialization of the model. As examples, +! might define information about the model size or model timestep. +! In models that require pre-computed static data, for instance +! spherical harmonic weights, these would also be computed here. +! Can be a NULL INTERFACE for the simplest models. + +subroutine static_init_model() + + real(r8) :: x_loc + integer :: i, dom_id,iunit,io,ss,dd +!integer :: iunit, io + +if ( module_initialized ) return ! only need to do this once. + +! Print module information to log file and stdout. +call register_module(source, revision, revdate) + +module_initialized = .true. + +! This is where you would read a namelist, for example. +call find_namelist_in_file("input.nml", "model_nml", iunit) +read(iunit, nml = model_nml, iostat = io) +call check_namelist_read(iunit, io, "model_nml") + +call error_handler(E_MSG,'static_init_model','model_nml values are',' ',' ',' ') +if (do_nml_file()) write(nmlfileunit, nml=model_nml) +if (do_nml_term()) write( * , nml=model_nml) + +call set_calendar_type('Gregorian') + +model_timestep = set_model_time_step() + +call get_time(model_timestep,ss,dd) ! set_time() assures the seconds [0,86400) + +write(string1,*)'assimilation period is ',dd,' days ',ss,' seconds' +call error_handler(E_MSG,'static_init_model',string1,source,revision,revdate) + +call get_horiz_grid_dims(Nx) +call get_ncat_dim(Ncat) + +call verify_state_variables(model_state_variables, nfields, variable_table, & + state_kinds_list, update_var_list) + +allocate(TLAT(Nx), TLON(Nx)) + +call read_horiz_grid(Nx, TLAT, TLON) + +if (do_output()) write(logfileunit, *) 'Using grid : Nx, Ncat = ', & + Nx, Ncat +if (do_output()) write( * , *) 'Using grid : Nx, Ncat = ', & + Nx, Ncat + +domain_id = add_domain('cice.r.nc', nfields, & + var_names = variable_table(1:nfields, VAR_NAME_INDEX), & + kind_list = state_kinds_list(1:nfields), & + update_list = update_var_list(1:nfields)) + +if (debug > 2) call state_structure_info(domain_id) + +model_size = get_domain_size(domain_id) +if (do_output()) write(*,*) 'model_size = ', model_size + + +end subroutine static_init_model +!------------------------------------------------------------------ +! Returns a model state vector, x, that is some sort of appropriate +! initial condition for starting up a long integration of the model. +! At present, this is only used if the namelist parameter +! start_from_restart is set to .false. in the program perfect_model_obs. +! If this option is not to be used in perfect_model_obs, or if no +! synthetic data experiments using perfect_model_obs are planned, +! this can be a NULL INTERFACE. + +!subroutine init_conditions(x) +! +!real(r8), intent(out) :: x(:) +! +!x = MISSING_R8 +! +!end subroutine init_conditions + + + +!------------------------------------------------------------------ +! Does a single timestep advance of the model. The input value of +! the vector x is the starting condition and x is updated to reflect +! the changed state after a timestep. The time argument is intent +! in and is used for models that need to know the date/time to +! compute a timestep, for instance for radiation computations. +! This interface is only called if the namelist parameter +! async is set to 0 in perfect_model_obs of filter or if the +! program integrate_model is to be used to advance the model +! state as a separate executable. If one of these options +! is not going to be used (the model will only be advanced as +! a separate model-specific executable), this can be a +! NULL INTERFACE. + +!subroutine adv_1step(x, time) +! +!real(r8), intent(inout) :: x(:) +!type(time_type), intent(in) :: time +! +!end subroutine adv_1step + + + +!------------------------------------------------------------------ +! Returns the number of items in the state vector as an integer. +! This interface is required for all applications. + +function get_model_size() + +integer(i8) :: get_model_size + +get_model_size = model_size + +end function get_model_size + + + +!------------------------------------------------------------------ +! Companion interface to init_conditions. Returns a time that is somehow +! appropriate for starting up a long integration of the model. +! At present, this is only used if the namelist parameter +! start_from_restart is set to .false. in the program perfect_model_obs. +! If this option is not to be used in perfect_model_obs, or if no +! synthetic data experiments using perfect_model_obs are planned, +! this can be a NULL INTERFACE. + +!subroutine init_time(time) +! +!type(time_type), intent(out) :: time +! +!! for now, just set to 0 +!time = set_time(0,0) +! +!end subroutine init_time + +!------------------------------------------------------------------ +! Given a state handle, a location, and a model state variable type, +! interpolates the state variable fields to that location and returns +! the values in expected_obs. The istatus variables should be returned as +! 0 unless there is some problem in computing the interpolation in +! which case an alternate value should be returned. The itype variable +! is a model specific integer that specifies the kind of field (for +! instance temperature, zonal wind component, etc.). In low order +! models that have no notion of types of variables this argument can +! be ignored. For applications in which only perfect model experiments +! with identity observations (i.e. only the value of a particular +! state variable is observed), this can be a NULL INTERFACE. + +subroutine model_interpolate(state_handle, ens_size, location, obs_type, expected_obs, istatus, thick_flag) + + +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: ens_size +type(location_type), intent(in) :: location +integer, intent(in) :: obs_type +real(r8), intent(out) :: expected_obs(ens_size) !< array of interpolated values +integer, intent(out) :: istatus(ens_size) +logical,optional, intent(inout) :: thick_flag + +!local vars +real(r8) :: loc_array(3), llon, llat +integer(i8) :: base_offset +integer :: cat_index, cat_signal, icat, cat_signal_interm +real(r8) :: expected_aggr_conc(ens_size) +integer :: set_obstype +integer :: var_table_index + +!Fei---need aicen*fyn to calculate the aggregate FY concentration------------ +real(r8) :: expected_conc(ens_size) +real(r8) :: expected_fy(ens_size) +real(r8) :: expected_tsfc(ens_size) +real(r8) :: temp(ens_size) +real(r8) :: temp1(ens_size) + +if ( .not. module_initialized ) call static_init_model + +expected_obs(:) = MISSING_R8 ! the DART bad value flag +istatus(:) = 99 + +loc_array = get_location(location) +llon = loc_array(1) +llat = loc_array(2) +cat_index = int(loc_array(3)) + +if (obs_type == QTY_SEAICE_CATEGORY) then + if (cat_index <= Ncat) then + istatus = 0 + expected_obs = cat_index + RETURN + endif +endif +if (debug > 1) then + print *, 'requesting interpolation of ', obs_type, ' at ', llon, llat, cat_index +endif + +SELECT CASE (obs_type) + CASE (QTY_SEAICE_AGREG_THICKNESS ) ! these kinds require aggregating 3D vars to make a 2D var + if (any(variable_table(:,1)=='hi')) then + cat_signal = 1 !was 1 ! for extra special procedure to aggregate + !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_AGREG_THICKNESS)) + thick_flag = .true. + base_offset = cat_index + set_obstype = obs_type + !call find_var_type('hi',var_index) + else + set_obstype = QTY_SEAICE_VOLUME + cat_signal = 1 ! for extra special procedure to aggregate + !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_VOLUME)) + base_offset = cat_index + !call find_var_type('vicen',var_index) + endif + CASE (QTY_SEAICE_AGREG_SNOWDEPTH ) ! these kinds require aggregating 3D vars to make a 2D var + if (any(variable_table(:,1)=='hs')) then + cat_signal = 1 !was 1 ! for extra special procedure to aggregate + !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_AGREG_SNOWDEPTH)) + base_offset = cat_index + thick_flag = .true. + set_obstype = obs_type + !call find_var_type('hs',var_index) + else + set_obstype = QTY_SEAICE_SNOWVOLUME + cat_signal = 1 ! for extra special procedure to aggregate + !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_SNOWVOLUME)) + base_offset = cat_index + !call find_var_type('vsnon',var_index) + endif + CASE (QTY_SEAICE_AGREG_CONCENTR ) ! these kinds require aggregating a 3D var to make a 2D var + cat_signal = 0 ! for aggregate variable, send signal to lon_lat_interp + set_obstype = obs_type + base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_CONCENTR)) + CASE (QTY_SEAICE_AGREG_VOLUME ) ! these kinds require aggregating a 3D var to make a 2D var + cat_signal = 0 ! for aggregate variable, send signal to lon_lat_interp + set_obstype = obs_type + base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_VOLUME)) + CASE (QTY_SEAICE_AGREG_SNOWVOLUME ) ! these kinds require aggregating a 3D var to make a 2D var + cat_signal = 0 ! for aggregate variable, send signal to lon_lat_interp + set_obstype = obs_type + base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_SNOWVOLUME)) + CASE (QTY_SEAICE_AGREG_SURFACETEMP) ! FEI need aicen to average the temp, have not considered open water temp yet + if (any(variable_table(:,1)=='Tsfc')) then + cat_signal = 1 + base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_AGREG_SURFACETEMP)) + thick_flag = .true. + set_obstype = obs_type + else + cat_signal = -3 + set_obstype = QTY_SEAICE_SURFACETEMP + base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_SURFACETEMP)) + endif + CASE (QTY_SOM_TEMPERATURE) ! these kinds are 1d variables + cat_signal = 1 + set_obstype = obs_type + !base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SOM_TEMPERATURE)) + base_offset = cat_index + CASE (QTY_SEAICE_CONCENTR , & ! these kinds have an additional dim for category + QTY_SEAICE_FY , & + QTY_SEAICE_VOLUME , & + QTY_SEAICE_SNOWVOLUME , & + QTY_SEAICE_SURFACETEMP , & + QTY_SEAICE_FIRSTYEARAREA , & + QTY_SEAICE_ICEAGE , & + QTY_SEAICE_LEVELAREA , & + QTY_SEAICE_LEVELVOLUME , & + QTY_SEAICE_MELTPONDAREA , & + QTY_SEAICE_MELTPONDDEPTH , & + QTY_SEAICE_MELTPONDLID , & + QTY_SEAICE_MELTPONDSNOW , & + QTY_SEAICE_SALINITY001 , & + QTY_SEAICE_SALINITY002 , & + QTY_SEAICE_SALINITY003 , & + QTY_SEAICE_SALINITY004 , & + QTY_SEAICE_SALINITY005 , & + QTY_SEAICE_SALINITY006 , & + QTY_SEAICE_SALINITY007 , & + QTY_SEAICE_SALINITY008 , & + QTY_SEAICE_ICEENTHALPY001 , & + QTY_SEAICE_ICEENTHALPY002 , & + QTY_SEAICE_ICEENTHALPY003 , & + QTY_SEAICE_ICEENTHALPY004 , & + QTY_SEAICE_ICEENTHALPY005 , & + QTY_SEAICE_ICEENTHALPY006 , & + QTY_SEAICE_ICEENTHALPY007 , & + QTY_SEAICE_ICEENTHALPY008 , & + QTY_SEAICE_SNOWENTHALPY001, & + QTY_SEAICE_SNOWENTHALPY002, & + QTY_SEAICE_SNOWENTHALPY003 ) + ! move pointer to the particular category + ! then treat as 2d field in lon_lat_interp + + base_offset = get_index_start(domain_id, get_varid_from_kind(obs_type)) + base_offset = base_offset + (cat_index-1)! * Nx + base_offset = cat_index + set_obstype = obs_type + cat_signal = 1 ! now same as boring 2d field + CASE DEFAULT + ! Not a legal type for interpolation, return istatus error + istatus = 15 + return +END SELECT + +if (cat_signal == -2) then + temp = 0.0_r8 + temp1= 0.0_r8 + do icat = 1,Ncat + !reads in aicen + cat_signal_interm = 1 + base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SEAICE_CONCENTR)) + base_offset = base_offset + (icat-1) * Nx + call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal_interm, expected_conc, istatus) + !reads in fyn + cat_signal_interm = 1 + base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SEAICE_FY)) + base_offset = base_offset + (icat-1) * Nx + call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal_interm, expected_fy, istatus) + temp = temp + expected_conc * expected_fy !sum(aicen*fyn) = FY % over ice + temp1= temp1+ expected_conc !sum(aicen) = aice + + if (any(expected_conc<0.0) .or. any(expected_conc>1.0))then + print*,'obstype FY expected sicn:',expected_conc + print*,'FY sicn lat lon:',llat,llon + endif + if (any(expected_fy>1.0) .or. any(expected_fy<0.0)) then + print*,'obstype FY expected fyn:',expected_fy,llat,llon + print*,'FY fyn lat lon:',llat,llon + endif + + end do + expected_obs = temp/max(temp1,1.0e-8) !sum(aicen*fyn)/aice = FY % in the gridcell +else if (cat_signal == -3 ) then + temp = 0.0_r8 + temp1= 0.0_r8 + do icat = 1,Ncat + !reads in aicen + cat_signal_interm = 1 + base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SEAICE_CONCENTR)) + base_offset = base_offset + (icat-1) * Nx + call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal_interm, expected_conc, istatus) + !reads in Tsfcn + cat_signal_interm = 1 + base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SEAICE_SURFACETEMP)) + base_offset = base_offset + (icat-1) * Nx + call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal_interm, expected_tsfc, istatus) + if (any(expected_conc<0.0) .or. any(expected_conc>1.0))then + print*,'obstype TSFC expected sicn:',expected_conc + print*,'TSFC sicn lat lon:',llat,llon + endif + if (any(expected_tsfc>50.0) .or. any(expected_tsfc<-100.0)) then + print*,'obstype TSFC expected tsfcn:',expected_tsfc + print*,'TSFC tsfcn lat lon:',llat,llon + endif + temp = temp + expected_conc * expected_tsfc !sum(aicen*Tsfcn) + temp1= temp1+ expected_conc !sum(aicen) = aice + end do + expected_obs = temp/max(temp1,1.0e-8) !sum(aicen*Tsfcn)/aice = Tsfc ;averaged temperature over sea-ice covered portion + if (any(expected_obs>50.0) .or. any(expected_obs<-100.0)) then + print*,'obstype TSFC expected obs:',expected_obs + print*,'TSFC tsfc lat lon:' ,llat,llon + print*,'temp:',temp + print*,'temp1:',temp1 + endif +else + call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal, expected_obs, istatus) + + if (any(expected_obs<0.0))then + print*,'obstype SIC expected concs:',expected_obs + print*,'SIC sic negative lat lon:',llat,llon + endif + if (any(expected_obs>1.0))then + print*,'obstype SIC expected concs:',expected_obs + print*,'SIC sic positive lat lon:',llat,llon + endif +endif + +if (cat_signal == -1) then + ! we need to know the aggregate sea ice concentration for these special cases + base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_CONCENTR)) + base_offset = base_offset + (cat_index-1) + print*,'CHECK CHECK CHECK' + call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal, expected_aggr_conc, istatus) + expected_obs = expected_obs/max(expected_aggr_conc,1.0e-8) ! hope this is allowed so we never divide by zero + + if (any(expected_aggr_conc<0.0) .or. any(expected_aggr_conc>1.0))then + print*,'obstype SIT expected conc:',expected_aggr_conc + print*,'SIT sic lat lon:',llat,llon + endif + +endif + +if (debug > 1) print *, 'interp val, istatus = ', expected_obs, istatus, size(expected_obs) + +! This should be the result of the interpolation of a +! given kind (itype) of variable at the given location. + +! The return code for successful return should be 0. +! Any positive number is an error. +! Negative values are reserved for use by the DART framework. +! Using distinct positive values for different types of errors can be +! useful in diagnosing problems. + +end subroutine model_interpolate +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_type, cat_signal, expected_obs, istatus) +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: ens_size +integer(i8), intent(in) :: offset +real(r8), intent(in) :: lon, lat +integer, intent(in) :: var_type +integer, intent(in) :: cat_signal +real(r8), intent(out) :: expected_obs(ens_size) +integer, intent(out) :: istatus(ens_size) + +integer :: lat_bot, lat_top, lon_bot, lon_top, num_inds, start_ind +integer :: x_ind, y_ind +real(r8) :: x_corners(4), y_corners(4) +real(r8) :: p(4,ens_size), xbot(ens_size), xtop(ens_size) +real(r8) :: work_expected_obs(ens_size) +real(r8) :: lon_fract, lat_fract +logical :: masked +integer :: quad_status +integer :: e, iterations, Niterations +integer :: next_offset +integer(i8) :: state_index +if ( .not. module_initialized ) call static_init_model + +istatus = 0 +print*,'VAR TYPE',var_type +if (var_type == 14) then + e = 1 +else if (var_type == 15) then + e = 2 +else if (var_type == 16) then + e = 3 +endif +if ( cat_signal < 1 ) then + Niterations = Ncat ! only iterate if aggregating over all types +else + Niterations = 1 ! no need to iterate +endif +work_expected_obs = 0.0_r8 +expected_obs = 0.0_r8 +do iterations = 1, Niterations + + ! FIXME: this should use the state structure routine 'get_dart_vector_index' + ! to get the start of the next category layer. this code assumes it knows + ! exactly how the state vector is laid out (reasonable, but might not be true + ! in future versions of dart.) + !next_offset = offset + (iterations-1)*Nx + !print*,'offset',offset + state_index = get_dart_vector_index(grid_oi,int(offset,i4),1, domain_id, e) + work_expected_obs = get_state(state_index,state_handle) + !if(masked) then + ! istatus = 3 + ! return + !endif + expected_obs = expected_obs+work_expected_obs +enddo +end subroutine lon_lat_interpolate +!------------------------------------------------------------------ +! Returns the smallest increment in time that the model is capable +! of advancing the state in a given implementation, or the shortest +! time you want the model to advance between assimilations. +! This interface is required for all applications. + +function shortest_time_between_assimilations() + +type(time_type) :: shortest_time_between_assimilations + +if ( .not. module_initialized ) call static_init_model + +shortest_time_between_assimilations = model_timestep + +end function shortest_time_between_assimilations +!------------------------------------------------------------------ +! Given an integer index into the state vector structure, returns the +! associated location. A second intent(out) optional argument kind +! can be returned if the model has more than one type of field (for +! instance temperature and zonal wind component). This interface is +! required for all filter applications as it is required for computing +! the distance between observations and state variables. + +subroutine get_state_meta_data(index_in, location, var_type) + +integer(i8), intent(in) :: index_in +type(location_type), intent(out) :: location +integer, intent(out), optional :: var_type + +real(r8) :: lat, lon, rcat +integer :: ni_index, hold_index, cat_index, local_var, var_id + +! these should be set to the actual location and state quantity +if ( .not. module_initialized ) call static_init_model + +call get_model_variable_indices(index_in, ni_index, cat_index, hold_index, var_id=var_id) +call get_state_kind(var_id, local_var) + +lon = TLON(ni_index) +lat = TLAT(ni_index) + +if (debug > 5) print *, 'lon, lat, cat_index = ', lon, lat, cat_index +rcat = cat_index*1.0_r8 +location = set_location(lon, lat, rcat, VERTISLEVEL) + +if (present(var_type)) then + var_type = local_var +endif + +end subroutine get_state_meta_data + +subroutine get_state_kind(var_ind, var_type) + integer, intent(in) :: var_ind + integer, intent(out) :: var_type + +! Given an integer index into the state vector structure, returns the kind, +! and both the starting offset for this kind, as well as the offset into +! the block of this kind. + +if ( .not. module_initialized ) call static_init_model + +var_type = state_kinds_list(var_ind) + +end subroutine get_state_kind + + +!------------------------------------------------------------------ +! Does any shutdown and clean-up needed for model. Can be a NULL +! INTERFACE if the model has no need to clean up storage, etc. + +subroutine end_model() + +deallocate(TLAT,TLON) + +end subroutine end_model + + +!------------------------------------------------------------------ +! write any additional attributes to the output and diagnostic files + +subroutine nc_write_model_atts(ncid, domain_id) + +integer, intent(in) :: ncid ! netCDF file identifier +integer, intent(in) :: domain_id +integer :: NGridDimID + +integer, parameter :: MAXLINELEN = 128 +character(len=8), parameter :: cice_namelist_file = 'cice_in' +character(len=MAXLINELEN), allocatable, dimension(:) :: textblock +integer :: LineLenDimID, nlinesDimID, nmlVarID +integer :: nlines, linelen,status +logical :: has_cice_namelist + +character(len=256) :: filename + +integer :: NlonDimID, NlatDimID +integer :: tlonVarID, tlatVarID + +if ( .not. module_initialized ) call static_init_model + +! put file into define mode. + +write(filename,*) 'ncid', ncid + +call nc_begin_define_mode(ncid) + +call nc_add_global_creation_time(ncid) + +call nc_add_global_creation_time(ncid) + +call nc_add_global_attribute(ncid, "model_source", source ) +call nc_add_global_attribute(ncid, "model_revision", revision ) +call nc_add_global_attribute(ncid, "model_revdate", revdate ) +call nc_add_global_attribute(ncid, "model", "CICE-SCM") + +call nc_check(nf90_def_dim(ncid, name='ni', & + len = Nx, dimid = NGridDimID),'nc_write_model_atts', 'ni def_dim '//trim(filename)) + +call nc_check(nf90_def_var(ncid,name='TLON', xtype=nf90_real, & + dimids=(/ NGridDimID /), varid=tlonVarID),& + 'nc_write_model_atts', 'TLON def_var '//trim(filename)) +call nc_check(nf90_def_var(ncid,name='TLAT', xtype=nf90_real, & + dimids=(/ NGridDimID /), varid=tlatVarID),& + 'nc_write_model_atts', 'TLAT def_var '//trim(filename)) + +call nc_end_define_mode(ncid) + +call nc_check(nf90_put_var(ncid, tlonVarID, TLON ), & + 'nc_write_model_atts', 'TLON put_var '//trim(filename)) +call nc_check(nf90_put_var(ncid, tlatVarID, TLAT ), & + 'nc_write_model_atts', 'TLAT put_var '//trim(filename)) + +! Flush the buffer and leave netCDF file open +call nc_synchronize_file(ncid) + +end subroutine nc_write_model_atts +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +function get_varid_from_kind(dart_kind) + +integer, intent(in) :: dart_kind +integer :: get_varid_from_kind + +! given a kind, return what variable number it is + +integer :: i + +do i = 1, get_num_variables(domain_id) + if (dart_kind == state_kinds_list(i)) then + get_varid_from_kind = i + return + endif +end do + +if (debug > 1) then + write(string1, *) 'Kind ', dart_kind, ' not found in state vector' + write(string2, *) 'AKA ', get_name_for_quantity(dart_kind), ' not found in state vector' + call error_handler(E_MSG,'get_varid_from_kind', string1, & + source, revision, revdate, text2=string2) +endif + +get_varid_from_kind = -1 + +end function get_varid_from_kind +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine verify_state_variables( state_variables, ngood, table, kind_list, update_var ) + +character(len=*), intent(inout) :: state_variables(:) +integer, intent(out) :: ngood +character(len=*), intent(out) :: table(:,:) +integer, intent(out) :: kind_list(:) ! kind number +logical, optional, intent(out) :: update_var(:) ! logical update + +integer :: nrows, i +character(len=NF90_MAX_NAME) :: varname, dartstr, update + +if ( .not. module_initialized ) call static_init_model + +nrows = size(table,1) + +ngood = 0 + +!>@todo deprecate. Remove a hidden 'default' set of variables. +!>@ The default is provided in the input namelist. + +if ( state_variables(1) == ' ' ) then ! no model_state_variables namelist provided + call use_default_state_variables( state_variables ) + string1 = 'model_nml:model_state_variables not specified using default variables' + call error_handler(E_MSG,'verify_state_variables',string1,source,revision,revdate) +endif + +MyLoop : do i = 1, nrows + + varname = trim(state_variables(3*i -2)) + dartstr = trim(state_variables(3*i -1)) + update = trim(state_variables(3*i )) + + call to_upper(update) + + table(i,1) = trim(varname) + table(i,2) = trim(dartstr) + table(i,3) = trim(update) + + if ( table(i,1) == ' ' .and. table(i,2) == ' ' .and. table(i,3) == ' ') exit MyLoop + + if ( table(i,1) == ' ' .or. table(i,2) == ' ' .or. table(i,3) == ' ' ) then + string1 = 'model_nml:model_state_variables not fully specified' + call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate) + endif + + ! Make sure DART kind is valid + + kind_list(i) = get_index_for_quantity(dartstr) + if( kind_list(i) < 0 ) then + write(string1,'(''there is no obs_kind <'',a,''> in obs_kind_mod.f90'')') trim(dartstr) + call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate) + endif + + ! Make sure the update variable has a valid name + + if ( present(update_var) )then + SELECT CASE (update) + CASE ('UPDATE') + update_var(i) = .true. + CASE ('NO_COPY_BACK') + update_var(i) = .false. + CASE DEFAULT + write(string1,'(A)') 'only UPDATE or NO_COPY_BACK supported in model_state_variable namelist' + write(string2,'(6A)') 'you provided : ', trim(varname), ', ', trim(dartstr), ', ', trim(update) + call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate, text2=string2) + END SELECT + endif + + ! Record the contents of the DART state vector + + if (do_output()) then + write(string1,'(A,I2,6A)') 'variable ',i,' is ',trim(varname), ', ', trim(dartstr), ', ', trim(update) + call error_handler(E_MSG,'verify_state_variables',string1,source,revision,revdate) + endif + + ngood = ngood + 1 +enddo MyLoop + +end subroutine verify_state_variables +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine use_default_state_variables( state_variables ) + +character(len=*), intent(inout) :: state_variables(:) + +! strings must all be the same length for the gnu compiler +state_variables( 1:5*num_state_table_columns ) = & + (/ 'CONCENTRATION ', 'QTY_SEAICE_CONCENTR ', 'UPDATE ', & + 'ICEVOLUME ', 'QTY_SEAICE_VOLUME ', 'UPDATE ', & + 'SNOWVOLUME ', 'QTY_SEAICE_SNOWVOLUME ', 'UPDATE ', & + 'UICE ', 'QTY_U_SEAICE_COMPONENT ', 'UPDATE ', & + 'VICE ', 'QTY_V_SEAICE_COMPONENT ', 'UPDATE '/) + +end subroutine use_default_state_variables +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_indx, & + num_close, close_indices, distances, state_handle) + +type(get_close_type), intent(in) :: filt_gc +type(location_type), intent(inout) :: base_loc +integer, intent(in) :: base_type +type(location_type), intent(inout) :: locs(:) +integer, intent(in) :: loc_qtys(:) +integer(i8), intent(in) :: loc_indx(:) +integer, intent(out) :: num_close +integer, intent(out) :: close_indices(:) +real(r8), intent(out), optional :: distances(:) +type(ensemble_type), intent(in), optional :: state_handle + +! Given a DART location (referred to as "base") and a set of candidate +! locations & kinds (locs, loc_qtys/indx), returns the subset close to the +! "base", their indices, and their distances to the "base" ... + +integer :: t_ind, k + +! Initialize variables to missing status + +num_close = 0 +close_indices = -99 +if (present(distances)) distances(:) = 1.0e9 !something big and positive (far away) + +! Get all the potentially close obs but no dist (optional argument dist(:) +! is not present) This way, we are decreasing the number of distance +! computations that will follow. This is a horizontal-distance operation and +! we don't need to have the relevant vertical coordinate information yet +! (for obs). +call loc_get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_indx, & + num_close, close_indices) + +! Loop over potentially close subset of obs priors or state variables +if (present(distances)) then + do k = 1, num_close + + t_ind = close_indices(k) + + ! if dry land, leave original 1e9 value. otherwise, compute real dist. + distances(k) = get_dist(base_loc, locs(t_ind), & + base_type, loc_qtys(t_ind)) + enddo +endif + +end subroutine get_close_state +!!!!!!!!!!!!!!!! +function read_model_time(filename) + +character(len=256) :: filename +type(time_type) :: read_model_time + +integer :: ncid !< netcdf file id +integer :: nyr , & ! year number, in cice restart + month , & ! month number, 1 to 12, in cice restart + mday , & ! day of the month, in cice restart + sec ! elapsed seconds into date, in cice restart +integer :: hour , & ! hour of the day, needed for dart set_date + minute , & ! minute of the hour, needed for dart set_date + secthismin + +if ( .not. module_initialized ) call static_init_model + +if ( .not. file_exist(filename) ) then + write(string1,*) 'cannot open file ', trim(filename),' for reading.' + call error_handler(E_ERR,'read_model_time',string1,source,revision,revdate) +endif + +call nc_check( nf90_open(trim(filename), NF90_NOWRITE, ncid), & + 'read_model_time', 'open '//trim(filename)) +call nc_check( nf90_get_att(ncid, NF90_GLOBAL, 'nyr' , nyr), & + 'read_model_time', 'get_att nyr') +call nc_check( nf90_get_att(ncid, NF90_GLOBAL, 'month' , month), & + 'read_model_time', 'get_att month') +call nc_check( nf90_get_att(ncid, NF90_GLOBAL, 'mday' , mday), & + 'read_model_time', 'get_att mday') +call nc_check( nf90_get_att(ncid, NF90_GLOBAL, 'sec', sec), & + 'read_model_time', 'get_att sec') + +! FIXME: we don't allow a real year of 0 - add one for now, but +! THIS MUST BE FIXED IN ANOTHER WAY! +if (nyr == 0) then + call error_handler(E_MSG, 'read_model_time', & + 'WARNING!!! year 0 not supported; setting to year 1') + nyr = 1 +endif + +hour = int(sec/3600) +minute = int((sec-hour*3600)/60) +secthismin = int(sec-hour*3600-minute*60) + +read_model_time = set_date(nyr, month, mday, hour, minute, secthismin) +end function read_model_time +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine write_model_time(ncid, model_time, adv_to_time) + +integer, intent(in) :: ncid +type(time_type), intent(in) :: model_time +type(time_type), intent(in), optional :: adv_to_time + +character(len=16), parameter :: routine = 'write_model_time' + +integer :: io, varid, iyear, imonth, iday, ihour, imin, isec +integer :: seconds + +if ( .not. module_initialized ) call static_init_model + +if (present(adv_to_time)) then + call get_date(adv_to_time, iyear, imonth, iday, ihour, imin, isec) + write(string1,*)'CICE/DART not configured to advance CICE.' + write(string2,*)'called with optional advance_to_time of' + write(string3,'(i4.4,5(1x,i2.2))')iyear,imonth,iday,ihour,imin, isec + call error_handler(E_ERR, routine, string1, & + source, revision, revdate, text2=string2,text3=string3) +endif + +call get_date(model_time, iyear, imonth, iday, ihour, imin, isec) + +seconds = (ihour*60 + imin)*60 + isec + +call nc_begin_define_mode(ncid) +call nc_add_global_attribute(ncid, 'nyr' , iyear) +call nc_add_global_attribute(ncid, 'month' , imonth) +call nc_add_global_attribute(ncid, 'mday' , iday) +call nc_add_global_attribute(ncid, 'sec' , seconds) +call nc_end_define_mode(ncid) + +end subroutine write_model_time +!----------------------------------------------------------------- +! Check which surface temperature state variable is in restart +subroutine check_sfctemp_var(flag) +logical, intent(inout) :: flag + +if (any(variable_table(:,1)=='Tsfc')) then + flag = .true. +else + flag = .false. +endif +end subroutine check_sfctemp_var +!----------------------------------------------------------------- +! Find state variable index +subroutine find_var_type(varname,var_index) +character(len=16), intent(in) :: varname +integer, intent(inout) :: var_index + +integer :: i + +do i=1,size(variable_table(:,1)) + if (trim(varname) == variable_table(i,1)) then + var_index = i + return + endif +enddo +write(string1,*)'Could not find index of state variable' +call error_handler(E_ERR, 'find_var_type', string1, & + source, revision, revdate) +end subroutine find_var_type +!=================================================================== +! End of model_mod +!=================================================================== +end module model_mod + +! +! $URL$ +! $Id$ +! $Revision$ +! $Date$ diff --git a/models/cice-scm2/readme.rst b/models/cice-scm2/readme.rst new file mode 100644 index 0000000000..1b867a5daf --- /dev/null +++ b/models/cice-scm2/readme.rst @@ -0,0 +1,5 @@ +cice-scm2 +============== + +.. attention:: + Add your model documentation here. diff --git a/models/cice-scm2/work/algorithm_info_mod.f90 b/models/cice-scm2/work/algorithm_info_mod.f90 new file mode 100644 index 0000000000..19bb14e1f9 --- /dev/null +++ b/models/cice-scm2/work/algorithm_info_mod.f90 @@ -0,0 +1,215 @@ +! DART software - Copyright UCAR. This open source software is provided +! by UCAR, "as is", without charge, subject to all terms of use at +! http://www.image.ucar.edu/DAReS/DART/DART_download + +module algorithm_info_mod + +use types_mod, only : r8 + +use obs_def_mod, only : obs_def_type, get_obs_def_type_of_obs, get_obs_def_error_variance +use obs_kind_mod, only : get_quantity_for_type_of_obs + +! Get the QTY definitions that are needed (aka kind) +use obs_kind_mod, only : QTY_SEAICE_VOLUME, QTY_SEAICE_CONCENTR, QTY_SEAICE_SNOWVOLUME, & + QTY_SEAICE_AGREG_THICKNESS, QTY_SEAICE_AGREG_CONCENTR, QTY_SEAICE_AGREG_FREEBOARD +! NOTE: Sadly, the QTY itself is not sufficient for the POWER because there is additional metadata + +implicit none +private + +integer, parameter :: NORMAL_PRIOR = 1 +integer, parameter :: BOUNDED_NORMAL_RH_PRIOR = 2 + +public :: obs_error_info, probit_dist_info, obs_inc_info, & + NORMAL_PRIOR, BOUNDED_NORMAL_RH_PRIOR + +! Provides routines that give information about details of algorithms for +! observation error sampling, observation increments, and the transformations +! for regression and inflation in probit space. +! For now, it is convenient to have these in a single module since several +! users will be developing their own problem specific versions of these +! subroutines. This will avoid constant merge conflicts as other parts of the +! assimilation code are updated. + +contains + +!------------------------------------------------------------------------- +subroutine obs_error_info(obs_def, error_variance, bounded, bounds) + +! Computes information needed to compute error sample for this observation +! This is called by perfect_model_obs when generating noisy obs +type(obs_def_type), intent(in) :: obs_def +real(r8), intent(out) :: error_variance +logical, intent(out) :: bounded(2) +real(r8), intent(out) :: bounds(2) + +integer :: obs_type, obs_kind + +! Get the kind of the observation +obs_type = get_obs_def_type_of_obs(obs_def) +obs_kind = get_quantity_for_type_of_obs(obs_type) + +! Get the default error variance +error_variance = get_obs_def_error_variance(obs_def) + +! Set the observation error details for each type of quantity +if(obs_kind == QTY_SEAICE_AGREG_CONCENTR) then + bounded(1) = .true.; bounded(2) = .true. + bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 +elseif(obs_kind == QTY_SEAICE_AGREG_THICKNESS) then + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; +elseif(obs_kind == QTY_SEAICE_AGREG_FREEBOARD) then + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; +else + bounded = .false. +endif + +end subroutine obs_error_info + + +!------------------------------------------------------------------------- + + +subroutine probit_dist_info(kind, is_state, is_inflation, dist_type, & + bounded, bounds) + +! Computes the details of the probit transform for initial experiments +! with Molly + +integer, intent(in) :: kind +logical, intent(in) :: is_state ! True for state variable, false for obs +logical, intent(in) :: is_inflation ! True for inflation transform +integer, intent(out) :: dist_type +logical, intent(out) :: bounded(2) +real(r8), intent(out) :: bounds(2) + +! Have input information about the kind of the state or observation being transformed +! along with additional logical info that indicates whether this is an observation +! or state variable and about whether the transformation is being done for inflation +! or for regress. +! Need to select the appropriate transform. At present, options are NORMAL_PRIOR +! which does nothing or BOUNDED_NORMAL_RH_PRIOR. +! If the BNRH is selected then information about the bounds must also be set. +! The two dimensional logical array 'bounded' is set to false for no bounds and true +! for bounded. the first element of the array is for the lower bound, the second for the upper. +! If bounded is chosen, the corresponding bound value(s) must be set in the two dimensional +! real array 'bounds'. +! For example, if my_state_kind corresponds to a sea ice fraction then an appropriate choice +! would be: +! bounded(1) = .true.; bounded(2) = .true. +! bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 + +! In the long run, may not have to have separate controls for each of the input possibilities +! However, for now these are things that need to be explored for science understanding + +if(is_inflation) then + ! Case for inflation transformation + if(kind == QTY_SEAICE_CONCENTR) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .true. + bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 + elseif(kind == QTY_SEAICE_VOLUME) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; + elseif(kind == QTY_SEAICE_SNOWVOLUME) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; + else + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded = .false. + endif +elseif(is_state) then + ! Case for state variable priors + if(kind == QTY_SEAICE_CONCENTR) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .true. + bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 + elseif(kind == QTY_SEAICE_VOLUME) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; + elseif(kind == QTY_SEAICE_SNOWVOLUME) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; + else + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded = .false. + endif +else + ! This case is for observation (extended state) priors + if(kind == QTY_SEAICE_CONCENTR) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .true. + bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 + elseif(kind == QTY_SEAICE_VOLUME) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; + elseif(kind == QTY_SEAICE_SNOWVOLUME) then + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; + else + dist_type = BOUNDED_NORMAL_RH_PRIOR + bounded = .false. + endif +endif + +end subroutine probit_dist_info + +!------------------------------------------------------------------------ + + +subroutine obs_inc_info(obs_kind, filter_kind, rectangular_quadrature, gaussian_likelihood_tails, & + sort_obs_inc, spread_restoration, bounded, bounds) + +integer, intent(in) :: obs_kind +integer, intent(out) :: filter_kind +logical, intent(out) :: rectangular_quadrature, gaussian_likelihood_tails +logical, intent(out) :: sort_obs_inc +logical, intent(out) :: spread_restoration +logical, intent(out) :: bounded(2) +real(r8), intent(out) :: bounds(2) + +! Temporary approach for setting the details of how to assimilate this observation +! This example is designed to reproduce the squared forward operator results from paper + +! Set the observation increment details for each type of quantity +if(obs_kind == QTY_SEAICE_AGREG_CONCENTR) then + filter_kind = 101 + bounded(1) = .true.; bounded(2) = .true. + bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 +elseif(obs_kind == QTY_SEAICE_AGREG_THICKNESS) then + filter_kind = 101 + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; +elseif(obs_kind == QTY_SEAICE_AGREG_FREEBOARD) then + filter_kind = 101 + bounded(1) = .true.; bounded(2) = .false. + bounds(1) = 0.0_r8; +else + filter_kind = 101 + bounded = .false. +endif + +! HK you are overwritting filter kind in the if statement with this: +filter_kind = 101 + +! Default settings for now for Icepack and tracer model tests +sort_obs_inc = .false. +spread_restoration = .false. + +! Only need to set these two for options on old RHF implementation +! rectangular_quadrature = .true. +! gaussian_likelihood_tails = .false. + +end subroutine obs_inc_info + +!------------------------------------------------------------------------ + +end module algorithm_info_mod diff --git a/models/cice-scm2/work/input.nml b/models/cice-scm2/work/input.nml new file mode 100644 index 0000000000..56706e4141 --- /dev/null +++ b/models/cice-scm2/work/input.nml @@ -0,0 +1,220 @@ +&perfect_model_obs_nml + read_input_state_from_file = .true., + single_file_in = .false. + input_state_files = "input_file.nc" + + write_output_state_to_file = .false., + single_file_out = .true. + output_state_files = "perfect_output.nc" + output_interval = 1, + + async = 0, + adv_ens_command = "./advance_model.csh", + + obs_seq_in_file_name = "obs_seq.in", + obs_seq_out_file_name = "obs_seq.out", + init_time_days = 0, + init_time_seconds = 0, + first_obs_days = -1, + first_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, + + trace_execution = .false., + output_timestamps = .false., + print_every_nth_obs = -1, + output_forward_op_errors = .false., + silence = .false., + / + +&filter_nml + single_file_in = .true., + input_state_files = '' + input_state_file_list = 'filter_input_list.txt' + + stages_to_write = 'input', 'preassim', 'analysis', 'output' + + single_file_out = .true., + output_state_files = '' + output_state_file_list = 'filter_output_list.txt' + output_interval = 1, + output_members = .true. + num_output_state_members = 0, + output_mean = .true. + output_sd = .true. + write_all_stages_at_end = .false. + + ens_size = 29, + num_groups = 1, + perturb_from_single_instance = .false., + perturbation_amplitude = 0.2, + distributed_state = .true. + + async = 0, + adv_ens_command = "./advance_model.csh", + + obs_sequence_in_name = "obs_seq.out", + obs_sequence_out_name = "obs_seq.final", + num_output_obs_members = 20, + init_time_days = 0, + init_time_seconds = 0, + first_obs_days = -1, + first_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, + + inf_flavor = 0, 0, + inf_initial_from_restart = .false., .false., + inf_sd_initial_from_restart = .false., .false., + inf_deterministic = .true., .true., + inf_initial = 1.0, 1.0, + inf_lower_bound = 1.0, 1.0, + inf_upper_bound = 100.0, 1000000.0, + inf_damping = 1.0, 1.0, + inf_sd_initial = 0.0, 0.0, + inf_sd_lower_bound = 0.0, 0.0, + inf_sd_max_change = 1.05, 1.05, + + trace_execution = .false., + output_timestamps = .false., + output_forward_op_errors = .false., + silence = .false., + / + +&smoother_nml + num_lags = 0, + start_from_restart = .false., + output_restart = .false., + restart_in_file_name = 'smoother_ics', + restart_out_file_name = 'smoother_restart' + / + +&ensemble_manager_nml + / + +&assim_tools_nml + filter_kind = 1, + cutoff = 1000000.0 + sort_obs_inc = .false., + spread_restoration = .false., + sampling_error_correction = .false., + adaptive_localization_threshold = -1, + distribute_mean = .false. + output_localization_diagnostics = .false., + localization_diagnostics_file = 'localization_diagnostics', + print_every_nth_obs = 0 + / + +&cov_cutoff_nml + select_localization = 1 + / + +®_factor_nml + select_regression = 1, + input_reg_file = "time_mean_reg", + save_reg_diagnostics = .false., + reg_diagnostics_file = "reg_diagnostics" + / + +&obs_sequence_nml + write_binary_obs_sequence = .false. + / + +&obs_kind_nml + assimilate_these_obs_types = 'SAT_SEAICE_AGREG_THICKNESS' + evaluate_these_obs_types = '' + / + +&model_nml + assimilation_period_days = 1 + assimilation_period_seconds = 0 + model_perturbation_amplitude = 2e-05 + debug = 100 + model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', + 'QTY_SEAICE_VOLUME', 'UPDATE', 'vsnon', 'QTY_SEAICE_SNOWVOLUME', + 'UPDATE' +/ + +&dart_to_cice_nml + dart_to_cice_input_file = 'restart_state.nc' + original_cice_input_file = 'dart_restart.nc' + previous_cice_input_file = 'pre_restart.nc' + balance_method = 'simple_squeeze' + r_snw_name = 'r_snw_vary' + gridpt_oi = 3 +/ + +&utilities_nml + TERMLEVEL = 1, + module_details = .false., + logfilename = 'dart_log.out', + nmlfilename = 'dart_log.nml', + write_nml = 'none' + / + +&preprocess_nml + input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90' + output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90' + input_obs_qty_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90' + output_obs_qty_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90' + obs_type_files = '../../../observations/forward_operators/obs_def_cice_mod.f90' + quantity_files = '../../../assimilation_code/modules/observations/seaice_quantities_mod.f90', + '../../../assimilation_code/modules/observations/ocean_quantities_mod.f90' + / + +&obs_sequence_tool_nml + filename_seq = 'obs_seq.one', 'obs_seq.two', + filename_out = 'obs_seq.processed', + first_obs_days = -1, + first_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, + print_only = .false., + gregorian_cal = .false. + / + +&obs_diag_nml + obs_sequence_name = 'obs_seq.final', + bin_width_days = -1, + bin_width_seconds = -1, + init_skip_days = 0, + init_skip_seconds = 0, + Nregions = 3, + trusted_obs = 'null', + lonlim1 = 0.00, 0.00, 0.50 + lonlim2 = 1.01, 0.50, 1.01 + reg_names = 'whole', 'yin', 'yang' + create_rank_histogram = .true., + outliers_in_histogram = .true., + use_zero_error_obs = .false., + verbose = .false. + / + +&state_vector_io_nml + / + +&model_mod_check_nml + input_state_files = 'input.nc' + output_state_files = 'mmc_output.nc' + test1thru = 0 + run_tests = 1,2,3,4,5,7 + x_ind = 42 + loc_of_interest = 0.3 + quantity_of_interest = 'QTY_STATE_VARIABLE' + interp_test_dx = 0.02 + interp_test_xrange = 0.0, 1.0 + verbose = .false. + / + +&quality_control_nml + input_qc_threshold = 3.0, + outlier_threshold = -1.0, +/ + +&location_nml + horiz_dist_only = .true. + approximate_distance = .false. + nlon = 71 + nlat = 36 + output_box_info = .true. +/ diff --git a/models/cice-scm2/work/quickbuild.sh b/models/cice-scm2/work/quickbuild.sh new file mode 100755 index 0000000000..e79b90dcb2 --- /dev/null +++ b/models/cice-scm2/work/quickbuild.sh @@ -0,0 +1,60 @@ +#!/usr/bin/env bash + +# DART software - Copyright UCAR. This open source software is provided +# by UCAR, "as is", without charge, subject to all terms of use at +# http://www.image.ucar.edu/DAReS/DART/DART_download + +main() { + +export DART=$(git rev-parse --show-toplevel) +source "$DART"/build_templates/buildfunctions.sh + +MODEL=cice-scm2 +LOCATION=threed_sphere + + +programs=( +closest_member_tool +filter +model_mod_check +perfect_model_obs +) + +serial_programs=( +create_fixed_network_seq +create_obs_sequence +fill_inflation_restart +integrate_model +obs_common_subset +obs_diag +obs_sequence_tool +) + +model_programs=( +) + +model_serial_programs=( +dart_to_cice +) + +# quickbuild arguments +arguments "$@" + +# clean the directory +\rm -f -- *.o *.mod Makefile .cppdefs + +# build any NetCDF files from .cdl files +cdl_to_netcdf + +# build and run preprocess before making any other DART executables +buildpreprocess + +# build +buildit + +# clean up +\rm -f -- *.o *.mod + +} + +main "$@" From c4f7a6fab706a67749a672da657e76cbcfd07ab2 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 12 Apr 2024 13:41:45 -0400 Subject: [PATCH 02/23] rename model directory cice-scm Sea Ice Single Column Model --- models/{cice-scm2 => cice-scm}/dart_cice_mod.f90 | 0 models/{cice-scm2 => cice-scm}/dart_to_cice.f90 | 0 models/{cice-scm2 => cice-scm}/model_mod.f90 | 0 models/{cice-scm2 => cice-scm}/readme.rst | 0 models/{cice-scm2 => cice-scm}/work/algorithm_info_mod.f90 | 0 models/{cice-scm2 => cice-scm}/work/input.nml | 0 models/{cice-scm2 => cice-scm}/work/quickbuild.sh | 2 +- 7 files changed, 1 insertion(+), 1 deletion(-) rename models/{cice-scm2 => cice-scm}/dart_cice_mod.f90 (100%) rename models/{cice-scm2 => cice-scm}/dart_to_cice.f90 (100%) rename models/{cice-scm2 => cice-scm}/model_mod.f90 (100%) rename models/{cice-scm2 => cice-scm}/readme.rst (100%) rename models/{cice-scm2 => cice-scm}/work/algorithm_info_mod.f90 (100%) rename models/{cice-scm2 => cice-scm}/work/input.nml (100%) rename models/{cice-scm2 => cice-scm}/work/quickbuild.sh (98%) diff --git a/models/cice-scm2/dart_cice_mod.f90 b/models/cice-scm/dart_cice_mod.f90 similarity index 100% rename from models/cice-scm2/dart_cice_mod.f90 rename to models/cice-scm/dart_cice_mod.f90 diff --git a/models/cice-scm2/dart_to_cice.f90 b/models/cice-scm/dart_to_cice.f90 similarity index 100% rename from models/cice-scm2/dart_to_cice.f90 rename to models/cice-scm/dart_to_cice.f90 diff --git a/models/cice-scm2/model_mod.f90 b/models/cice-scm/model_mod.f90 similarity index 100% rename from models/cice-scm2/model_mod.f90 rename to models/cice-scm/model_mod.f90 diff --git a/models/cice-scm2/readme.rst b/models/cice-scm/readme.rst similarity index 100% rename from models/cice-scm2/readme.rst rename to models/cice-scm/readme.rst diff --git a/models/cice-scm2/work/algorithm_info_mod.f90 b/models/cice-scm/work/algorithm_info_mod.f90 similarity index 100% rename from models/cice-scm2/work/algorithm_info_mod.f90 rename to models/cice-scm/work/algorithm_info_mod.f90 diff --git a/models/cice-scm2/work/input.nml b/models/cice-scm/work/input.nml similarity index 100% rename from models/cice-scm2/work/input.nml rename to models/cice-scm/work/input.nml diff --git a/models/cice-scm2/work/quickbuild.sh b/models/cice-scm/work/quickbuild.sh similarity index 98% rename from models/cice-scm2/work/quickbuild.sh rename to models/cice-scm/work/quickbuild.sh index e79b90dcb2..2bd790cb41 100755 --- a/models/cice-scm2/work/quickbuild.sh +++ b/models/cice-scm/work/quickbuild.sh @@ -9,7 +9,7 @@ main() { export DART=$(git rev-parse --show-toplevel) source "$DART"/build_templates/buildfunctions.sh -MODEL=cice-scm2 +MODEL=cice-scm LOCATION=threed_sphere From f00a36d8ecb8c3583e3e022e5fcb7170ef4e6822 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 12 Apr 2024 14:08:02 -0400 Subject: [PATCH 03/23] remove outdated local algorithm_info_mod.f90 --- models/cice-scm/work/algorithm_info_mod.f90 | 215 -------------------- 1 file changed, 215 deletions(-) delete mode 100644 models/cice-scm/work/algorithm_info_mod.f90 diff --git a/models/cice-scm/work/algorithm_info_mod.f90 b/models/cice-scm/work/algorithm_info_mod.f90 deleted file mode 100644 index 19bb14e1f9..0000000000 --- a/models/cice-scm/work/algorithm_info_mod.f90 +++ /dev/null @@ -1,215 +0,0 @@ -! DART software - Copyright UCAR. This open source software is provided -! by UCAR, "as is", without charge, subject to all terms of use at -! http://www.image.ucar.edu/DAReS/DART/DART_download - -module algorithm_info_mod - -use types_mod, only : r8 - -use obs_def_mod, only : obs_def_type, get_obs_def_type_of_obs, get_obs_def_error_variance -use obs_kind_mod, only : get_quantity_for_type_of_obs - -! Get the QTY definitions that are needed (aka kind) -use obs_kind_mod, only : QTY_SEAICE_VOLUME, QTY_SEAICE_CONCENTR, QTY_SEAICE_SNOWVOLUME, & - QTY_SEAICE_AGREG_THICKNESS, QTY_SEAICE_AGREG_CONCENTR, QTY_SEAICE_AGREG_FREEBOARD -! NOTE: Sadly, the QTY itself is not sufficient for the POWER because there is additional metadata - -implicit none -private - -integer, parameter :: NORMAL_PRIOR = 1 -integer, parameter :: BOUNDED_NORMAL_RH_PRIOR = 2 - -public :: obs_error_info, probit_dist_info, obs_inc_info, & - NORMAL_PRIOR, BOUNDED_NORMAL_RH_PRIOR - -! Provides routines that give information about details of algorithms for -! observation error sampling, observation increments, and the transformations -! for regression and inflation in probit space. -! For now, it is convenient to have these in a single module since several -! users will be developing their own problem specific versions of these -! subroutines. This will avoid constant merge conflicts as other parts of the -! assimilation code are updated. - -contains - -!------------------------------------------------------------------------- -subroutine obs_error_info(obs_def, error_variance, bounded, bounds) - -! Computes information needed to compute error sample for this observation -! This is called by perfect_model_obs when generating noisy obs -type(obs_def_type), intent(in) :: obs_def -real(r8), intent(out) :: error_variance -logical, intent(out) :: bounded(2) -real(r8), intent(out) :: bounds(2) - -integer :: obs_type, obs_kind - -! Get the kind of the observation -obs_type = get_obs_def_type_of_obs(obs_def) -obs_kind = get_quantity_for_type_of_obs(obs_type) - -! Get the default error variance -error_variance = get_obs_def_error_variance(obs_def) - -! Set the observation error details for each type of quantity -if(obs_kind == QTY_SEAICE_AGREG_CONCENTR) then - bounded(1) = .true.; bounded(2) = .true. - bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 -elseif(obs_kind == QTY_SEAICE_AGREG_THICKNESS) then - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; -elseif(obs_kind == QTY_SEAICE_AGREG_FREEBOARD) then - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; -else - bounded = .false. -endif - -end subroutine obs_error_info - - -!------------------------------------------------------------------------- - - -subroutine probit_dist_info(kind, is_state, is_inflation, dist_type, & - bounded, bounds) - -! Computes the details of the probit transform for initial experiments -! with Molly - -integer, intent(in) :: kind -logical, intent(in) :: is_state ! True for state variable, false for obs -logical, intent(in) :: is_inflation ! True for inflation transform -integer, intent(out) :: dist_type -logical, intent(out) :: bounded(2) -real(r8), intent(out) :: bounds(2) - -! Have input information about the kind of the state or observation being transformed -! along with additional logical info that indicates whether this is an observation -! or state variable and about whether the transformation is being done for inflation -! or for regress. -! Need to select the appropriate transform. At present, options are NORMAL_PRIOR -! which does nothing or BOUNDED_NORMAL_RH_PRIOR. -! If the BNRH is selected then information about the bounds must also be set. -! The two dimensional logical array 'bounded' is set to false for no bounds and true -! for bounded. the first element of the array is for the lower bound, the second for the upper. -! If bounded is chosen, the corresponding bound value(s) must be set in the two dimensional -! real array 'bounds'. -! For example, if my_state_kind corresponds to a sea ice fraction then an appropriate choice -! would be: -! bounded(1) = .true.; bounded(2) = .true. -! bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 - -! In the long run, may not have to have separate controls for each of the input possibilities -! However, for now these are things that need to be explored for science understanding - -if(is_inflation) then - ! Case for inflation transformation - if(kind == QTY_SEAICE_CONCENTR) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .true. - bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 - elseif(kind == QTY_SEAICE_VOLUME) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; - elseif(kind == QTY_SEAICE_SNOWVOLUME) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; - else - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded = .false. - endif -elseif(is_state) then - ! Case for state variable priors - if(kind == QTY_SEAICE_CONCENTR) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .true. - bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 - elseif(kind == QTY_SEAICE_VOLUME) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; - elseif(kind == QTY_SEAICE_SNOWVOLUME) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; - else - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded = .false. - endif -else - ! This case is for observation (extended state) priors - if(kind == QTY_SEAICE_CONCENTR) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .true. - bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 - elseif(kind == QTY_SEAICE_VOLUME) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; - elseif(kind == QTY_SEAICE_SNOWVOLUME) then - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; - else - dist_type = BOUNDED_NORMAL_RH_PRIOR - bounded = .false. - endif -endif - -end subroutine probit_dist_info - -!------------------------------------------------------------------------ - - -subroutine obs_inc_info(obs_kind, filter_kind, rectangular_quadrature, gaussian_likelihood_tails, & - sort_obs_inc, spread_restoration, bounded, bounds) - -integer, intent(in) :: obs_kind -integer, intent(out) :: filter_kind -logical, intent(out) :: rectangular_quadrature, gaussian_likelihood_tails -logical, intent(out) :: sort_obs_inc -logical, intent(out) :: spread_restoration -logical, intent(out) :: bounded(2) -real(r8), intent(out) :: bounds(2) - -! Temporary approach for setting the details of how to assimilate this observation -! This example is designed to reproduce the squared forward operator results from paper - -! Set the observation increment details for each type of quantity -if(obs_kind == QTY_SEAICE_AGREG_CONCENTR) then - filter_kind = 101 - bounded(1) = .true.; bounded(2) = .true. - bounds(1) = 0.0_r8; bounds(2) = 1.0_r8 -elseif(obs_kind == QTY_SEAICE_AGREG_THICKNESS) then - filter_kind = 101 - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; -elseif(obs_kind == QTY_SEAICE_AGREG_FREEBOARD) then - filter_kind = 101 - bounded(1) = .true.; bounded(2) = .false. - bounds(1) = 0.0_r8; -else - filter_kind = 101 - bounded = .false. -endif - -! HK you are overwritting filter kind in the if statement with this: -filter_kind = 101 - -! Default settings for now for Icepack and tracer model tests -sort_obs_inc = .false. -spread_restoration = .false. - -! Only need to set these two for options on old RHF implementation -! rectangular_quadrature = .true. -! gaussian_likelihood_tails = .false. - -end subroutine obs_inc_info - -!------------------------------------------------------------------------ - -end module algorithm_info_mod From 83e41629d072b65af335decaf3a1640c7e815845 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 27 Aug 2024 00:08:03 -0600 Subject: [PATCH 04/23] model_mod - remove unneeded and update comments, remove svn info and register_module, adjusting style and organization to be more readable and consistent --- models/cice-scm/model_mod.f90 | 247 +++++++++++++++------------------- 1 file changed, 110 insertions(+), 137 deletions(-) diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index a2c1b617ed..a90f9451ad 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -1,43 +1,31 @@ ! DART software - Copyright UCAR. This open source software is provided ! by UCAR, "as is", without charge, subject to all terms of use at ! http://www.image.ucar.edu/DAReS/DART/DART_download -! -! $Id$ module model_mod -! This is a template showing the interfaces required for a model to be compliant -! with the DART data assimilation infrastructure. The public interfaces listed -! must all be supported with the argument lists as indicated. Many of the interfaces -! are not required for minimal implementation (see the discussion of each -! interface and look for NULL INTERFACE). - ! Modules that are absolutely required for use are listed use types_mod, only : i4, r8, i8, MISSING_R8, metadatalength -use time_manager_mod, only : time_type, set_time, set_time_missing,set_calendar_type,get_time, & - set_date, get_date -use location_mod, only : location_type, get_close_type, & - get_close_obs, get_dist,& +use time_manager_mod, only : time_type, set_time, set_time_missing, set_calendar_type, & + get_time, set_date, get_date +use location_mod, only : location_type, get_close_type, get_close_obs, get_dist, & convert_vertical_obs, convert_vertical_state, & - set_location, set_location_missing,VERTISLEVEL, & - get_location, & - loc_get_close_state => get_close_state -use utilities_mod, only : register_module, error_handler, & - E_ERR, E_MSG, logfileunit, & - nmlfileunit, do_output, do_nml_file, do_nml_term, & + set_location, set_location_missing, VERTISLEVEL, & + get_location, loc_get_close_state => get_close_state +use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, logfileunit, & + nmlfileunit, do_output, do_nml_file, do_nml_term, & find_namelist_in_file, check_namelist_read,to_upper, & file_exist use netcdf_utilities_mod, only : nc_add_global_attribute, nc_synchronize_file, & - nc_add_global_creation_time, & - nc_begin_define_mode, nc_end_define_mode, & - nc_check + nc_add_global_creation_time, nc_begin_define_mode, & + nc_end_define_mode, nc_check use state_structure_mod, only : add_domain, get_domain_size use ensemble_manager_mod, only : ensemble_type use distributed_state_mod, only : get_state use default_model_mod, only : pert_model_copies, nc_write_model_vars, init_conditions, & init_time, adv_1step -use dart_cice_mod, only : set_model_time_step,get_horiz_grid_dims, & - get_ncat_dim, read_horiz_grid +use dart_cice_mod, only : set_model_time_step,get_horiz_grid_dims, get_ncat_dim, & + read_horiz_grid use state_structure_mod, only : state_structure_info,get_index_start, get_num_variables, & get_dart_vector_index, get_model_variable_indices use obs_kind_mod, only : QTY_SEAICE_AGREG_CONCENTR , & @@ -96,9 +84,9 @@ module model_mod implicit none private -! required by DART code - will be called from filter and other -! DART executables. interfaces to these routines are fixed and -! cannot be changed in any way. +! required routines by DART code - will be called from filter and other +! DART executables. interfaces to these routines are fixed and cannot +! be changed in any way. public :: get_model_size, & adv_1step, & get_state_meta_data, & @@ -111,7 +99,7 @@ module model_mod init_conditions, & check_sfctemp_var -! public but in another module +! required routines where code is in other modules public :: nc_write_model_vars, & pert_model_copies, & get_close_obs, & @@ -123,10 +111,11 @@ module model_mod ! version controlled file description for error handling, do not edit -character(len=256), parameter :: source = & - "$URL$" -character(len=32 ), parameter :: revision = "$Revision$" -character(len=128), parameter :: revdate = "$Date$" +character(len=256), parameter :: source = 'cice-scm/model_mod.f90' + +logical, save :: module_initialized = .false. + +! message strings character(len=512) :: string1 character(len=512) :: string2 character(len=512) :: string3 @@ -146,18 +135,7 @@ module model_mod integer, parameter :: VAR_QTY_INDEX = 2 integer, parameter :: VAR_UPDATE_INDEX = 3 -! EXAMPLE: perhaps a namelist here for anything you want to/can set at runtime. -! this is optional! only add things which can be changed at runtime. -integer :: model_size -integer :: assimilation_period_days = 0 -integer :: assimilation_period_seconds = 3600 - -real(r8) :: model_perturbation_amplitude = 0.01 - -character(len=metadatalength) :: model_state_variables(max_state_variables * num_state_table_columns ) = ' ' -integer :: debug = 100 -integer :: grid_oi = 3 -logical, save :: module_initialized = .false. +integer :: model_size real(r8), allocatable :: TLAT(:), TLON(:) @@ -166,10 +144,14 @@ module model_mod integer :: Nx=-1 integer :: Ncat=-1 integer :: domain_id,nfields -! uncomment this, the namelist related items in the 'use utilities' section above, -! and the namelist related items below in static_init_model() to enable the -! run-time namelist settings. -!namelist /model_nml/ model_size, assimilation_time_step_days, assimilation_time_step_seconds + +! things which can/should be in the model_nml +integer :: assimilation_period_days = 0 +integer :: assimilation_period_seconds = 3600 +real(r8) :: model_perturbation_amplitude = 0.01 +character(len=metadatalength) :: model_state_variables(max_state_variables * num_state_table_columns ) = ' ' +integer :: debug = 100 +integer :: grid_oi = 3 namelist /model_nml/ & assimilation_period_days, & ! for now, this is the timestep @@ -182,7 +164,6 @@ module model_mod contains !------------------------------------------------------------------ -! ! Called to do one time initialization of the model. As examples, ! might define information about the model size or model timestep. ! In models that require pre-computed static data, for instance @@ -191,25 +172,20 @@ module model_mod subroutine static_init_model() - real(r8) :: x_loc - integer :: i, dom_id,iunit,io,ss,dd -!integer :: iunit, io +real(r8) :: x_loc +integer :: i, dom_id, iunit, io, ss, dd -if ( module_initialized ) return ! only need to do this once. +if ( module_initialized ) return ! only need to do this once -! Print module information to log file and stdout. -call register_module(source, revision, revdate) - module_initialized = .true. -! This is where you would read a namelist, for example. call find_namelist_in_file("input.nml", "model_nml", iunit) read(iunit, nml = model_nml, iostat = io) call check_namelist_read(iunit, io, "model_nml") call error_handler(E_MSG,'static_init_model','model_nml values are',' ',' ',' ') -if (do_nml_file()) write(nmlfileunit, nml=model_nml) -if (do_nml_term()) write( * , nml=model_nml) +if (do_nml_file()) write(nmlfileunit, nml=model_nml) +if (do_nml_term()) write(*, nml=model_nml) call set_calendar_type('Gregorian') @@ -217,8 +193,8 @@ subroutine static_init_model() call get_time(model_timestep,ss,dd) ! set_time() assures the seconds [0,86400) -write(string1,*)'assimilation period is ',dd,' days ',ss,' seconds' -call error_handler(E_MSG,'static_init_model',string1,source,revision,revdate) +write(string1, *) 'assimilation period is ', dd,' days ', ss,' seconds' +call error_handler(E_MSG, 'static_init_model', string1, source) call get_horiz_grid_dims(Nx) call get_ncat_dim(Ncat) @@ -230,10 +206,8 @@ subroutine static_init_model() call read_horiz_grid(Nx, TLAT, TLON) -if (do_output()) write(logfileunit, *) 'Using grid : Nx, Ncat = ', & - Nx, Ncat -if (do_output()) write( * , *) 'Using grid : Nx, Ncat = ', & - Nx, Ncat +if (do_output()) write(logfileunit, *) 'Using grid : Nx, Ncat = ', Nx, Ncat +if (do_output()) write(*, *) 'Using grid : Nx, Ncat = ', Nx, Ncat domain_id = add_domain('cice.r.nc', nfields, & var_names = variable_table(1:nfields, VAR_NAME_INDEX), & @@ -243,10 +217,11 @@ subroutine static_init_model() if (debug > 2) call state_structure_info(domain_id) model_size = get_domain_size(domain_id) -if (do_output()) write(*,*) 'model_size = ', model_size +if (do_output()) write(*, *) 'model_size = ', model_size end subroutine static_init_model + !------------------------------------------------------------------ ! Returns a model state vector, x, that is some sort of appropriate ! initial condition for starting up a long integration of the model. @@ -264,8 +239,6 @@ end subroutine static_init_model ! !end subroutine init_conditions - - !------------------------------------------------------------------ ! Does a single timestep advance of the model. The input value of ! the vector x is the starting condition and x is updated to reflect @@ -301,8 +274,6 @@ function get_model_size() end function get_model_size - - !------------------------------------------------------------------ ! Companion interface to init_conditions. Returns a time that is somehow ! appropriate for starting up a long integration of the model. @@ -326,22 +297,15 @@ end function get_model_size ! interpolates the state variable fields to that location and returns ! the values in expected_obs. The istatus variables should be returned as ! 0 unless there is some problem in computing the interpolation in -! which case an alternate value should be returned. The itype variable -! is a model specific integer that specifies the kind of field (for -! instance temperature, zonal wind component, etc.). In low order -! models that have no notion of types of variables this argument can -! be ignored. For applications in which only perfect model experiments -! with identity observations (i.e. only the value of a particular -! state variable is observed), this can be a NULL INTERFACE. +! which case an alternate value should be returned. subroutine model_interpolate(state_handle, ens_size, location, obs_type, expected_obs, istatus, thick_flag) - type(ensemble_type), intent(in) :: state_handle integer, intent(in) :: ens_size type(location_type), intent(in) :: location integer, intent(in) :: obs_type -real(r8), intent(out) :: expected_obs(ens_size) !< array of interpolated values +real(r8), intent(out) :: expected_obs(ens_size) ! array of interpolated values integer, intent(out) :: istatus(ens_size) logical,optional, intent(inout) :: thick_flag @@ -353,7 +317,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte integer :: set_obstype integer :: var_table_index -!Fei---need aicen*fyn to calculate the aggregate FY concentration------------ +!Fei---need aicen*fyn to calculate the aggregate FY concentration real(r8) :: expected_conc(ens_size) real(r8) :: expected_fy(ens_size) real(r8) :: expected_tsfc(ens_size) @@ -362,7 +326,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte if ( .not. module_initialized ) call static_init_model -expected_obs(:) = MISSING_R8 ! the DART bad value flag +expected_obs(:) = MISSING_R8 ! represents a bad value in DART istatus(:) = 99 loc_array = get_location(location) @@ -577,7 +541,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte if (debug > 1) print *, 'interp val, istatus = ', expected_obs, istatus, size(expected_obs) ! This should be the result of the interpolation of a -! given kind (itype) of variable at the given location. +! given obs_type of variable at the given location. ! The return code for successful return should be 0. ! Any positive number is an error. @@ -586,7 +550,9 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte ! useful in diagnosing problems. end subroutine model_interpolate -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_type, cat_signal, expected_obs, istatus) type(ensemble_type), intent(in) :: state_handle integer, intent(in) :: ens_size @@ -643,6 +609,7 @@ subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_typ expected_obs = expected_obs+work_expected_obs enddo end subroutine lon_lat_interpolate + !------------------------------------------------------------------ ! Returns the smallest increment in time that the model is capable ! of advancing the state in a given implementation, or the shortest @@ -658,13 +625,12 @@ function shortest_time_between_assimilations() shortest_time_between_assimilations = model_timestep end function shortest_time_between_assimilations + !------------------------------------------------------------------ ! Given an integer index into the state vector structure, returns the -! associated location. A second intent(out) optional argument kind -! can be returned if the model has more than one type of field (for -! instance temperature and zonal wind component). This interface is -! required for all filter applications as it is required for computing -! the distance between observations and state variables. +! associated location. This interface is required for all filter +! applications as it is required for computing the distance between +! observations and state variables. subroutine get_state_meta_data(index_in, location, var_type) @@ -674,8 +640,8 @@ subroutine get_state_meta_data(index_in, location, var_type) real(r8) :: lat, lon, rcat integer :: ni_index, hold_index, cat_index, local_var, var_id - ! these should be set to the actual location and state quantity + if ( .not. module_initialized ) call static_init_model call get_model_variable_indices(index_in, ni_index, cat_index, hold_index, var_id=var_id) @@ -694,24 +660,23 @@ subroutine get_state_meta_data(index_in, location, var_type) end subroutine get_state_meta_data -subroutine get_state_kind(var_ind, var_type) - integer, intent(in) :: var_ind - integer, intent(out) :: var_type - +!------------------------------------------------------------------ ! Given an integer index into the state vector structure, returns the kind, ! and both the starting offset for this kind, as well as the offset into ! the block of this kind. +subroutine get_state_kind(var_ind, var_type) + integer, intent(in) :: var_ind + integer, intent(out) :: var_type + if ( .not. module_initialized ) call static_init_model var_type = state_kinds_list(var_ind) end subroutine get_state_kind - !------------------------------------------------------------------ -! Does any shutdown and clean-up needed for model. Can be a NULL -! INTERFACE if the model has no need to clean up storage, etc. +! Does any shutdown and clean-up needed for model subroutine end_model() @@ -719,7 +684,6 @@ subroutine end_model() end subroutine end_model - !------------------------------------------------------------------ ! write any additional attributes to the output and diagnostic files @@ -754,8 +718,6 @@ subroutine nc_write_model_atts(ncid, domain_id) call nc_add_global_creation_time(ncid) call nc_add_global_attribute(ncid, "model_source", source ) -call nc_add_global_attribute(ncid, "model_revision", revision ) -call nc_add_global_attribute(ncid, "model_revdate", revdate ) call nc_add_global_attribute(ncid, "model", "CICE-SCM") call nc_check(nf90_def_dim(ncid, name='ni', & @@ -779,14 +741,15 @@ subroutine nc_write_model_atts(ncid, domain_id) call nc_synchronize_file(ncid) end subroutine nc_write_model_atts -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ +! given a kind, return what variable number it is + function get_varid_from_kind(dart_kind) integer, intent(in) :: dart_kind integer :: get_varid_from_kind -! given a kind, return what variable number it is - integer :: i do i = 1, get_num_variables(domain_id) @@ -799,15 +762,16 @@ function get_varid_from_kind(dart_kind) if (debug > 1) then write(string1, *) 'Kind ', dart_kind, ' not found in state vector' write(string2, *) 'AKA ', get_name_for_quantity(dart_kind), ' not found in state vector' - call error_handler(E_MSG,'get_varid_from_kind', string1, & - source, revision, revdate, text2=string2) + call error_handler(E_MSG, 'get_varid_from_kind', string1, source, text2=string2) endif get_varid_from_kind = -1 end function get_varid_from_kind -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -subroutine verify_state_variables( state_variables, ngood, table, kind_list, update_var ) + +!------------------------------------------------------------------ + +subroutine verify_state_variables(state_variables, ngood, table, kind_list, update_var) character(len=*), intent(inout) :: state_variables(:) integer, intent(out) :: ngood @@ -828,9 +792,9 @@ subroutine verify_state_variables( state_variables, ngood, table, kind_list, upd !>@ The default is provided in the input namelist. if ( state_variables(1) == ' ' ) then ! no model_state_variables namelist provided - call use_default_state_variables( state_variables ) + call use_default_state_variables(state_variables) string1 = 'model_nml:model_state_variables not specified using default variables' - call error_handler(E_MSG,'verify_state_variables',string1,source,revision,revdate) + call error_handler(E_MSG, 'verify_state_variables', string1, source) endif MyLoop : do i = 1, nrows @@ -849,19 +813,17 @@ subroutine verify_state_variables( state_variables, ngood, table, kind_list, upd if ( table(i,1) == ' ' .or. table(i,2) == ' ' .or. table(i,3) == ' ' ) then string1 = 'model_nml:model_state_variables not fully specified' - call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate) + call error_handler(E_ERR, 'verify_state_variables', string1, source) endif ! Make sure DART kind is valid - kind_list(i) = get_index_for_quantity(dartstr) if( kind_list(i) < 0 ) then write(string1,'(''there is no obs_kind <'',a,''> in obs_kind_mod.f90'')') trim(dartstr) - call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate) + call error_handler(E_ERR, 'verify_state_variables', string1, source) endif ! Make sure the update variable has a valid name - if ( present(update_var) )then SELECT CASE (update) CASE ('UPDATE') @@ -871,23 +833,25 @@ subroutine verify_state_variables( state_variables, ngood, table, kind_list, upd CASE DEFAULT write(string1,'(A)') 'only UPDATE or NO_COPY_BACK supported in model_state_variable namelist' write(string2,'(6A)') 'you provided : ', trim(varname), ', ', trim(dartstr), ', ', trim(update) - call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate, text2=string2) + call error_handler(E_ERR, 'verify_state_variables', string1, source, text2=string2) END SELECT endif ! Record the contents of the DART state vector - if (do_output()) then write(string1,'(A,I2,6A)') 'variable ',i,' is ',trim(varname), ', ', trim(dartstr), ', ', trim(update) - call error_handler(E_MSG,'verify_state_variables',string1,source,revision,revdate) + call error_handler(E_MSG, 'verify_state_variables', string1, source) endif ngood = ngood + 1 + enddo MyLoop end subroutine verify_state_variables -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -subroutine use_default_state_variables( state_variables ) + +!------------------------------------------------------------------ + +subroutine use_default_state_variables(state_variables) character(len=*), intent(inout) :: state_variables(:) @@ -900,7 +864,12 @@ subroutine use_default_state_variables( state_variables ) 'VICE ', 'QTY_V_SEAICE_COMPONENT ', 'UPDATE '/) end subroutine use_default_state_variables -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ +! Given a DART location (referred to as "base") and a set of candidate +! locations & kinds (locs, loc_qtys/indx), returns the subset close to the +! "base", their indices, and their distances to the "base" ... + subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_indx, & num_close, close_indices, distances, state_handle) @@ -915,14 +884,9 @@ subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_ind real(r8), intent(out), optional :: distances(:) type(ensemble_type), intent(in), optional :: state_handle -! Given a DART location (referred to as "base") and a set of candidate -! locations & kinds (locs, loc_qtys/indx), returns the subset close to the -! "base", their indices, and their distances to the "base" ... - integer :: t_ind, k ! Initialize variables to missing status - num_close = 0 close_indices = -99 if (present(distances)) distances(:) = 1.0e9 !something big and positive (far away) @@ -948,13 +912,15 @@ subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_ind endif end subroutine get_close_state -!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + function read_model_time(filename) character(len=256) :: filename type(time_type) :: read_model_time -integer :: ncid !< netcdf file id +integer :: ncid ! netcdf file id integer :: nyr , & ! year number, in cice restart month , & ! month number, 1 to 12, in cice restart mday , & ! day of the month, in cice restart @@ -967,7 +933,7 @@ function read_model_time(filename) if ( .not. file_exist(filename) ) then write(string1,*) 'cannot open file ', trim(filename),' for reading.' - call error_handler(E_ERR,'read_model_time',string1,source,revision,revdate) + call error_handler(E_ERR, 'read_model_time', string1, source) endif call nc_check( nf90_open(trim(filename), NF90_NOWRITE, ncid), & @@ -985,7 +951,8 @@ function read_model_time(filename) ! THIS MUST BE FIXED IN ANOTHER WAY! if (nyr == 0) then call error_handler(E_MSG, 'read_model_time', & - 'WARNING!!! year 0 not supported; setting to year 1') + 'WARNING!!! year 0 not supported; setting to year 1', & + source) nyr = 1 endif @@ -994,8 +961,11 @@ function read_model_time(filename) secthismin = int(sec-hour*3600-minute*60) read_model_time = set_date(nyr, month, mday, hour, minute, secthismin) + end function read_model_time -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + subroutine write_model_time(ncid, model_time, adv_to_time) integer, intent(in) :: ncid @@ -1014,8 +984,8 @@ subroutine write_model_time(ncid, model_time, adv_to_time) write(string1,*)'CICE/DART not configured to advance CICE.' write(string2,*)'called with optional advance_to_time of' write(string3,'(i4.4,5(1x,i2.2))')iyear,imonth,iday,ihour,imin, isec - call error_handler(E_ERR, routine, string1, & - source, revision, revdate, text2=string2,text3=string3) + call error_handler(E_ERR, routine, string1, source, text2=string2, & + text3=string3) endif call get_date(model_time, iyear, imonth, iday, ihour, imin, isec) @@ -1030,9 +1000,12 @@ subroutine write_model_time(ncid, model_time, adv_to_time) call nc_end_define_mode(ncid) end subroutine write_model_time + !----------------------------------------------------------------- ! Check which surface temperature state variable is in restart + subroutine check_sfctemp_var(flag) + logical, intent(inout) :: flag if (any(variable_table(:,1)=='Tsfc')) then @@ -1040,10 +1013,14 @@ subroutine check_sfctemp_var(flag) else flag = .false. endif + end subroutine check_sfctemp_var + !----------------------------------------------------------------- ! Find state variable index + subroutine find_var_type(varname,var_index) + character(len=16), intent(in) :: varname integer, intent(inout) :: var_index @@ -1056,16 +1033,12 @@ subroutine find_var_type(varname,var_index) endif enddo write(string1,*)'Could not find index of state variable' -call error_handler(E_ERR, 'find_var_type', string1, & - source, revision, revdate) +call error_handler(E_ERR, 'find_var_type', string1, source) + end subroutine find_var_type + !=================================================================== ! End of model_mod !=================================================================== -end module model_mod -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ +end module model_mod From 70204d46ffabb39f146c7a8da6c5b88cb58138a6 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 27 Aug 2024 02:18:38 -0600 Subject: [PATCH 05/23] Remove unused variables and subroutines, including those commented out that were replaced with the corresponding ones from default_model_mod --- models/cice-scm/model_mod.f90 | 80 +++-------------------------------- 1 file changed, 5 insertions(+), 75 deletions(-) diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index a90f9451ad..23fc9fd47b 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -6,8 +6,7 @@ module model_mod ! Modules that are absolutely required for use are listed use types_mod, only : i4, r8, i8, MISSING_R8, metadatalength -use time_manager_mod, only : time_type, set_time, set_time_missing, set_calendar_type, & - get_time, set_date, get_date +use time_manager_mod, only : time_type, set_calendar_type, get_time, set_date, get_date use location_mod, only : location_type, get_close_type, get_close_obs, get_dist, & convert_vertical_obs, convert_vertical_state, & set_location, set_location_missing, VERTISLEVEL, & @@ -120,10 +119,6 @@ module model_mod character(len=512) :: string2 character(len=512) :: string3 -type(location_type), allocatable :: state_loc(:) ! state locations, compute once and store for speed - -type(time_type) :: assimilation_time_step - ! DART state vector contents are specified in the input.nml:&model_nml namelist. integer, parameter :: max_state_variables = 10 integer, parameter :: num_state_table_columns = 3 @@ -191,7 +186,7 @@ subroutine static_init_model() model_timestep = set_model_time_step() -call get_time(model_timestep,ss,dd) ! set_time() assures the seconds [0,86400) +call get_time(model_timestep,ss,dd) write(string1, *) 'assimilation period is ', dd,' days ', ss,' seconds' call error_handler(E_MSG, 'static_init_model', string1, source) @@ -222,46 +217,6 @@ subroutine static_init_model() end subroutine static_init_model -!------------------------------------------------------------------ -! Returns a model state vector, x, that is some sort of appropriate -! initial condition for starting up a long integration of the model. -! At present, this is only used if the namelist parameter -! start_from_restart is set to .false. in the program perfect_model_obs. -! If this option is not to be used in perfect_model_obs, or if no -! synthetic data experiments using perfect_model_obs are planned, -! this can be a NULL INTERFACE. - -!subroutine init_conditions(x) -! -!real(r8), intent(out) :: x(:) -! -!x = MISSING_R8 -! -!end subroutine init_conditions - -!------------------------------------------------------------------ -! Does a single timestep advance of the model. The input value of -! the vector x is the starting condition and x is updated to reflect -! the changed state after a timestep. The time argument is intent -! in and is used for models that need to know the date/time to -! compute a timestep, for instance for radiation computations. -! This interface is only called if the namelist parameter -! async is set to 0 in perfect_model_obs of filter or if the -! program integrate_model is to be used to advance the model -! state as a separate executable. If one of these options -! is not going to be used (the model will only be advanced as -! a separate model-specific executable), this can be a -! NULL INTERFACE. - -!subroutine adv_1step(x, time) -! -!real(r8), intent(inout) :: x(:) -!type(time_type), intent(in) :: time -! -!end subroutine adv_1step - - - !------------------------------------------------------------------ ! Returns the number of items in the state vector as an integer. ! This interface is required for all applications. @@ -274,24 +229,6 @@ function get_model_size() end function get_model_size -!------------------------------------------------------------------ -! Companion interface to init_conditions. Returns a time that is somehow -! appropriate for starting up a long integration of the model. -! At present, this is only used if the namelist parameter -! start_from_restart is set to .false. in the program perfect_model_obs. -! If this option is not to be used in perfect_model_obs, or if no -! synthetic data experiments using perfect_model_obs are planned, -! this can be a NULL INTERFACE. - -!subroutine init_time(time) -! -!type(time_type), intent(out) :: time -! -!! for now, just set to 0 -!time = set_time(0,0) -! -!end subroutine init_time - !------------------------------------------------------------------ ! Given a state handle, a location, and a model state variable type, ! interpolates the state variable fields to that location and returns @@ -691,20 +628,13 @@ subroutine nc_write_model_atts(ncid, domain_id) integer, intent(in) :: ncid ! netCDF file identifier integer, intent(in) :: domain_id -integer :: NGridDimID -integer, parameter :: MAXLINELEN = 128 -character(len=8), parameter :: cice_namelist_file = 'cice_in' -character(len=MAXLINELEN), allocatable, dimension(:) :: textblock -integer :: LineLenDimID, nlinesDimID, nmlVarID -integer :: nlines, linelen,status -logical :: has_cice_namelist +integer :: NGridDimID +integer :: tlonVarID, tlatVarID +integer :: status character(len=256) :: filename -integer :: NlonDimID, NlatDimID -integer :: tlonVarID, tlatVarID - if ( .not. module_initialized ) call static_init_model ! put file into define mode. From fa5903e19420e41540b0206ae2244a3b3b63c91a Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 27 Aug 2024 02:50:28 -0600 Subject: [PATCH 06/23] dart_cice_mod.f90 and dart_to_cice.f90 - remove svn info and register_module, adjusting style to be more readable and consistent --- models/cice-scm/dart_cice_mod.f90 | 62 ++++++++++++--------------- models/cice-scm/dart_to_cice.f90 | 69 ++++++++++++++++--------------- 2 files changed, 62 insertions(+), 69 deletions(-) diff --git a/models/cice-scm/dart_cice_mod.f90 b/models/cice-scm/dart_cice_mod.f90 index 5abe47e686..e5b167aa3d 100644 --- a/models/cice-scm/dart_cice_mod.f90 +++ b/models/cice-scm/dart_cice_mod.f90 @@ -1,8 +1,6 @@ ! DART software - Copyright UCAR. This open source software is provided ! by UCAR, "as is", without charge, subject to all terms of use at ! http://www.image.ucar.edu/DAReS/DART/DART_download -! -! $Id$ module dart_cice_mod @@ -27,10 +25,7 @@ module dart_cice_mod public :: set_model_time_step,get_horiz_grid_dims, & get_ncat_dim, read_horiz_grid -character(len=*), parameter :: source = "$URL$" -character(len=*), parameter :: revision = "$Revision$" -character(len=*), parameter :: revdate = "$Date$" - +character(len=*), parameter :: source = 'dart_cice_mod.f90' character(len=512) :: msgstring logical, save :: module_initialized = .false. @@ -38,15 +33,16 @@ module dart_cice_mod contains -subroutine initialize_module - -integer :: iunit, io - +!----------------------------------------------------------------- ! Read calendar information ! In 'restart' mode, this is primarily the calendar type and 'stop' ! information. The time attributes of the restart file override ! the namelist time information. +subroutine initialize_module + +integer :: iunit, io + ! FIXME : Real observations are always GREGORIAN dates ... ! but stomping on that here gets in the way of running ! a perfect_model experiment for pre-1601 AD cases. @@ -55,23 +51,20 @@ subroutine initialize_module ! Make sure we have a cice restart file (for grid dims) if ( .not. file_exist(ic_filename) ) then msgstring = 'dart_cice_mod: '//trim(ic_filename)//' not found' - call error_handler(E_ERR,'initialize_module', & - msgstring, source, revision, revdate) + call error_handler(E_ERR,'initialize_module', msgstring, source) endif module_initialized = .true. -! Print module information to log file and stdout. -call register_module(source, revision, revdate) - end subroutine initialize_module -!!!!!!!!!!!!!!!! -function set_model_time_step() +!----------------------------------------------------------------- ! the initialize_module ensures that the cice namelists are read. ! The restart times in the cice_in&restart_nml are used to define ! appropriate assimilation timesteps. -! + +function set_model_time_step() + type(time_type) :: set_model_time_step if ( .not. module_initialized ) call initialize_module @@ -90,14 +83,12 @@ function set_model_time_step() !endif end function set_model_time_step -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -subroutine get_horiz_grid_dims(Nx) -! +!----------------------------------------------------------------- ! Read the lon, lat grid size from the restart netcdf file. ! The actual grid file is a binary file with no header information. -! -! The file name comes from module storage ... namelist. + +subroutine get_horiz_grid_dims(Nx) integer, intent(out) :: Nx ! Number of Longitudes @@ -112,8 +103,7 @@ subroutine get_horiz_grid_dims(Nx) nc_rc = nf90_inq_dimid(grid_id, 'ni', dimid) if (nc_rc /= nf90_noerr) then msgstring = "unable to find either 'ni' or 'nlon' in file "//trim(ic_filename) - call error_handler(E_ERR, 'get_horiz_grid_dims', msgstring, & - source,revision,revdate) + call error_handler(E_ERR, 'get_horiz_grid_dims', msgstring, source) endif call nc_check(nf90_inquire_dimension(grid_id, dimid, len=Nx), & @@ -123,12 +113,12 @@ subroutine get_horiz_grid_dims(Nx) 'get_horiz_grid_dims','close '//trim(ic_filename) ) end subroutine get_horiz_grid_dims -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -subroutine get_ncat_dim(Ncat) -! +!----------------------------------------------------------------- ! Read the ncat size from the restart netcdf file. +subroutine get_ncat_dim(Ncat) + integer, intent(out) :: Ncat ! Number of categories in ice-thick dist integer :: grid_id, dimid, nc_rc @@ -144,8 +134,7 @@ subroutine get_ncat_dim(Ncat) nc_rc = nf90_inq_dimid(grid_id, 'Ncat', dimid) if (nc_rc /= nf90_noerr) then msgstring = "unable to find either 'ncat' or 'Ncat' in file "//trim(ic_filename) - call error_handler(E_ERR, 'get_horiz_grid_dims', msgstring, & - source,revision,revdate) + call error_handler(E_ERR, 'get_horiz_grid_dims', msgstring, source) endif endif @@ -153,12 +142,13 @@ subroutine get_ncat_dim(Ncat) 'get_ncat_dim','inquire_dimension ni '//trim(ic_filename)) ! tidy up - call nc_check(nf90_close(grid_id), & 'get_ncat_dim','close '//trim(ic_filename) ) end subroutine get_ncat_dim -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!----------------------------------------------------------------- + subroutine read_horiz_grid(nx, TLAT, TLON) integer, intent(in) :: nx @@ -172,8 +162,7 @@ subroutine read_horiz_grid(nx, TLAT, TLON) if ( .not. file_exist(ic_filename) ) then msgstring = 'cice grid '//trim(ic_filename)//' not found' - call error_handler(E_ERR,'read_horiz_grid', & - msgstring, source, revision, revdate) + call error_handler(E_ERR,'read_horiz_grid', msgstring, source) endif ! Open it and read them in the EXPECTED order. @@ -212,5 +201,8 @@ subroutine read_horiz_grid(nx, TLAT, TLON) end subroutine read_horiz_grid -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!=================================================================== +! End of model_mod +!=================================================================== + end module dart_cice_mod diff --git a/models/cice-scm/dart_to_cice.f90 b/models/cice-scm/dart_to_cice.f90 index 3882e2fd7c..54832f81f0 100644 --- a/models/cice-scm/dart_to_cice.f90 +++ b/models/cice-scm/dart_to_cice.f90 @@ -1,8 +1,6 @@ ! DART software - Copyright UCAR. This open source software is provided ! by UCAR, "as is", without charge, subject to all terms of use at ! http://www.image.ucar.edu/DAReS/DART/DART_download -! -! $Id$ program dart_to_cice @@ -26,13 +24,7 @@ program dart_to_cice implicit none -! version controlled file description for error handling, do not edit -character(len=*), parameter :: source = & - "$URL$" -character(len=*), parameter :: revision = "$Revision$" -character(len=*), parameter :: revdate = "$Date$" - -!------------------------------------------------------------------ +character(len=*), parameter :: source = 'dart_to_cice.f90' character(len=256) :: dart_to_cice_input_file = 'dart_restart.nc' character(len=256) :: original_cice_input_file = 'cice_restart.nc' @@ -86,7 +78,7 @@ program dart_to_cice phi_init = 0.75_r8, & dSin0_frazil = 3.0_r8 real(r8), parameter :: sss = 34.7_r8 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(r8) :: squeeze,cc1,cc2,cc3,x1,Si0new,Ti,qsno_hold,qi0new real(r8), allocatable :: hin_max(:) real(r8), allocatable :: hcat_midpoint(:) @@ -145,7 +137,7 @@ program dart_to_cice call get_variable(ncid,'qsno'//trim(nchar),qsno(l,:),dart_to_cice_input_file,gridpt_oi,Ncat) enddo call nc_check(nf90_close(ncid),'dart_to_cice', 'close '//trim(original_cice_input_file)) -!!!!!!!!! + call nc_check( nf90_open(trim(dart_to_cice_input_file), NF90_NOWRITE, ncid), & 'dart_to_cice', 'open "'//trim(dart_to_cice_input_file)//'"') allocate(aicen(NCAT),vicen(NCAT),vsnon(NCAT)) @@ -154,7 +146,7 @@ program dart_to_cice call get_variable(ncid,'vsnon',vsnon,dart_to_cice_input_file,gridpt_oi,Ncat) call get_variable1d(ncid,'sst',sst,dart_to_cice_input_file,gridpt_oi,sst_present) call nc_check(nf90_close(ncid),'dart_to_cice', 'close '//trim(dart_to_cice_input_file)) -!!!!!!!!!!!!!!!!!!!!!!!!! + qice = min(0.0_r8,qice) sice = max(0.0_r8,sice) qsno = min(0.0_r8,qsno) @@ -247,7 +239,7 @@ program dart_to_cice vsnon(n) = 0.0_r8 endif enddo -!!!!!!!! + call nc_check( nf90_open(trim(original_cice_input_file), NF90_WRITE, ncid), & 'dart_to_cice', 'open "'//trim(original_cice_input_file)//'"') varname='aicen' @@ -257,7 +249,7 @@ program dart_to_cice io = nf90_put_var(ncid, VarID, aicen,start=(/gridpt_oi,1/),count=(/1,NCAT/)) call nc_check(io, 'dart_to_cice', & 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) -!!!! + varname='vicen' io = nf90_inq_varid(ncid, trim(varname), VarID) call nc_check(io, 'dart_to_cice', & @@ -265,7 +257,7 @@ program dart_to_cice io = nf90_put_var(ncid, VarID, vicen,start=(/gridpt_oi,1/),count=(/1,NCAT/)) call nc_check(io, 'dart_to_cice', & 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) -!!!! + varname='vsnon' io = nf90_inq_varid(ncid, trim(varname), VarID) call nc_check(io, 'dart_to_cice', & @@ -273,7 +265,7 @@ program dart_to_cice io = nf90_put_var(ncid, VarID, vsnon,start=(/gridpt_oi,1/),count=(/1,NCAT/)) call nc_check(io, 'dart_to_cice', & 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) -!!!! + varname='Tsfcn' io = nf90_inq_varid(ncid, trim(varname), VarID) call nc_check(io, 'dart_to_cice', & @@ -281,7 +273,7 @@ program dart_to_cice io = nf90_put_var(ncid, VarID, Tsfcn,start=(/gridpt_oi,1/),count=(/1,NCAT/)) call nc_check(io, 'dart_to_cice', & 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) -!!!!! + if (sst_present) then varname='sst' io = nf90_inq_varid(ncid, trim(varname), VarID) @@ -291,7 +283,7 @@ program dart_to_cice call nc_check(io, 'dart_to_cice', & 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) endif -!!!!! + do l=1, Nilyr write(nchar,'(i3.3)') l varname='qice'//trim(nchar) @@ -301,7 +293,7 @@ program dart_to_cice io = nf90_put_var(ncid, VarID, qice(l,:),start=(/gridpt_oi,1/),count=(/1,NCAT/)) call nc_check(io, 'dart_to_cice', & 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) - !!!!!!!!!! + varname='sice'//trim(nchar) io = nf90_inq_varid(ncid, trim(varname), VarID) call nc_check(io, 'dart_to_cice', & @@ -310,7 +302,7 @@ program dart_to_cice call nc_check(io, 'dart_to_cice', & 'put_var '//trim(varname)//' '//trim(original_cice_input_file)) enddo -!!!! + do l=1, Nslyr write(nchar,'(i3.3)') l varname='qsno'//trim(nchar) @@ -330,9 +322,10 @@ program dart_to_cice call finalize_utilities('dart_to_cice') - contains +!------------------------------------------------------------------ + subroutine get_variable(ncid,varname,var,filename,space_index,ncat) integer, intent(in) :: ncid,ncat character(len=*), intent(in) :: varname @@ -355,7 +348,9 @@ subroutine get_variable(ncid,varname,var,filename,space_index,ncat) var(:) = holder(gridpt_oi,:) end subroutine get_variable -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + subroutine get_variable1d(ncid,varname,var,filename,space_index,var_present) integer, intent(in) :: ncid character(len=*), intent(in) :: varname @@ -384,7 +379,9 @@ subroutine get_variable1d(ncid,varname,var,filename,space_index,var_present) var = holder(gridpt_oi) end subroutine get_variable1d -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + function enthalpy_mush(zTin, zSin) result(zqin) ! enthalpy of mush from mush temperature and bulk salinity @@ -422,7 +419,9 @@ function enthalpy_mush(zTin, zSin) result(zqin) rhoi * cp_ice * zTin - (1._r8 - phi) * rhoi * Lfresh end function enthalpy_mush -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + function liquid_fraction(zTin, zSin) result(phi) ! liquid fraction of mush from mush temperature and bulk salinity @@ -441,7 +440,9 @@ function liquid_fraction(zTin, zSin) result(phi) phi = zSin / max(Sbr, zSin) end function liquid_fraction -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + function snow_enthaply(Ti) result(qsno) real(r8), intent(in) :: Ti @@ -452,7 +453,9 @@ function snow_enthaply(Ti) result(qsno) qsno = -rhos*(Lfresh - cp_ice*min(0.0_r8,Ti)) end function snow_enthaply -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + function liquidus_brine_salinity_mush(zTin) result(Sbr) ! liquidus relation: equilibrium brine salinity as function of temperature @@ -512,7 +515,9 @@ function liquidus_brine_salinity_mush(zTin) result(Sbr) Sbr = Sbr * lsubzero end function liquidus_brine_salinity_mush -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!------------------------------------------------------------------ + function liquidus_temperature_mush(Sbr) result(zTin) ! liquidus relation: equilibrium temperature as function of brine salinity @@ -568,11 +573,7 @@ function liquidus_temperature_mush(Sbr) result(zTin) ((Sbr / (M2_liq + N2_liq * Sbr)) + O2_liq) * (1._r8 - t_high) end function liquidus_temperature_mush -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -end program dart_to_cice -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ +!------------------------------------------------------------------ + +end program dart_to_cice From 673c2e872733d11d257923a832250a1b5ceff3fe Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 27 Aug 2024 14:17:37 -0600 Subject: [PATCH 07/23] dart_cice_mod: more cleaning and removing use statements for unused subroutines and unused variables --- models/cice-scm/dart_cice_mod.f90 | 69 +++++++++++++------------------ 1 file changed, 28 insertions(+), 41 deletions(-) diff --git a/models/cice-scm/dart_cice_mod.f90 b/models/cice-scm/dart_cice_mod.f90 index e5b167aa3d..fd83c33089 100644 --- a/models/cice-scm/dart_cice_mod.f90 +++ b/models/cice-scm/dart_cice_mod.f90 @@ -4,25 +4,18 @@ module dart_cice_mod -use types_mod, only : r8, rad2deg, PI, SECPERDAY, digits12 -use time_manager_mod, only : time_type, get_date, set_date, get_time, set_time, & - set_calendar_type, get_calendar_string, & - print_date, print_time, operator(==), operator(-) -use utilities_mod, only : get_unit, open_file, close_file, file_exist, & - register_module, error_handler, & - find_namelist_in_file, check_namelist_read, & - E_ERR, E_MSG, find_textfile_dims - +use types_mod, only : r8, rad2deg +use time_manager_mod, only : time_type, set_time, set_calendar_type, & + operator(==), operator(-) +use utilities_mod, only : file_exist, error_handler, E_ERR, E_MSG use netcdf_utilities_mod, only : nc_check - -use typesizes use netcdf implicit none private -public :: set_model_time_step,get_horiz_grid_dims, & +public :: set_model_time_step, get_horiz_grid_dims, & get_ncat_dim, read_horiz_grid character(len=*), parameter :: source = 'dart_cice_mod.f90' @@ -75,8 +68,10 @@ function set_model_time_step() !if ( (trim(restart_option) == 'ndays') .or. (trim(restart_option) == 'nday' ) ) then ! set_model_time_step = set_time(0, restart_n) ! (seconds, days) !else if ( trim(restart_option) == 'nyears' ) then - ! FIXME ... CMB I guess we ignore it and make the freq 1 day anyway? - set_model_time_step = set_time(0, 1) ! (seconds, days) + +! FIXME ... CMB I guess we ignore it and make the freq 1 day anyway? +set_model_time_step = set_time(0, 1) ! (seconds, days) + !else ! call error_handler(E_ERR,'set_model_time_step', & ! 'restart_option must be ndays or nday', source, revision, revdate) @@ -107,10 +102,9 @@ subroutine get_horiz_grid_dims(Nx) endif call nc_check(nf90_inquire_dimension(grid_id, dimid, len=Nx), & - 'get_horiz_grid_dims','inquire_dimension ni '//trim(ic_filename)) + 'get_horiz_grid_dims','inquire_dimension ni '//trim(ic_filename)) -call nc_check(nf90_close(grid_id), & - 'get_horiz_grid_dims','close '//trim(ic_filename) ) +call nc_check(nf90_close(grid_id), 'get_horiz_grid_dims','close '//trim(ic_filename) ) end subroutine get_horiz_grid_dims @@ -126,7 +120,7 @@ subroutine get_ncat_dim(Ncat) if ( .not. module_initialized ) call initialize_module call nc_check(nf90_open(trim(ic_filename), nf90_nowrite, grid_id), & - 'get_ncat_dim','open '//trim(ic_filename)) + 'get_ncat_dim','open '//trim(ic_filename)) ! ncat : get dimid for 'ncat' and then get value nc_rc = nf90_inq_dimid(grid_id, 'ncat', dimid) @@ -139,11 +133,9 @@ subroutine get_ncat_dim(Ncat) endif call nc_check(nf90_inquire_dimension(grid_id, dimid, len=Ncat), & - 'get_ncat_dim','inquire_dimension ni '//trim(ic_filename)) + 'get_ncat_dim','inquire_dimension ni '//trim(ic_filename)) -! tidy up -call nc_check(nf90_close(grid_id), & - 'get_ncat_dim','close '//trim(ic_filename) ) +call nc_check(nf90_close(grid_id), 'get_ncat_dim','close '//trim(ic_filename) ) end subroutine get_ncat_dim @@ -151,48 +143,43 @@ end subroutine get_ncat_dim subroutine read_horiz_grid(nx, TLAT, TLON) -integer, intent(in) :: nx +integer, intent(in) :: nx real(r8), dimension(nx), intent(out) :: TLAT, TLON -integer :: grid_id, reclength,VarId,status +integer :: grid_id, reclength, VarId if ( .not. module_initialized ) call initialize_module ! Check to see that the file exists. - if ( .not. file_exist(ic_filename) ) then msgstring = 'cice grid '//trim(ic_filename)//' not found' call error_handler(E_ERR,'read_horiz_grid', msgstring, source) endif ! Open it and read them in the EXPECTED order. -! Actually, we only need the first two, so I'm skipping the rest. - call nc_check(nf90_open(trim(ic_filename), nf90_nowrite, grid_id), & - 'read_horiz_grid','open '//trim(ic_filename)) + 'read_horiz_grid', 'open '//trim(ic_filename)) + ! Latitude call nc_check(nf90_inq_varid(grid_id, 'tlat', VarId), & - 'read_horiz_grid','inquiring tlat from '//trim(ic_filename)) -call nc_check(nf90_get_var(grid_id, VarId, TLAT, & - start=(/1/), & - count=(/nx/)), & -'read_horiz_grid','getting tlat from '//trim(ic_filename)) -!Longitude + 'read_horiz_grid', 'inquiring tlat from '//trim(ic_filename)) +call nc_check(nf90_get_var(grid_id, VarId, TLAT, start=(/1/), & + count=(/nx/)), 'read_horiz_grid', & + 'getting tlat from '//trim(ic_filename)) + +! Longitude call nc_check(nf90_inq_varid(grid_id, 'tlon', VarId), & -'read_horiz_grid','inquiring tlon from '//trim(ic_filename)) + 'read_horiz_grid', 'inquiring tlon from '//trim(ic_filename)) call nc_check(nf90_get_var(grid_id, VarId, TLON, & - start=(/1/), & - count=(/nx/)), & - 'read_horiz_grid','getting tlon from '//trim(ic_filename)) + start=(/1/), count=(/nx/)), & + 'read_horiz_grid', 'getting tlon from '//trim(ic_filename)) -call nc_check(nf90_close(grid_id), & - 'read_horiz_grid','close '//trim(ic_filename) ) +call nc_check(nf90_close(grid_id), 'read_horiz_grid', 'close '//trim(ic_filename)) TLAT = TLAT * rad2deg TLON = TLON * rad2deg ! ensure [0,360) [-90,90] - where (TLON < 0.0_r8) TLON = TLON + 360.0_r8 where (TLON > 360.0_r8) TLON = TLON - 360.0_r8 From 8697962e0da3ba9fb43f1685a54e46abe2128482 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Wed, 25 Sep 2024 17:12:16 -0600 Subject: [PATCH 08/23] Updating work/input.nml to have QCEFF namelists --- models/cice-scm/work/input.nml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/models/cice-scm/work/input.nml b/models/cice-scm/work/input.nml index 56706e4141..f873081782 100644 --- a/models/cice-scm/work/input.nml +++ b/models/cice-scm/work/input.nml @@ -1,3 +1,10 @@ +&probit_transform_nml + / + +&algorithm_info_nml + qceff_table_filename = '' + / + &perfect_model_obs_nml read_input_state_from_file = .true., single_file_in = .false. @@ -93,7 +100,6 @@ / &assim_tools_nml - filter_kind = 1, cutoff = 1000000.0 sort_obs_inc = .false., spread_restoration = .false., From eb5a29dc13bd44ccd32ad5a61c5947344382665c Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 1 Oct 2024 11:56:01 -0600 Subject: [PATCH 09/23] model_mod.f90: Remove unused subroutine find_var_type and unused variables; use len=vtablenamelength in definition for state variable_table instead of len=NF90_MAX_NAME --- models/cice-scm/model_mod.f90 | 35 ++--------------------------------- 1 file changed, 2 insertions(+), 33 deletions(-) diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index 23fc9fd47b..9789b0a37d 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -5,7 +5,7 @@ module model_mod ! Modules that are absolutely required for use are listed -use types_mod, only : i4, r8, i8, MISSING_R8, metadatalength +use types_mod, only : i4, r8, i8, MISSING_R8, metadatalength, vtablenamelength use time_manager_mod, only : time_type, set_calendar_type, get_time, set_date, get_date use location_mod, only : location_type, get_close_type, get_close_obs, get_dist, & convert_vertical_obs, convert_vertical_state, & @@ -122,7 +122,7 @@ module model_mod ! DART state vector contents are specified in the input.nml:&model_nml namelist. integer, parameter :: max_state_variables = 10 integer, parameter :: num_state_table_columns = 3 -character(len=NF90_MAX_NAME) :: variable_table( max_state_variables, num_state_table_columns ) +character(len=vtablenamelength) :: variable_table( max_state_variables, num_state_table_columns ) integer :: state_kinds_list( max_state_variables ) logical :: update_var_list( max_state_variables ) @@ -290,13 +290,11 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte thick_flag = .true. base_offset = cat_index set_obstype = obs_type - !call find_var_type('hi',var_index) else set_obstype = QTY_SEAICE_VOLUME cat_signal = 1 ! for extra special procedure to aggregate !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_VOLUME)) base_offset = cat_index - !call find_var_type('vicen',var_index) endif CASE (QTY_SEAICE_AGREG_SNOWDEPTH ) ! these kinds require aggregating 3D vars to make a 2D var if (any(variable_table(:,1)=='hs')) then @@ -305,13 +303,11 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte base_offset = cat_index thick_flag = .true. set_obstype = obs_type - !call find_var_type('hs',var_index) else set_obstype = QTY_SEAICE_SNOWVOLUME cat_signal = 1 ! for extra special procedure to aggregate !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_SNOWVOLUME)) base_offset = cat_index - !call find_var_type('vsnon',var_index) endif CASE (QTY_SEAICE_AGREG_CONCENTR ) ! these kinds require aggregating a 3D var to make a 2D var cat_signal = 0 ! for aggregate variable, send signal to lon_lat_interp @@ -464,7 +460,6 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte ! we need to know the aggregate sea ice concentration for these special cases base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_CONCENTR)) base_offset = base_offset + (cat_index-1) - print*,'CHECK CHECK CHECK' call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal, expected_aggr_conc, istatus) expected_obs = expected_obs/max(expected_aggr_conc,1.0e-8) ! hope this is allowed so we never divide by zero @@ -506,7 +501,6 @@ subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_typ real(r8) :: p(4,ens_size), xbot(ens_size), xtop(ens_size) real(r8) :: work_expected_obs(ens_size) real(r8) :: lon_fract, lat_fract -logical :: masked integer :: quad_status integer :: e, iterations, Niterations integer :: next_offset @@ -539,10 +533,6 @@ subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_typ !print*,'offset',offset state_index = get_dart_vector_index(grid_oi,int(offset,i4),1, domain_id, e) work_expected_obs = get_state(state_index,state_handle) - !if(masked) then - ! istatus = 3 - ! return - !endif expected_obs = expected_obs+work_expected_obs enddo end subroutine lon_lat_interpolate @@ -946,27 +936,6 @@ subroutine check_sfctemp_var(flag) end subroutine check_sfctemp_var -!----------------------------------------------------------------- -! Find state variable index - -subroutine find_var_type(varname,var_index) - -character(len=16), intent(in) :: varname -integer, intent(inout) :: var_index - -integer :: i - -do i=1,size(variable_table(:,1)) - if (trim(varname) == variable_table(i,1)) then - var_index = i - return - endif -enddo -write(string1,*)'Could not find index of state variable' -call error_handler(E_ERR, 'find_var_type', string1, source) - -end subroutine find_var_type - !=================================================================== ! End of model_mod !=================================================================== From 6d31e557852c041a0f72d88f53135897461ec0f6 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 1 Oct 2024 12:01:23 -0600 Subject: [PATCH 10/23] dart_cice_mod.f90: remove unused variables and out-of-date comments --- models/cice-scm/dart_cice_mod.f90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/models/cice-scm/dart_cice_mod.f90 b/models/cice-scm/dart_cice_mod.f90 index fd83c33089..d527ece527 100644 --- a/models/cice-scm/dart_cice_mod.f90 +++ b/models/cice-scm/dart_cice_mod.f90 @@ -5,8 +5,7 @@ module dart_cice_mod use types_mod, only : r8, rad2deg -use time_manager_mod, only : time_type, set_time, set_calendar_type, & - operator(==), operator(-) +use time_manager_mod, only : time_type, set_time, set_calendar_type use utilities_mod, only : file_exist, error_handler, E_ERR, E_MSG use netcdf_utilities_mod, only : nc_check @@ -34,11 +33,6 @@ module dart_cice_mod subroutine initialize_module -integer :: iunit, io - -! FIXME : Real observations are always GREGORIAN dates ... -! but stomping on that here gets in the way of running -! a perfect_model experiment for pre-1601 AD cases. call set_calendar_type('gregorian') ! Make sure we have a cice restart file (for grid dims) From b0bc8052aa3b51ff45910979714cead25f3fe982 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 1 Oct 2024 13:33:11 -0600 Subject: [PATCH 11/23] Fixing more comments in the model_mod --- models/cice-scm/model_mod.f90 | 46 +++++++++++++++-------------------- 1 file changed, 19 insertions(+), 27 deletions(-) diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index 9789b0a37d..f0c05ef8c1 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -108,8 +108,6 @@ module model_mod read_model_time, & write_model_time - -! version controlled file description for error handling, do not edit character(len=256), parameter :: source = 'cice-scm/model_mod.f90' logical, save :: module_initialized = .false. @@ -159,11 +157,10 @@ module model_mod contains !------------------------------------------------------------------ -! Called to do one time initialization of the model. As examples, -! might define information about the model size or model timestep. -! In models that require pre-computed static data, for instance -! spherical harmonic weights, these would also be computed here. -! Can be a NULL INTERFACE for the simplest models. +! Called to do one time initialization of the model. Reads the +! namelist, defines information about the model size and model +! timestep, initializes module variables, and calls add_domain() +! to set what data should be read into the state subroutine static_init_model() @@ -219,7 +216,6 @@ end subroutine static_init_model !------------------------------------------------------------------ ! Returns the number of items in the state vector as an integer. -! This interface is required for all applications. function get_model_size() @@ -232,9 +228,9 @@ end function get_model_size !------------------------------------------------------------------ ! Given a state handle, a location, and a model state variable type, ! interpolates the state variable fields to that location and returns -! the values in expected_obs. The istatus variables should be returned as -! 0 unless there is some problem in computing the interpolation in -! which case an alternate value should be returned. +! the values in expected_obs. The istatus variables should be +! returned as 0 unless there is some problem in computing the +! interpolation, in which case an alternate value should be returned. subroutine model_interpolate(state_handle, ens_size, location, obs_type, expected_obs, istatus, thick_flag) @@ -285,7 +281,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte SELECT CASE (obs_type) CASE (QTY_SEAICE_AGREG_THICKNESS ) ! these kinds require aggregating 3D vars to make a 2D var if (any(variable_table(:,1)=='hi')) then - cat_signal = 1 !was 1 ! for extra special procedure to aggregate + cat_signal = 1 ! for extra special procedure to aggregate !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_AGREG_THICKNESS)) thick_flag = .true. base_offset = cat_index @@ -298,7 +294,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte endif CASE (QTY_SEAICE_AGREG_SNOWDEPTH ) ! these kinds require aggregating 3D vars to make a 2D var if (any(variable_table(:,1)=='hs')) then - cat_signal = 1 !was 1 ! for extra special procedure to aggregate + cat_signal = 1 ! for extra special procedure to aggregate !base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_AGREG_SNOWDEPTH)) base_offset = cat_index thick_flag = .true. @@ -323,7 +319,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_SNOWVOLUME)) CASE (QTY_SEAICE_AGREG_SURFACETEMP) ! FEI need aicen to average the temp, have not considered open water temp yet if (any(variable_table(:,1)=='Tsfc')) then - cat_signal = 1 + cat_signal = 1 ! for extra special procedure to aggregate base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_AGREG_SURFACETEMP)) thick_flag = .true. set_obstype = obs_type @@ -333,7 +329,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_SURFACETEMP)) endif CASE (QTY_SOM_TEMPERATURE) ! these kinds are 1d variables - cat_signal = 1 + cat_signal = 1 ! for extra special procedure to aggregate set_obstype = obs_type !base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SOM_TEMPERATURE)) base_offset = cat_index @@ -373,7 +369,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte ! then treat as 2d field in lon_lat_interp base_offset = get_index_start(domain_id, get_varid_from_kind(obs_type)) - base_offset = base_offset + (cat_index-1)! * Nx + base_offset = base_offset + (cat_index-1) base_offset = cat_index set_obstype = obs_type cat_signal = 1 ! now same as boring 2d field @@ -478,8 +474,6 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte ! The return code for successful return should be 0. ! Any positive number is an error. ! Negative values are reserved for use by the DART framework. -! Using distinct positive values for different types of errors can be -! useful in diagnosing problems. end subroutine model_interpolate @@ -541,7 +535,6 @@ end subroutine lon_lat_interpolate ! Returns the smallest increment in time that the model is capable ! of advancing the state in a given implementation, or the shortest ! time you want the model to advance between assimilations. -! This interface is required for all applications. function shortest_time_between_assimilations() @@ -554,10 +547,8 @@ function shortest_time_between_assimilations() end function shortest_time_between_assimilations !------------------------------------------------------------------ -! Given an integer index into the state vector structure, returns the -! associated location. This interface is required for all filter -! applications as it is required for computing the distance between -! observations and state variables. +! Given an integer index into the state vector structure, returns +! the associated location. subroutine get_state_meta_data(index_in, location, var_type) @@ -663,7 +654,7 @@ subroutine nc_write_model_atts(ncid, domain_id) end subroutine nc_write_model_atts !------------------------------------------------------------------ -! given a kind, return what variable number it is +! Given a kind, return what variable number it is function get_varid_from_kind(dart_kind) @@ -786,9 +777,10 @@ subroutine use_default_state_variables(state_variables) end subroutine use_default_state_variables !------------------------------------------------------------------ -! Given a DART location (referred to as "base") and a set of candidate -! locations & kinds (locs, loc_qtys/indx), returns the subset close to the -! "base", their indices, and their distances to the "base" ... +! Given a DART location (referred to as "base") and a set of +! candidate locations & kinds (locs, loc_qtys/indx), returns the +! subset close to the base, their indices, and their distances to +! the base subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_indx, & num_close, close_indices, distances, state_handle) From af4ad1cd1e5fbc7776ff3e7d1620642055d74177 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 1 Oct 2024 16:09:27 -0600 Subject: [PATCH 12/23] Removed function set_model_time_step() from dart_cice_mod, using the default ; removed assimilation_period_days, assimilation_period_seconds from &model_nml MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Set default namelist item ‘debug’ value to 1 to not print all the additional info --- models/cice-scm/dart_cice_mod.f90 | 33 ++----------------------------- models/cice-scm/model_mod.f90 | 31 +++++------------------------ 2 files changed, 7 insertions(+), 57 deletions(-) diff --git a/models/cice-scm/dart_cice_mod.f90 b/models/cice-scm/dart_cice_mod.f90 index d527ece527..f88fa99736 100644 --- a/models/cice-scm/dart_cice_mod.f90 +++ b/models/cice-scm/dart_cice_mod.f90 @@ -14,8 +14,7 @@ module dart_cice_mod implicit none private -public :: set_model_time_step, get_horiz_grid_dims, & - get_ncat_dim, read_horiz_grid +public :: get_horiz_grid_dims, get_ncat_dim, read_horiz_grid character(len=*), parameter :: source = 'dart_cice_mod.f90' character(len=512) :: msgstring @@ -45,34 +44,6 @@ subroutine initialize_module end subroutine initialize_module -!----------------------------------------------------------------- -! the initialize_module ensures that the cice namelists are read. -! The restart times in the cice_in&restart_nml are used to define -! appropriate assimilation timesteps. - -function set_model_time_step() - -type(time_type) :: set_model_time_step - -if ( .not. module_initialized ) call initialize_module - -! Check the 'restart_option' and 'restart_n' to determine -! when we can stop the model -! CMB not sure if nday is actually different than ndays, no matter here though -!if ( (trim(restart_option) == 'ndays') .or. (trim(restart_option) == 'nday' ) ) then -! set_model_time_step = set_time(0, restart_n) ! (seconds, days) -!else if ( trim(restart_option) == 'nyears' ) then - -! FIXME ... CMB I guess we ignore it and make the freq 1 day anyway? -set_model_time_step = set_time(0, 1) ! (seconds, days) - -!else -! call error_handler(E_ERR,'set_model_time_step', & -! 'restart_option must be ndays or nday', source, revision, revdate) -!endif - -end function set_model_time_step - !----------------------------------------------------------------- ! Read the lon, lat grid size from the restart netcdf file. ! The actual grid file is a binary file with no header information. @@ -183,7 +154,7 @@ subroutine read_horiz_grid(nx, TLAT, TLON) end subroutine read_horiz_grid !=================================================================== -! End of model_mod +! End of module dart_cice_mod !=================================================================== end module dart_cice_mod diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index f0c05ef8c1..70a2eba504 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -22,9 +22,8 @@ module model_mod use ensemble_manager_mod, only : ensemble_type use distributed_state_mod, only : get_state use default_model_mod, only : pert_model_copies, nc_write_model_vars, init_conditions, & - init_time, adv_1step -use dart_cice_mod, only : set_model_time_step,get_horiz_grid_dims, get_ncat_dim, & - read_horiz_grid + init_time, adv_1step, shortest_time_between_assimilations +use dart_cice_mod, only : get_horiz_grid_dims, get_ncat_dim, read_horiz_grid use state_structure_mod, only : state_structure_info,get_index_start, get_num_variables, & get_dart_vector_index, get_model_variable_indices use obs_kind_mod, only : QTY_SEAICE_AGREG_CONCENTR , & @@ -138,17 +137,13 @@ module model_mod integer :: Ncat=-1 integer :: domain_id,nfields -! things which can/should be in the model_nml -integer :: assimilation_period_days = 0 -integer :: assimilation_period_seconds = 3600 +! Items in the model_nml real(r8) :: model_perturbation_amplitude = 0.01 character(len=metadatalength) :: model_state_variables(max_state_variables * num_state_table_columns ) = ' ' -integer :: debug = 100 +integer :: debug = 1 integer :: grid_oi = 3 namelist /model_nml/ & - assimilation_period_days, & ! for now, this is the timestep - assimilation_period_seconds, & model_perturbation_amplitude, & model_state_variables, & debug, & @@ -181,7 +176,7 @@ subroutine static_init_model() call set_calendar_type('Gregorian') -model_timestep = set_model_time_step() +model_timestep = shortest_time_between_assimilations() call get_time(model_timestep,ss,dd) @@ -502,7 +497,6 @@ subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_typ if ( .not. module_initialized ) call static_init_model istatus = 0 -print*,'VAR TYPE',var_type if (var_type == 14) then e = 1 else if (var_type == 15) then @@ -531,21 +525,6 @@ subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_typ enddo end subroutine lon_lat_interpolate -!------------------------------------------------------------------ -! Returns the smallest increment in time that the model is capable -! of advancing the state in a given implementation, or the shortest -! time you want the model to advance between assimilations. - -function shortest_time_between_assimilations() - -type(time_type) :: shortest_time_between_assimilations - -if ( .not. module_initialized ) call static_init_model - -shortest_time_between_assimilations = model_timestep - -end function shortest_time_between_assimilations - !------------------------------------------------------------------ ! Given an integer index into the state vector structure, returns ! the associated location. From 54e6a83999cf1e79de0f0b4b529deb02436ca976 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 1 Oct 2024 17:12:00 -0600 Subject: [PATCH 13/23] Updating the namelist to reflect changes in the model_mod --- models/cice-scm/work/input.nml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/models/cice-scm/work/input.nml b/models/cice-scm/work/input.nml index f873081782..a239ac1903 100644 --- a/models/cice-scm/work/input.nml +++ b/models/cice-scm/work/input.nml @@ -132,10 +132,8 @@ / &model_nml - assimilation_period_days = 1 - assimilation_period_seconds = 0 model_perturbation_amplitude = 2e-05 - debug = 100 + debug = 1 model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', 'QTY_SEAICE_VOLUME', 'UPDATE', 'vsnon', 'QTY_SEAICE_SNOWVOLUME', 'UPDATE' From e3a51292d91091013124686b868a3f1e704eb833 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Wed, 2 Oct 2024 13:32:45 -0600 Subject: [PATCH 14/23] Added a readme including a brief description of the model and instructions to use the icepack model_mod. Added a example test case that uses perturb_single_instance=.true. to the repo --- index.rst | 2 +- models/cice-scm/icepack_test/README | 14 + models/cice-scm/icepack_test/cice.r.nc | Bin 0 -> 10252 bytes .../icepack_test/cice_restarts_in.txt | 30 + .../icepack_test/cice_restarts_out.txt | 10 + .../icepack_test/iced.2011-01-02-00000.nc | Bin 0 -> 10252 bytes models/cice-scm/icepack_test/input.nml | 224 + models/cice-scm/icepack_test/input_file.nc | Bin 0 -> 10252 bytes models/cice-scm/icepack_test/input_mean.nc | Bin 0 -> 4096 bytes models/cice-scm/icepack_test/input_sd.nc | Bin 0 -> 4096 bytes models/cice-scm/icepack_test/obs_seq.out | 3612 +++++++++++++++++ models/cice-scm/icepack_test/preassim_mean.nc | Bin 0 -> 4096 bytes models/cice-scm/icepack_test/preassim_sd.nc | Bin 0 -> 4096 bytes models/cice-scm/readme.rst | 75 +- 14 files changed, 3962 insertions(+), 5 deletions(-) create mode 100644 models/cice-scm/icepack_test/README create mode 100644 models/cice-scm/icepack_test/cice.r.nc create mode 100644 models/cice-scm/icepack_test/cice_restarts_in.txt create mode 100644 models/cice-scm/icepack_test/cice_restarts_out.txt create mode 100644 models/cice-scm/icepack_test/iced.2011-01-02-00000.nc create mode 100644 models/cice-scm/icepack_test/input.nml create mode 100644 models/cice-scm/icepack_test/input_file.nc create mode 100644 models/cice-scm/icepack_test/input_mean.nc create mode 100644 models/cice-scm/icepack_test/input_sd.nc create mode 100644 models/cice-scm/icepack_test/obs_seq.out create mode 100644 models/cice-scm/icepack_test/preassim_mean.nc create mode 100644 models/cice-scm/icepack_test/preassim_sd.nc diff --git a/index.rst b/index.rst index 06b4686699..21d94ed604 100644 --- a/index.rst +++ b/index.rst @@ -457,6 +457,7 @@ References models/gitm/readme models/gitm/netcdf_to_gitm_blocks models/gitm/gitm_blocks_to_netcdf + models/icepack/readme models/ikeda/readme models/LMDZ/readme models/lorenz_04/readme @@ -494,7 +495,6 @@ References models/template/readme models/utilities/default_model_mod - .. toctree:: :maxdepth: 2 :caption: Contributing and Community diff --git a/models/cice-scm/icepack_test/README b/models/cice-scm/icepack_test/README new file mode 100644 index 0000000000..6c401bccfb --- /dev/null +++ b/models/cice-scm/icepack_test/README @@ -0,0 +1,14 @@ +This test case performs DART data assimilation with CICE_SCM (Icepack) + +The assimilation is performed within a single time window, and therefore the model is never advanced. + +This example uses 10 ensemble members, which are created by perturbing the single restart file iced.2011-01-02-00000.nc to generate the ensemble. + +Note that the model time has been set to match the time of the observations with the following values in the &filter_nml: + init_time_days = 153076, + init_time_seconds = 0, + +The observation sequence contains 300 observations, 100 for each of the following types: + SAT_SEAICE_AGREG_CONCENTR + SAT_SEAICE_AGREG_THICKNESS + SAT_SEAICE_AGREG_SNOWDEPTH diff --git a/models/cice-scm/icepack_test/cice.r.nc b/models/cice-scm/icepack_test/cice.r.nc new file mode 100644 index 0000000000000000000000000000000000000000..559db66cb92309c8d5afec51173d52fea3eff289 GIT binary patch literal 10252 zcmeI2c{~+wyvM~kmLG+z$yQV`_ce zwveTgy`uUdTP5qAqt2Y)>)u=X@7~va-RJe1^O>3V=lgxW^UTb1<_zk)G!`-aXn$eC zOk3=&=64XVPlCOPkqf3oY~jKdHf&+FBDt73ZpPLyjxDr!VcNQjm7N);th9Z|7uv4* z#zEVE#@xZ#Xc++S{#fqX3HPv z`BxrVeax05?DN-oYB9z}!ur~@Y5s!v%`q&d)y3xYN8Tm0`hMo!g022;Y`A3^c^CBl ztKO{(R5=ZGpT?2N-!5^6~{U@@`)sFTX4! z?}FZ1M&2C@LJbAh~q>5RM!d4;s*z1Tgt@bxP+!0;|~oe2jsybE1B z%VaSx7s3$_Z~K)`gzJaTYJq$r zv>LH|R;CN&)53f#Bogf_n zt#3K4HV&-cGYt_4=oT6MbpWDK|^!a>__NKqjC#FU7SuX4w zp!uv8^oa-4e5RHp+SkT!#!x~Qw;TUPHf5rS^KhgvA82b5{pQ(O(Jgb8L6*J$@!ZE95=`r-< z`Gc6+f5rS^KWl8^_Z3q*yEX{JiCN{Rb5}ayM4OMo!`{E)L|#d{n~F7-^S2EaJJog8 zMij#0$wT)!&JMt$iP4;8X?y5Fus`Vd;NUJ#*sqHo(l%6w{d=FcjEbznc^chbh&QX9#|-FqJJn<;5M^^X`0u$?9`{&!zUm z6cejZ52Z~oWuL(&^Vjcjp2)l+;>ouLnCNn8-COo{c%Q`j>IqXe&iiiH_p7OGf_)_U z)NWfZ*mn;4Z$VRVo*!t&mVDg?=Ko{(%&q5d_)v0nk=tw-&MV~gO%H{u!HS9wxs5hW z@F`2sOMioMoVT1XFPM0bz*c)M`7nM%*t+akWEhJe&acL+cOP1!00Y-7SIk!JfdL;g ziLu7C`Fp;>^44!9_d<5V^3HCTWm_F!IduhVY-1zNgF_lKS1cETAxOCPB`*4t_!Ro;i;?8G9jq7E4Lg1O{- z^D=sTsq(cGGyX59FdY%~oE|P!4h@b>c&=75>#;srLd~aC#m9c#p3QqpReYBx2_|@9 z+YL`$$`Tnod*2%W5R7L(yH!Crjj33tOPDc(zb)3VKA2sq@^)6URDe>d(px6x{%x4S zo7nd?oKPxNX*{X^$XT~k<*^Z~%kB<3ho8H%Gx}C4V_L%zFVKo<;p%Hg_2~7(FF}Iq zZY1i$FD*XnFA$7yO@{|p~|Qr zVqz^KRP23V;F}{N^t5CkC|nQL9^QS7e6JtjUH8^|tgQp#87_%zGG|A4x7Y>>jY6EW z+idC?ZZ$^O6>5hqY&{V6ZKhQZT7u~ueoJHCJ@{S?er<8AcPTptzsX(YRJ!Vh^G|ja zYq)vD;0HasO7`_au;+Bl{{9X#I!CEy(eg7U8YtDYhSU2v54QcV>55-6{rFI7y^n#e zjUlE-;%<63VY)i+yA=p0!p!#f!*6pt+B z+cuGNt`S+fhBqV9G82v-&D?%Z$rIt8+gjv*$PeN6-4GDS?2K@~af-gEl7w^C$Vy+L z&ohM8n7uu5q!3|6q_k8Iq|rJ2mhG9FxH}(yZQtd4rmP2k>2BhCT>1>>W65Pjiy#G# z&a7dYE&B`y?+~PJ^?avulxpH!(Yq)er5e}g-t>0IwqrG{x#;CHq12?xt20U2C^cF6 zYWTS;nC|mBe<6l$K&jsd(a#KCqSUV;q0HVsD0SlOo};0eIM3c&@%qxP9yELZWv{3D zkI?LW-*UKQ&f}bVw6`E6{TWK#XGSbgI)hUD4g}bCh0r;|?X%ziB^Mdt-a!t~X`mq7 zXFIe!VtWy$?YaZH#j*&Otw!9&zgHk!E4Kc1r;dVf8Qi!vkn4eSf>7b^Q+FE?mf4U4 zt>k)y<#~?xg}i1uhvWA&$nk7maO`84X~tY495cvteiYD;^Y5IaJ!HdE;Jqg20BwGW3wF^vZI1f{+(xm%&?kMnHN6^C~=Povpl-PNqGdC+XpGrPIpZ@@Vv z{>=_y>J^j{`RdBw{h265SJ?+P(B8SsH-t-4^%Fst58>=stz;nl7U2?Eq#*BXiV)hF zQkq~l!m+INgJgpY!oeglSNH)zIE05Yuhrz?oLP=MDBuDD@PftL>#3N>+#_~`KJ3qqa-ghvSEQzohM!YtNBqFSO zu5xW-4-r;V;nX9Ni8x=R(W@kKF$7t3gn7vsi!@}BsN(r3c1}8nW2Rp|&aPvHqkT>% z*Tq`E(VL$Vq~4a{eD2bz(!2YI;N01pL%1g3n zBr~StvEn_TqsWI%YyCq(;LgD{YkG+A=w~bQwxY*IwntJ)9AzYjr(*$&D*4NM3zq4c4`t5pb*>g|`Z zqa5eV>8DNxj`1MO89_=`3O5nv$c7!B%-880jz>#s=qakeaaH%z@ptyZaSn@5#4nLJ zpG{B6)Av0HXLIybN4j>v8NJHyp6obBDbL(bOKj)hegeY!?4Up|{~3gpnt!$BvpT~1RAlIH6C(y+`bPg+9)hs4t(B!l zY9p)yp?Y6!0_Yr0>ZGQf9oB@C3Mp>W5kBy{_ry@(J6)VlT{%J-Q#6268Du`L`|)s! ztvA5><`p_eDGI9JLq}9F<<5y}!_NPX{M^H*0lj`~K9AEj(vHM*$SEr2IHu@7TR27; zJfn%YSVI$~WIVc&kkEzc+iU3sPjOD=Pdvb5Qi4(i0wy$0RHIbE@5NSP-*8T`*-U6W zhUK-l8kken!t}tMz`SZYN5nc!`u8ZwA>zbO$uaM~AmU4uXY&=y5st{3+x!V_2w!(F zb6xc;!dD%ZmCw=BJ2SE`vA>iYcm=k&7fKA z0{qcC#Lz5Og*<%?aXdb&?ol2OtV6SEYxpu(EkU!IBOceuAI3Rl&x30Zr<_sBfqS76 zd;YrcXK~_YmcTcWORuoEu+SH%~ko=RWAPT_Tskv-QV{f)1i_l&A>LeW7SvwiQ9? z@68N8k|cMb`3)L35*vCSvY~Oq%8zG=Rt)aO691Iwg~mB`pE#7Z35^qeW%N`hgwE;b z`G2dHOg|WrlV<+#pOs!OO#D{6ZBEb}CMxFV%6@$c6EmN?eag(BbJeT&pN#J`U#c3i z$4#+VaJ_2ibNKwOdhJ{_U&;{`)vzhw>qkvisfN!s6Yph=;qeh>j@B))X{t98 zU#7S+aiQCq;y`{*)Q=pwTG!rBb@aPZ~GaafA;;U8=8KPk>X`*UZ!FQ|Z@ zT@2S3g=oOfK9(j1!~onsq#ToNDbxywc;35ByY7QS(tf+{9Jz<{9#d|`s?`m!$LWc) zno}+$x|f9W+k#W(1u`0tT)gzI7~4sBU;iDyyZ#`~ZOQ}sxpg-{M}_oZ;z=$T zdvKso3)zD6kGU_2J03N{k1It;_lBzAM;R8MWY1)r_q#}M5SI>yePt=_9?BPB-{Z7G zN)12GTVD1G$p;C+77P9Ac8F<747{hY+kv$C9snvIjya7fD2u7qImBINT zN240s3ms6qsXIsSQyh%&vQ3}u45f4WIQ~y5d{c70kk?D=f2#k5`UU-?pDJcqZY<>c zfBt`S1iGnEZ#P2bj)!mTM(l9TVo_$LUB?Akj3;d_pSuNFOr>JU zI_)?o2u_GJf>V&d!x`j!BOMY1qYZ65`WSqb-fC%qb&w!*uUJi}3lapT9j*i-bPgIz z9KWxuY0Ug(Ij%W%n`AR+dHqh3^SlUXNqQr6>%B3~yDc=jTrUlQp2#Kp zWeTJ~kI$Zu%|!hB9aL;`97|4n2cBwP3-`aJ2`bf{<^A#*=l8nxlD@5`D7e1dKC*GZ z8C*BDXlUDQf#)X=pQ;@#@dLNn%(^oMv;cWrF_<=&jX^FI2GqU;@1bbIU8Hkz@7}E_@$4>tg{ADu<~MH zKr9|#(RDWH^;I!Yp~137J|hfNJbSh4wF>QjUFI8jF8AftnnGvrd`0ct>H3G@`G%t- z@AGAGUeCFH$0Ms6P|xD`_(@M9s3$sdEoHN>A zT;W#$u7dl_o@WjMl77wiBr8ii{_K>sy@Js$;OS9rTlm)v;KA+@FLhx6=dOWweWAw) zaC2TOLvT6_NTnO^r0LzkxsPt+?D?&0fUhdpC?m)Nyr)@7DW_K9+&A6b;Zds;@RKv) z&`WOwzH|P<=He4LH$=4dXgw$f#@F(nxtA{nhF_Mws?RONxgBpnRoDGfz;WmIGvLbw z;2^R^=Hi_PICno@ViBv61w2=CC%!pV1U&St?9^j_{+X1C2^jewJGWF_0+{SSwmQK1 zGBDAr<2=8X1&=pS*Q7SGbb;d)K3WBm^1wh5(W*G(i*w6Ty{X-jvcU31*_*zXY{0V2 z?QJ|iV|>i3@J`PN{&$ip|y$?*b0vmx5=HC%>Oa&On*gtw$_73M^zKf2w8nA&d;`Yr=!CfHCu2YAvJPGH~ zGA9Oa1OAO^4aWt zZdrqv2kV4czTWBdJ~ArEt_(wK7(`1c5#2Pw*+8y z(V#SRxf8IQS=XkAzy4za?waWzhHMkS*{7O1n}a04+0|e6oMywH@4>mRygaw>h6C^H z;KFw;Ou+m8LH7f$5qN$NvT#?9rVj8_JHzbZdIESEo|4ODb8_}W?BXP4!GnPZy)OSd2} zt&HfH`XG&Sr|UUtoY_Ud*;{|mRJ|5B2e+OJY-Nm}SN5gLy&ndE_c>9SAcHaB-H;_w l$s~lw8~_ literal 0 HcmV?d00001 diff --git a/models/cice-scm/icepack_test/cice_restarts_in.txt b/models/cice-scm/icepack_test/cice_restarts_in.txt new file mode 100644 index 0000000000..84893af580 --- /dev/null +++ b/models/cice-scm/icepack_test/cice_restarts_in.txt @@ -0,0 +1,30 @@ +../mem0001/restart/iced.2011-01-02-00000.nc +../mem0002/restart/iced.2011-01-02-00000.nc +../mem0003/restart/iced.2011-01-02-00000.nc +../mem0004/restart/iced.2011-01-02-00000.nc +../mem0005/restart/iced.2011-01-02-00000.nc +../mem0006/restart/iced.2011-01-02-00000.nc +../mem0007/restart/iced.2011-01-02-00000.nc +../mem0008/restart/iced.2011-01-02-00000.nc +../mem0009/restart/iced.2011-01-02-00000.nc +../mem0010/restart/iced.2011-01-02-00000.nc +../mem0011/restart/iced.2011-01-02-00000.nc +../mem0012/restart/iced.2011-01-02-00000.nc +../mem0013/restart/iced.2011-01-02-00000.nc +../mem0014/restart/iced.2011-01-02-00000.nc +../mem0015/restart/iced.2011-01-02-00000.nc +../mem0016/restart/iced.2011-01-02-00000.nc +../mem0017/restart/iced.2011-01-02-00000.nc +../mem0018/restart/iced.2011-01-02-00000.nc +../mem0019/restart/iced.2011-01-02-00000.nc +../mem0020/restart/iced.2011-01-02-00000.nc +../mem0021/restart/iced.2011-01-02-00000.nc +../mem0022/restart/iced.2011-01-02-00000.nc +../mem0023/restart/iced.2011-01-02-00000.nc +../mem0024/restart/iced.2011-01-02-00000.nc +../mem0025/restart/iced.2011-01-02-00000.nc +../mem0026/restart/iced.2011-01-02-00000.nc +../mem0027/restart/iced.2011-01-02-00000.nc +../mem0028/restart/iced.2011-01-02-00000.nc +../mem0029/restart/iced.2011-01-02-00000.nc +../mem0030/restart/iced.2011-01-02-00000.nc diff --git a/models/cice-scm/icepack_test/cice_restarts_out.txt b/models/cice-scm/icepack_test/cice_restarts_out.txt new file mode 100644 index 0000000000..0ba594abce --- /dev/null +++ b/models/cice-scm/icepack_test/cice_restarts_out.txt @@ -0,0 +1,10 @@ +./out_iced.2011-01-02-00000_mem1.nc +./out_iced.2011-01-02-00000_mem2.nc +./out_iced.2011-01-02-00000_mem3.nc +./out_iced.2011-01-02-00000_mem4.nc +./out_iced.2011-01-02-00000_mem5.nc +./out_iced.2011-01-02-00000_mem6.nc +./out_iced.2011-01-02-00000_mem7.nc +./out_iced.2011-01-02-00000_mem8.nc +./out_iced.2011-01-02-00000_mem9.nc +./out_iced.2011-01-02-00000_mem10.nc diff --git a/models/cice-scm/icepack_test/iced.2011-01-02-00000.nc b/models/cice-scm/icepack_test/iced.2011-01-02-00000.nc new file mode 100644 index 0000000000000000000000000000000000000000..559db66cb92309c8d5afec51173d52fea3eff289 GIT binary patch literal 10252 zcmeI2c{~+wyvM~kmLG+z$yQV`_ce zwveTgy`uUdTP5qAqt2Y)>)u=X@7~va-RJe1^O>3V=lgxW^UTb1<_zk)G!`-aXn$eC zOk3=&=64XVPlCOPkqf3oY~jKdHf&+FBDt73ZpPLyjxDr!VcNQjm7N);th9Z|7uv4* z#zEVE#@xZ#Xc++S{#fqX3HPv z`BxrVeax05?DN-oYB9z}!ur~@Y5s!v%`q&d)y3xYN8Tm0`hMo!g022;Y`A3^c^CBl ztKO{(R5=ZGpT?2N-!5^6~{U@@`)sFTX4! z?}FZ1M&2C@LJbAh~q>5RM!d4;s*z1Tgt@bxP+!0;|~oe2jsybE1B z%VaSx7s3$_Z~K)`gzJaTYJq$r zv>LH|R;CN&)53f#Bogf_n zt#3K4HV&-cGYt_4=oT6MbpWDK|^!a>__NKqjC#FU7SuX4w zp!uv8^oa-4e5RHp+SkT!#!x~Qw;TUPHf5rS^KhgvA82b5{pQ(O(Jgb8L6*J$@!ZE95=`r-< z`Gc6+f5rS^KWl8^_Z3q*yEX{JiCN{Rb5}ayM4OMo!`{E)L|#d{n~F7-^S2EaJJog8 zMij#0$wT)!&JMt$iP4;8X?y5Fus`Vd;NUJ#*sqHo(l%6w{d=FcjEbznc^chbh&QX9#|-FqJJn<;5M^^X`0u$?9`{&!zUm z6cejZ52Z~oWuL(&^Vjcjp2)l+;>ouLnCNn8-COo{c%Q`j>IqXe&iiiH_p7OGf_)_U z)NWfZ*mn;4Z$VRVo*!t&mVDg?=Ko{(%&q5d_)v0nk=tw-&MV~gO%H{u!HS9wxs5hW z@F`2sOMioMoVT1XFPM0bz*c)M`7nM%*t+akWEhJe&acL+cOP1!00Y-7SIk!JfdL;g ziLu7C`Fp;>^44!9_d<5V^3HCTWm_F!IduhVY-1zNgF_lKS1cETAxOCPB`*4t_!Ro;i;?8G9jq7E4Lg1O{- z^D=sTsq(cGGyX59FdY%~oE|P!4h@b>c&=75>#;srLd~aC#m9c#p3QqpReYBx2_|@9 z+YL`$$`Tnod*2%W5R7L(yH!Crjj33tOPDc(zb)3VKA2sq@^)6URDe>d(px6x{%x4S zo7nd?oKPxNX*{X^$XT~k<*^Z~%kB<3ho8H%Gx}C4V_L%zFVKo<;p%Hg_2~7(FF}Iq zZY1i$FD*XnFA$7yO@{|p~|Qr zVqz^KRP23V;F}{N^t5CkC|nQL9^QS7e6JtjUH8^|tgQp#87_%zGG|A4x7Y>>jY6EW z+idC?ZZ$^O6>5hqY&{V6ZKhQZT7u~ueoJHCJ@{S?er<8AcPTptzsX(YRJ!Vh^G|ja zYq)vD;0HasO7`_au;+Bl{{9X#I!CEy(eg7U8YtDYhSU2v54QcV>55-6{rFI7y^n#e zjUlE-;%<63VY)i+yA=p0!p!#f!*6pt+B z+cuGNt`S+fhBqV9G82v-&D?%Z$rIt8+gjv*$PeN6-4GDS?2K@~af-gEl7w^C$Vy+L z&ohM8n7uu5q!3|6q_k8Iq|rJ2mhG9FxH}(yZQtd4rmP2k>2BhCT>1>>W65Pjiy#G# z&a7dYE&B`y?+~PJ^?avulxpH!(Yq)er5e}g-t>0IwqrG{x#;CHq12?xt20U2C^cF6 zYWTS;nC|mBe<6l$K&jsd(a#KCqSUV;q0HVsD0SlOo};0eIM3c&@%qxP9yELZWv{3D zkI?LW-*UKQ&f}bVw6`E6{TWK#XGSbgI)hUD4g}bCh0r;|?X%ziB^Mdt-a!t~X`mq7 zXFIe!VtWy$?YaZH#j*&Otw!9&zgHk!E4Kc1r;dVf8Qi!vkn4eSf>7b^Q+FE?mf4U4 zt>k)y<#~?xg}i1uhvWA&$nk7maO`84X~tY495cvteiYD;^Y5IaJ!HdE;Jqg20BwGW3wF^vZI1f{+(xm%&?kMnHN6^C~=Povpl-PNqGdC+XpGrPIpZ@@Vv z{>=_y>J^j{`RdBw{h265SJ?+P(B8SsH-t-4^%Fst58>=stz;nl7U2?Eq#*BXiV)hF zQkq~l!m+INgJgpY!oeglSNH)zIE05Yuhrz?oLP=MDBuDD@PftL>#3N>+#_~`KJ3qqa-ghvSEQzohM!YtNBqFSO zu5xW-4-r;V;nX9Ni8x=R(W@kKF$7t3gn7vsi!@}BsN(r3c1}8nW2Rp|&aPvHqkT>% z*Tq`E(VL$Vq~4a{eD2bz(!2YI;N01pL%1g3n zBr~StvEn_TqsWI%YyCq(;LgD{YkG+A=w~bQwxY*IwntJ)9AzYjr(*$&D*4NM3zq4c4`t5pb*>g|`Z zqa5eV>8DNxj`1MO89_=`3O5nv$c7!B%-880jz>#s=qakeaaH%z@ptyZaSn@5#4nLJ zpG{B6)Av0HXLIybN4j>v8NJHyp6obBDbL(bOKj)hegeY!?4Up|{~3gpnt!$BvpT~1RAlIH6C(y+`bPg+9)hs4t(B!l zY9p)yp?Y6!0_Yr0>ZGQf9oB@C3Mp>W5kBy{_ry@(J6)VlT{%J-Q#6268Du`L`|)s! ztvA5><`p_eDGI9JLq}9F<<5y}!_NPX{M^H*0lj`~K9AEj(vHM*$SEr2IHu@7TR27; zJfn%YSVI$~WIVc&kkEzc+iU3sPjOD=Pdvb5Qi4(i0wy$0RHIbE@5NSP-*8T`*-U6W zhUK-l8kken!t}tMz`SZYN5nc!`u8ZwA>zbO$uaM~AmU4uXY&=y5st{3+x!V_2w!(F zb6xc;!dD%ZmCw=BJ2SE`vA>iYcm=k&7fKA z0{qcC#Lz5Og*<%?aXdb&?ol2OtV6SEYxpu(EkU!IBOceuAI3Rl&x30Zr<_sBfqS76 zd;YrcXK~_YmcTcWORuoEu+SH%~ko=RWAPT_Tskv-QV{f)1i_l&A>LeW7SvwiQ9? z@68N8k|cMb`3)L35*vCSvY~Oq%8zG=Rt)aO691Iwg~mB`pE#7Z35^qeW%N`hgwE;b z`G2dHOg|WrlV<+#pOs!OO#D{6ZBEb}CMxFV%6@$c6EmN?eag(BbJeT&pN#J`U#c3i z$4#+VaJ_2ibNKwOdhJ{_U&;{`)vzhw>qkvisfN!s6Yph=;qeh>j@B))X{t98 zU#7S+aiQCq;y`{*)Q=pwTG!rBb@aPZ~GaafA;;U8=8KPk>X`*UZ!FQ|Z@ zT@2S3g=oOfK9(j1!~onsq#ToNDbxywc;35ByY7QS(tf+{9Jz<{9#d|`s?`m!$LWc) zno}+$x|f9W+k#W(1u`0tT)gzI7~4sBU;iDyyZ#`~ZOQ}sxpg-{M}_oZ;z=$T zdvKso3)zD6kGU_2J03N{k1It;_lBzAM;R8MWY1)r_q#}M5SI>yePt=_9?BPB-{Z7G zN)12GTVD1G$p;C+77P9Ac8F<747{hY+kv$C9snvIjya7fD2u7qImBINT zN240s3ms6qsXIsSQyh%&vQ3}u45f4WIQ~y5d{c70kk?D=f2#k5`UU-?pDJcqZY<>c zfBt`S1iGnEZ#P2bj)!mTM(l9TVo_$LUB?Akj3;d_pSuNFOr>JU zI_)?o2u_GJf>V&d!x`j!BOMY1qYZ65`WSqb-fC%qb&w!*uUJi}3lapT9j*i-bPgIz z9KWxuY0Ug(Ij%W%n`AR+dHqh3^SlUXNqQr6>%B3~yDc=jTrUlQp2#Kp zWeTJ~kI$Zu%|!hB9aL;`97|4n2cBwP3-`aJ2`bf{<^A#*=l8nxlD@5`D7e1dKC*GZ z8C*BDXlUDQf#)X=pQ;@#@dLNn%(^oMv;cWrF_<=&jX^FI2GqU;@1bbIU8Hkz@7}E_@$4>tg{ADu<~MH zKr9|#(RDWH^;I!Yp~137J|hfNJbSh4wF>QjUFI8jF8AftnnGvrd`0ct>H3G@`G%t- z@AGAGUeCFH$0Ms6P|xD`_(@M9s3$sdEoHN>A zT;W#$u7dl_o@WjMl77wiBr8ii{_K>sy@Js$;OS9rTlm)v;KA+@FLhx6=dOWweWAw) zaC2TOLvT6_NTnO^r0LzkxsPt+?D?&0fUhdpC?m)Nyr)@7DW_K9+&A6b;Zds;@RKv) z&`WOwzH|P<=He4LH$=4dXgw$f#@F(nxtA{nhF_Mws?RONxgBpnRoDGfz;WmIGvLbw z;2^R^=Hi_PICno@ViBv61w2=CC%!pV1U&St?9^j_{+X1C2^jewJGWF_0+{SSwmQK1 zGBDAr<2=8X1&=pS*Q7SGbb;d)K3WBm^1wh5(W*G(i*w6Ty{X-jvcU31*_*zXY{0V2 z?QJ|iV|>i3@J`PN{&$ip|y$?*b0vmx5=HC%>Oa&On*gtw$_73M^zKf2w8nA&d;`Yr=!CfHCu2YAvJPGH~ zGA9Oa1OAO^4aWt zZdrqv2kV4czTWBdJ~ArEt_(wK7(`1c5#2Pw*+8y z(V#SRxf8IQS=XkAzy4za?waWzhHMkS*{7O1n}a04+0|e6oMywH@4>mRygaw>h6C^H z;KFw;Ou+m8LH7f$5qN$NvT#?9rVj8_JHzbZdIESEo|4ODb8_}W?BXP4!GnPZy)OSd2} zt&HfH`XG&Sr|UUtoY_Ud*;{|mRJ|5B2e+OJY-Nm}SN5gLy&ndE_c>9SAcHaB-H;_w l$s~lw8~_ literal 0 HcmV?d00001 diff --git a/models/cice-scm/icepack_test/input.nml b/models/cice-scm/icepack_test/input.nml new file mode 100644 index 0000000000..a00e096d68 --- /dev/null +++ b/models/cice-scm/icepack_test/input.nml @@ -0,0 +1,224 @@ +&probit_transform_nml + / + +&algorithm_info_nml + qceff_table_filename = '' + / + +&perfect_model_obs_nml + read_input_state_from_file = .true., + single_file_in = .false. + input_state_files = "input_file.nc" + + write_output_state_to_file = .false., + single_file_out = .true. + output_state_files = "perfect_output.nc" + output_interval = 1, + + async = 0, + adv_ens_command = "./advance_model.csh", + + obs_seq_in_file_name = "obs_seq.in", + obs_seq_out_file_name = "obs_seq.out", + init_time_days = 153076, + init_time_seconds = 0, + first_obs_days = -1, + first_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, + + trace_execution = .true., + output_timestamps = .false., + print_every_nth_obs = -1, + output_forward_op_errors = .false., + silence = .false., + / + +&filter_nml + single_file_in = .false., + input_state_files = 'iced.2011-01-02-00000.nc' + input_state_file_list = '' + + stages_to_write = 'input', 'preassim', 'analysis', 'output' + + single_file_out = .false., + output_state_files = '' + output_state_file_list = 'cice_restarts_out.txt' + output_interval = 1, + output_members = .true. + num_output_state_members = 0, + output_mean = .true. + output_sd = .true. + write_all_stages_at_end = .false. + + ens_size = 10, + num_groups = 1, + perturb_from_single_instance = .false., + perturbation_amplitude = 0.2, + distributed_state = .true. + + async = 0, + adv_ens_command = "./advance_model.csh", + + obs_sequence_in_name = "obs_seq.out", + obs_sequence_out_name = "obs_seq.final", + num_output_obs_members = 1, + init_time_days = 153076, + init_time_seconds = 0, + first_obs_days = -1, + first_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, + + inf_flavor = 0, 0, + inf_initial_from_restart = .false., .false., + inf_sd_initial_from_restart = .false., .false., + inf_deterministic = .true., .true., + inf_initial = 1.0, 1.0, + inf_lower_bound = 1.0, 1.0, + inf_upper_bound = 100.0, 1000000.0, + inf_damping = 1.0, 1.0, + inf_sd_initial = 0.0, 0.0, + inf_sd_lower_bound = 0.0, 0.0, + inf_sd_max_change = 1.05, 1.05, + + trace_execution = .true., + output_timestamps = .false., + output_forward_op_errors = .false., + silence = .false., + / + +&smoother_nml + num_lags = 0, + start_from_restart = .false., + output_restart = .false., + restart_in_file_name = 'smoother_ics', + restart_out_file_name = 'smoother_restart' + / + +&ensemble_manager_nml + / + +&assim_tools_nml + cutoff = 1000000.0 + sort_obs_inc = .false., + spread_restoration = .false., + sampling_error_correction = .false., + adaptive_localization_threshold = -1, + distribute_mean = .false. + output_localization_diagnostics = .false., + localization_diagnostics_file = 'localization_diagnostics', + print_every_nth_obs = 0 + / + +&cov_cutoff_nml + select_localization = 1 + / + +®_factor_nml + select_regression = 1, + input_reg_file = "time_mean_reg", + save_reg_diagnostics = .false., + reg_diagnostics_file = "reg_diagnostics" + / + +&obs_sequence_nml + write_binary_obs_sequence = .false. + / + +&obs_kind_nml + assimilate_these_obs_types = 'SAT_SEAICE_AGREG_THICKNESS' + evaluate_these_obs_types = '' + / + +&model_nml + model_perturbation_amplitude = 2e-05 + debug = 1 + model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', + 'QTY_SEAICE_VOLUME', 'UPDATE', 'vsnon', 'QTY_SEAICE_SNOWVOLUME', + 'UPDATE' +/ + +&dart_to_cice_nml + dart_to_cice_input_file = 'restart_state.nc' + original_cice_input_file = 'dart_restart.nc' + previous_cice_input_file = 'pre_restart.nc' + balance_method = 'simple_squeeze' + r_snw_name = 'r_snw_vary' + gridpt_oi = 3 +/ + +&utilities_nml + TERMLEVEL = 1, + module_details = .false., + logfilename = 'dart_log.out', + nmlfilename = 'dart_log.nml', + write_nml = 'none' + / + +&preprocess_nml + input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90' + output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90' + input_obs_qty_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90' + output_obs_qty_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90' + obs_type_files = '../../../observations/forward_operators/obs_def_cice_mod.f90' + quantity_files = '../../../assimilation_code/modules/observations/seaice_quantities_mod.f90', + '../../../assimilation_code/modules/observations/ocean_quantities_mod.f90' + / + +&obs_sequence_tool_nml + filename_seq = 'obs_seq.one', 'obs_seq.two', + filename_out = 'obs_seq.processed', + first_obs_days = -1, + first_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, + print_only = .false., + gregorian_cal = .false. + / + +&obs_diag_nml + obs_sequence_name = 'obs_seq.final', + bin_width_days = -1, + bin_width_seconds = -1, + init_skip_days = 0, + init_skip_seconds = 0, + Nregions = 3, + trusted_obs = 'null', + lonlim1 = 0.00, 0.00, 0.50 + lonlim2 = 1.01, 0.50, 1.01 + reg_names = 'whole', 'yin', 'yang' + create_rank_histogram = .true., + outliers_in_histogram = .true., + use_zero_error_obs = .false., + verbose = .false. + / + +&state_vector_io_nml + / + +&model_mod_check_nml + input_state_files = 'input.nc' + output_state_files = 'mmc_output.nc' + test1thru = 0 + run_tests = 1,2,3,4,5,7 + x_ind = 42 + loc_of_interest = 0.3 + quantity_of_interest = 'QTY_STATE_VARIABLE' + interp_test_dx = 0.02 + interp_test_xrange = 0.0, 1.0 + verbose = .false. + / + +&quality_control_nml + input_qc_threshold = 3.0, + outlier_threshold = -1.0, +/ + +&location_nml + horiz_dist_only = .true. + approximate_distance = .false. + nlon = 71 + nlat = 36 + output_box_info = .true. +/ diff --git a/models/cice-scm/icepack_test/input_file.nc b/models/cice-scm/icepack_test/input_file.nc new file mode 100644 index 0000000000000000000000000000000000000000..559db66cb92309c8d5afec51173d52fea3eff289 GIT binary patch literal 10252 zcmeI2c{~+wyvM~kmLG+z$yQV`_ce zwveTgy`uUdTP5qAqt2Y)>)u=X@7~va-RJe1^O>3V=lgxW^UTb1<_zk)G!`-aXn$eC zOk3=&=64XVPlCOPkqf3oY~jKdHf&+FBDt73ZpPLyjxDr!VcNQjm7N);th9Z|7uv4* z#zEVE#@xZ#Xc++S{#fqX3HPv z`BxrVeax05?DN-oYB9z}!ur~@Y5s!v%`q&d)y3xYN8Tm0`hMo!g022;Y`A3^c^CBl ztKO{(R5=ZGpT?2N-!5^6~{U@@`)sFTX4! z?}FZ1M&2C@LJbAh~q>5RM!d4;s*z1Tgt@bxP+!0;|~oe2jsybE1B z%VaSx7s3$_Z~K)`gzJaTYJq$r zv>LH|R;CN&)53f#Bogf_n zt#3K4HV&-cGYt_4=oT6MbpWDK|^!a>__NKqjC#FU7SuX4w zp!uv8^oa-4e5RHp+SkT!#!x~Qw;TUPHf5rS^KhgvA82b5{pQ(O(Jgb8L6*J$@!ZE95=`r-< z`Gc6+f5rS^KWl8^_Z3q*yEX{JiCN{Rb5}ayM4OMo!`{E)L|#d{n~F7-^S2EaJJog8 zMij#0$wT)!&JMt$iP4;8X?y5Fus`Vd;NUJ#*sqHo(l%6w{d=FcjEbznc^chbh&QX9#|-FqJJn<;5M^^X`0u$?9`{&!zUm z6cejZ52Z~oWuL(&^Vjcjp2)l+;>ouLnCNn8-COo{c%Q`j>IqXe&iiiH_p7OGf_)_U z)NWfZ*mn;4Z$VRVo*!t&mVDg?=Ko{(%&q5d_)v0nk=tw-&MV~gO%H{u!HS9wxs5hW z@F`2sOMioMoVT1XFPM0bz*c)M`7nM%*t+akWEhJe&acL+cOP1!00Y-7SIk!JfdL;g ziLu7C`Fp;>^44!9_d<5V^3HCTWm_F!IduhVY-1zNgF_lKS1cETAxOCPB`*4t_!Ro;i;?8G9jq7E4Lg1O{- z^D=sTsq(cGGyX59FdY%~oE|P!4h@b>c&=75>#;srLd~aC#m9c#p3QqpReYBx2_|@9 z+YL`$$`Tnod*2%W5R7L(yH!Crjj33tOPDc(zb)3VKA2sq@^)6URDe>d(px6x{%x4S zo7nd?oKPxNX*{X^$XT~k<*^Z~%kB<3ho8H%Gx}C4V_L%zFVKo<;p%Hg_2~7(FF}Iq zZY1i$FD*XnFA$7yO@{|p~|Qr zVqz^KRP23V;F}{N^t5CkC|nQL9^QS7e6JtjUH8^|tgQp#87_%zGG|A4x7Y>>jY6EW z+idC?ZZ$^O6>5hqY&{V6ZKhQZT7u~ueoJHCJ@{S?er<8AcPTptzsX(YRJ!Vh^G|ja zYq)vD;0HasO7`_au;+Bl{{9X#I!CEy(eg7U8YtDYhSU2v54QcV>55-6{rFI7y^n#e zjUlE-;%<63VY)i+yA=p0!p!#f!*6pt+B z+cuGNt`S+fhBqV9G82v-&D?%Z$rIt8+gjv*$PeN6-4GDS?2K@~af-gEl7w^C$Vy+L z&ohM8n7uu5q!3|6q_k8Iq|rJ2mhG9FxH}(yZQtd4rmP2k>2BhCT>1>>W65Pjiy#G# z&a7dYE&B`y?+~PJ^?avulxpH!(Yq)er5e}g-t>0IwqrG{x#;CHq12?xt20U2C^cF6 zYWTS;nC|mBe<6l$K&jsd(a#KCqSUV;q0HVsD0SlOo};0eIM3c&@%qxP9yELZWv{3D zkI?LW-*UKQ&f}bVw6`E6{TWK#XGSbgI)hUD4g}bCh0r;|?X%ziB^Mdt-a!t~X`mq7 zXFIe!VtWy$?YaZH#j*&Otw!9&zgHk!E4Kc1r;dVf8Qi!vkn4eSf>7b^Q+FE?mf4U4 zt>k)y<#~?xg}i1uhvWA&$nk7maO`84X~tY495cvteiYD;^Y5IaJ!HdE;Jqg20BwGW3wF^vZI1f{+(xm%&?kMnHN6^C~=Povpl-PNqGdC+XpGrPIpZ@@Vv z{>=_y>J^j{`RdBw{h265SJ?+P(B8SsH-t-4^%Fst58>=stz;nl7U2?Eq#*BXiV)hF zQkq~l!m+INgJgpY!oeglSNH)zIE05Yuhrz?oLP=MDBuDD@PftL>#3N>+#_~`KJ3qqa-ghvSEQzohM!YtNBqFSO zu5xW-4-r;V;nX9Ni8x=R(W@kKF$7t3gn7vsi!@}BsN(r3c1}8nW2Rp|&aPvHqkT>% z*Tq`E(VL$Vq~4a{eD2bz(!2YI;N01pL%1g3n zBr~StvEn_TqsWI%YyCq(;LgD{YkG+A=w~bQwxY*IwntJ)9AzYjr(*$&D*4NM3zq4c4`t5pb*>g|`Z zqa5eV>8DNxj`1MO89_=`3O5nv$c7!B%-880jz>#s=qakeaaH%z@ptyZaSn@5#4nLJ zpG{B6)Av0HXLIybN4j>v8NJHyp6obBDbL(bOKj)hegeY!?4Up|{~3gpnt!$BvpT~1RAlIH6C(y+`bPg+9)hs4t(B!l zY9p)yp?Y6!0_Yr0>ZGQf9oB@C3Mp>W5kBy{_ry@(J6)VlT{%J-Q#6268Du`L`|)s! ztvA5><`p_eDGI9JLq}9F<<5y}!_NPX{M^H*0lj`~K9AEj(vHM*$SEr2IHu@7TR27; zJfn%YSVI$~WIVc&kkEzc+iU3sPjOD=Pdvb5Qi4(i0wy$0RHIbE@5NSP-*8T`*-U6W zhUK-l8kken!t}tMz`SZYN5nc!`u8ZwA>zbO$uaM~AmU4uXY&=y5st{3+x!V_2w!(F zb6xc;!dD%ZmCw=BJ2SE`vA>iYcm=k&7fKA z0{qcC#Lz5Og*<%?aXdb&?ol2OtV6SEYxpu(EkU!IBOceuAI3Rl&x30Zr<_sBfqS76 zd;YrcXK~_YmcTcWORuoEu+SH%~ko=RWAPT_Tskv-QV{f)1i_l&A>LeW7SvwiQ9? z@68N8k|cMb`3)L35*vCSvY~Oq%8zG=Rt)aO691Iwg~mB`pE#7Z35^qeW%N`hgwE;b z`G2dHOg|WrlV<+#pOs!OO#D{6ZBEb}CMxFV%6@$c6EmN?eag(BbJeT&pN#J`U#c3i z$4#+VaJ_2ibNKwOdhJ{_U&;{`)vzhw>qkvisfN!s6Yph=;qeh>j@B))X{t98 zU#7S+aiQCq;y`{*)Q=pwTG!rBb@aPZ~GaafA;;U8=8KPk>X`*UZ!FQ|Z@ zT@2S3g=oOfK9(j1!~onsq#ToNDbxywc;35ByY7QS(tf+{9Jz<{9#d|`s?`m!$LWc) zno}+$x|f9W+k#W(1u`0tT)gzI7~4sBU;iDyyZ#`~ZOQ}sxpg-{M}_oZ;z=$T zdvKso3)zD6kGU_2J03N{k1It;_lBzAM;R8MWY1)r_q#}M5SI>yePt=_9?BPB-{Z7G zN)12GTVD1G$p;C+77P9Ac8F<747{hY+kv$C9snvIjya7fD2u7qImBINT zN240s3ms6qsXIsSQyh%&vQ3}u45f4WIQ~y5d{c70kk?D=f2#k5`UU-?pDJcqZY<>c zfBt`S1iGnEZ#P2bj)!mTM(l9TVo_$LUB?Akj3;d_pSuNFOr>JU zI_)?o2u_GJf>V&d!x`j!BOMY1qYZ65`WSqb-fC%qb&w!*uUJi}3lapT9j*i-bPgIz z9KWxuY0Ug(Ij%W%n`AR+dHqh3^SlUXNqQr6>%B3~yDc=jTrUlQp2#Kp zWeTJ~kI$Zu%|!hB9aL;`97|4n2cBwP3-`aJ2`bf{<^A#*=l8nxlD@5`D7e1dKC*GZ z8C*BDXlUDQf#)X=pQ;@#@dLNn%(^oMv;cWrF_<=&jX^FI2GqU;@1bbIU8Hkz@7}E_@$4>tg{ADu<~MH zKr9|#(RDWH^;I!Yp~137J|hfNJbSh4wF>QjUFI8jF8AftnnGvrd`0ct>H3G@`G%t- z@AGAGUeCFH$0Ms6P|xD`_(@M9s3$sdEoHN>A zT;W#$u7dl_o@WjMl77wiBr8ii{_K>sy@Js$;OS9rTlm)v;KA+@FLhx6=dOWweWAw) zaC2TOLvT6_NTnO^r0LzkxsPt+?D?&0fUhdpC?m)Nyr)@7DW_K9+&A6b;Zds;@RKv) z&`WOwzH|P<=He4LH$=4dXgw$f#@F(nxtA{nhF_Mws?RONxgBpnRoDGfz;WmIGvLbw z;2^R^=Hi_PICno@ViBv61w2=CC%!pV1U&St?9^j_{+X1C2^jewJGWF_0+{SSwmQK1 zGBDAr<2=8X1&=pS*Q7SGbb;d)K3WBm^1wh5(W*G(i*w6Ty{X-jvcU31*_*zXY{0V2 z?QJ|iV|>i3@J`PN{&$ip|y$?*b0vmx5=HC%>Oa&On*gtw$_73M^zKf2w8nA&d;`Yr=!CfHCu2YAvJPGH~ zGA9Oa1OAO^4aWt zZdrqv2kV4czTWBdJ~ArEt_(wK7(`1c5#2Pw*+8y z(V#SRxf8IQS=XkAzy4za?waWzhHMkS*{7O1n}a04+0|e6oMywH@4>mRygaw>h6C^H z;KFw;Ou+m8LH7f$5qN$NvT#?9rVj8_JHzbZdIESEo|4ODb8_}W?BXP4!GnPZy)OSd2} zt&HfH`XG&Sr|UUtoY_Ud*;{|mRJ|5B2e+OJY-Nm}SN5gLy&ndE_c>9SAcHaB-H;_w l$s~lw8~_ literal 0 HcmV?d00001 diff --git a/models/cice-scm/icepack_test/input_mean.nc b/models/cice-scm/icepack_test/input_mean.nc new file mode 100644 index 0000000000000000000000000000000000000000..e54645987cf39dc9ae74ad0f8a561c170c1ca6c5 GIT binary patch literal 4096 zcmZ>EabseD04^W}Vl(Asf(2NBBuid$VhNCD1!5i`<_2Qk{zwRGwt6*ecWTIeTp3gPnbWY*81-ppf{q z%$(Ht%)GSxqFk^85o(1q^9o8!6jJkwQ*)DYQWbJj6Z1f_LSTKE9wNs-++efd-U0hZ zG$perHMt}{FSR5&B`qG=I}Ds)^?CWoVTj9}%z2eXAoqgegpq-P%@Ifg!y~UG10)I; z2gxz8vO+dVn zfnoo$oQJ=hdk@)PkSck`&ZZye_MCs{K@c^+5Y`llD*EZ|};uXvY47zt(OlW684Ly3HqX-J2Kohii9!uR3~c z|MKk%*QbiF+P}6S&}c>LBKv(R3?YqM^6U?q2UO4hv(kR%j;oipD(v3B#=Ev?UcH?C z^DjxlpR0@PpBIEPw%(Xx|Dxsh``Yw(`;TNMPUbpjXus`-KxpK?cKZ_&3tqoF#SgSE zZuQN1+V-ubWwsw2GVHf54nHMoearsRou4J(ulINE=TETTcW3#eJq>T|&+1)2kS%+`exGqnI{z!){R_7i%&5K6yMJ@#w*}(! zy6jh3FG!fBaLInFTHR@jmzw+6z5Ug&*WSr~%E>jqri)*)pTvFF$amV&{j1&h%f1_N z*l+#BeQ&aqnEh4@%Qh)(`Tffyz8y{e@Y;Tg%-5Bn;gjt*++)0PJlYH;@<%zNAut*O ZqaiRF0;3@?8UmvsFd71*Auz&2007(xYx@8I literal 0 HcmV?d00001 diff --git a/models/cice-scm/icepack_test/input_sd.nc b/models/cice-scm/icepack_test/input_sd.nc new file mode 100644 index 0000000000000000000000000000000000000000..953ccb0a234a789f902b8b73555bea97567c01b0 GIT binary patch literal 4096 zcmZ>EabseD04^W}Vl(Asf(2NBBuid$VhNCD1!5i`<_2Qk{zwRGwt6*ecWTIeTp3gPnbWY*81-ppf{q z%$(Ht%)GSxqFk^85o!f9^9o8!6jJkwQ*)DYQWc6*AaX)reV861$3NU)v*6wV`$se- zvnVyWBt9>-BsnE59@#q#oM82N`N(02%bm=5l|>*IgW`mdfq~5tNCU$ouOtH`3Ks{- zF|g#OBvzt{F&C#MBdY_kL2(I+SC$YTe?K4%(u)j0asm(mrUyV8sLnA2NaIuY0VvO! z2#mu#AOi?M;fSuD4Jft%h=G6^M6i|-uYLhoeQ{nsapto)0M(-ar!5Q&PMd*v6A*7? zV6Z>f;`8{d;wJlx9Ztu&q8RM=zY)05vSzjYp)&I|uO^1r?_6^}?Ek)Q`^(cp9%e+X zvA@cFx=6cytNoD^exe0E@9i%<7n>Qh-NF9M8K|r}Y@ud< z;=~u$+0h~Pr!M8Ni;2v)KmLB^<(vu6?GOE{Rx-Zx$o_al`cL+N*Y*dVJz~$uSFk@j zCs%9=SEc=a9W~!MjkD}e&k(;abM>D6*;I$JjWed&A6IPjn=pHu{kiAvGA?49><=CJ z82Lc`n*Bv%&Q+|{+w3pCd4KCbVV?aFmIt>aCMVe+kgdA6SllJ*riW*!#>(y=zQS6 ze!iIfkw1ptZdly3KlVeJo9)pO`(uyyp3<&Qvp<`#cgvF08}@r|z2!(YGqOJ%%NqPL z`KbMwAoXRJy29+wOqm(G+xWQsX^RtXPuJGjUo^ch{m&}b{)ENz1Fz%z?9V6Uyhv=D zV1G1kna}^pBKD`6m+z6|t+hXO#(?SWEp_`d53CkkK5uM)__^wdZ3^Znkw3~A4S~@R Z7!85Z5Eu=C(GVC7fzc2c4S^9J0stXnYRdos literal 0 HcmV?d00001 diff --git a/models/cice-scm/icepack_test/obs_seq.out b/models/cice-scm/icepack_test/obs_seq.out new file mode 100644 index 0000000000..132e55d641 --- /dev/null +++ b/models/cice-scm/icepack_test/obs_seq.out @@ -0,0 +1,3612 @@ + obs_sequence +obs_type_definitions + 3 + 12 SAT_SEAICE_AGREG_CONCENTR + 15 SAT_SEAICE_AGREG_THICKNESS + 16 SAT_SEAICE_AGREG_SNOWDEPTH + num_copies: 2 num_qc: 1 + num_obs: 300 max_num_obs: 300 +observations +truth +Quality Control + first: 1 last: 300 + OBS 1 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + -1 2 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 0 153076 + 5.625000000000000E-003 + OBS 2 + 1.45479447859952 + 1.36880203692740 + 0.000000000000000E+000 + 1 3 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 0 153076 + 1.000000000000000E-002 + OBS 3 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 2 4 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 0 153076 + 1.225000000000000E-003 + OBS 4 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 3 5 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 10 153076 + 5.625000000000000E-003 + OBS 5 + 1.24928159257768 + 1.36880203692740 + 0.000000000000000E+000 + 4 6 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 10 153076 + 1.000000000000000E-002 + OBS 6 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 5 7 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 10 153076 + 1.225000000000000E-003 + OBS 7 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 6 8 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 20 153076 + 5.625000000000000E-003 + OBS 8 + 1.40659533635447 + 1.36880203692740 + 0.000000000000000E+000 + 7 9 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 20 153076 + 1.000000000000000E-002 + OBS 9 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 8 10 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 20 153076 + 1.225000000000000E-003 + OBS 10 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 9 11 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 30 153076 + 5.625000000000000E-003 + OBS 11 + 1.42938872353235 + 1.36880203692740 + 0.000000000000000E+000 + 10 12 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 30 153076 + 1.000000000000000E-002 + OBS 12 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 11 13 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 30 153076 + 1.225000000000000E-003 + OBS 13 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 12 14 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 40 153076 + 5.625000000000000E-003 + OBS 14 + 1.36183664228386 + 1.36880203692740 + 0.000000000000000E+000 + 13 15 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 40 153076 + 1.000000000000000E-002 + OBS 15 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 14 16 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 40 153076 + 1.225000000000000E-003 + OBS 16 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 15 17 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 50 153076 + 5.625000000000000E-003 + OBS 17 + 1.52931921450675 + 1.36880203692740 + 0.000000000000000E+000 + 16 18 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 50 153076 + 1.000000000000000E-002 + OBS 18 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 17 19 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 50 153076 + 1.225000000000000E-003 + OBS 19 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 18 20 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 60 153076 + 5.625000000000000E-003 + OBS 20 + 1.30988567741016 + 1.36880203692740 + 0.000000000000000E+000 + 19 21 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 60 153076 + 1.000000000000000E-002 + OBS 21 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 20 22 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 60 153076 + 1.225000000000000E-003 + OBS 22 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 21 23 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 70 153076 + 5.625000000000000E-003 + OBS 23 + 1.33570970501553 + 1.36880203692740 + 0.000000000000000E+000 + 22 24 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 70 153076 + 1.000000000000000E-002 + OBS 24 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 23 25 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 70 153076 + 1.225000000000000E-003 + OBS 25 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 24 26 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 80 153076 + 5.625000000000000E-003 + OBS 26 + 1.39946886485301 + 1.36880203692740 + 0.000000000000000E+000 + 25 27 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 80 153076 + 1.000000000000000E-002 + OBS 27 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 26 28 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 80 153076 + 1.225000000000000E-003 + OBS 28 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 27 29 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 90 153076 + 5.625000000000000E-003 + OBS 29 + 1.46530676974347 + 1.36880203692740 + 0.000000000000000E+000 + 28 30 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 90 153076 + 1.000000000000000E-002 + OBS 30 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 29 31 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 90 153076 + 1.225000000000000E-003 + OBS 31 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 30 32 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 100 153076 + 5.625000000000000E-003 + OBS 32 + 1.34995291120735 + 1.36880203692740 + 0.000000000000000E+000 + 31 33 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 100 153076 + 1.000000000000000E-002 + OBS 33 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 32 34 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 100 153076 + 1.225000000000000E-003 + OBS 34 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 33 35 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 110 153076 + 5.625000000000000E-003 + OBS 35 + 1.40263563728655 + 1.36880203692740 + 0.000000000000000E+000 + 34 36 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 110 153076 + 1.000000000000000E-002 + OBS 36 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 35 37 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 110 153076 + 1.225000000000000E-003 + OBS 37 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 36 38 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 120 153076 + 5.625000000000000E-003 + OBS 38 + 1.38978288540425 + 1.36880203692740 + 0.000000000000000E+000 + 37 39 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 120 153076 + 1.000000000000000E-002 + OBS 39 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 38 40 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 120 153076 + 1.225000000000000E-003 + OBS 40 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 39 41 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 130 153076 + 5.625000000000000E-003 + OBS 41 + 1.40660245934679 + 1.36880203692740 + 0.000000000000000E+000 + 40 42 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 130 153076 + 1.000000000000000E-002 + OBS 42 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 41 43 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 130 153076 + 1.225000000000000E-003 + OBS 43 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 42 44 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 140 153076 + 5.625000000000000E-003 + OBS 44 + 1.31002118015847 + 1.36880203692740 + 0.000000000000000E+000 + 43 45 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 140 153076 + 1.000000000000000E-002 + OBS 45 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 44 46 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 140 153076 + 1.225000000000000E-003 + OBS 46 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 45 47 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 150 153076 + 5.625000000000000E-003 + OBS 47 + 1.37280337509743 + 1.36880203692740 + 0.000000000000000E+000 + 46 48 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 150 153076 + 1.000000000000000E-002 + OBS 48 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 47 49 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 150 153076 + 1.225000000000000E-003 + OBS 49 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 48 50 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 160 153076 + 5.625000000000000E-003 + OBS 50 + 1.31205337003581 + 1.36880203692740 + 0.000000000000000E+000 + 49 51 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 160 153076 + 1.000000000000000E-002 + OBS 51 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 50 52 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 160 153076 + 1.225000000000000E-003 + OBS 52 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 51 53 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 170 153076 + 5.625000000000000E-003 + OBS 53 + 1.38680382447059 + 1.36880203692740 + 0.000000000000000E+000 + 52 54 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 170 153076 + 1.000000000000000E-002 + OBS 54 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 53 55 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 170 153076 + 1.225000000000000E-003 + OBS 55 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 54 56 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 180 153076 + 5.625000000000000E-003 + OBS 56 + 1.41297264714418 + 1.36880203692740 + 0.000000000000000E+000 + 55 57 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 180 153076 + 1.000000000000000E-002 + OBS 57 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 56 58 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 180 153076 + 1.225000000000000E-003 + OBS 58 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 57 59 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 190 153076 + 5.625000000000000E-003 + OBS 59 + 1.45650147247994 + 1.36880203692740 + 0.000000000000000E+000 + 58 60 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 190 153076 + 1.000000000000000E-002 + OBS 60 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 59 61 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 190 153076 + 1.225000000000000E-003 + OBS 61 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 60 62 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 200 153076 + 5.625000000000000E-003 + OBS 62 + 1.44932080366232 + 1.36880203692740 + 0.000000000000000E+000 + 61 63 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 200 153076 + 1.000000000000000E-002 + OBS 63 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 62 64 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 200 153076 + 1.225000000000000E-003 + OBS 64 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 63 65 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 210 153076 + 5.625000000000000E-003 + OBS 65 + 1.29266747025851 + 1.36880203692740 + 0.000000000000000E+000 + 64 66 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 210 153076 + 1.000000000000000E-002 + OBS 66 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 65 67 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 210 153076 + 1.225000000000000E-003 + OBS 67 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 66 68 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 220 153076 + 5.625000000000000E-003 + OBS 68 + 1.23618328646292 + 1.36880203692740 + 0.000000000000000E+000 + 67 69 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 220 153076 + 1.000000000000000E-002 + OBS 69 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 68 70 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 220 153076 + 1.225000000000000E-003 + OBS 70 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 69 71 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 230 153076 + 5.625000000000000E-003 + OBS 71 + 1.43701990037563 + 1.36880203692740 + 0.000000000000000E+000 + 70 72 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 230 153076 + 1.000000000000000E-002 + OBS 72 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 71 73 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 230 153076 + 1.225000000000000E-003 + OBS 73 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 72 74 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 240 153076 + 5.625000000000000E-003 + OBS 74 + 1.27762733432142 + 1.36880203692740 + 0.000000000000000E+000 + 73 75 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 240 153076 + 1.000000000000000E-002 + OBS 75 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 74 76 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 240 153076 + 1.225000000000000E-003 + OBS 76 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 75 77 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 250 153076 + 5.625000000000000E-003 + OBS 77 + 1.53612611508987 + 1.36880203692740 + 0.000000000000000E+000 + 76 78 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 250 153076 + 1.000000000000000E-002 + OBS 78 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 77 79 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 250 153076 + 1.225000000000000E-003 + OBS 79 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 78 80 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 260 153076 + 5.625000000000000E-003 + OBS 80 + 1.62577847168120 + 1.36880203692740 + 0.000000000000000E+000 + 79 81 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 260 153076 + 1.000000000000000E-002 + OBS 81 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 80 82 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 260 153076 + 1.225000000000000E-003 + OBS 82 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 81 83 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 270 153076 + 5.625000000000000E-003 + OBS 83 + 1.42833411804831 + 1.36880203692740 + 0.000000000000000E+000 + 82 84 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 270 153076 + 1.000000000000000E-002 + OBS 84 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 83 85 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 270 153076 + 1.225000000000000E-003 + OBS 85 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 84 86 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 280 153076 + 5.625000000000000E-003 + OBS 86 + 1.28702193276144 + 1.36880203692740 + 0.000000000000000E+000 + 85 87 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 280 153076 + 1.000000000000000E-002 + OBS 87 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 86 88 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 280 153076 + 1.225000000000000E-003 + OBS 88 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 87 89 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 290 153076 + 5.625000000000000E-003 + OBS 89 + 1.46917625609907 + 1.36880203692740 + 0.000000000000000E+000 + 88 90 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 290 153076 + 1.000000000000000E-002 + OBS 90 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 89 91 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 290 153076 + 1.225000000000000E-003 + OBS 91 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 90 92 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 300 153076 + 5.625000000000000E-003 + OBS 92 + 1.31178657239111 + 1.36880203692740 + 0.000000000000000E+000 + 91 93 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 300 153076 + 1.000000000000000E-002 + OBS 93 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 92 94 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 300 153076 + 1.225000000000000E-003 + OBS 94 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 93 95 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 310 153076 + 5.625000000000000E-003 + OBS 95 + 1.49015321627907 + 1.36880203692740 + 0.000000000000000E+000 + 94 96 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 310 153076 + 1.000000000000000E-002 + OBS 96 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 95 97 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 310 153076 + 1.225000000000000E-003 + OBS 97 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 96 98 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 320 153076 + 5.625000000000000E-003 + OBS 98 + 1.58772800541024 + 1.36880203692740 + 0.000000000000000E+000 + 97 99 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 320 153076 + 1.000000000000000E-002 + OBS 99 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 98 100 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 320 153076 + 1.225000000000000E-003 + OBS 100 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 99 101 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 330 153076 + 5.625000000000000E-003 + OBS 101 + 1.48160826802888 + 1.36880203692740 + 0.000000000000000E+000 + 100 102 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 330 153076 + 1.000000000000000E-002 + OBS 102 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 101 103 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 330 153076 + 1.225000000000000E-003 + OBS 103 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 102 104 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 340 153076 + 5.625000000000000E-003 + OBS 104 + 1.43691787413256 + 1.36880203692740 + 0.000000000000000E+000 + 103 105 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 340 153076 + 1.000000000000000E-002 + OBS 105 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 104 106 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 340 153076 + 1.225000000000000E-003 + OBS 106 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 105 107 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 350 153076 + 5.625000000000000E-003 + OBS 107 + 1.46762268041634 + 1.36880203692740 + 0.000000000000000E+000 + 106 108 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 350 153076 + 1.000000000000000E-002 + OBS 108 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 107 109 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 350 153076 + 1.225000000000000E-003 + OBS 109 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 108 110 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 360 153076 + 5.625000000000000E-003 + OBS 110 + 1.51430676610828 + 1.36880203692740 + 0.000000000000000E+000 + 109 111 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 360 153076 + 1.000000000000000E-002 + OBS 111 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 110 112 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 360 153076 + 1.225000000000000E-003 + OBS 112 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 111 113 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 370 153076 + 5.625000000000000E-003 + OBS 113 + 1.42228361621345 + 1.36880203692740 + 0.000000000000000E+000 + 112 114 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 370 153076 + 1.000000000000000E-002 + OBS 114 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 113 115 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 370 153076 + 1.225000000000000E-003 + OBS 115 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 114 116 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 380 153076 + 5.625000000000000E-003 + OBS 116 + 1.26180504982221 + 1.36880203692740 + 0.000000000000000E+000 + 115 117 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 380 153076 + 1.000000000000000E-002 + OBS 117 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 116 118 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 380 153076 + 1.225000000000000E-003 + OBS 118 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 117 119 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 390 153076 + 5.625000000000000E-003 + OBS 119 + 1.28821820967047 + 1.36880203692740 + 0.000000000000000E+000 + 118 120 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 390 153076 + 1.000000000000000E-002 + OBS 120 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 119 121 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 390 153076 + 1.225000000000000E-003 + OBS 121 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 120 122 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 400 153076 + 5.625000000000000E-003 + OBS 122 + 1.29601516489605 + 1.36880203692740 + 0.000000000000000E+000 + 121 123 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 400 153076 + 1.000000000000000E-002 + OBS 123 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 122 124 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 400 153076 + 1.225000000000000E-003 + OBS 124 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 123 125 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 410 153076 + 5.625000000000000E-003 + OBS 125 + 1.44012478975899 + 1.36880203692740 + 0.000000000000000E+000 + 124 126 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 410 153076 + 1.000000000000000E-002 + OBS 126 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 125 127 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 410 153076 + 1.225000000000000E-003 + OBS 127 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 126 128 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 420 153076 + 5.625000000000000E-003 + OBS 128 + 1.57173907400877 + 1.36880203692740 + 0.000000000000000E+000 + 127 129 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 420 153076 + 1.000000000000000E-002 + OBS 129 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 128 130 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 420 153076 + 1.225000000000000E-003 + OBS 130 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 129 131 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 430 153076 + 5.625000000000000E-003 + OBS 131 + 1.26492011748196 + 1.36880203692740 + 0.000000000000000E+000 + 130 132 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 430 153076 + 1.000000000000000E-002 + OBS 132 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 131 133 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 430 153076 + 1.225000000000000E-003 + OBS 133 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 132 134 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 440 153076 + 5.625000000000000E-003 + OBS 134 + 1.40465584779102 + 1.36880203692740 + 0.000000000000000E+000 + 133 135 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 440 153076 + 1.000000000000000E-002 + OBS 135 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 134 136 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 440 153076 + 1.225000000000000E-003 + OBS 136 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 135 137 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 450 153076 + 5.625000000000000E-003 + OBS 137 + 1.48217290211226 + 1.36880203692740 + 0.000000000000000E+000 + 136 138 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 450 153076 + 1.000000000000000E-002 + OBS 138 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 137 139 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 450 153076 + 1.225000000000000E-003 + OBS 139 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 138 140 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 460 153076 + 5.625000000000000E-003 + OBS 140 + 1.36698649351147 + 1.36880203692740 + 0.000000000000000E+000 + 139 141 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 460 153076 + 1.000000000000000E-002 + OBS 141 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 140 142 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 460 153076 + 1.225000000000000E-003 + OBS 142 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 141 143 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 470 153076 + 5.625000000000000E-003 + OBS 143 + 1.24926157039964 + 1.36880203692740 + 0.000000000000000E+000 + 142 144 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 470 153076 + 1.000000000000000E-002 + OBS 144 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 143 145 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 470 153076 + 1.225000000000000E-003 + OBS 145 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 144 146 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 480 153076 + 5.625000000000000E-003 + OBS 146 + 1.25669198775998 + 1.36880203692740 + 0.000000000000000E+000 + 145 147 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 480 153076 + 1.000000000000000E-002 + OBS 147 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 146 148 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 480 153076 + 1.225000000000000E-003 + OBS 148 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 147 149 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 490 153076 + 5.625000000000000E-003 + OBS 149 + 1.52332752161428 + 1.36880203692740 + 0.000000000000000E+000 + 148 150 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 490 153076 + 1.000000000000000E-002 + OBS 150 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 149 151 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 490 153076 + 1.225000000000000E-003 + OBS 151 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 150 152 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 500 153076 + 5.625000000000000E-003 + OBS 152 + 1.40481949481270 + 1.36880203692740 + 0.000000000000000E+000 + 151 153 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 500 153076 + 1.000000000000000E-002 + OBS 153 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 152 154 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 500 153076 + 1.225000000000000E-003 + OBS 154 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 153 155 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 510 153076 + 5.625000000000000E-003 + OBS 155 + 1.18009188943686 + 1.36880203692740 + 0.000000000000000E+000 + 154 156 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 510 153076 + 1.000000000000000E-002 + OBS 156 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 155 157 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 510 153076 + 1.225000000000000E-003 + OBS 157 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 156 158 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 520 153076 + 5.625000000000000E-003 + OBS 158 + 1.28276957890148 + 1.36880203692740 + 0.000000000000000E+000 + 157 159 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 520 153076 + 1.000000000000000E-002 + OBS 159 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 158 160 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 520 153076 + 1.225000000000000E-003 + OBS 160 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 159 161 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 530 153076 + 5.625000000000000E-003 + OBS 161 + 1.32127203754923 + 1.36880203692740 + 0.000000000000000E+000 + 160 162 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 530 153076 + 1.000000000000000E-002 + OBS 162 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 161 163 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 530 153076 + 1.225000000000000E-003 + OBS 163 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 162 164 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 540 153076 + 5.625000000000000E-003 + OBS 164 + 1.27257505233025 + 1.36880203692740 + 0.000000000000000E+000 + 163 165 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 540 153076 + 1.000000000000000E-002 + OBS 165 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 164 166 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 540 153076 + 1.225000000000000E-003 + OBS 166 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 165 167 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 550 153076 + 5.625000000000000E-003 + OBS 167 + 1.29521287980472 + 1.36880203692740 + 0.000000000000000E+000 + 166 168 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 550 153076 + 1.000000000000000E-002 + OBS 168 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 167 169 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 550 153076 + 1.225000000000000E-003 + OBS 169 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 168 170 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 560 153076 + 5.625000000000000E-003 + OBS 170 + 1.28755673111242 + 1.36880203692740 + 0.000000000000000E+000 + 169 171 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 560 153076 + 1.000000000000000E-002 + OBS 171 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 170 172 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 560 153076 + 1.225000000000000E-003 + OBS 172 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 171 173 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 570 153076 + 5.625000000000000E-003 + OBS 173 + 1.45018963085652 + 1.36880203692740 + 0.000000000000000E+000 + 172 174 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 570 153076 + 1.000000000000000E-002 + OBS 174 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 173 175 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 570 153076 + 1.225000000000000E-003 + OBS 175 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 174 176 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 580 153076 + 5.625000000000000E-003 + OBS 176 + 1.43594646724107 + 1.36880203692740 + 0.000000000000000E+000 + 175 177 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 580 153076 + 1.000000000000000E-002 + OBS 177 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 176 178 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 580 153076 + 1.225000000000000E-003 + OBS 178 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 177 179 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 590 153076 + 5.625000000000000E-003 + OBS 179 + 1.25431196112062 + 1.36880203692740 + 0.000000000000000E+000 + 178 180 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 590 153076 + 1.000000000000000E-002 + OBS 180 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 179 181 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 590 153076 + 1.225000000000000E-003 + OBS 181 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 180 182 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 600 153076 + 5.625000000000000E-003 + OBS 182 + 1.48171895093781 + 1.36880203692740 + 0.000000000000000E+000 + 181 183 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 600 153076 + 1.000000000000000E-002 + OBS 183 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 182 184 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 600 153076 + 1.225000000000000E-003 + OBS 184 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 183 185 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 610 153076 + 5.625000000000000E-003 + OBS 185 + 1.37940704017051 + 1.36880203692740 + 0.000000000000000E+000 + 184 186 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 610 153076 + 1.000000000000000E-002 + OBS 186 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 185 187 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 610 153076 + 1.225000000000000E-003 + OBS 187 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 186 188 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 620 153076 + 5.625000000000000E-003 + OBS 188 + 1.33788907941085 + 1.36880203692740 + 0.000000000000000E+000 + 187 189 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 620 153076 + 1.000000000000000E-002 + OBS 189 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 188 190 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 620 153076 + 1.225000000000000E-003 + OBS 190 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 189 191 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 630 153076 + 5.625000000000000E-003 + OBS 191 + 1.19227574165152 + 1.36880203692740 + 0.000000000000000E+000 + 190 192 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 630 153076 + 1.000000000000000E-002 + OBS 192 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 191 193 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 630 153076 + 1.225000000000000E-003 + OBS 193 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 192 194 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 640 153076 + 5.625000000000000E-003 + OBS 194 + 1.50691607074127 + 1.36880203692740 + 0.000000000000000E+000 + 193 195 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 640 153076 + 1.000000000000000E-002 + OBS 195 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 194 196 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 640 153076 + 1.225000000000000E-003 + OBS 196 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 195 197 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 650 153076 + 5.625000000000000E-003 + OBS 197 + 1.45123848854319 + 1.36880203692740 + 0.000000000000000E+000 + 196 198 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 650 153076 + 1.000000000000000E-002 + OBS 198 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 197 199 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 650 153076 + 1.225000000000000E-003 + OBS 199 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 198 200 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 660 153076 + 5.625000000000000E-003 + OBS 200 + 1.31674944687435 + 1.36880203692740 + 0.000000000000000E+000 + 199 201 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 660 153076 + 1.000000000000000E-002 + OBS 201 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 200 202 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 660 153076 + 1.225000000000000E-003 + OBS 202 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 201 203 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 670 153076 + 5.625000000000000E-003 + OBS 203 + 1.31600573808352 + 1.36880203692740 + 0.000000000000000E+000 + 202 204 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 670 153076 + 1.000000000000000E-002 + OBS 204 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 203 205 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 670 153076 + 1.225000000000000E-003 + OBS 205 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 204 206 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 680 153076 + 5.625000000000000E-003 + OBS 206 + 1.52126447451870 + 1.36880203692740 + 0.000000000000000E+000 + 205 207 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 680 153076 + 1.000000000000000E-002 + OBS 207 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 206 208 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 680 153076 + 1.225000000000000E-003 + OBS 208 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 207 209 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 690 153076 + 5.625000000000000E-003 + OBS 209 + 1.30796753931319 + 1.36880203692740 + 0.000000000000000E+000 + 208 210 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 690 153076 + 1.000000000000000E-002 + OBS 210 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 209 211 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 690 153076 + 1.225000000000000E-003 + OBS 211 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 210 212 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 700 153076 + 5.625000000000000E-003 + OBS 212 + 1.55912651280059 + 1.36880203692740 + 0.000000000000000E+000 + 211 213 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 700 153076 + 1.000000000000000E-002 + OBS 213 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 212 214 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 700 153076 + 1.225000000000000E-003 + OBS 214 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 213 215 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 710 153076 + 5.625000000000000E-003 + OBS 215 + 1.32371793358352 + 1.36880203692740 + 0.000000000000000E+000 + 214 216 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 710 153076 + 1.000000000000000E-002 + OBS 216 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 215 217 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 710 153076 + 1.225000000000000E-003 + OBS 217 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 216 218 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 720 153076 + 5.625000000000000E-003 + OBS 218 + 1.39056815473816 + 1.36880203692740 + 0.000000000000000E+000 + 217 219 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 720 153076 + 1.000000000000000E-002 + OBS 219 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 218 220 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 720 153076 + 1.225000000000000E-003 + OBS 220 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 219 221 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 730 153076 + 5.625000000000000E-003 + OBS 221 + 1.45855005149100 + 1.36880203692740 + 0.000000000000000E+000 + 220 222 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 730 153076 + 1.000000000000000E-002 + OBS 222 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 221 223 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 730 153076 + 1.225000000000000E-003 + OBS 223 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 222 224 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 740 153076 + 5.625000000000000E-003 + OBS 224 + 1.32681246716103 + 1.36880203692740 + 0.000000000000000E+000 + 223 225 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 740 153076 + 1.000000000000000E-002 + OBS 225 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 224 226 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 740 153076 + 1.225000000000000E-003 + OBS 226 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 225 227 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 750 153076 + 5.625000000000000E-003 + OBS 227 + 1.42864593674731 + 1.36880203692740 + 0.000000000000000E+000 + 226 228 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 750 153076 + 1.000000000000000E-002 + OBS 228 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 227 229 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 750 153076 + 1.225000000000000E-003 + OBS 229 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 228 230 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 760 153076 + 5.625000000000000E-003 + OBS 230 + 1.24013261442570 + 1.36880203692740 + 0.000000000000000E+000 + 229 231 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 760 153076 + 1.000000000000000E-002 + OBS 231 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 230 232 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 760 153076 + 1.225000000000000E-003 + OBS 232 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 231 233 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 770 153076 + 5.625000000000000E-003 + OBS 233 + 1.31234865068045 + 1.36880203692740 + 0.000000000000000E+000 + 232 234 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 770 153076 + 1.000000000000000E-002 + OBS 234 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 233 235 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 770 153076 + 1.225000000000000E-003 + OBS 235 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 234 236 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 780 153076 + 5.625000000000000E-003 + OBS 236 + 1.25260305693748 + 1.36880203692740 + 0.000000000000000E+000 + 235 237 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 780 153076 + 1.000000000000000E-002 + OBS 237 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 236 238 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 780 153076 + 1.225000000000000E-003 + OBS 238 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 237 239 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 790 153076 + 5.625000000000000E-003 + OBS 239 + 1.31818103903736 + 1.36880203692740 + 0.000000000000000E+000 + 238 240 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 790 153076 + 1.000000000000000E-002 + OBS 240 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 239 241 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 790 153076 + 1.225000000000000E-003 + OBS 241 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 240 242 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 800 153076 + 5.625000000000000E-003 + OBS 242 + 1.25481056952136 + 1.36880203692740 + 0.000000000000000E+000 + 241 243 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 800 153076 + 1.000000000000000E-002 + OBS 243 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 242 244 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 800 153076 + 1.225000000000000E-003 + OBS 244 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 243 245 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 810 153076 + 5.625000000000000E-003 + OBS 245 + 1.15262532878938 + 1.36880203692740 + 0.000000000000000E+000 + 244 246 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 810 153076 + 1.000000000000000E-002 + OBS 246 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 245 247 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 810 153076 + 1.225000000000000E-003 + OBS 247 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 246 248 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 820 153076 + 5.625000000000000E-003 + OBS 248 + 1.47224309416468 + 1.36880203692740 + 0.000000000000000E+000 + 247 249 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 820 153076 + 1.000000000000000E-002 + OBS 249 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 248 250 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 820 153076 + 1.225000000000000E-003 + OBS 250 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 249 251 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 830 153076 + 5.625000000000000E-003 + OBS 251 + 1.49766085387692 + 1.36880203692740 + 0.000000000000000E+000 + 250 252 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 830 153076 + 1.000000000000000E-002 + OBS 252 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 251 253 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 830 153076 + 1.225000000000000E-003 + OBS 253 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 252 254 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 840 153076 + 5.625000000000000E-003 + OBS 254 + 1.41486500830714 + 1.36880203692740 + 0.000000000000000E+000 + 253 255 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 840 153076 + 1.000000000000000E-002 + OBS 255 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 254 256 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 840 153076 + 1.225000000000000E-003 + OBS 256 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 255 257 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 850 153076 + 5.625000000000000E-003 + OBS 257 + 1.21351844879144 + 1.36880203692740 + 0.000000000000000E+000 + 256 258 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 850 153076 + 1.000000000000000E-002 + OBS 258 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 257 259 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 850 153076 + 1.225000000000000E-003 + OBS 259 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 258 260 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 860 153076 + 5.625000000000000E-003 + OBS 260 + 1.25482567067007 + 1.36880203692740 + 0.000000000000000E+000 + 259 261 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 860 153076 + 1.000000000000000E-002 + OBS 261 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 260 262 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 860 153076 + 1.225000000000000E-003 + OBS 262 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 261 263 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 870 153076 + 5.625000000000000E-003 + OBS 263 + 1.37399909518299 + 1.36880203692740 + 0.000000000000000E+000 + 262 264 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 870 153076 + 1.000000000000000E-002 + OBS 264 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 263 265 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 870 153076 + 1.225000000000000E-003 + OBS 265 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 264 266 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 880 153076 + 5.625000000000000E-003 + OBS 266 + 1.57916374604842 + 1.36880203692740 + 0.000000000000000E+000 + 265 267 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 880 153076 + 1.000000000000000E-002 + OBS 267 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 266 268 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 880 153076 + 1.225000000000000E-003 + OBS 268 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 267 269 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 890 153076 + 5.625000000000000E-003 + OBS 269 + 1.36793484757941 + 1.36880203692740 + 0.000000000000000E+000 + 268 270 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 890 153076 + 1.000000000000000E-002 + OBS 270 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 269 271 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 890 153076 + 1.225000000000000E-003 + OBS 271 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 270 272 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 900 153076 + 5.625000000000000E-003 + OBS 272 + 1.12376745707373 + 1.36880203692740 + 0.000000000000000E+000 + 271 273 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 900 153076 + 1.000000000000000E-002 + OBS 273 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 272 274 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 900 153076 + 1.225000000000000E-003 + OBS 274 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 273 275 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 910 153076 + 5.625000000000000E-003 + OBS 275 + 1.54150975765236 + 1.36880203692740 + 0.000000000000000E+000 + 274 276 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 910 153076 + 1.000000000000000E-002 + OBS 276 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 275 277 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 910 153076 + 1.225000000000000E-003 + OBS 277 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 276 278 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 920 153076 + 5.625000000000000E-003 + OBS 278 + 1.34606733640038 + 1.36880203692740 + 0.000000000000000E+000 + 277 279 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 920 153076 + 1.000000000000000E-002 + OBS 279 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 278 280 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 920 153076 + 1.225000000000000E-003 + OBS 280 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 279 281 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 930 153076 + 5.625000000000000E-003 + OBS 281 + 1.48948315350324 + 1.36880203692740 + 0.000000000000000E+000 + 280 282 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 930 153076 + 1.000000000000000E-002 + OBS 282 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 281 283 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 930 153076 + 1.225000000000000E-003 + OBS 283 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 282 284 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 940 153076 + 5.625000000000000E-003 + OBS 284 + 1.20645405326318 + 1.36880203692740 + 0.000000000000000E+000 + 283 285 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 940 153076 + 1.000000000000000E-002 + OBS 285 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 284 286 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 940 153076 + 1.225000000000000E-003 + OBS 286 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 285 287 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 950 153076 + 5.625000000000000E-003 + OBS 287 + 1.56876666357552 + 1.36880203692740 + 0.000000000000000E+000 + 286 288 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 950 153076 + 1.000000000000000E-002 + OBS 288 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 287 289 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 950 153076 + 1.225000000000000E-003 + OBS 289 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 288 290 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 960 153076 + 5.625000000000000E-003 + OBS 290 + 1.36852430263385 + 1.36880203692740 + 0.000000000000000E+000 + 289 291 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 960 153076 + 1.000000000000000E-002 + OBS 291 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 290 292 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 960 153076 + 1.225000000000000E-003 + OBS 292 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 291 293 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 970 153076 + 5.625000000000000E-003 + OBS 293 + 1.49001722639392 + 1.36880203692740 + 0.000000000000000E+000 + 292 294 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 970 153076 + 1.000000000000000E-002 + OBS 294 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 293 295 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 970 153076 + 1.225000000000000E-003 + OBS 295 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 294 296 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 980 153076 + 5.625000000000000E-003 + OBS 296 + 1.46756341653326 + 1.36880203692740 + 0.000000000000000E+000 + 295 297 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 980 153076 + 1.000000000000000E-002 + OBS 297 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 296 298 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 980 153076 + 1.225000000000000E-003 + OBS 298 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 297 299 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 12 + 990 153076 + 5.625000000000000E-003 + OBS 299 + 1.32141551613841 + 1.36880203692740 + 0.000000000000000E+000 + 298 300 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 15 + 990 153076 + 1.000000000000000E-002 + OBS 300 + -888888.000000000 + -888888.000000000 + 1000.00000000000 + 299 -1 -1 +obdef +loc3d + 0.000000000000000 1.553343034274953 0.000000000000000 -1 +kind + 16 + 990 153076 + 1.225000000000000E-003 diff --git a/models/cice-scm/icepack_test/preassim_mean.nc b/models/cice-scm/icepack_test/preassim_mean.nc new file mode 100644 index 0000000000000000000000000000000000000000..7657818af583b47c239fd02da31643c47f934ae3 GIT binary patch literal 4096 zcmZ>EabseD04^W}Vl(Asf(2NBBuid$VhNCD1!5i`<_2Qk{zwRGwt6*ecWTIeTp3gPnbWY*81-ppf{q z%$(Ht%)GSxqFk^85o*N>fNm}>&dgOv%_~mLP0C4C$W2Ym11k^$>&5gGIey{>n+5k0 z*iWJOgEzoPy$)CB(vS-#ggZHn}_UA++Vydt97dVRDSh9`*V}_Pu_3u%D8C8{)4~PZYpERvfsMRCvn}I7xss1 zcYd!rdTjsl?F-kZim%$gwjj`GMe8E_eJTtgja%~U51I#5&;PU1e&&v=m$oYG-oM7X zwrF0xoc;4JNy4A2i|n5lgfq6@m}38;<@fvA^mqG@WF}7LI%sIW?S?>TE!_U*g5^&iuKH|0p(a~eynx%j`#{#ogFL+U3+|_}FQ33^ zAL`J))_9fL{(i6bckbs;u-|uQ`J_D!Z|%?OT|ba5d%=F6aZEb@E8hJJw-(H(z0$jX zbLF=M;`6%fS6MGen5A&ZeydvDX^WSd``5kw)v(vz$$rYoHNU2dU$URXeb>l$+R^>1 z-T2GC8*$ig{ltB5vXq$pRtw8EDQ)@v%Ok!WP5$uOeu~W3m7(F2?Kj+Gym36*3_0#c f*`pya8UmvsFd71*Aut*OqaiRF0;3@?QbPa$bc}CT literal 0 HcmV?d00001 diff --git a/models/cice-scm/icepack_test/preassim_sd.nc b/models/cice-scm/icepack_test/preassim_sd.nc new file mode 100644 index 0000000000000000000000000000000000000000..d46097a0f944b922d481bf54fbda5605ceb43d23 GIT binary patch literal 4096 zcmeHEdu&T#6u-LG*d|2Ql6YOuMZCJ!tR!+~t0CD#)>@cQb$e@-_LjDmj36HI4wDU= zHL*XKWa_bD2&1}3tG%^uGiKOoMLjb_JTk_2?-Djb#J}!I&UeoD`+n!-JHL}4Pvl`; z7KQ?o^C%q)@X^Vq2(<-80rCjs;mG?DCQ@zD87Y-UZ6OhWjHw&H2pOK7jLYTt+__Am zP~bChiC8if7t3%-EFK+$izT>3!j@nW2BU`5tIWnVCW2|h^bip`f}CU~3{$!u(K%T= zUCb5;Sg5O(;r2#MDII?1G&-W|glC3uV>($-Ra8UU$ zGs6ar;U3e3?dPG&l_FfVryYDjQ9;^;IG}S^T6ybF0ewu{p7x~_d{j)YhHRivE?n^`bp8vlKWPiiG~(d38boG**xMb_5!{Esu)H<}W z1-xWjR%!kLaE{!Rl2cd?H-mGA%0*@1sCu)=A9Wk*qS>&l_-WqY%IH3e0CfAiqn zfb&{e*?aq{?yY)L{RlP`hAn^F4TM+9p1a`DAWWh+!Hox!Mm*D+)=U#Dw<#Q zA*M;7a*06kjHm`WEvmSFS31yn1xqeVo#2tV5+9%30Ch2~Lpo;|z$FXXU#Rv%?K1sS z^|lh8zE#^IFjsn_0qo|=)3YEdJu5vuK$MU%grvRq_rvRq_ RrvRq_rvRq_r@()%z&G50ZT|oO literal 0 HcmV?d00001 diff --git a/models/cice-scm/readme.rst b/models/cice-scm/readme.rst index 1b867a5daf..965a8c7961 100644 --- a/models/cice-scm/readme.rst +++ b/models/cice-scm/readme.rst @@ -1,5 +1,72 @@ -cice-scm2 -============== +.. _icepack: -.. attention:: - Add your model documentation here. +Icepack +======= + +Overview +-------- + +DART interface modules for Icepack, the column physics of the sea ice model CICE (`https://github.com/cice-consortium/Icepack `_). Icepack is maintained by the CICE Consortium. + +The column physics package of the sea ice model CICE, “Icepack”, is maintained by the CICE Consortium. A large portion of the physics in sea ice models can be described in a vertical column, without reference to neighboring grid cells. This code includes several options for simulating sea ice thermodynamics, mechanical redistribution (ridging) and associated area and thickness changes. In addition, the model supports a number of tracers, including thickness, enthalpy, ice age, first-year ice area, deformed ice area and volume, melt ponds, and biogeochemistry. + +More information about the model and instructions on how to run Icepack can be found in the `Icepack documentation: `_ + +This model is run as a separate executable from DART, and this means that you must use scripts to alternate the model and DART program execution and allow for the progression of the assimilation through multiple time windows. These scripts will be provided by DART, but they are currently still in progress. + +The assimilation process can be easily executed within a single assimilation window, however. There is a test case available in /DART/models/icepack/icepack_test that contains the necessary input files to run filter, the main program in DART that performs the assimilation. There is a README file in this directory to give more details on the specifics of the test case. + +The steps to run this example are as follows: + +1. | ``cd /DART/models/icepack/work`` + | Navigate to the work directory for Icepack + +2. | ``./quickbuild.sh`` (or ``quickbuild.sh nompi`` if you are not building with mpi) + | Builds all DART executables + +3. | ``cd /DART/models/icepack/icepack_test`` + | Navigate to the test directory + +4. | In ``work/input.nml``, set ``perturb_from_single_instance = .true.`` in the + ``&filter_nml`` + | This setting causes filter to perturb a single restart file to generate an + ensemble + +5. | ``./filter`` + | Runs the assimilation program, resulting in four main output files: + | ``analysis_mean.nc`` and ``analysis_sd`` - the mean and standard deviation of the state of all ensemble members after the assimilation + | ``obs_seq.final`` - the ensemble members' estimate of the observations. + | ``dart_log.out`` - detailed log file for the execution of filter + +Namelist +-------- + +.. code-block:: fortran + +&model_nml + model_perturbation_amplitude = 2e-05 + debug = 1 + model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', + 'QTY_SEAICE_VOLUME', 'UPDATE', 'vsnon', 'QTY_SEAICE_SNOWVOLUME', + 'UPDATE' +/ + +Description of each namelist entry +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ++------------------------------+---------------+---------------------------------+ +| Item | Type | Description | ++==============================+===============+=================================+ +| model_perturbation_amplitude | real(r8) | Perturbation amplitude | ++------------------------------+---------------+---------------------------------+ +| debug | integer | When set to 0, debug statements | +| | | are not printed. Higher numbers | +| | | mean more debug reporting. | ++------------------------------+---------------+---------------------------------+ +| model_state_variables | character(*) | List of model state variables | ++------------------------------+---------------+---------------------------------+ + +References +~~~~~~~~~~ + +.. [1] Hunke E et al. 2018 CICE-Consortium/Icepack version 1.4.1. `doi:10.5281/zenodo.11223808 `_ From c7fefc3ad0b5caca14de3ee32a534af13d5f303a Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Wed, 2 Oct 2024 15:27:15 -0600 Subject: [PATCH 15/23] Fixes the subroutine use_default_state_variables to use the correct netcdf variable names for the corresponding QTYs. Note that this commit is more for bookeeping since this subroutine will be removed from the code in the following commit. Other model_mods do not include this subroutine and the default is typically hardcoded in the model_state_variables item of the &model_nml --- models/cice-scm/model_mod.f90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index 70a2eba504..61196749ab 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -746,12 +746,10 @@ subroutine use_default_state_variables(state_variables) character(len=*), intent(inout) :: state_variables(:) ! strings must all be the same length for the gnu compiler -state_variables( 1:5*num_state_table_columns ) = & - (/ 'CONCENTRATION ', 'QTY_SEAICE_CONCENTR ', 'UPDATE ', & - 'ICEVOLUME ', 'QTY_SEAICE_VOLUME ', 'UPDATE ', & - 'SNOWVOLUME ', 'QTY_SEAICE_SNOWVOLUME ', 'UPDATE ', & - 'UICE ', 'QTY_U_SEAICE_COMPONENT ', 'UPDATE ', & - 'VICE ', 'QTY_V_SEAICE_COMPONENT ', 'UPDATE '/) +state_variables( 1:3*num_state_table_columns ) = & + (/ 'aicen ', 'QTY_SEAICE_CONCENTR ', 'UPDATE ', & + 'vicen ', 'QTY_SEAICE_VOLUME ', 'UPDATE ', & + 'vsnon ', 'QTY_SEAICE_SNOWVOLUME ', 'UPDATE '/) end subroutine use_default_state_variables From 56ad32146b5f8ed01d8d60939aa5e71e9f7a4b64 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Thu, 3 Oct 2024 09:13:07 -0600 Subject: [PATCH 16/23] Removing the subroutine use_default_state_variables as stated by the comment. The rest of the model_mods do not use a subroutine like this. The default is provided in the input namelist. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Added check in place of the subroutine calll to error out if the model_stat_variables nml entry is completely empty (model_stat_variables = ‘ ’) --- models/cice-scm/model_mod.f90 | 27 ++++++--------------------- 1 file changed, 6 insertions(+), 21 deletions(-) diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index 61196749ab..d1ee25bd77 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -678,13 +678,12 @@ subroutine verify_state_variables(state_variables, ngood, table, kind_list, upda ngood = 0 -!>@todo deprecate. Remove a hidden 'default' set of variables. -!>@ The default is provided in the input namelist. - -if ( state_variables(1) == ' ' ) then ! no model_state_variables namelist provided - call use_default_state_variables(state_variables) - string1 = 'model_nml:model_state_variables not specified using default variables' - call error_handler(E_MSG, 'verify_state_variables', string1, source) +! Including this check as well because the conditionals below do not pass and cause the +! code to error out when the model_state_variables namelist entry is completely empty +! (model_state_variables = '') +if ( state_variables(1) == ' ' ) then ! no model_state_variables namelist entry provided + string1 = 'model_nml:model_state_variables not specified' + call error_handler(E_ERR, 'verify_state_variables', string1, source) endif MyLoop : do i = 1, nrows @@ -739,20 +738,6 @@ subroutine verify_state_variables(state_variables, ngood, table, kind_list, upda end subroutine verify_state_variables -!------------------------------------------------------------------ - -subroutine use_default_state_variables(state_variables) - -character(len=*), intent(inout) :: state_variables(:) - -! strings must all be the same length for the gnu compiler -state_variables( 1:3*num_state_table_columns ) = & - (/ 'aicen ', 'QTY_SEAICE_CONCENTR ', 'UPDATE ', & - 'vicen ', 'QTY_SEAICE_VOLUME ', 'UPDATE ', & - 'vsnon ', 'QTY_SEAICE_SNOWVOLUME ', 'UPDATE '/) - -end subroutine use_default_state_variables - !------------------------------------------------------------------ ! Given a DART location (referred to as "base") and a set of ! candidate locations & kinds (locs, loc_qtys/indx), returns the From b8b9555eba0ce8375745617d91dedf70eb44accb Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Thu, 3 Oct 2024 09:44:34 -0600 Subject: [PATCH 17/23] Erroring out in read_model_time when the model time has a year of 0 --- models/cice-scm/model_mod.f90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/models/cice-scm/model_mod.f90 b/models/cice-scm/model_mod.f90 index d1ee25bd77..3ee4140839 100644 --- a/models/cice-scm/model_mod.f90 +++ b/models/cice-scm/model_mod.f90 @@ -821,13 +821,10 @@ function read_model_time(filename) call nc_check( nf90_get_att(ncid, NF90_GLOBAL, 'sec', sec), & 'read_model_time', 'get_att sec') -! FIXME: we don't allow a real year of 0 - add one for now, but -! THIS MUST BE FIXED IN ANOTHER WAY! if (nyr == 0) then - call error_handler(E_MSG, 'read_model_time', & - 'WARNING!!! year 0 not supported; setting to year 1', & + call error_handler(E_ERR, 'read_model_time', & + 'A model time with year 0 is not supported', & source) - nyr = 1 endif hour = int(sec/3600) From d74df86bad730530d9277cb3d5c88490e7a4d93a Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Thu, 3 Oct 2024 11:37:03 -0600 Subject: [PATCH 18/23] Changing the dir name to icepack to match the docs. Removing icepack_test dir --- models/cice-scm/icepack_test/README | 14 - models/cice-scm/icepack_test/cice.r.nc | Bin 10252 -> 0 bytes .../icepack_test/cice_restarts_in.txt | 30 - .../icepack_test/cice_restarts_out.txt | 10 - .../icepack_test/iced.2011-01-02-00000.nc | Bin 10252 -> 0 bytes models/cice-scm/icepack_test/input.nml | 224 - models/cice-scm/icepack_test/input_file.nc | Bin 10252 -> 0 bytes models/cice-scm/icepack_test/input_mean.nc | Bin 4096 -> 0 bytes models/cice-scm/icepack_test/input_sd.nc | Bin 4096 -> 0 bytes models/cice-scm/icepack_test/obs_seq.out | 3612 ----------------- models/cice-scm/icepack_test/preassim_mean.nc | Bin 4096 -> 0 bytes models/cice-scm/icepack_test/preassim_sd.nc | Bin 4096 -> 0 bytes .../{cice-scm => icepack}/dart_cice_mod.f90 | 0 models/{cice-scm => icepack}/dart_to_cice.f90 | 0 models/{cice-scm => icepack}/model_mod.f90 | 0 models/{cice-scm => icepack}/readme.rst | 0 models/{cice-scm => icepack}/work/input.nml | 0 .../{cice-scm => icepack}/work/quickbuild.sh | 2 +- 18 files changed, 1 insertion(+), 3891 deletions(-) delete mode 100644 models/cice-scm/icepack_test/README delete mode 100644 models/cice-scm/icepack_test/cice.r.nc delete mode 100644 models/cice-scm/icepack_test/cice_restarts_in.txt delete mode 100644 models/cice-scm/icepack_test/cice_restarts_out.txt delete mode 100644 models/cice-scm/icepack_test/iced.2011-01-02-00000.nc delete mode 100644 models/cice-scm/icepack_test/input.nml delete mode 100644 models/cice-scm/icepack_test/input_file.nc delete mode 100644 models/cice-scm/icepack_test/input_mean.nc delete mode 100644 models/cice-scm/icepack_test/input_sd.nc delete mode 100644 models/cice-scm/icepack_test/obs_seq.out delete mode 100644 models/cice-scm/icepack_test/preassim_mean.nc delete mode 100644 models/cice-scm/icepack_test/preassim_sd.nc rename models/{cice-scm => icepack}/dart_cice_mod.f90 (100%) rename models/{cice-scm => icepack}/dart_to_cice.f90 (100%) rename models/{cice-scm => icepack}/model_mod.f90 (100%) rename models/{cice-scm => icepack}/readme.rst (100%) rename models/{cice-scm => icepack}/work/input.nml (100%) rename models/{cice-scm => icepack}/work/quickbuild.sh (98%) diff --git a/models/cice-scm/icepack_test/README b/models/cice-scm/icepack_test/README deleted file mode 100644 index 6c401bccfb..0000000000 --- a/models/cice-scm/icepack_test/README +++ /dev/null @@ -1,14 +0,0 @@ -This test case performs DART data assimilation with CICE_SCM (Icepack) - -The assimilation is performed within a single time window, and therefore the model is never advanced. - -This example uses 10 ensemble members, which are created by perturbing the single restart file iced.2011-01-02-00000.nc to generate the ensemble. - -Note that the model time has been set to match the time of the observations with the following values in the &filter_nml: - init_time_days = 153076, - init_time_seconds = 0, - -The observation sequence contains 300 observations, 100 for each of the following types: - SAT_SEAICE_AGREG_CONCENTR - SAT_SEAICE_AGREG_THICKNESS - SAT_SEAICE_AGREG_SNOWDEPTH diff --git a/models/cice-scm/icepack_test/cice.r.nc b/models/cice-scm/icepack_test/cice.r.nc deleted file mode 100644 index 559db66cb92309c8d5afec51173d52fea3eff289..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10252 zcmeI2c{~+wyvM~kmLG+z$yQV`_ce zwveTgy`uUdTP5qAqt2Y)>)u=X@7~va-RJe1^O>3V=lgxW^UTb1<_zk)G!`-aXn$eC zOk3=&=64XVPlCOPkqf3oY~jKdHf&+FBDt73ZpPLyjxDr!VcNQjm7N);th9Z|7uv4* z#zEVE#@xZ#Xc++S{#fqX3HPv z`BxrVeax05?DN-oYB9z}!ur~@Y5s!v%`q&d)y3xYN8Tm0`hMo!g022;Y`A3^c^CBl ztKO{(R5=ZGpT?2N-!5^6~{U@@`)sFTX4! z?}FZ1M&2C@LJbAh~q>5RM!d4;s*z1Tgt@bxP+!0;|~oe2jsybE1B z%VaSx7s3$_Z~K)`gzJaTYJq$r zv>LH|R;CN&)53f#Bogf_n zt#3K4HV&-cGYt_4=oT6MbpWDK|^!a>__NKqjC#FU7SuX4w zp!uv8^oa-4e5RHp+SkT!#!x~Qw;TUPHf5rS^KhgvA82b5{pQ(O(Jgb8L6*J$@!ZE95=`r-< z`Gc6+f5rS^KWl8^_Z3q*yEX{JiCN{Rb5}ayM4OMo!`{E)L|#d{n~F7-^S2EaJJog8 zMij#0$wT)!&JMt$iP4;8X?y5Fus`Vd;NUJ#*sqHo(l%6w{d=FcjEbznc^chbh&QX9#|-FqJJn<;5M^^X`0u$?9`{&!zUm z6cejZ52Z~oWuL(&^Vjcjp2)l+;>ouLnCNn8-COo{c%Q`j>IqXe&iiiH_p7OGf_)_U z)NWfZ*mn;4Z$VRVo*!t&mVDg?=Ko{(%&q5d_)v0nk=tw-&MV~gO%H{u!HS9wxs5hW z@F`2sOMioMoVT1XFPM0bz*c)M`7nM%*t+akWEhJe&acL+cOP1!00Y-7SIk!JfdL;g ziLu7C`Fp;>^44!9_d<5V^3HCTWm_F!IduhVY-1zNgF_lKS1cETAxOCPB`*4t_!Ro;i;?8G9jq7E4Lg1O{- z^D=sTsq(cGGyX59FdY%~oE|P!4h@b>c&=75>#;srLd~aC#m9c#p3QqpReYBx2_|@9 z+YL`$$`Tnod*2%W5R7L(yH!Crjj33tOPDc(zb)3VKA2sq@^)6URDe>d(px6x{%x4S zo7nd?oKPxNX*{X^$XT~k<*^Z~%kB<3ho8H%Gx}C4V_L%zFVKo<;p%Hg_2~7(FF}Iq zZY1i$FD*XnFA$7yO@{|p~|Qr zVqz^KRP23V;F}{N^t5CkC|nQL9^QS7e6JtjUH8^|tgQp#87_%zGG|A4x7Y>>jY6EW z+idC?ZZ$^O6>5hqY&{V6ZKhQZT7u~ueoJHCJ@{S?er<8AcPTptzsX(YRJ!Vh^G|ja zYq)vD;0HasO7`_au;+Bl{{9X#I!CEy(eg7U8YtDYhSU2v54QcV>55-6{rFI7y^n#e zjUlE-;%<63VY)i+yA=p0!p!#f!*6pt+B z+cuGNt`S+fhBqV9G82v-&D?%Z$rIt8+gjv*$PeN6-4GDS?2K@~af-gEl7w^C$Vy+L z&ohM8n7uu5q!3|6q_k8Iq|rJ2mhG9FxH}(yZQtd4rmP2k>2BhCT>1>>W65Pjiy#G# z&a7dYE&B`y?+~PJ^?avulxpH!(Yq)er5e}g-t>0IwqrG{x#;CHq12?xt20U2C^cF6 zYWTS;nC|mBe<6l$K&jsd(a#KCqSUV;q0HVsD0SlOo};0eIM3c&@%qxP9yELZWv{3D zkI?LW-*UKQ&f}bVw6`E6{TWK#XGSbgI)hUD4g}bCh0r;|?X%ziB^Mdt-a!t~X`mq7 zXFIe!VtWy$?YaZH#j*&Otw!9&zgHk!E4Kc1r;dVf8Qi!vkn4eSf>7b^Q+FE?mf4U4 zt>k)y<#~?xg}i1uhvWA&$nk7maO`84X~tY495cvteiYD;^Y5IaJ!HdE;Jqg20BwGW3wF^vZI1f{+(xm%&?kMnHN6^C~=Povpl-PNqGdC+XpGrPIpZ@@Vv z{>=_y>J^j{`RdBw{h265SJ?+P(B8SsH-t-4^%Fst58>=stz;nl7U2?Eq#*BXiV)hF zQkq~l!m+INgJgpY!oeglSNH)zIE05Yuhrz?oLP=MDBuDD@PftL>#3N>+#_~`KJ3qqa-ghvSEQzohM!YtNBqFSO zu5xW-4-r;V;nX9Ni8x=R(W@kKF$7t3gn7vsi!@}BsN(r3c1}8nW2Rp|&aPvHqkT>% z*Tq`E(VL$Vq~4a{eD2bz(!2YI;N01pL%1g3n zBr~StvEn_TqsWI%YyCq(;LgD{YkG+A=w~bQwxY*IwntJ)9AzYjr(*$&D*4NM3zq4c4`t5pb*>g|`Z zqa5eV>8DNxj`1MO89_=`3O5nv$c7!B%-880jz>#s=qakeaaH%z@ptyZaSn@5#4nLJ zpG{B6)Av0HXLIybN4j>v8NJHyp6obBDbL(bOKj)hegeY!?4Up|{~3gpnt!$BvpT~1RAlIH6C(y+`bPg+9)hs4t(B!l zY9p)yp?Y6!0_Yr0>ZGQf9oB@C3Mp>W5kBy{_ry@(J6)VlT{%J-Q#6268Du`L`|)s! ztvA5><`p_eDGI9JLq}9F<<5y}!_NPX{M^H*0lj`~K9AEj(vHM*$SEr2IHu@7TR27; zJfn%YSVI$~WIVc&kkEzc+iU3sPjOD=Pdvb5Qi4(i0wy$0RHIbE@5NSP-*8T`*-U6W zhUK-l8kken!t}tMz`SZYN5nc!`u8ZwA>zbO$uaM~AmU4uXY&=y5st{3+x!V_2w!(F zb6xc;!dD%ZmCw=BJ2SE`vA>iYcm=k&7fKA z0{qcC#Lz5Og*<%?aXdb&?ol2OtV6SEYxpu(EkU!IBOceuAI3Rl&x30Zr<_sBfqS76 zd;YrcXK~_YmcTcWORuoEu+SH%~ko=RWAPT_Tskv-QV{f)1i_l&A>LeW7SvwiQ9? z@68N8k|cMb`3)L35*vCSvY~Oq%8zG=Rt)aO691Iwg~mB`pE#7Z35^qeW%N`hgwE;b z`G2dHOg|WrlV<+#pOs!OO#D{6ZBEb}CMxFV%6@$c6EmN?eag(BbJeT&pN#J`U#c3i z$4#+VaJ_2ibNKwOdhJ{_U&;{`)vzhw>qkvisfN!s6Yph=;qeh>j@B))X{t98 zU#7S+aiQCq;y`{*)Q=pwTG!rBb@aPZ~GaafA;;U8=8KPk>X`*UZ!FQ|Z@ zT@2S3g=oOfK9(j1!~onsq#ToNDbxywc;35ByY7QS(tf+{9Jz<{9#d|`s?`m!$LWc) zno}+$x|f9W+k#W(1u`0tT)gzI7~4sBU;iDyyZ#`~ZOQ}sxpg-{M}_oZ;z=$T zdvKso3)zD6kGU_2J03N{k1It;_lBzAM;R8MWY1)r_q#}M5SI>yePt=_9?BPB-{Z7G zN)12GTVD1G$p;C+77P9Ac8F<747{hY+kv$C9snvIjya7fD2u7qImBINT zN240s3ms6qsXIsSQyh%&vQ3}u45f4WIQ~y5d{c70kk?D=f2#k5`UU-?pDJcqZY<>c zfBt`S1iGnEZ#P2bj)!mTM(l9TVo_$LUB?Akj3;d_pSuNFOr>JU zI_)?o2u_GJf>V&d!x`j!BOMY1qYZ65`WSqb-fC%qb&w!*uUJi}3lapT9j*i-bPgIz z9KWxuY0Ug(Ij%W%n`AR+dHqh3^SlUXNqQr6>%B3~yDc=jTrUlQp2#Kp zWeTJ~kI$Zu%|!hB9aL;`97|4n2cBwP3-`aJ2`bf{<^A#*=l8nxlD@5`D7e1dKC*GZ z8C*BDXlUDQf#)X=pQ;@#@dLNn%(^oMv;cWrF_<=&jX^FI2GqU;@1bbIU8Hkz@7}E_@$4>tg{ADu<~MH zKr9|#(RDWH^;I!Yp~137J|hfNJbSh4wF>QjUFI8jF8AftnnGvrd`0ct>H3G@`G%t- z@AGAGUeCFH$0Ms6P|xD`_(@M9s3$sdEoHN>A zT;W#$u7dl_o@WjMl77wiBr8ii{_K>sy@Js$;OS9rTlm)v;KA+@FLhx6=dOWweWAw) zaC2TOLvT6_NTnO^r0LzkxsPt+?D?&0fUhdpC?m)Nyr)@7DW_K9+&A6b;Zds;@RKv) z&`WOwzH|P<=He4LH$=4dXgw$f#@F(nxtA{nhF_Mws?RONxgBpnRoDGfz;WmIGvLbw z;2^R^=Hi_PICno@ViBv61w2=CC%!pV1U&St?9^j_{+X1C2^jewJGWF_0+{SSwmQK1 zGBDAr<2=8X1&=pS*Q7SGbb;d)K3WBm^1wh5(W*G(i*w6Ty{X-jvcU31*_*zXY{0V2 z?QJ|iV|>i3@J`PN{&$ip|y$?*b0vmx5=HC%>Oa&On*gtw$_73M^zKf2w8nA&d;`Yr=!CfHCu2YAvJPGH~ zGA9Oa1OAO^4aWt zZdrqv2kV4czTWBdJ~ArEt_(wK7(`1c5#2Pw*+8y z(V#SRxf8IQS=XkAzy4za?waWzhHMkS*{7O1n}a04+0|e6oMywH@4>mRygaw>h6C^H z;KFw;Ou+m8LH7f$5qN$NvT#?9rVj8_JHzbZdIESEo|4ODb8_}W?BXP4!GnPZy)OSd2} zt&HfH`XG&Sr|UUtoY_Ud*;{|mRJ|5B2e+OJY-Nm}SN5gLy&ndE_c>9SAcHaB-H;_w l$s~lw8~_ diff --git a/models/cice-scm/icepack_test/cice_restarts_in.txt b/models/cice-scm/icepack_test/cice_restarts_in.txt deleted file mode 100644 index 84893af580..0000000000 --- a/models/cice-scm/icepack_test/cice_restarts_in.txt +++ /dev/null @@ -1,30 +0,0 @@ -../mem0001/restart/iced.2011-01-02-00000.nc -../mem0002/restart/iced.2011-01-02-00000.nc -../mem0003/restart/iced.2011-01-02-00000.nc -../mem0004/restart/iced.2011-01-02-00000.nc -../mem0005/restart/iced.2011-01-02-00000.nc -../mem0006/restart/iced.2011-01-02-00000.nc -../mem0007/restart/iced.2011-01-02-00000.nc -../mem0008/restart/iced.2011-01-02-00000.nc -../mem0009/restart/iced.2011-01-02-00000.nc -../mem0010/restart/iced.2011-01-02-00000.nc -../mem0011/restart/iced.2011-01-02-00000.nc -../mem0012/restart/iced.2011-01-02-00000.nc -../mem0013/restart/iced.2011-01-02-00000.nc -../mem0014/restart/iced.2011-01-02-00000.nc -../mem0015/restart/iced.2011-01-02-00000.nc -../mem0016/restart/iced.2011-01-02-00000.nc -../mem0017/restart/iced.2011-01-02-00000.nc -../mem0018/restart/iced.2011-01-02-00000.nc -../mem0019/restart/iced.2011-01-02-00000.nc -../mem0020/restart/iced.2011-01-02-00000.nc -../mem0021/restart/iced.2011-01-02-00000.nc -../mem0022/restart/iced.2011-01-02-00000.nc -../mem0023/restart/iced.2011-01-02-00000.nc -../mem0024/restart/iced.2011-01-02-00000.nc -../mem0025/restart/iced.2011-01-02-00000.nc -../mem0026/restart/iced.2011-01-02-00000.nc -../mem0027/restart/iced.2011-01-02-00000.nc -../mem0028/restart/iced.2011-01-02-00000.nc -../mem0029/restart/iced.2011-01-02-00000.nc -../mem0030/restart/iced.2011-01-02-00000.nc diff --git a/models/cice-scm/icepack_test/cice_restarts_out.txt b/models/cice-scm/icepack_test/cice_restarts_out.txt deleted file mode 100644 index 0ba594abce..0000000000 --- a/models/cice-scm/icepack_test/cice_restarts_out.txt +++ /dev/null @@ -1,10 +0,0 @@ -./out_iced.2011-01-02-00000_mem1.nc -./out_iced.2011-01-02-00000_mem2.nc -./out_iced.2011-01-02-00000_mem3.nc -./out_iced.2011-01-02-00000_mem4.nc -./out_iced.2011-01-02-00000_mem5.nc -./out_iced.2011-01-02-00000_mem6.nc -./out_iced.2011-01-02-00000_mem7.nc -./out_iced.2011-01-02-00000_mem8.nc -./out_iced.2011-01-02-00000_mem9.nc -./out_iced.2011-01-02-00000_mem10.nc diff --git a/models/cice-scm/icepack_test/iced.2011-01-02-00000.nc b/models/cice-scm/icepack_test/iced.2011-01-02-00000.nc deleted file mode 100644 index 559db66cb92309c8d5afec51173d52fea3eff289..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10252 zcmeI2c{~+wyvM~kmLG+z$yQV`_ce zwveTgy`uUdTP5qAqt2Y)>)u=X@7~va-RJe1^O>3V=lgxW^UTb1<_zk)G!`-aXn$eC zOk3=&=64XVPlCOPkqf3oY~jKdHf&+FBDt73ZpPLyjxDr!VcNQjm7N);th9Z|7uv4* z#zEVE#@xZ#Xc++S{#fqX3HPv z`BxrVeax05?DN-oYB9z}!ur~@Y5s!v%`q&d)y3xYN8Tm0`hMo!g022;Y`A3^c^CBl ztKO{(R5=ZGpT?2N-!5^6~{U@@`)sFTX4! z?}FZ1M&2C@LJbAh~q>5RM!d4;s*z1Tgt@bxP+!0;|~oe2jsybE1B z%VaSx7s3$_Z~K)`gzJaTYJq$r zv>LH|R;CN&)53f#Bogf_n zt#3K4HV&-cGYt_4=oT6MbpWDK|^!a>__NKqjC#FU7SuX4w zp!uv8^oa-4e5RHp+SkT!#!x~Qw;TUPHf5rS^KhgvA82b5{pQ(O(Jgb8L6*J$@!ZE95=`r-< z`Gc6+f5rS^KWl8^_Z3q*yEX{JiCN{Rb5}ayM4OMo!`{E)L|#d{n~F7-^S2EaJJog8 zMij#0$wT)!&JMt$iP4;8X?y5Fus`Vd;NUJ#*sqHo(l%6w{d=FcjEbznc^chbh&QX9#|-FqJJn<;5M^^X`0u$?9`{&!zUm z6cejZ52Z~oWuL(&^Vjcjp2)l+;>ouLnCNn8-COo{c%Q`j>IqXe&iiiH_p7OGf_)_U z)NWfZ*mn;4Z$VRVo*!t&mVDg?=Ko{(%&q5d_)v0nk=tw-&MV~gO%H{u!HS9wxs5hW z@F`2sOMioMoVT1XFPM0bz*c)M`7nM%*t+akWEhJe&acL+cOP1!00Y-7SIk!JfdL;g ziLu7C`Fp;>^44!9_d<5V^3HCTWm_F!IduhVY-1zNgF_lKS1cETAxOCPB`*4t_!Ro;i;?8G9jq7E4Lg1O{- z^D=sTsq(cGGyX59FdY%~oE|P!4h@b>c&=75>#;srLd~aC#m9c#p3QqpReYBx2_|@9 z+YL`$$`Tnod*2%W5R7L(yH!Crjj33tOPDc(zb)3VKA2sq@^)6URDe>d(px6x{%x4S zo7nd?oKPxNX*{X^$XT~k<*^Z~%kB<3ho8H%Gx}C4V_L%zFVKo<;p%Hg_2~7(FF}Iq zZY1i$FD*XnFA$7yO@{|p~|Qr zVqz^KRP23V;F}{N^t5CkC|nQL9^QS7e6JtjUH8^|tgQp#87_%zGG|A4x7Y>>jY6EW z+idC?ZZ$^O6>5hqY&{V6ZKhQZT7u~ueoJHCJ@{S?er<8AcPTptzsX(YRJ!Vh^G|ja zYq)vD;0HasO7`_au;+Bl{{9X#I!CEy(eg7U8YtDYhSU2v54QcV>55-6{rFI7y^n#e zjUlE-;%<63VY)i+yA=p0!p!#f!*6pt+B z+cuGNt`S+fhBqV9G82v-&D?%Z$rIt8+gjv*$PeN6-4GDS?2K@~af-gEl7w^C$Vy+L z&ohM8n7uu5q!3|6q_k8Iq|rJ2mhG9FxH}(yZQtd4rmP2k>2BhCT>1>>W65Pjiy#G# z&a7dYE&B`y?+~PJ^?avulxpH!(Yq)er5e}g-t>0IwqrG{x#;CHq12?xt20U2C^cF6 zYWTS;nC|mBe<6l$K&jsd(a#KCqSUV;q0HVsD0SlOo};0eIM3c&@%qxP9yELZWv{3D zkI?LW-*UKQ&f}bVw6`E6{TWK#XGSbgI)hUD4g}bCh0r;|?X%ziB^Mdt-a!t~X`mq7 zXFIe!VtWy$?YaZH#j*&Otw!9&zgHk!E4Kc1r;dVf8Qi!vkn4eSf>7b^Q+FE?mf4U4 zt>k)y<#~?xg}i1uhvWA&$nk7maO`84X~tY495cvteiYD;^Y5IaJ!HdE;Jqg20BwGW3wF^vZI1f{+(xm%&?kMnHN6^C~=Povpl-PNqGdC+XpGrPIpZ@@Vv z{>=_y>J^j{`RdBw{h265SJ?+P(B8SsH-t-4^%Fst58>=stz;nl7U2?Eq#*BXiV)hF zQkq~l!m+INgJgpY!oeglSNH)zIE05Yuhrz?oLP=MDBuDD@PftL>#3N>+#_~`KJ3qqa-ghvSEQzohM!YtNBqFSO zu5xW-4-r;V;nX9Ni8x=R(W@kKF$7t3gn7vsi!@}BsN(r3c1}8nW2Rp|&aPvHqkT>% z*Tq`E(VL$Vq~4a{eD2bz(!2YI;N01pL%1g3n zBr~StvEn_TqsWI%YyCq(;LgD{YkG+A=w~bQwxY*IwntJ)9AzYjr(*$&D*4NM3zq4c4`t5pb*>g|`Z zqa5eV>8DNxj`1MO89_=`3O5nv$c7!B%-880jz>#s=qakeaaH%z@ptyZaSn@5#4nLJ zpG{B6)Av0HXLIybN4j>v8NJHyp6obBDbL(bOKj)hegeY!?4Up|{~3gpnt!$BvpT~1RAlIH6C(y+`bPg+9)hs4t(B!l zY9p)yp?Y6!0_Yr0>ZGQf9oB@C3Mp>W5kBy{_ry@(J6)VlT{%J-Q#6268Du`L`|)s! ztvA5><`p_eDGI9JLq}9F<<5y}!_NPX{M^H*0lj`~K9AEj(vHM*$SEr2IHu@7TR27; zJfn%YSVI$~WIVc&kkEzc+iU3sPjOD=Pdvb5Qi4(i0wy$0RHIbE@5NSP-*8T`*-U6W zhUK-l8kken!t}tMz`SZYN5nc!`u8ZwA>zbO$uaM~AmU4uXY&=y5st{3+x!V_2w!(F zb6xc;!dD%ZmCw=BJ2SE`vA>iYcm=k&7fKA z0{qcC#Lz5Og*<%?aXdb&?ol2OtV6SEYxpu(EkU!IBOceuAI3Rl&x30Zr<_sBfqS76 zd;YrcXK~_YmcTcWORuoEu+SH%~ko=RWAPT_Tskv-QV{f)1i_l&A>LeW7SvwiQ9? z@68N8k|cMb`3)L35*vCSvY~Oq%8zG=Rt)aO691Iwg~mB`pE#7Z35^qeW%N`hgwE;b z`G2dHOg|WrlV<+#pOs!OO#D{6ZBEb}CMxFV%6@$c6EmN?eag(BbJeT&pN#J`U#c3i z$4#+VaJ_2ibNKwOdhJ{_U&;{`)vzhw>qkvisfN!s6Yph=;qeh>j@B))X{t98 zU#7S+aiQCq;y`{*)Q=pwTG!rBb@aPZ~GaafA;;U8=8KPk>X`*UZ!FQ|Z@ zT@2S3g=oOfK9(j1!~onsq#ToNDbxywc;35ByY7QS(tf+{9Jz<{9#d|`s?`m!$LWc) zno}+$x|f9W+k#W(1u`0tT)gzI7~4sBU;iDyyZ#`~ZOQ}sxpg-{M}_oZ;z=$T zdvKso3)zD6kGU_2J03N{k1It;_lBzAM;R8MWY1)r_q#}M5SI>yePt=_9?BPB-{Z7G zN)12GTVD1G$p;C+77P9Ac8F<747{hY+kv$C9snvIjya7fD2u7qImBINT zN240s3ms6qsXIsSQyh%&vQ3}u45f4WIQ~y5d{c70kk?D=f2#k5`UU-?pDJcqZY<>c zfBt`S1iGnEZ#P2bj)!mTM(l9TVo_$LUB?Akj3;d_pSuNFOr>JU zI_)?o2u_GJf>V&d!x`j!BOMY1qYZ65`WSqb-fC%qb&w!*uUJi}3lapT9j*i-bPgIz z9KWxuY0Ug(Ij%W%n`AR+dHqh3^SlUXNqQr6>%B3~yDc=jTrUlQp2#Kp zWeTJ~kI$Zu%|!hB9aL;`97|4n2cBwP3-`aJ2`bf{<^A#*=l8nxlD@5`D7e1dKC*GZ z8C*BDXlUDQf#)X=pQ;@#@dLNn%(^oMv;cWrF_<=&jX^FI2GqU;@1bbIU8Hkz@7}E_@$4>tg{ADu<~MH zKr9|#(RDWH^;I!Yp~137J|hfNJbSh4wF>QjUFI8jF8AftnnGvrd`0ct>H3G@`G%t- z@AGAGUeCFH$0Ms6P|xD`_(@M9s3$sdEoHN>A zT;W#$u7dl_o@WjMl77wiBr8ii{_K>sy@Js$;OS9rTlm)v;KA+@FLhx6=dOWweWAw) zaC2TOLvT6_NTnO^r0LzkxsPt+?D?&0fUhdpC?m)Nyr)@7DW_K9+&A6b;Zds;@RKv) z&`WOwzH|P<=He4LH$=4dXgw$f#@F(nxtA{nhF_Mws?RONxgBpnRoDGfz;WmIGvLbw z;2^R^=Hi_PICno@ViBv61w2=CC%!pV1U&St?9^j_{+X1C2^jewJGWF_0+{SSwmQK1 zGBDAr<2=8X1&=pS*Q7SGbb;d)K3WBm^1wh5(W*G(i*w6Ty{X-jvcU31*_*zXY{0V2 z?QJ|iV|>i3@J`PN{&$ip|y$?*b0vmx5=HC%>Oa&On*gtw$_73M^zKf2w8nA&d;`Yr=!CfHCu2YAvJPGH~ zGA9Oa1OAO^4aWt zZdrqv2kV4czTWBdJ~ArEt_(wK7(`1c5#2Pw*+8y z(V#SRxf8IQS=XkAzy4za?waWzhHMkS*{7O1n}a04+0|e6oMywH@4>mRygaw>h6C^H z;KFw;Ou+m8LH7f$5qN$NvT#?9rVj8_JHzbZdIESEo|4ODb8_}W?BXP4!GnPZy)OSd2} zt&HfH`XG&Sr|UUtoY_Ud*;{|mRJ|5B2e+OJY-Nm}SN5gLy&ndE_c>9SAcHaB-H;_w l$s~lw8~_ diff --git a/models/cice-scm/icepack_test/input.nml b/models/cice-scm/icepack_test/input.nml deleted file mode 100644 index a00e096d68..0000000000 --- a/models/cice-scm/icepack_test/input.nml +++ /dev/null @@ -1,224 +0,0 @@ -&probit_transform_nml - / - -&algorithm_info_nml - qceff_table_filename = '' - / - -&perfect_model_obs_nml - read_input_state_from_file = .true., - single_file_in = .false. - input_state_files = "input_file.nc" - - write_output_state_to_file = .false., - single_file_out = .true. - output_state_files = "perfect_output.nc" - output_interval = 1, - - async = 0, - adv_ens_command = "./advance_model.csh", - - obs_seq_in_file_name = "obs_seq.in", - obs_seq_out_file_name = "obs_seq.out", - init_time_days = 153076, - init_time_seconds = 0, - first_obs_days = -1, - first_obs_seconds = -1, - last_obs_days = -1, - last_obs_seconds = -1, - - trace_execution = .true., - output_timestamps = .false., - print_every_nth_obs = -1, - output_forward_op_errors = .false., - silence = .false., - / - -&filter_nml - single_file_in = .false., - input_state_files = 'iced.2011-01-02-00000.nc' - input_state_file_list = '' - - stages_to_write = 'input', 'preassim', 'analysis', 'output' - - single_file_out = .false., - output_state_files = '' - output_state_file_list = 'cice_restarts_out.txt' - output_interval = 1, - output_members = .true. - num_output_state_members = 0, - output_mean = .true. - output_sd = .true. - write_all_stages_at_end = .false. - - ens_size = 10, - num_groups = 1, - perturb_from_single_instance = .false., - perturbation_amplitude = 0.2, - distributed_state = .true. - - async = 0, - adv_ens_command = "./advance_model.csh", - - obs_sequence_in_name = "obs_seq.out", - obs_sequence_out_name = "obs_seq.final", - num_output_obs_members = 1, - init_time_days = 153076, - init_time_seconds = 0, - first_obs_days = -1, - first_obs_seconds = -1, - last_obs_days = -1, - last_obs_seconds = -1, - - inf_flavor = 0, 0, - inf_initial_from_restart = .false., .false., - inf_sd_initial_from_restart = .false., .false., - inf_deterministic = .true., .true., - inf_initial = 1.0, 1.0, - inf_lower_bound = 1.0, 1.0, - inf_upper_bound = 100.0, 1000000.0, - inf_damping = 1.0, 1.0, - inf_sd_initial = 0.0, 0.0, - inf_sd_lower_bound = 0.0, 0.0, - inf_sd_max_change = 1.05, 1.05, - - trace_execution = .true., - output_timestamps = .false., - output_forward_op_errors = .false., - silence = .false., - / - -&smoother_nml - num_lags = 0, - start_from_restart = .false., - output_restart = .false., - restart_in_file_name = 'smoother_ics', - restart_out_file_name = 'smoother_restart' - / - -&ensemble_manager_nml - / - -&assim_tools_nml - cutoff = 1000000.0 - sort_obs_inc = .false., - spread_restoration = .false., - sampling_error_correction = .false., - adaptive_localization_threshold = -1, - distribute_mean = .false. - output_localization_diagnostics = .false., - localization_diagnostics_file = 'localization_diagnostics', - print_every_nth_obs = 0 - / - -&cov_cutoff_nml - select_localization = 1 - / - -®_factor_nml - select_regression = 1, - input_reg_file = "time_mean_reg", - save_reg_diagnostics = .false., - reg_diagnostics_file = "reg_diagnostics" - / - -&obs_sequence_nml - write_binary_obs_sequence = .false. - / - -&obs_kind_nml - assimilate_these_obs_types = 'SAT_SEAICE_AGREG_THICKNESS' - evaluate_these_obs_types = '' - / - -&model_nml - model_perturbation_amplitude = 2e-05 - debug = 1 - model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', - 'QTY_SEAICE_VOLUME', 'UPDATE', 'vsnon', 'QTY_SEAICE_SNOWVOLUME', - 'UPDATE' -/ - -&dart_to_cice_nml - dart_to_cice_input_file = 'restart_state.nc' - original_cice_input_file = 'dart_restart.nc' - previous_cice_input_file = 'pre_restart.nc' - balance_method = 'simple_squeeze' - r_snw_name = 'r_snw_vary' - gridpt_oi = 3 -/ - -&utilities_nml - TERMLEVEL = 1, - module_details = .false., - logfilename = 'dart_log.out', - nmlfilename = 'dart_log.nml', - write_nml = 'none' - / - -&preprocess_nml - input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90' - output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90' - input_obs_qty_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90' - output_obs_qty_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90' - obs_type_files = '../../../observations/forward_operators/obs_def_cice_mod.f90' - quantity_files = '../../../assimilation_code/modules/observations/seaice_quantities_mod.f90', - '../../../assimilation_code/modules/observations/ocean_quantities_mod.f90' - / - -&obs_sequence_tool_nml - filename_seq = 'obs_seq.one', 'obs_seq.two', - filename_out = 'obs_seq.processed', - first_obs_days = -1, - first_obs_seconds = -1, - last_obs_days = -1, - last_obs_seconds = -1, - print_only = .false., - gregorian_cal = .false. - / - -&obs_diag_nml - obs_sequence_name = 'obs_seq.final', - bin_width_days = -1, - bin_width_seconds = -1, - init_skip_days = 0, - init_skip_seconds = 0, - Nregions = 3, - trusted_obs = 'null', - lonlim1 = 0.00, 0.00, 0.50 - lonlim2 = 1.01, 0.50, 1.01 - reg_names = 'whole', 'yin', 'yang' - create_rank_histogram = .true., - outliers_in_histogram = .true., - use_zero_error_obs = .false., - verbose = .false. - / - -&state_vector_io_nml - / - -&model_mod_check_nml - input_state_files = 'input.nc' - output_state_files = 'mmc_output.nc' - test1thru = 0 - run_tests = 1,2,3,4,5,7 - x_ind = 42 - loc_of_interest = 0.3 - quantity_of_interest = 'QTY_STATE_VARIABLE' - interp_test_dx = 0.02 - interp_test_xrange = 0.0, 1.0 - verbose = .false. - / - -&quality_control_nml - input_qc_threshold = 3.0, - outlier_threshold = -1.0, -/ - -&location_nml - horiz_dist_only = .true. - approximate_distance = .false. - nlon = 71 - nlat = 36 - output_box_info = .true. -/ diff --git a/models/cice-scm/icepack_test/input_file.nc b/models/cice-scm/icepack_test/input_file.nc deleted file mode 100644 index 559db66cb92309c8d5afec51173d52fea3eff289..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10252 zcmeI2c{~+wyvM~kmLG+z$yQV`_ce zwveTgy`uUdTP5qAqt2Y)>)u=X@7~va-RJe1^O>3V=lgxW^UTb1<_zk)G!`-aXn$eC zOk3=&=64XVPlCOPkqf3oY~jKdHf&+FBDt73ZpPLyjxDr!VcNQjm7N);th9Z|7uv4* z#zEVE#@xZ#Xc++S{#fqX3HPv z`BxrVeax05?DN-oYB9z}!ur~@Y5s!v%`q&d)y3xYN8Tm0`hMo!g022;Y`A3^c^CBl ztKO{(R5=ZGpT?2N-!5^6~{U@@`)sFTX4! z?}FZ1M&2C@LJbAh~q>5RM!d4;s*z1Tgt@bxP+!0;|~oe2jsybE1B z%VaSx7s3$_Z~K)`gzJaTYJq$r zv>LH|R;CN&)53f#Bogf_n zt#3K4HV&-cGYt_4=oT6MbpWDK|^!a>__NKqjC#FU7SuX4w zp!uv8^oa-4e5RHp+SkT!#!x~Qw;TUPHf5rS^KhgvA82b5{pQ(O(Jgb8L6*J$@!ZE95=`r-< z`Gc6+f5rS^KWl8^_Z3q*yEX{JiCN{Rb5}ayM4OMo!`{E)L|#d{n~F7-^S2EaJJog8 zMij#0$wT)!&JMt$iP4;8X?y5Fus`Vd;NUJ#*sqHo(l%6w{d=FcjEbznc^chbh&QX9#|-FqJJn<;5M^^X`0u$?9`{&!zUm z6cejZ52Z~oWuL(&^Vjcjp2)l+;>ouLnCNn8-COo{c%Q`j>IqXe&iiiH_p7OGf_)_U z)NWfZ*mn;4Z$VRVo*!t&mVDg?=Ko{(%&q5d_)v0nk=tw-&MV~gO%H{u!HS9wxs5hW z@F`2sOMioMoVT1XFPM0bz*c)M`7nM%*t+akWEhJe&acL+cOP1!00Y-7SIk!JfdL;g ziLu7C`Fp;>^44!9_d<5V^3HCTWm_F!IduhVY-1zNgF_lKS1cETAxOCPB`*4t_!Ro;i;?8G9jq7E4Lg1O{- z^D=sTsq(cGGyX59FdY%~oE|P!4h@b>c&=75>#;srLd~aC#m9c#p3QqpReYBx2_|@9 z+YL`$$`Tnod*2%W5R7L(yH!Crjj33tOPDc(zb)3VKA2sq@^)6URDe>d(px6x{%x4S zo7nd?oKPxNX*{X^$XT~k<*^Z~%kB<3ho8H%Gx}C4V_L%zFVKo<;p%Hg_2~7(FF}Iq zZY1i$FD*XnFA$7yO@{|p~|Qr zVqz^KRP23V;F}{N^t5CkC|nQL9^QS7e6JtjUH8^|tgQp#87_%zGG|A4x7Y>>jY6EW z+idC?ZZ$^O6>5hqY&{V6ZKhQZT7u~ueoJHCJ@{S?er<8AcPTptzsX(YRJ!Vh^G|ja zYq)vD;0HasO7`_au;+Bl{{9X#I!CEy(eg7U8YtDYhSU2v54QcV>55-6{rFI7y^n#e zjUlE-;%<63VY)i+yA=p0!p!#f!*6pt+B z+cuGNt`S+fhBqV9G82v-&D?%Z$rIt8+gjv*$PeN6-4GDS?2K@~af-gEl7w^C$Vy+L z&ohM8n7uu5q!3|6q_k8Iq|rJ2mhG9FxH}(yZQtd4rmP2k>2BhCT>1>>W65Pjiy#G# z&a7dYE&B`y?+~PJ^?avulxpH!(Yq)er5e}g-t>0IwqrG{x#;CHq12?xt20U2C^cF6 zYWTS;nC|mBe<6l$K&jsd(a#KCqSUV;q0HVsD0SlOo};0eIM3c&@%qxP9yELZWv{3D zkI?LW-*UKQ&f}bVw6`E6{TWK#XGSbgI)hUD4g}bCh0r;|?X%ziB^Mdt-a!t~X`mq7 zXFIe!VtWy$?YaZH#j*&Otw!9&zgHk!E4Kc1r;dVf8Qi!vkn4eSf>7b^Q+FE?mf4U4 zt>k)y<#~?xg}i1uhvWA&$nk7maO`84X~tY495cvteiYD;^Y5IaJ!HdE;Jqg20BwGW3wF^vZI1f{+(xm%&?kMnHN6^C~=Povpl-PNqGdC+XpGrPIpZ@@Vv z{>=_y>J^j{`RdBw{h265SJ?+P(B8SsH-t-4^%Fst58>=stz;nl7U2?Eq#*BXiV)hF zQkq~l!m+INgJgpY!oeglSNH)zIE05Yuhrz?oLP=MDBuDD@PftL>#3N>+#_~`KJ3qqa-ghvSEQzohM!YtNBqFSO zu5xW-4-r;V;nX9Ni8x=R(W@kKF$7t3gn7vsi!@}BsN(r3c1}8nW2Rp|&aPvHqkT>% z*Tq`E(VL$Vq~4a{eD2bz(!2YI;N01pL%1g3n zBr~StvEn_TqsWI%YyCq(;LgD{YkG+A=w~bQwxY*IwntJ)9AzYjr(*$&D*4NM3zq4c4`t5pb*>g|`Z zqa5eV>8DNxj`1MO89_=`3O5nv$c7!B%-880jz>#s=qakeaaH%z@ptyZaSn@5#4nLJ zpG{B6)Av0HXLIybN4j>v8NJHyp6obBDbL(bOKj)hegeY!?4Up|{~3gpnt!$BvpT~1RAlIH6C(y+`bPg+9)hs4t(B!l zY9p)yp?Y6!0_Yr0>ZGQf9oB@C3Mp>W5kBy{_ry@(J6)VlT{%J-Q#6268Du`L`|)s! ztvA5><`p_eDGI9JLq}9F<<5y}!_NPX{M^H*0lj`~K9AEj(vHM*$SEr2IHu@7TR27; zJfn%YSVI$~WIVc&kkEzc+iU3sPjOD=Pdvb5Qi4(i0wy$0RHIbE@5NSP-*8T`*-U6W zhUK-l8kken!t}tMz`SZYN5nc!`u8ZwA>zbO$uaM~AmU4uXY&=y5st{3+x!V_2w!(F zb6xc;!dD%ZmCw=BJ2SE`vA>iYcm=k&7fKA z0{qcC#Lz5Og*<%?aXdb&?ol2OtV6SEYxpu(EkU!IBOceuAI3Rl&x30Zr<_sBfqS76 zd;YrcXK~_YmcTcWORuoEu+SH%~ko=RWAPT_Tskv-QV{f)1i_l&A>LeW7SvwiQ9? z@68N8k|cMb`3)L35*vCSvY~Oq%8zG=Rt)aO691Iwg~mB`pE#7Z35^qeW%N`hgwE;b z`G2dHOg|WrlV<+#pOs!OO#D{6ZBEb}CMxFV%6@$c6EmN?eag(BbJeT&pN#J`U#c3i z$4#+VaJ_2ibNKwOdhJ{_U&;{`)vzhw>qkvisfN!s6Yph=;qeh>j@B))X{t98 zU#7S+aiQCq;y`{*)Q=pwTG!rBb@aPZ~GaafA;;U8=8KPk>X`*UZ!FQ|Z@ zT@2S3g=oOfK9(j1!~onsq#ToNDbxywc;35ByY7QS(tf+{9Jz<{9#d|`s?`m!$LWc) zno}+$x|f9W+k#W(1u`0tT)gzI7~4sBU;iDyyZ#`~ZOQ}sxpg-{M}_oZ;z=$T zdvKso3)zD6kGU_2J03N{k1It;_lBzAM;R8MWY1)r_q#}M5SI>yePt=_9?BPB-{Z7G zN)12GTVD1G$p;C+77P9Ac8F<747{hY+kv$C9snvIjya7fD2u7qImBINT zN240s3ms6qsXIsSQyh%&vQ3}u45f4WIQ~y5d{c70kk?D=f2#k5`UU-?pDJcqZY<>c zfBt`S1iGnEZ#P2bj)!mTM(l9TVo_$LUB?Akj3;d_pSuNFOr>JU zI_)?o2u_GJf>V&d!x`j!BOMY1qYZ65`WSqb-fC%qb&w!*uUJi}3lapT9j*i-bPgIz z9KWxuY0Ug(Ij%W%n`AR+dHqh3^SlUXNqQr6>%B3~yDc=jTrUlQp2#Kp zWeTJ~kI$Zu%|!hB9aL;`97|4n2cBwP3-`aJ2`bf{<^A#*=l8nxlD@5`D7e1dKC*GZ z8C*BDXlUDQf#)X=pQ;@#@dLNn%(^oMv;cWrF_<=&jX^FI2GqU;@1bbIU8Hkz@7}E_@$4>tg{ADu<~MH zKr9|#(RDWH^;I!Yp~137J|hfNJbSh4wF>QjUFI8jF8AftnnGvrd`0ct>H3G@`G%t- z@AGAGUeCFH$0Ms6P|xD`_(@M9s3$sdEoHN>A zT;W#$u7dl_o@WjMl77wiBr8ii{_K>sy@Js$;OS9rTlm)v;KA+@FLhx6=dOWweWAw) zaC2TOLvT6_NTnO^r0LzkxsPt+?D?&0fUhdpC?m)Nyr)@7DW_K9+&A6b;Zds;@RKv) z&`WOwzH|P<=He4LH$=4dXgw$f#@F(nxtA{nhF_Mws?RONxgBpnRoDGfz;WmIGvLbw z;2^R^=Hi_PICno@ViBv61w2=CC%!pV1U&St?9^j_{+X1C2^jewJGWF_0+{SSwmQK1 zGBDAr<2=8X1&=pS*Q7SGbb;d)K3WBm^1wh5(W*G(i*w6Ty{X-jvcU31*_*zXY{0V2 z?QJ|iV|>i3@J`PN{&$ip|y$?*b0vmx5=HC%>Oa&On*gtw$_73M^zKf2w8nA&d;`Yr=!CfHCu2YAvJPGH~ zGA9Oa1OAO^4aWt zZdrqv2kV4czTWBdJ~ArEt_(wK7(`1c5#2Pw*+8y z(V#SRxf8IQS=XkAzy4za?waWzhHMkS*{7O1n}a04+0|e6oMywH@4>mRygaw>h6C^H z;KFw;Ou+m8LH7f$5qN$NvT#?9rVj8_JHzbZdIESEo|4ODb8_}W?BXP4!GnPZy)OSd2} zt&HfH`XG&Sr|UUtoY_Ud*;{|mRJ|5B2e+OJY-Nm}SN5gLy&ndE_c>9SAcHaB-H;_w l$s~lw8~_ diff --git a/models/cice-scm/icepack_test/input_mean.nc b/models/cice-scm/icepack_test/input_mean.nc deleted file mode 100644 index e54645987cf39dc9ae74ad0f8a561c170c1ca6c5..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4096 zcmZ>EabseD04^W}Vl(Asf(2NBBuid$VhNCD1!5i`<_2Qk{zwRGwt6*ecWTIeTp3gPnbWY*81-ppf{q z%$(Ht%)GSxqFk^85o(1q^9o8!6jJkwQ*)DYQWbJj6Z1f_LSTKE9wNs-++efd-U0hZ zG$perHMt}{FSR5&B`qG=I}Ds)^?CWoVTj9}%z2eXAoqgegpq-P%@Ifg!y~UG10)I; z2gxz8vO+dVn zfnoo$oQJ=hdk@)PkSck`&ZZye_MCs{K@c^+5Y`llD*EZ|};uXvY47zt(OlW684Ly3HqX-J2Kohii9!uR3~c z|MKk%*QbiF+P}6S&}c>LBKv(R3?YqM^6U?q2UO4hv(kR%j;oipD(v3B#=Ev?UcH?C z^DjxlpR0@PpBIEPw%(Xx|Dxsh``Yw(`;TNMPUbpjXus`-KxpK?cKZ_&3tqoF#SgSE zZuQN1+V-ubWwsw2GVHf54nHMoearsRou4J(ulINE=TETTcW3#eJq>T|&+1)2kS%+`exGqnI{z!){R_7i%&5K6yMJ@#w*}(! zy6jh3FG!fBaLInFTHR@jmzw+6z5Ug&*WSr~%E>jqri)*)pTvFF$amV&{j1&h%f1_N z*l+#BeQ&aqnEh4@%Qh)(`Tffyz8y{e@Y;Tg%-5Bn;gjt*++)0PJlYH;@<%zNAut*O ZqaiRF0;3@?8UmvsFd71*Auz&2007(xYx@8I diff --git a/models/cice-scm/icepack_test/input_sd.nc b/models/cice-scm/icepack_test/input_sd.nc deleted file mode 100644 index 953ccb0a234a789f902b8b73555bea97567c01b0..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4096 zcmZ>EabseD04^W}Vl(Asf(2NBBuid$VhNCD1!5i`<_2Qk{zwRGwt6*ecWTIeTp3gPnbWY*81-ppf{q z%$(Ht%)GSxqFk^85o!f9^9o8!6jJkwQ*)DYQWc6*AaX)reV861$3NU)v*6wV`$se- zvnVyWBt9>-BsnE59@#q#oM82N`N(02%bm=5l|>*IgW`mdfq~5tNCU$ouOtH`3Ks{- zF|g#OBvzt{F&C#MBdY_kL2(I+SC$YTe?K4%(u)j0asm(mrUyV8sLnA2NaIuY0VvO! z2#mu#AOi?M;fSuD4Jft%h=G6^M6i|-uYLhoeQ{nsapto)0M(-ar!5Q&PMd*v6A*7? zV6Z>f;`8{d;wJlx9Ztu&q8RM=zY)05vSzjYp)&I|uO^1r?_6^}?Ek)Q`^(cp9%e+X zvA@cFx=6cytNoD^exe0E@9i%<7n>Qh-NF9M8K|r}Y@ud< z;=~u$+0h~Pr!M8Ni;2v)KmLB^<(vu6?GOE{Rx-Zx$o_al`cL+N*Y*dVJz~$uSFk@j zCs%9=SEc=a9W~!MjkD}e&k(;abM>D6*;I$JjWed&A6IPjn=pHu{kiAvGA?49><=CJ z82Lc`n*Bv%&Q+|{+w3pCd4KCbVV?aFmIt>aCMVe+kgdA6SllJ*riW*!#>(y=zQS6 ze!iIfkw1ptZdly3KlVeJo9)pO`(uyyp3<&Qvp<`#cgvF08}@r|z2!(YGqOJ%%NqPL z`KbMwAoXRJy29+wOqm(G+xWQsX^RtXPuJGjUo^ch{m&}b{)ENz1Fz%z?9V6Uyhv=D zV1G1kna}^pBKD`6m+z6|t+hXO#(?SWEp_`d53CkkK5uM)__^wdZ3^Znkw3~A4S~@R Z7!85Z5Eu=C(GVC7fzc2c4S^9J0stXnYRdos diff --git a/models/cice-scm/icepack_test/obs_seq.out b/models/cice-scm/icepack_test/obs_seq.out deleted file mode 100644 index 132e55d641..0000000000 --- a/models/cice-scm/icepack_test/obs_seq.out +++ /dev/null @@ -1,3612 +0,0 @@ - obs_sequence -obs_type_definitions - 3 - 12 SAT_SEAICE_AGREG_CONCENTR - 15 SAT_SEAICE_AGREG_THICKNESS - 16 SAT_SEAICE_AGREG_SNOWDEPTH - num_copies: 2 num_qc: 1 - num_obs: 300 max_num_obs: 300 -observations -truth -Quality Control - first: 1 last: 300 - OBS 1 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - -1 2 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 0 153076 - 5.625000000000000E-003 - OBS 2 - 1.45479447859952 - 1.36880203692740 - 0.000000000000000E+000 - 1 3 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 0 153076 - 1.000000000000000E-002 - OBS 3 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 2 4 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 0 153076 - 1.225000000000000E-003 - OBS 4 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 3 5 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 10 153076 - 5.625000000000000E-003 - OBS 5 - 1.24928159257768 - 1.36880203692740 - 0.000000000000000E+000 - 4 6 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 10 153076 - 1.000000000000000E-002 - OBS 6 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 5 7 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 10 153076 - 1.225000000000000E-003 - OBS 7 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 6 8 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 20 153076 - 5.625000000000000E-003 - OBS 8 - 1.40659533635447 - 1.36880203692740 - 0.000000000000000E+000 - 7 9 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 20 153076 - 1.000000000000000E-002 - OBS 9 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 8 10 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 20 153076 - 1.225000000000000E-003 - OBS 10 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 9 11 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 30 153076 - 5.625000000000000E-003 - OBS 11 - 1.42938872353235 - 1.36880203692740 - 0.000000000000000E+000 - 10 12 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 30 153076 - 1.000000000000000E-002 - OBS 12 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 11 13 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 30 153076 - 1.225000000000000E-003 - OBS 13 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 12 14 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 40 153076 - 5.625000000000000E-003 - OBS 14 - 1.36183664228386 - 1.36880203692740 - 0.000000000000000E+000 - 13 15 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 40 153076 - 1.000000000000000E-002 - OBS 15 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 14 16 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 40 153076 - 1.225000000000000E-003 - OBS 16 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 15 17 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 50 153076 - 5.625000000000000E-003 - OBS 17 - 1.52931921450675 - 1.36880203692740 - 0.000000000000000E+000 - 16 18 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 50 153076 - 1.000000000000000E-002 - OBS 18 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 17 19 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 50 153076 - 1.225000000000000E-003 - OBS 19 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 18 20 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 60 153076 - 5.625000000000000E-003 - OBS 20 - 1.30988567741016 - 1.36880203692740 - 0.000000000000000E+000 - 19 21 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 60 153076 - 1.000000000000000E-002 - OBS 21 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 20 22 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 60 153076 - 1.225000000000000E-003 - OBS 22 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 21 23 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 70 153076 - 5.625000000000000E-003 - OBS 23 - 1.33570970501553 - 1.36880203692740 - 0.000000000000000E+000 - 22 24 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 70 153076 - 1.000000000000000E-002 - OBS 24 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 23 25 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 70 153076 - 1.225000000000000E-003 - OBS 25 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 24 26 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 80 153076 - 5.625000000000000E-003 - OBS 26 - 1.39946886485301 - 1.36880203692740 - 0.000000000000000E+000 - 25 27 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 80 153076 - 1.000000000000000E-002 - OBS 27 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 26 28 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 80 153076 - 1.225000000000000E-003 - OBS 28 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 27 29 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 90 153076 - 5.625000000000000E-003 - OBS 29 - 1.46530676974347 - 1.36880203692740 - 0.000000000000000E+000 - 28 30 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 90 153076 - 1.000000000000000E-002 - OBS 30 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 29 31 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 90 153076 - 1.225000000000000E-003 - OBS 31 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 30 32 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 100 153076 - 5.625000000000000E-003 - OBS 32 - 1.34995291120735 - 1.36880203692740 - 0.000000000000000E+000 - 31 33 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 100 153076 - 1.000000000000000E-002 - OBS 33 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 32 34 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 100 153076 - 1.225000000000000E-003 - OBS 34 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 33 35 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 110 153076 - 5.625000000000000E-003 - OBS 35 - 1.40263563728655 - 1.36880203692740 - 0.000000000000000E+000 - 34 36 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 110 153076 - 1.000000000000000E-002 - OBS 36 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 35 37 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 110 153076 - 1.225000000000000E-003 - OBS 37 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 36 38 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 120 153076 - 5.625000000000000E-003 - OBS 38 - 1.38978288540425 - 1.36880203692740 - 0.000000000000000E+000 - 37 39 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 120 153076 - 1.000000000000000E-002 - OBS 39 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 38 40 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 120 153076 - 1.225000000000000E-003 - OBS 40 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 39 41 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 130 153076 - 5.625000000000000E-003 - OBS 41 - 1.40660245934679 - 1.36880203692740 - 0.000000000000000E+000 - 40 42 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 130 153076 - 1.000000000000000E-002 - OBS 42 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 41 43 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 130 153076 - 1.225000000000000E-003 - OBS 43 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 42 44 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 140 153076 - 5.625000000000000E-003 - OBS 44 - 1.31002118015847 - 1.36880203692740 - 0.000000000000000E+000 - 43 45 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 140 153076 - 1.000000000000000E-002 - OBS 45 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 44 46 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 140 153076 - 1.225000000000000E-003 - OBS 46 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 45 47 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 150 153076 - 5.625000000000000E-003 - OBS 47 - 1.37280337509743 - 1.36880203692740 - 0.000000000000000E+000 - 46 48 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 150 153076 - 1.000000000000000E-002 - OBS 48 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 47 49 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 150 153076 - 1.225000000000000E-003 - OBS 49 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 48 50 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 160 153076 - 5.625000000000000E-003 - OBS 50 - 1.31205337003581 - 1.36880203692740 - 0.000000000000000E+000 - 49 51 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 160 153076 - 1.000000000000000E-002 - OBS 51 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 50 52 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 160 153076 - 1.225000000000000E-003 - OBS 52 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 51 53 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 170 153076 - 5.625000000000000E-003 - OBS 53 - 1.38680382447059 - 1.36880203692740 - 0.000000000000000E+000 - 52 54 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 170 153076 - 1.000000000000000E-002 - OBS 54 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 53 55 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 170 153076 - 1.225000000000000E-003 - OBS 55 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 54 56 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 180 153076 - 5.625000000000000E-003 - OBS 56 - 1.41297264714418 - 1.36880203692740 - 0.000000000000000E+000 - 55 57 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 180 153076 - 1.000000000000000E-002 - OBS 57 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 56 58 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 180 153076 - 1.225000000000000E-003 - OBS 58 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 57 59 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 190 153076 - 5.625000000000000E-003 - OBS 59 - 1.45650147247994 - 1.36880203692740 - 0.000000000000000E+000 - 58 60 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 190 153076 - 1.000000000000000E-002 - OBS 60 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 59 61 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 190 153076 - 1.225000000000000E-003 - OBS 61 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 60 62 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 200 153076 - 5.625000000000000E-003 - OBS 62 - 1.44932080366232 - 1.36880203692740 - 0.000000000000000E+000 - 61 63 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 200 153076 - 1.000000000000000E-002 - OBS 63 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 62 64 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 200 153076 - 1.225000000000000E-003 - OBS 64 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 63 65 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 210 153076 - 5.625000000000000E-003 - OBS 65 - 1.29266747025851 - 1.36880203692740 - 0.000000000000000E+000 - 64 66 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 210 153076 - 1.000000000000000E-002 - OBS 66 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 65 67 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 210 153076 - 1.225000000000000E-003 - OBS 67 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 66 68 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 220 153076 - 5.625000000000000E-003 - OBS 68 - 1.23618328646292 - 1.36880203692740 - 0.000000000000000E+000 - 67 69 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 220 153076 - 1.000000000000000E-002 - OBS 69 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 68 70 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 220 153076 - 1.225000000000000E-003 - OBS 70 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 69 71 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 230 153076 - 5.625000000000000E-003 - OBS 71 - 1.43701990037563 - 1.36880203692740 - 0.000000000000000E+000 - 70 72 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 230 153076 - 1.000000000000000E-002 - OBS 72 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 71 73 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 230 153076 - 1.225000000000000E-003 - OBS 73 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 72 74 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 240 153076 - 5.625000000000000E-003 - OBS 74 - 1.27762733432142 - 1.36880203692740 - 0.000000000000000E+000 - 73 75 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 240 153076 - 1.000000000000000E-002 - OBS 75 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 74 76 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 240 153076 - 1.225000000000000E-003 - OBS 76 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 75 77 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 250 153076 - 5.625000000000000E-003 - OBS 77 - 1.53612611508987 - 1.36880203692740 - 0.000000000000000E+000 - 76 78 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 250 153076 - 1.000000000000000E-002 - OBS 78 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 77 79 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 250 153076 - 1.225000000000000E-003 - OBS 79 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 78 80 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 260 153076 - 5.625000000000000E-003 - OBS 80 - 1.62577847168120 - 1.36880203692740 - 0.000000000000000E+000 - 79 81 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 260 153076 - 1.000000000000000E-002 - OBS 81 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 80 82 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 260 153076 - 1.225000000000000E-003 - OBS 82 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 81 83 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 270 153076 - 5.625000000000000E-003 - OBS 83 - 1.42833411804831 - 1.36880203692740 - 0.000000000000000E+000 - 82 84 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 270 153076 - 1.000000000000000E-002 - OBS 84 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 83 85 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 270 153076 - 1.225000000000000E-003 - OBS 85 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 84 86 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 280 153076 - 5.625000000000000E-003 - OBS 86 - 1.28702193276144 - 1.36880203692740 - 0.000000000000000E+000 - 85 87 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 280 153076 - 1.000000000000000E-002 - OBS 87 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 86 88 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 280 153076 - 1.225000000000000E-003 - OBS 88 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 87 89 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 290 153076 - 5.625000000000000E-003 - OBS 89 - 1.46917625609907 - 1.36880203692740 - 0.000000000000000E+000 - 88 90 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 290 153076 - 1.000000000000000E-002 - OBS 90 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 89 91 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 290 153076 - 1.225000000000000E-003 - OBS 91 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 90 92 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 300 153076 - 5.625000000000000E-003 - OBS 92 - 1.31178657239111 - 1.36880203692740 - 0.000000000000000E+000 - 91 93 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 300 153076 - 1.000000000000000E-002 - OBS 93 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 92 94 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 300 153076 - 1.225000000000000E-003 - OBS 94 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 93 95 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 310 153076 - 5.625000000000000E-003 - OBS 95 - 1.49015321627907 - 1.36880203692740 - 0.000000000000000E+000 - 94 96 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 310 153076 - 1.000000000000000E-002 - OBS 96 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 95 97 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 310 153076 - 1.225000000000000E-003 - OBS 97 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 96 98 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 320 153076 - 5.625000000000000E-003 - OBS 98 - 1.58772800541024 - 1.36880203692740 - 0.000000000000000E+000 - 97 99 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 320 153076 - 1.000000000000000E-002 - OBS 99 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 98 100 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 320 153076 - 1.225000000000000E-003 - OBS 100 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 99 101 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 330 153076 - 5.625000000000000E-003 - OBS 101 - 1.48160826802888 - 1.36880203692740 - 0.000000000000000E+000 - 100 102 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 330 153076 - 1.000000000000000E-002 - OBS 102 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 101 103 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 330 153076 - 1.225000000000000E-003 - OBS 103 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 102 104 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 340 153076 - 5.625000000000000E-003 - OBS 104 - 1.43691787413256 - 1.36880203692740 - 0.000000000000000E+000 - 103 105 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 340 153076 - 1.000000000000000E-002 - OBS 105 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 104 106 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 340 153076 - 1.225000000000000E-003 - OBS 106 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 105 107 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 350 153076 - 5.625000000000000E-003 - OBS 107 - 1.46762268041634 - 1.36880203692740 - 0.000000000000000E+000 - 106 108 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 350 153076 - 1.000000000000000E-002 - OBS 108 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 107 109 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 350 153076 - 1.225000000000000E-003 - OBS 109 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 108 110 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 360 153076 - 5.625000000000000E-003 - OBS 110 - 1.51430676610828 - 1.36880203692740 - 0.000000000000000E+000 - 109 111 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 360 153076 - 1.000000000000000E-002 - OBS 111 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 110 112 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 360 153076 - 1.225000000000000E-003 - OBS 112 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 111 113 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 370 153076 - 5.625000000000000E-003 - OBS 113 - 1.42228361621345 - 1.36880203692740 - 0.000000000000000E+000 - 112 114 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 370 153076 - 1.000000000000000E-002 - OBS 114 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 113 115 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 370 153076 - 1.225000000000000E-003 - OBS 115 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 114 116 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 380 153076 - 5.625000000000000E-003 - OBS 116 - 1.26180504982221 - 1.36880203692740 - 0.000000000000000E+000 - 115 117 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 380 153076 - 1.000000000000000E-002 - OBS 117 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 116 118 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 380 153076 - 1.225000000000000E-003 - OBS 118 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 117 119 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 390 153076 - 5.625000000000000E-003 - OBS 119 - 1.28821820967047 - 1.36880203692740 - 0.000000000000000E+000 - 118 120 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 390 153076 - 1.000000000000000E-002 - OBS 120 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 119 121 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 390 153076 - 1.225000000000000E-003 - OBS 121 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 120 122 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 400 153076 - 5.625000000000000E-003 - OBS 122 - 1.29601516489605 - 1.36880203692740 - 0.000000000000000E+000 - 121 123 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 400 153076 - 1.000000000000000E-002 - OBS 123 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 122 124 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 400 153076 - 1.225000000000000E-003 - OBS 124 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 123 125 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 410 153076 - 5.625000000000000E-003 - OBS 125 - 1.44012478975899 - 1.36880203692740 - 0.000000000000000E+000 - 124 126 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 410 153076 - 1.000000000000000E-002 - OBS 126 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 125 127 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 410 153076 - 1.225000000000000E-003 - OBS 127 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 126 128 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 420 153076 - 5.625000000000000E-003 - OBS 128 - 1.57173907400877 - 1.36880203692740 - 0.000000000000000E+000 - 127 129 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 420 153076 - 1.000000000000000E-002 - OBS 129 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 128 130 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 420 153076 - 1.225000000000000E-003 - OBS 130 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 129 131 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 430 153076 - 5.625000000000000E-003 - OBS 131 - 1.26492011748196 - 1.36880203692740 - 0.000000000000000E+000 - 130 132 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 430 153076 - 1.000000000000000E-002 - OBS 132 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 131 133 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 430 153076 - 1.225000000000000E-003 - OBS 133 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 132 134 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 440 153076 - 5.625000000000000E-003 - OBS 134 - 1.40465584779102 - 1.36880203692740 - 0.000000000000000E+000 - 133 135 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 440 153076 - 1.000000000000000E-002 - OBS 135 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 134 136 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 440 153076 - 1.225000000000000E-003 - OBS 136 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 135 137 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 450 153076 - 5.625000000000000E-003 - OBS 137 - 1.48217290211226 - 1.36880203692740 - 0.000000000000000E+000 - 136 138 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 450 153076 - 1.000000000000000E-002 - OBS 138 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 137 139 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 450 153076 - 1.225000000000000E-003 - OBS 139 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 138 140 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 460 153076 - 5.625000000000000E-003 - OBS 140 - 1.36698649351147 - 1.36880203692740 - 0.000000000000000E+000 - 139 141 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 460 153076 - 1.000000000000000E-002 - OBS 141 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 140 142 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 460 153076 - 1.225000000000000E-003 - OBS 142 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 141 143 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 470 153076 - 5.625000000000000E-003 - OBS 143 - 1.24926157039964 - 1.36880203692740 - 0.000000000000000E+000 - 142 144 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 470 153076 - 1.000000000000000E-002 - OBS 144 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 143 145 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 470 153076 - 1.225000000000000E-003 - OBS 145 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 144 146 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 480 153076 - 5.625000000000000E-003 - OBS 146 - 1.25669198775998 - 1.36880203692740 - 0.000000000000000E+000 - 145 147 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 480 153076 - 1.000000000000000E-002 - OBS 147 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 146 148 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 480 153076 - 1.225000000000000E-003 - OBS 148 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 147 149 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 490 153076 - 5.625000000000000E-003 - OBS 149 - 1.52332752161428 - 1.36880203692740 - 0.000000000000000E+000 - 148 150 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 490 153076 - 1.000000000000000E-002 - OBS 150 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 149 151 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 490 153076 - 1.225000000000000E-003 - OBS 151 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 150 152 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 500 153076 - 5.625000000000000E-003 - OBS 152 - 1.40481949481270 - 1.36880203692740 - 0.000000000000000E+000 - 151 153 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 500 153076 - 1.000000000000000E-002 - OBS 153 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 152 154 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 500 153076 - 1.225000000000000E-003 - OBS 154 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 153 155 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 510 153076 - 5.625000000000000E-003 - OBS 155 - 1.18009188943686 - 1.36880203692740 - 0.000000000000000E+000 - 154 156 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 510 153076 - 1.000000000000000E-002 - OBS 156 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 155 157 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 510 153076 - 1.225000000000000E-003 - OBS 157 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 156 158 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 520 153076 - 5.625000000000000E-003 - OBS 158 - 1.28276957890148 - 1.36880203692740 - 0.000000000000000E+000 - 157 159 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 520 153076 - 1.000000000000000E-002 - OBS 159 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 158 160 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 520 153076 - 1.225000000000000E-003 - OBS 160 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 159 161 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 530 153076 - 5.625000000000000E-003 - OBS 161 - 1.32127203754923 - 1.36880203692740 - 0.000000000000000E+000 - 160 162 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 530 153076 - 1.000000000000000E-002 - OBS 162 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 161 163 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 530 153076 - 1.225000000000000E-003 - OBS 163 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 162 164 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 540 153076 - 5.625000000000000E-003 - OBS 164 - 1.27257505233025 - 1.36880203692740 - 0.000000000000000E+000 - 163 165 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 540 153076 - 1.000000000000000E-002 - OBS 165 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 164 166 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 540 153076 - 1.225000000000000E-003 - OBS 166 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 165 167 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 550 153076 - 5.625000000000000E-003 - OBS 167 - 1.29521287980472 - 1.36880203692740 - 0.000000000000000E+000 - 166 168 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 550 153076 - 1.000000000000000E-002 - OBS 168 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 167 169 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 550 153076 - 1.225000000000000E-003 - OBS 169 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 168 170 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 560 153076 - 5.625000000000000E-003 - OBS 170 - 1.28755673111242 - 1.36880203692740 - 0.000000000000000E+000 - 169 171 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 560 153076 - 1.000000000000000E-002 - OBS 171 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 170 172 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 560 153076 - 1.225000000000000E-003 - OBS 172 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 171 173 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 570 153076 - 5.625000000000000E-003 - OBS 173 - 1.45018963085652 - 1.36880203692740 - 0.000000000000000E+000 - 172 174 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 570 153076 - 1.000000000000000E-002 - OBS 174 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 173 175 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 570 153076 - 1.225000000000000E-003 - OBS 175 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 174 176 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 580 153076 - 5.625000000000000E-003 - OBS 176 - 1.43594646724107 - 1.36880203692740 - 0.000000000000000E+000 - 175 177 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 580 153076 - 1.000000000000000E-002 - OBS 177 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 176 178 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 580 153076 - 1.225000000000000E-003 - OBS 178 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 177 179 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 590 153076 - 5.625000000000000E-003 - OBS 179 - 1.25431196112062 - 1.36880203692740 - 0.000000000000000E+000 - 178 180 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 590 153076 - 1.000000000000000E-002 - OBS 180 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 179 181 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 590 153076 - 1.225000000000000E-003 - OBS 181 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 180 182 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 600 153076 - 5.625000000000000E-003 - OBS 182 - 1.48171895093781 - 1.36880203692740 - 0.000000000000000E+000 - 181 183 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 600 153076 - 1.000000000000000E-002 - OBS 183 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 182 184 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 600 153076 - 1.225000000000000E-003 - OBS 184 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 183 185 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 610 153076 - 5.625000000000000E-003 - OBS 185 - 1.37940704017051 - 1.36880203692740 - 0.000000000000000E+000 - 184 186 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 610 153076 - 1.000000000000000E-002 - OBS 186 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 185 187 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 610 153076 - 1.225000000000000E-003 - OBS 187 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 186 188 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 620 153076 - 5.625000000000000E-003 - OBS 188 - 1.33788907941085 - 1.36880203692740 - 0.000000000000000E+000 - 187 189 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 620 153076 - 1.000000000000000E-002 - OBS 189 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 188 190 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 620 153076 - 1.225000000000000E-003 - OBS 190 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 189 191 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 630 153076 - 5.625000000000000E-003 - OBS 191 - 1.19227574165152 - 1.36880203692740 - 0.000000000000000E+000 - 190 192 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 630 153076 - 1.000000000000000E-002 - OBS 192 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 191 193 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 630 153076 - 1.225000000000000E-003 - OBS 193 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 192 194 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 640 153076 - 5.625000000000000E-003 - OBS 194 - 1.50691607074127 - 1.36880203692740 - 0.000000000000000E+000 - 193 195 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 640 153076 - 1.000000000000000E-002 - OBS 195 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 194 196 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 640 153076 - 1.225000000000000E-003 - OBS 196 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 195 197 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 650 153076 - 5.625000000000000E-003 - OBS 197 - 1.45123848854319 - 1.36880203692740 - 0.000000000000000E+000 - 196 198 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 650 153076 - 1.000000000000000E-002 - OBS 198 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 197 199 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 650 153076 - 1.225000000000000E-003 - OBS 199 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 198 200 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 660 153076 - 5.625000000000000E-003 - OBS 200 - 1.31674944687435 - 1.36880203692740 - 0.000000000000000E+000 - 199 201 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 660 153076 - 1.000000000000000E-002 - OBS 201 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 200 202 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 660 153076 - 1.225000000000000E-003 - OBS 202 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 201 203 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 670 153076 - 5.625000000000000E-003 - OBS 203 - 1.31600573808352 - 1.36880203692740 - 0.000000000000000E+000 - 202 204 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 670 153076 - 1.000000000000000E-002 - OBS 204 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 203 205 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 670 153076 - 1.225000000000000E-003 - OBS 205 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 204 206 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 680 153076 - 5.625000000000000E-003 - OBS 206 - 1.52126447451870 - 1.36880203692740 - 0.000000000000000E+000 - 205 207 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 680 153076 - 1.000000000000000E-002 - OBS 207 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 206 208 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 680 153076 - 1.225000000000000E-003 - OBS 208 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 207 209 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 690 153076 - 5.625000000000000E-003 - OBS 209 - 1.30796753931319 - 1.36880203692740 - 0.000000000000000E+000 - 208 210 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 690 153076 - 1.000000000000000E-002 - OBS 210 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 209 211 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 690 153076 - 1.225000000000000E-003 - OBS 211 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 210 212 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 700 153076 - 5.625000000000000E-003 - OBS 212 - 1.55912651280059 - 1.36880203692740 - 0.000000000000000E+000 - 211 213 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 700 153076 - 1.000000000000000E-002 - OBS 213 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 212 214 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 700 153076 - 1.225000000000000E-003 - OBS 214 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 213 215 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 710 153076 - 5.625000000000000E-003 - OBS 215 - 1.32371793358352 - 1.36880203692740 - 0.000000000000000E+000 - 214 216 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 710 153076 - 1.000000000000000E-002 - OBS 216 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 215 217 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 710 153076 - 1.225000000000000E-003 - OBS 217 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 216 218 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 720 153076 - 5.625000000000000E-003 - OBS 218 - 1.39056815473816 - 1.36880203692740 - 0.000000000000000E+000 - 217 219 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 720 153076 - 1.000000000000000E-002 - OBS 219 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 218 220 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 720 153076 - 1.225000000000000E-003 - OBS 220 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 219 221 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 730 153076 - 5.625000000000000E-003 - OBS 221 - 1.45855005149100 - 1.36880203692740 - 0.000000000000000E+000 - 220 222 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 730 153076 - 1.000000000000000E-002 - OBS 222 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 221 223 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 730 153076 - 1.225000000000000E-003 - OBS 223 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 222 224 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 740 153076 - 5.625000000000000E-003 - OBS 224 - 1.32681246716103 - 1.36880203692740 - 0.000000000000000E+000 - 223 225 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 740 153076 - 1.000000000000000E-002 - OBS 225 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 224 226 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 740 153076 - 1.225000000000000E-003 - OBS 226 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 225 227 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 750 153076 - 5.625000000000000E-003 - OBS 227 - 1.42864593674731 - 1.36880203692740 - 0.000000000000000E+000 - 226 228 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 750 153076 - 1.000000000000000E-002 - OBS 228 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 227 229 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 750 153076 - 1.225000000000000E-003 - OBS 229 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 228 230 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 760 153076 - 5.625000000000000E-003 - OBS 230 - 1.24013261442570 - 1.36880203692740 - 0.000000000000000E+000 - 229 231 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 760 153076 - 1.000000000000000E-002 - OBS 231 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 230 232 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 760 153076 - 1.225000000000000E-003 - OBS 232 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 231 233 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 770 153076 - 5.625000000000000E-003 - OBS 233 - 1.31234865068045 - 1.36880203692740 - 0.000000000000000E+000 - 232 234 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 770 153076 - 1.000000000000000E-002 - OBS 234 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 233 235 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 770 153076 - 1.225000000000000E-003 - OBS 235 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 234 236 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 780 153076 - 5.625000000000000E-003 - OBS 236 - 1.25260305693748 - 1.36880203692740 - 0.000000000000000E+000 - 235 237 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 780 153076 - 1.000000000000000E-002 - OBS 237 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 236 238 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 780 153076 - 1.225000000000000E-003 - OBS 238 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 237 239 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 790 153076 - 5.625000000000000E-003 - OBS 239 - 1.31818103903736 - 1.36880203692740 - 0.000000000000000E+000 - 238 240 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 790 153076 - 1.000000000000000E-002 - OBS 240 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 239 241 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 790 153076 - 1.225000000000000E-003 - OBS 241 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 240 242 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 800 153076 - 5.625000000000000E-003 - OBS 242 - 1.25481056952136 - 1.36880203692740 - 0.000000000000000E+000 - 241 243 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 800 153076 - 1.000000000000000E-002 - OBS 243 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 242 244 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 800 153076 - 1.225000000000000E-003 - OBS 244 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 243 245 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 810 153076 - 5.625000000000000E-003 - OBS 245 - 1.15262532878938 - 1.36880203692740 - 0.000000000000000E+000 - 244 246 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 810 153076 - 1.000000000000000E-002 - OBS 246 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 245 247 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 810 153076 - 1.225000000000000E-003 - OBS 247 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 246 248 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 820 153076 - 5.625000000000000E-003 - OBS 248 - 1.47224309416468 - 1.36880203692740 - 0.000000000000000E+000 - 247 249 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 820 153076 - 1.000000000000000E-002 - OBS 249 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 248 250 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 820 153076 - 1.225000000000000E-003 - OBS 250 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 249 251 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 830 153076 - 5.625000000000000E-003 - OBS 251 - 1.49766085387692 - 1.36880203692740 - 0.000000000000000E+000 - 250 252 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 830 153076 - 1.000000000000000E-002 - OBS 252 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 251 253 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 830 153076 - 1.225000000000000E-003 - OBS 253 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 252 254 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 840 153076 - 5.625000000000000E-003 - OBS 254 - 1.41486500830714 - 1.36880203692740 - 0.000000000000000E+000 - 253 255 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 840 153076 - 1.000000000000000E-002 - OBS 255 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 254 256 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 840 153076 - 1.225000000000000E-003 - OBS 256 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 255 257 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 850 153076 - 5.625000000000000E-003 - OBS 257 - 1.21351844879144 - 1.36880203692740 - 0.000000000000000E+000 - 256 258 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 850 153076 - 1.000000000000000E-002 - OBS 258 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 257 259 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 850 153076 - 1.225000000000000E-003 - OBS 259 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 258 260 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 860 153076 - 5.625000000000000E-003 - OBS 260 - 1.25482567067007 - 1.36880203692740 - 0.000000000000000E+000 - 259 261 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 860 153076 - 1.000000000000000E-002 - OBS 261 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 260 262 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 860 153076 - 1.225000000000000E-003 - OBS 262 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 261 263 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 870 153076 - 5.625000000000000E-003 - OBS 263 - 1.37399909518299 - 1.36880203692740 - 0.000000000000000E+000 - 262 264 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 870 153076 - 1.000000000000000E-002 - OBS 264 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 263 265 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 870 153076 - 1.225000000000000E-003 - OBS 265 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 264 266 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 880 153076 - 5.625000000000000E-003 - OBS 266 - 1.57916374604842 - 1.36880203692740 - 0.000000000000000E+000 - 265 267 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 880 153076 - 1.000000000000000E-002 - OBS 267 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 266 268 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 880 153076 - 1.225000000000000E-003 - OBS 268 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 267 269 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 890 153076 - 5.625000000000000E-003 - OBS 269 - 1.36793484757941 - 1.36880203692740 - 0.000000000000000E+000 - 268 270 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 890 153076 - 1.000000000000000E-002 - OBS 270 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 269 271 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 890 153076 - 1.225000000000000E-003 - OBS 271 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 270 272 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 900 153076 - 5.625000000000000E-003 - OBS 272 - 1.12376745707373 - 1.36880203692740 - 0.000000000000000E+000 - 271 273 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 900 153076 - 1.000000000000000E-002 - OBS 273 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 272 274 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 900 153076 - 1.225000000000000E-003 - OBS 274 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 273 275 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 910 153076 - 5.625000000000000E-003 - OBS 275 - 1.54150975765236 - 1.36880203692740 - 0.000000000000000E+000 - 274 276 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 910 153076 - 1.000000000000000E-002 - OBS 276 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 275 277 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 910 153076 - 1.225000000000000E-003 - OBS 277 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 276 278 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 920 153076 - 5.625000000000000E-003 - OBS 278 - 1.34606733640038 - 1.36880203692740 - 0.000000000000000E+000 - 277 279 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 920 153076 - 1.000000000000000E-002 - OBS 279 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 278 280 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 920 153076 - 1.225000000000000E-003 - OBS 280 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 279 281 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 930 153076 - 5.625000000000000E-003 - OBS 281 - 1.48948315350324 - 1.36880203692740 - 0.000000000000000E+000 - 280 282 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 930 153076 - 1.000000000000000E-002 - OBS 282 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 281 283 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 930 153076 - 1.225000000000000E-003 - OBS 283 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 282 284 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 940 153076 - 5.625000000000000E-003 - OBS 284 - 1.20645405326318 - 1.36880203692740 - 0.000000000000000E+000 - 283 285 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 940 153076 - 1.000000000000000E-002 - OBS 285 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 284 286 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 940 153076 - 1.225000000000000E-003 - OBS 286 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 285 287 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 950 153076 - 5.625000000000000E-003 - OBS 287 - 1.56876666357552 - 1.36880203692740 - 0.000000000000000E+000 - 286 288 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 950 153076 - 1.000000000000000E-002 - OBS 288 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 287 289 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 950 153076 - 1.225000000000000E-003 - OBS 289 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 288 290 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 960 153076 - 5.625000000000000E-003 - OBS 290 - 1.36852430263385 - 1.36880203692740 - 0.000000000000000E+000 - 289 291 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 960 153076 - 1.000000000000000E-002 - OBS 291 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 290 292 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 960 153076 - 1.225000000000000E-003 - OBS 292 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 291 293 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 970 153076 - 5.625000000000000E-003 - OBS 293 - 1.49001722639392 - 1.36880203692740 - 0.000000000000000E+000 - 292 294 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 970 153076 - 1.000000000000000E-002 - OBS 294 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 293 295 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 970 153076 - 1.225000000000000E-003 - OBS 295 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 294 296 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 980 153076 - 5.625000000000000E-003 - OBS 296 - 1.46756341653326 - 1.36880203692740 - 0.000000000000000E+000 - 295 297 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 980 153076 - 1.000000000000000E-002 - OBS 297 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 296 298 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 980 153076 - 1.225000000000000E-003 - OBS 298 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 297 299 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 12 - 990 153076 - 5.625000000000000E-003 - OBS 299 - 1.32141551613841 - 1.36880203692740 - 0.000000000000000E+000 - 298 300 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 15 - 990 153076 - 1.000000000000000E-002 - OBS 300 - -888888.000000000 - -888888.000000000 - 1000.00000000000 - 299 -1 -1 -obdef -loc3d - 0.000000000000000 1.553343034274953 0.000000000000000 -1 -kind - 16 - 990 153076 - 1.225000000000000E-003 diff --git a/models/cice-scm/icepack_test/preassim_mean.nc b/models/cice-scm/icepack_test/preassim_mean.nc deleted file mode 100644 index 7657818af583b47c239fd02da31643c47f934ae3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4096 zcmZ>EabseD04^W}Vl(Asf(2NBBuid$VhNCD1!5i`<_2Qk{zwRGwt6*ecWTIeTp3gPnbWY*81-ppf{q z%$(Ht%)GSxqFk^85o*N>fNm}>&dgOv%_~mLP0C4C$W2Ym11k^$>&5gGIey{>n+5k0 z*iWJOgEzoPy$)CB(vS-#ggZHn}_UA++Vydt97dVRDSh9`*V}_Pu_3u%D8C8{)4~PZYpERvfsMRCvn}I7xss1 zcYd!rdTjsl?F-kZim%$gwjj`GMe8E_eJTtgja%~U51I#5&;PU1e&&v=m$oYG-oM7X zwrF0xoc;4JNy4A2i|n5lgfq6@m}38;<@fvA^mqG@WF}7LI%sIW?S?>TE!_U*g5^&iuKH|0p(a~eynx%j`#{#ogFL+U3+|_}FQ33^ zAL`J))_9fL{(i6bckbs;u-|uQ`J_D!Z|%?OT|ba5d%=F6aZEb@E8hJJw-(H(z0$jX zbLF=M;`6%fS6MGen5A&ZeydvDX^WSd``5kw)v(vz$$rYoHNU2dU$URXeb>l$+R^>1 z-T2GC8*$ig{ltB5vXq$pRtw8EDQ)@v%Ok!WP5$uOeu~W3m7(F2?Kj+Gym36*3_0#c f*`pya8UmvsFd71*Aut*OqaiRF0;3@?QbPa$bc}CT diff --git a/models/cice-scm/icepack_test/preassim_sd.nc b/models/cice-scm/icepack_test/preassim_sd.nc deleted file mode 100644 index d46097a0f944b922d481bf54fbda5605ceb43d23..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4096 zcmeHEdu&T#6u-LG*d|2Ql6YOuMZCJ!tR!+~t0CD#)>@cQb$e@-_LjDmj36HI4wDU= zHL*XKWa_bD2&1}3tG%^uGiKOoMLjb_JTk_2?-Djb#J}!I&UeoD`+n!-JHL}4Pvl`; z7KQ?o^C%q)@X^Vq2(<-80rCjs;mG?DCQ@zD87Y-UZ6OhWjHw&H2pOK7jLYTt+__Am zP~bChiC8if7t3%-EFK+$izT>3!j@nW2BU`5tIWnVCW2|h^bip`f}CU~3{$!u(K%T= zUCb5;Sg5O(;r2#MDII?1G&-W|glC3uV>($-Ra8UU$ zGs6ar;U3e3?dPG&l_FfVryYDjQ9;^;IG}S^T6ybF0ewu{p7x~_d{j)YhHRivE?n^`bp8vlKWPiiG~(d38boG**xMb_5!{Esu)H<}W z1-xWjR%!kLaE{!Rl2cd?H-mGA%0*@1sCu)=A9Wk*qS>&l_-WqY%IH3e0CfAiqn zfb&{e*?aq{?yY)L{RlP`hAn^F4TM+9p1a`DAWWh+!Hox!Mm*D+)=U#Dw<#Q zA*M;7a*06kjHm`WEvmSFS31yn1xqeVo#2tV5+9%30Ch2~Lpo;|z$FXXU#Rv%?K1sS z^|lh8zE#^IFjsn_0qo|=)3YEdJu5vuK$MU%grvRq_rvRq_ RrvRq_rvRq_r@()%z&G50ZT|oO diff --git a/models/cice-scm/dart_cice_mod.f90 b/models/icepack/dart_cice_mod.f90 similarity index 100% rename from models/cice-scm/dart_cice_mod.f90 rename to models/icepack/dart_cice_mod.f90 diff --git a/models/cice-scm/dart_to_cice.f90 b/models/icepack/dart_to_cice.f90 similarity index 100% rename from models/cice-scm/dart_to_cice.f90 rename to models/icepack/dart_to_cice.f90 diff --git a/models/cice-scm/model_mod.f90 b/models/icepack/model_mod.f90 similarity index 100% rename from models/cice-scm/model_mod.f90 rename to models/icepack/model_mod.f90 diff --git a/models/cice-scm/readme.rst b/models/icepack/readme.rst similarity index 100% rename from models/cice-scm/readme.rst rename to models/icepack/readme.rst diff --git a/models/cice-scm/work/input.nml b/models/icepack/work/input.nml similarity index 100% rename from models/cice-scm/work/input.nml rename to models/icepack/work/input.nml diff --git a/models/cice-scm/work/quickbuild.sh b/models/icepack/work/quickbuild.sh similarity index 98% rename from models/cice-scm/work/quickbuild.sh rename to models/icepack/work/quickbuild.sh index 2bd790cb41..c7ffd76576 100755 --- a/models/cice-scm/work/quickbuild.sh +++ b/models/icepack/work/quickbuild.sh @@ -9,7 +9,7 @@ main() { export DART=$(git rev-parse --show-toplevel) source "$DART"/build_templates/buildfunctions.sh -MODEL=cice-scm +MODEL=icepack LOCATION=threed_sphere From 293b033a8ae0440a7425dcd115fe379b0486528d Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Thu, 3 Oct 2024 12:50:28 -0600 Subject: [PATCH 19/23] Updating the documentation to reflect the removal of the icepack_test dir from the repo and include the model_nml item grid_oi. Updating source variable in model_mod --- models/icepack/model_mod.f90 | 2 +- models/icepack/readme.rst | 17 +++++++++++++---- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/models/icepack/model_mod.f90 b/models/icepack/model_mod.f90 index 3ee4140839..7237a74962 100644 --- a/models/icepack/model_mod.f90 +++ b/models/icepack/model_mod.f90 @@ -107,7 +107,7 @@ module model_mod read_model_time, & write_model_time -character(len=256), parameter :: source = 'cice-scm/model_mod.f90' +character(len=256), parameter :: source = 'icepack/model_mod.f90' logical, save :: module_initialized = .false. diff --git a/models/icepack/readme.rst b/models/icepack/readme.rst index 965a8c7961..34df28f127 100644 --- a/models/icepack/readme.rst +++ b/models/icepack/readme.rst @@ -14,7 +14,7 @@ More information about the model and instructions on how to run Icepack can be f This model is run as a separate executable from DART, and this means that you must use scripts to alternate the model and DART program execution and allow for the progression of the assimilation through multiple time windows. These scripts will be provided by DART, but they are currently still in progress. -The assimilation process can be easily executed within a single assimilation window, however. There is a test case available in /DART/models/icepack/icepack_test that contains the necessary input files to run filter, the main program in DART that performs the assimilation. There is a README file in this directory to give more details on the specifics of the test case. +The assimilation process can be easily executed within a single assimilation window, however. There is a test case available in ``/glade/work/masmith/test_cases/icepack_test`` that contains the necessary input files to run filter, the main program in DART that performs the assimilation. There is a README file in this directory to give more details on the specifics of the test case. If you do not have access to the NSF NCAR Derecho Supercomputer, the reach out to the DAReS team at ``masmith@ucar.edu`` and we will provide you with the test case. The steps to run this example are as follows: @@ -24,15 +24,18 @@ The steps to run this example are as follows: 2. | ``./quickbuild.sh`` (or ``quickbuild.sh nompi`` if you are not building with mpi) | Builds all DART executables -3. | ``cd /DART/models/icepack/icepack_test`` +3. | ``cp -r /glade/work/masmith/test_cases/icepack_test ..`` + | Copy the test directory from the directory stated above to your Icepack directory + +4. | ``cd ../icepack_test`` | Navigate to the test directory -4. | In ``work/input.nml``, set ``perturb_from_single_instance = .true.`` in the +5. | In ``work/input.nml``, set ``perturb_from_single_instance = .true.`` in the ``&filter_nml`` | This setting causes filter to perturb a single restart file to generate an ensemble -5. | ``./filter`` +6. | ``./filter`` | Runs the assimilation program, resulting in four main output files: | ``analysis_mean.nc`` and ``analysis_sd`` - the mean and standard deviation of the state of all ensemble members after the assimilation | ``obs_seq.final`` - the ensemble members' estimate of the observations. @@ -49,6 +52,7 @@ Namelist model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', 'QTY_SEAICE_VOLUME', 'UPDATE', 'vsnon', 'QTY_SEAICE_SNOWVOLUME', 'UPDATE' + grid_oi = 3 / Description of each namelist entry @@ -65,6 +69,11 @@ Description of each namelist entry +------------------------------+---------------+---------------------------------+ | model_state_variables | character(*) | List of model state variables | +------------------------------+---------------+---------------------------------+ +| grid_oi | integer | Specifies a constant to be used | +| | | as the value for the first | +| | | dimension in calls to | +| | | get_dart_vector_index | ++------------------------------+---------------+---------------------------------+ References ~~~~~~~~~~ From 5223c244a4073cecd5b6327ee9cb03b4cf0fced8 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Thu, 3 Oct 2024 13:42:33 -0600 Subject: [PATCH 20/23] One last sweep for unused variables --- models/icepack/model_mod.f90 | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/models/icepack/model_mod.f90 b/models/icepack/model_mod.f90 index 7237a74962..f89c20390d 100644 --- a/models/icepack/model_mod.f90 +++ b/models/icepack/model_mod.f90 @@ -159,8 +159,7 @@ module model_mod subroutine static_init_model() -real(r8) :: x_loc -integer :: i, dom_id, iunit, io, ss, dd +integer :: iunit, io, ss, dd if ( module_initialized ) return ! only need to do this once @@ -243,7 +242,6 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte integer :: cat_index, cat_signal, icat, cat_signal_interm real(r8) :: expected_aggr_conc(ens_size) integer :: set_obstype -integer :: var_table_index !Fei---need aicen*fyn to calculate the aggregate FY concentration real(r8) :: expected_conc(ens_size) @@ -484,16 +482,10 @@ subroutine lon_lat_interpolate(state_handle, ens_size, offset, lon, lat, var_typ real(r8), intent(out) :: expected_obs(ens_size) integer, intent(out) :: istatus(ens_size) -integer :: lat_bot, lat_top, lon_bot, lon_top, num_inds, start_ind -integer :: x_ind, y_ind -real(r8) :: x_corners(4), y_corners(4) -real(r8) :: p(4,ens_size), xbot(ens_size), xtop(ens_size) real(r8) :: work_expected_obs(ens_size) -real(r8) :: lon_fract, lat_fract -integer :: quad_status integer :: e, iterations, Niterations -integer :: next_offset integer(i8) :: state_index + if ( .not. module_initialized ) call static_init_model istatus = 0 @@ -591,7 +583,6 @@ subroutine nc_write_model_atts(ncid, domain_id) integer :: NGridDimID integer :: tlonVarID, tlatVarID -integer :: status character(len=256) :: filename @@ -845,7 +836,7 @@ subroutine write_model_time(ncid, model_time, adv_to_time) character(len=16), parameter :: routine = 'write_model_time' -integer :: io, varid, iyear, imonth, iday, ihour, imin, isec +integer :: iyear, imonth, iday, ihour, imin, isec integer :: seconds if ( .not. module_initialized ) call static_init_model From 584b8aa080cac05666c6a20a94efa9c6432edbad Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Thu, 3 Oct 2024 13:47:32 -0600 Subject: [PATCH 21/23] Adding conidtionals to check debug value before printing lots of info from model_interpolate --- models/icepack/model_mod.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/models/icepack/model_mod.f90 b/models/icepack/model_mod.f90 index f89c20390d..a8e71f9445 100644 --- a/models/icepack/model_mod.f90 +++ b/models/icepack/model_mod.f90 @@ -389,11 +389,11 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte temp = temp + expected_conc * expected_fy !sum(aicen*fyn) = FY % over ice temp1= temp1+ expected_conc !sum(aicen) = aice - if (any(expected_conc<0.0) .or. any(expected_conc>1.0))then + if ((any(expected_conc<0.0) .or. any(expected_conc>1.0)) .and. (debug > 1)) then print*,'obstype FY expected sicn:',expected_conc print*,'FY sicn lat lon:',llat,llon endif - if (any(expected_fy>1.0) .or. any(expected_fy<0.0)) then + if ((any(expected_fy>1.0) .or. any(expected_fy<0.0)) .and. (debug > 1)) then print*,'obstype FY expected fyn:',expected_fy,llat,llon print*,'FY fyn lat lon:',llat,llon endif @@ -414,11 +414,11 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SEAICE_SURFACETEMP)) base_offset = base_offset + (icat-1) * Nx call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal_interm, expected_tsfc, istatus) - if (any(expected_conc<0.0) .or. any(expected_conc>1.0))then + if ((any(expected_conc<0.0) .or. any(expected_conc>1.0)) .and. (debug > 1)) then print*,'obstype TSFC expected sicn:',expected_conc print*,'TSFC sicn lat lon:',llat,llon endif - if (any(expected_tsfc>50.0) .or. any(expected_tsfc<-100.0)) then + if ((any(expected_tsfc>50.0) .or. any(expected_tsfc<-100.0)) .and. (debug > 1)) then print*,'obstype TSFC expected tsfcn:',expected_tsfc print*,'TSFC tsfcn lat lon:',llat,llon endif @@ -426,7 +426,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte temp1= temp1+ expected_conc !sum(aicen) = aice end do expected_obs = temp/max(temp1,1.0e-8) !sum(aicen*Tsfcn)/aice = Tsfc ;averaged temperature over sea-ice covered portion - if (any(expected_obs>50.0) .or. any(expected_obs<-100.0)) then + if ((any(expected_obs>50.0) .or. any(expected_obs<-100.0)) .and. (debug > 1)) then print*,'obstype TSFC expected obs:',expected_obs print*,'TSFC tsfc lat lon:' ,llat,llon print*,'temp:',temp @@ -435,11 +435,11 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte else call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal, expected_obs, istatus) - if (any(expected_obs<0.0))then + if (any(expected_obs<0.0) .and. (debug > 1)) then print*,'obstype SIC expected concs:',expected_obs print*,'SIC sic negative lat lon:',llat,llon endif - if (any(expected_obs>1.0))then + if (any(expected_obs>1.0) .and. (debug > 1)) then print*,'obstype SIC expected concs:',expected_obs print*,'SIC sic positive lat lon:',llat,llon endif @@ -452,7 +452,7 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, set_obstype, cat_signal, expected_aggr_conc, istatus) expected_obs = expected_obs/max(expected_aggr_conc,1.0e-8) ! hope this is allowed so we never divide by zero - if (any(expected_aggr_conc<0.0) .or. any(expected_aggr_conc>1.0))then + if ((any(expected_aggr_conc<0.0) .or. any(expected_aggr_conc>1.0)) .and. (debug > 1)) then print*,'obstype SIT expected conc:',expected_aggr_conc print*,'SIT sic lat lon:',llat,llon endif From c33ba0ba628ea923f79004ad29f67fa83fb31bec Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Thu, 3 Oct 2024 14:56:55 -0600 Subject: [PATCH 22/23] Doc fixes --- models/icepack/readme.rst | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/models/icepack/readme.rst b/models/icepack/readme.rst index 34df28f127..bf16a50877 100644 --- a/models/icepack/readme.rst +++ b/models/icepack/readme.rst @@ -8,9 +8,9 @@ Overview DART interface modules for Icepack, the column physics of the sea ice model CICE (`https://github.com/cice-consortium/Icepack `_). Icepack is maintained by the CICE Consortium. -The column physics package of the sea ice model CICE, “Icepack”, is maintained by the CICE Consortium. A large portion of the physics in sea ice models can be described in a vertical column, without reference to neighboring grid cells. This code includes several options for simulating sea ice thermodynamics, mechanical redistribution (ridging) and associated area and thickness changes. In addition, the model supports a number of tracers, including thickness, enthalpy, ice age, first-year ice area, deformed ice area and volume, melt ponds, and biogeochemistry. +A large portion of the physics in sea ice models can be described in a vertical column, without reference to neighboring grid cells. This code includes several options for simulating sea ice thermodynamics, mechanical redistribution (ridging) and associated area and thickness changes. In addition, the model supports a number of tracers, including thickness, enthalpy, ice age, first-year ice area, deformed ice area and volume, melt ponds, and biogeochemistry. -More information about the model and instructions on how to run Icepack can be found in the `Icepack documentation: `_ +More information about the model and instructions on how to run Icepack can be found in the `Icepack documentation `_. This model is run as a separate executable from DART, and this means that you must use scripts to alternate the model and DART program execution and allow for the progression of the assimilation through multiple time windows. These scripts will be provided by DART, but they are currently still in progress. @@ -46,14 +46,14 @@ Namelist .. code-block:: fortran -&model_nml - model_perturbation_amplitude = 2e-05 - debug = 1 - model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', + &model_nml + model_perturbation_amplitude = 2e-05 + debug = 1 + model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR', 'UPDATE', 'vicen', 'QTY_SEAICE_VOLUME', 'UPDATE', 'vsnon', 'QTY_SEAICE_SNOWVOLUME', 'UPDATE' - grid_oi = 3 -/ + grid_oi = 3 + / Description of each namelist entry ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From ff4ea2b43fec5b4431d47590a038698a08ac8b36 Mon Sep 17 00:00:00 2001 From: Marlena Smith <44214771+mjs2369@users.noreply.github.com> Date: Tue, 8 Oct 2024 11:08:34 -0600 Subject: [PATCH 23/23] Remove comment from models/icepack/model_mod.f90 that was leftover from the template Co-authored-by: Helen Kershaw <20047007+hkershaw-brown@users.noreply.github.com> --- models/icepack/model_mod.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/models/icepack/model_mod.f90 b/models/icepack/model_mod.f90 index a8e71f9445..a155e6b241 100644 --- a/models/icepack/model_mod.f90 +++ b/models/icepack/model_mod.f90 @@ -4,7 +4,6 @@ module model_mod -! Modules that are absolutely required for use are listed use types_mod, only : i4, r8, i8, MISSING_R8, metadatalength, vtablenamelength use time_manager_mod, only : time_type, set_calendar_type, get_time, set_date, get_date use location_mod, only : location_type, get_close_type, get_close_obs, get_dist, &