Skip to content

Commit

Permalink
Merge pull request #132 from GEOS-ESM/bugfix/out_incr_history
Browse files Browse the repository at this point in the history
Bugfix/out incr history
  • Loading branch information
weiyuan-jiang committed Feb 26, 2020
2 parents aba0212 + 5165eaf commit 8750222
Show file tree
Hide file tree
Showing 4 changed files with 150 additions and 155 deletions.
4 changes: 2 additions & 2 deletions src/Applications/LDAS_App/LDASsa_DEFAULT_inputs_ensupd.nml
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ centered_update = .false.

out_obslog = .true.
out_ObsFcstAna = .false.
out_incr = .false.
!out_incr = .false.
out_smapL4SMaup = .false.

! select format of increments output
Expand All @@ -51,7 +51,7 @@ out_smapL4SMaup = .false.
! 1: suitable for land incremental analysis update (LIAU) in GEOS-5 GCM
! (output on global domain in GEOS-5 global tile order)

out_incr_format = 0
!out_incr_format = 0

! ---------------------------------------------------------------------
!
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -93,9 +93,7 @@ module GEOS_LandAssimGridCompMod
integer :: N_obs_param
logical :: out_obslog
logical :: out_ObsFcstAna
logical :: out_incr
logical :: out_smapL4SMaup
integer :: out_incr_format
integer :: N_obsbias_max

integer,dimension(:),pointer :: N_catl_vec,low_ind
Expand Down Expand Up @@ -1115,8 +1113,8 @@ subroutine Initialize(gc, import, export, clock, rc)
obs_param, &
out_obslog, &
out_ObsFcstAna, &
out_incr, &
out_incr_format, &
! out_incr, &
! out_incr_format, &
out_smapL4SMaup, &
N_obsbias_max &
)
Expand All @@ -1134,8 +1132,8 @@ subroutine Initialize(gc, import, export, clock, rc)
call MPI_BCAST(N_obs_param, 1, MPI_INTEGER, 0,MPICOMM,mpierr)
call MPI_BCAST(out_obslog, 1, MPI_LOGICAL, 0,MPICOMM,mpierr)
call MPI_BCAST(out_ObsFcstAna, 1, MPI_LOGICAL, 0,MPICOMM,mpierr)
call MPI_BCAST(out_incr, 1, MPI_LOGICAL, 0,MPICOMM,mpierr)
call MPI_BCAST(out_incr_format, 1, MPI_INTEGER, 0,MPICOMM,mpierr)
! call MPI_BCAST(out_incr, 1, MPI_LOGICAL, 0,MPICOMM,mpierr)
! call MPI_BCAST(out_incr_format, 1, MPI_INTEGER, 0,MPICOMM,mpierr)
call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr)
call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr)

Expand Down Expand Up @@ -1261,10 +1259,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC )

real, dimension(:),pointer :: TC1_incr=>null()
real, dimension(:),pointer :: TC2_incr=>null()
real, dimension(:),pointer :: TC3_incr=>null()
real, dimension(:),pointer :: TC4_incr=>null()
real, dimension(:),pointer :: QC1_incr=>null()
real, dimension(:),pointer :: QC2_incr=>null()
real, dimension(:),pointer :: QC3_incr=>null()
real, dimension(:),pointer :: QC4_incr=>null()
real, dimension(:),pointer :: CAPAC_incr=>null()
real, dimension(:),pointer :: CATDEF_incr=>null()
real, dimension(:),pointer :: RZEXC_incr=>null()
Expand Down Expand Up @@ -1497,13 +1495,13 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC )
VERIFY_(status)
call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status)
VERIFY_(status)
call MAPL_GetPointer(export, TC3_incr, 'TCFWLT_INCR' ,rc=status)
call MAPL_GetPointer(export, TC4_incr, 'TCFWLT_INCR' ,rc=status)
VERIFY_(status)
call MAPL_GetPointer(export, QC1_incr, 'QCFSAT_INCR' ,rc=status)
VERIFY_(status)
call MAPL_GetPointer(export, QC2_incr, 'QCFTRN_INCR' ,rc=status)
VERIFY_(status)
call MAPL_GetPointer(export, QC3_incr, 'QCFWLT_INCR' ,rc=status)
call MAPL_GetPointer(export, QC4_incr, 'QCFWLT_INCR' ,rc=status)
VERIFY_(status)
call MAPL_GetPointer(export, CAPAC_incr, 'CAPAC_INCR' ,rc=status)
VERIFY_(status)
Expand Down Expand Up @@ -1743,10 +1741,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC )
! Need to find the number
N_catg = maxval(rf2g)

