Skip to content

Commit

Permalink
Fix to driver history (#421)
Browse files Browse the repository at this point in the history
  • Loading branch information
@dabail10
dabail10 authored Dec 17, 2022
1 parent 8f96707 commit 3a4d02e
Showing 1 changed file with 74 additions and 7 deletions.
81 changes: 74 additions & 7 deletions configuration/driver/icedrv_history.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ module icedrv_history

use icedrv_kinds
use icedrv_constants, only: nu_diag, nu_diag_out
use icedrv_domain_size, only: nx, ncat
use icedrv_domain_size, only: nx, ncat, nfsd
use icedrv_diagnostics, only: nx_names
use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_sizes
Expand All @@ -27,7 +27,7 @@ module icedrv_history
character (len=char_len_long) :: hist_file ! hist file name

integer (kind=int_kind) :: ncid ! cdf file id
integer (kind=int_kind) :: nxid, ncatid, ntrcrid, timid ! cdf dim ids
integer (kind=int_kind) :: nxid, ncatid, ntrcrid, nfsdid, timid ! cdf dim ids
integer (kind=int_kind) :: timcnt ! time counter

!=======================================================================
Expand All @@ -50,6 +50,7 @@ subroutine history_write()
use icedrv_flux, only: Tair, Qa, fsw, fcondtop
use icedrv_flux, only: meltt, meltb, meltl, snoice
use icedrv_flux, only: dsnow, congel, sst, sss, Tf, fhocn
use icedrv_arrays_column, only: d_afsd_newi, d_afsd_latg, d_afsd_latm, d_afsd_wave, d_afsd_weld
#ifdef USE_NETCDF
use netcdf
#endif
Expand Down Expand Up @@ -95,6 +96,14 @@ subroutine history_write()
character(len=16), parameter :: fld_3d_ncat(num_3d_ncat) = &
(/ 'aicen ', 'vicen ', 'vsnon ' /)

logical (kind=log_kind) :: &
tr_fsd ! flag for tracing fsd

integer (kind=dbl_kind), parameter :: num_3d_nfsd = 5
character(len=16), parameter :: fld_3d_nfsd(num_3d_nfsd) = &
(/ 'd_afsd_newi ', 'd_afsd_latg ', 'd_afsd_latm ', &
'd_afsd_wave ', 'd_afsd_weld ' /)

integer (kind=dbl_kind), parameter :: num_3d_ntrcr = 1
character(len=16), parameter :: fld_3d_ntrcr(num_3d_ntrcr) = &
(/ 'trcr ' /)
Expand All @@ -109,6 +118,7 @@ subroutine history_write()

#ifdef USE_NETCDF
call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
call icepack_query_tracer_flags(tr_fsd_out=tr_fsd)
if (first_call) then
timcnt = 0
write(hist_file,'(a,i8.8,a)') './history/icepack.h.',idate,'.nc'
Expand Down Expand Up @@ -139,6 +149,14 @@ subroutine history_write()
status = nf90_def_var(ncid,'ntrcr',NF90_INT,ntrcrid,varid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var ntrcr')

if (tr_fsd) then
! nfsd category dimension
status = nf90_def_dim(ncid,'nfsd',nfsd,nfsdid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim nfsd')
status = nf90_def_var(ncid,'nfsd',NF90_INT,nfsdid,varid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var nfsd')
endif

! time dimension
status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim time')
Expand Down Expand Up @@ -189,6 +207,19 @@ subroutine history_write()
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_3d_ncat(n)))
enddo

if (tr_fsd) then
! 3d nfsd fields

dimid3(1) = nxid
dimid3(2) = nfsdid
dimid3(3) = timid

do n = 1,num_3d_nfsd
status = nf90_def_var(ncid,trim(fld_3d_nfsd(n)),NF90_DOUBLE,dimid3,varid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_3d_nfsd(n)))
enddo
endif

! 3d ntrcr fields

dimid3(1) = nxid
Expand All @@ -203,8 +234,8 @@ subroutine history_write()
! 4d ncat ntrcr fields

dimid4(1) = nxid
dimid4(2) = ncatid
dimid4(3) = ntrcrid
dimid4(2) = ntrcrid
dimid4(3) = ncatid
dimid4(4) = timid

do n = 1,num_4d_ncat_ntrcr
Expand Down Expand Up @@ -234,6 +265,13 @@ subroutine history_write()
status = nf90_put_var(ncid,varid,(/(n,n=1,ntrcr)/))
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'ntrcr')

if (tr_fsd) then
status = nf90_inq_varid(ncid,'nfsd',varid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'nfsd')
status = nf90_put_var(ncid,varid,(/(n,n=1,nfsd)/))
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'nfsd')
endif

endif

first_call = .false.
Expand Down Expand Up @@ -336,6 +374,35 @@ subroutine history_write()
deallocate(value3)
enddo

if (tr_fsd) then
! 3d nfsd fields

start3(1) = 1
count3(1) = nx
start3(2) = 1
count3(2) = nfsd
start3(3) = timcnt
count3(3) = 1

do n = 1,num_3d_nfsd
allocate(value3(count3(1),count3(2),1))

value3 = -9999._dbl_kind
if (trim(fld_3d_nfsd(n)) == 'd_afsd_newi') value3(1:count3(1),1:count3(2),1) = d_afsd_newi(1:count3(1),1:count3(2))
if (trim(fld_3d_nfsd(n)) == 'd_afsd_latg') value3(1:count3(1),1:count3(2),1) = d_afsd_latg(1:count3(1),1:count3(2))
if (trim(fld_3d_nfsd(n)) == 'd_afsd_latm') value3(1:count3(1),1:count3(2),1) = d_afsd_latm(1:count3(1),1:count3(2))
if (trim(fld_3d_nfsd(n)) == 'd_afsd_wave') value3(1:count3(1),1:count3(2),1) = d_afsd_wave(1:count3(1),1:count3(2))
if (trim(fld_3d_nfsd(n)) == 'd_afsd_weld') value3(1:count3(1),1:count3(2),1) = d_afsd_weld(1:count3(1),1:count3(2))

status = nf90_inq_varid(ncid,trim(fld_3d_nfsd(n)),varid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_3d_nfsd(n)))
status = nf90_put_var(ncid,varid,value3,start=start3,count=count3)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_3d_nfsd(n)))

deallocate(value3)
enddo
endif

! 3d ntrcr fields

start3(1) = 1
Expand Down Expand Up @@ -364,17 +431,17 @@ subroutine history_write()
start4(1) = 1
count4(1) = nx
start4(2) = 1
count4(2) = ncat
count4(2) = ntrcr
start4(3) = 1
count4(3) = ntrcr
count4(3) = ncat
start4(4) = timcnt
count4(4) = 1

do n = 1,num_4d_ncat_ntrcr
allocate(value4(count4(1),count4(2),count4(3),1))

value4 = -9999._dbl_kind
if (trim(fld_4d_ncat_ntrcr(n)) == 'trcr') value4(1:count4(1),1:count4(2),1:count4(3),1) = trcrn(1:count4(1),1:count4(2),1:count4(3))
if (trim(fld_4d_ncat_ntrcr(n)) == 'trcrn') value4(1:count4(1),1:count4(2),1:count4(3),1) = trcrn(1:count4(1),1:count4(2),1:count4(3))

status = nf90_inq_varid(ncid,trim(fld_4d_ncat_ntrcr(n)),varid)
if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_4d_ncat_ntrcr(n)))
Expand Down

0 comments on commit 3a4d02e

Please sign in to comment.