if (mod(secs_in_day, dtstep_assim)==0) then
if (mod(secs_in_day, dtstep_assim)==0) then

call output_incr_etc( out_ObsFcstAna, out_incr, &
out_incr_format, date_time_new, trim(out_path), trim(exp_id), &
call output_incr_etc( out_ObsFcstAna, &
date_time_new, trim(out_path), trim(exp_id), &
N_obsl, N_obs_param, NUM_ENSEMBLE, &
N_catl, tile_coord_l, &
N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, &
Expand All @@ -1756,48 +1754,46 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC )
cat_param, cat_progn, cat_progn_incr, mwRTM_param, &
Observations_l )

if (out_incr) then

do i = 1, N_catl
cat_progn_incr_ensavg(i) = 0.0
do n_e=1, NUM_ENSEMBLE
cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) &
+ cat_progn_incr(i,n_e)
end do
cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE)
enddo

TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1
TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2
TC3_incr(:) = cat_progn_incr_ensavg(:)%tc4
QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1
QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2
QC3_incr(:) = cat_progn_incr_ensavg(:)%qa4

CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac
CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef
RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc
SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc

GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1)
GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2)
GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3)
GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4)
GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5)
GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6)

WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1)
WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2)
WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3)

HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1)
HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2)
HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3)

SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1)
SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2)
SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3)
endif

do i = 1, N_catl
cat_progn_incr_ensavg(i) = 0.0
do n_e=1, NUM_ENSEMBLE
cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) &
+ cat_progn_incr(i,n_e)
end do
cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE)
enddo

if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1
if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2
if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4
if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1
if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2
if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4

if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac
if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef
if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc
if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc

if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1)
if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2)
if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3)
if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4)
if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5)
if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6)

if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1)
if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2)
if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3)

if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1)
if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2)
if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3)

if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1)
if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2)
if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3)



Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1596,8 +1596,8 @@ end subroutine output_ObsFcstAna

! **********************************************************************

subroutine output_incr_etc( out_ObsFcstAna, out_incr, &
out_incr_format, date_time, work_path, exp_id, &
subroutine output_incr_etc( out_ObsFcstAna, &
date_time, work_path, exp_id, &
N_obsl, N_obs_param, N_ens, &
N_catl, tile_coord_l, &
N_catf, tile_coord_f, tile_grid_f, tile_grid_g, &
Expand All @@ -1615,9 +1615,8 @@ subroutine output_incr_etc( out_ObsFcstAna, out_incr, &

! major revisions for new obs handling and MPI

logical, intent(in) :: out_ObsFcstAna, out_incr
logical, intent(in) :: out_ObsFcstAna

integer, intent(in) :: out_incr_format

type(date_time_type), intent(in) :: date_time

Expand Down Expand Up @@ -1710,94 +1709,94 @@ subroutine output_incr_etc( out_ObsFcstAna, out_incr, &

! output ens avg increments

if (out_incr) then

! compute increments for local domain

do i=1,N_catl
cat_progn_incr_ensavg(i) = 0.
do n_e=1,N_ens
cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) &
+ cat_progn_incr(i,n_e)
end do
cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(N_ens)
end do


! gather and write to file

file_tag = 'ldas_incr'
dir_name = 'ana'

if (master_proc) allocate(cat_progn_incr_f(N_catf))

#ifdef LDAS_MPI

call MPI_GATHERV( &
cat_progn_incr_ensavg, N_catl, MPI_cat_progn_type, &
cat_progn_incr_f, N_catl_vec, low_ind-1, MPI_cat_progn_type, &
0, mpicomm, mpierr )

#else
cat_progn_incr_f = cat_progn_incr_ensavg
#endif
if (master_proc) then


select case (out_incr_format)

case (0)

! output increments in LDASsa domain and in LDASsa tile order (standard LDASsa)
if(present(rf2f)) then
allocate(cat_progn_incr_tmp(N_catf))
cat_progn_incr_tmp(:) = cat_progn_incr_f(rf2f(:))
cat_progn_incr_f = cat_progn_incr_tmp
deallocate(cat_progn_incr_tmp)
endif

call io_rstrt( 'w', work_path, exp_id, -1, date_time, &
N_catf, cat_progn_incr_f, file_tag, dir_name=dir_name)

case (1)

! output increments on global domain in GEOS-5 global tile order
! suitable for reading into GEOS-5 GCM as land incremental analysis
! update (LIAU)

allocate(cat_progn_incr_g(N_catg))

! initialize

do i=1,N_catg
cat_progn_incr_g(i) = 0.0
end do

! reorder increments to GEOS-5 gcm global tile order

do i=1,N_catf
cat_progn_incr_g(f2g(i)) = cat_progn_incr_f(i)
end do

file_tag = trim(file_tag) // 'LIAU'

call io_rstrt( 'w', work_path, exp_id, -1, date_time, &
N_catg, cat_progn_incr_g, file_tag, dir_name=dir_name, &
is_little_endian=.true. )

deallocate(cat_progn_incr_g)

case default

call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown out_incr_format')

end select

deallocate(cat_progn_incr_f)

end if ! masterproc

end if ! out_incr
!! if (out_incr) then
!!
!! ! compute increments for local domain
!!
!! do i=1,N_catl
!! cat_progn_incr_ensavg(i) = 0.
!! do n_e=1,N_ens
!! cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) &
!! + cat_progn_incr(i,n_e)
!! end do
!! cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(N_ens)
!! end do
!!
!!
!! ! gather and write to file
!!
!! file_tag = 'ldas_incr'
!! dir_name = 'ana'
!!
!! if (master_proc) allocate(cat_progn_incr_f(N_catf))
!!
!!#ifdef LDAS_MPI
!!
!! call MPI_GATHERV( &
!! cat_progn_incr_ensavg, N_catl, MPI_cat_progn_type, &
!! cat_progn_incr_f, N_catl_vec, low_ind-1, MPI_cat_progn_type, &
!! 0, mpicomm, mpierr )
!!
!!#else
!! cat_progn_incr_f = cat_progn_incr_ensavg
!!#endif
!! if (master_proc) then
!!
!!
!! select case (out_incr_format)
!!
!! case (0)
!!
!! ! output increments in LDASsa domain and in LDASsa tile order (standard LDASsa)
!! if(present(rf2f)) then
!! allocate(cat_progn_incr_tmp(N_catf))
!! cat_progn_incr_tmp(:) = cat_progn_incr_f(rf2f(:))
!! cat_progn_incr_f = cat_progn_incr_tmp
!! deallocate(cat_progn_incr_tmp)
!! endif
!!
!! call io_rstrt( 'w', work_path, exp_id, -1, date_time, &
!! N_catf, cat_progn_incr_f, file_tag, dir_name=dir_name)
!!
!! case (1)
!!
!! ! output increments on global domain in GEOS-5 global tile order
!! ! suitable for reading into GEOS-5 GCM as land incremental analysis
!! ! update (LIAU)
!!
!! allocate(cat_progn_incr_g(N_catg))
!!
!! ! initialize
!!
!! do i=1,N_catg
!! cat_progn_incr_g(i) = 0.0
!! end do
!!
!! ! reorder increments to GEOS-5 gcm global tile order
!!
!! do i=1,N_catf
!! cat_progn_incr_g(f2g(i)) = cat_progn_incr_f(i)
!! end do
!!
!! file_tag = trim(file_tag) // 'LIAU'
!!
!! call io_rstrt( 'w', work_path, exp_id, -1, date_time, &
!! N_catg, cat_progn_incr_g, file_tag, dir_name=dir_name, &
!! is_little_endian=.true. )
!!
!! deallocate(cat_progn_incr_g)
!!
!! case default
!!
!! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'unknown out_incr_format')
!!
!! end select
!!
!! deallocate(cat_progn_incr_f)
!!
!! end if ! masterproc
!!
!! end if ! out_incr

end subroutine output_incr_etc

Expand Down
Loading

0 comments on commit 8750222

Please sign in to comment.