-
Notifications
You must be signed in to change notification settings - Fork 150
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge remote-tracking branch 'emc/develop' into spack-stack
- Loading branch information
Showing
15 changed files
with
311 additions
and
83 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -22,6 +22,8 @@ module gsi_rfv3io_mod | |
! used as background for surface observation operator | ||
! 2022-04-15 Wang - add IO for regional FV3-CMAQ (RRFS-CMAQ) model | ||
! 2022-08-10 Wang - add IO for regional FV3-SMOKE (RRFS-SMOKE) model | ||
! 2023-07-30 Zhao - add IO for the analysis of the significant wave height | ||
! (SWH, aka howv in GSI) in fv3-lam based DA (eg., RRFS-3DRTMA) | ||
! | ||
! subroutines included: | ||
! sub gsi_rfv3io_get_grid_specs | ||
|
@@ -56,6 +58,7 @@ module gsi_rfv3io_mod | |
use rapidrefresh_cldsurf_mod, only: i_use_2mq4b,i_use_2mt4b | ||
use chemmod, only: naero_cmaq_fv3,aeronames_cmaq_fv3,imodes_cmaq_fv3,laeroana_fv3cmaq | ||
use chemmod, only: naero_smoke_fv3,aeronames_smoke_fv3,laeroana_fv3smoke | ||
use rapidrefresh_cldsurf_mod, only: i_howv_3dda | ||
|
||
implicit none | ||
public type_fv3regfilenameg | ||
|
@@ -133,7 +136,7 @@ module gsi_rfv3io_mod | |
public :: mype_u,mype_v,mype_t,mype_q,mype_p,mype_oz,mype_ql | ||
public :: mype_qi,mype_qr,mype_qs,mype_qg,mype_qnr,mype_w | ||
public :: k_slmsk,k_tsea,k_vfrac,k_vtype,k_stype,k_zorl,k_smc,k_stc | ||
public :: k_snwdph,k_f10m,mype_2d,n2d,k_orog,k_psfc,k_t2m,k_q2m | ||
public :: k_snwdph,k_f10m,mype_2d,n2d,k_orog,k_psfc,k_t2m,k_q2m,k_howv | ||
public :: ijns,ijns2d,displss,displss2d,ijnz,displsz_g | ||
public :: fv3lam_io_dynmetvars3d_nouv,fv3lam_io_tracermetvars3d_nouv | ||
public :: fv3lam_io_tracerchemvars3d_nouv,fv3lam_io_tracersmokevars3d_nouv | ||
|
@@ -144,7 +147,7 @@ module gsi_rfv3io_mod | |
integer(i_kind) mype_qi,mype_qr,mype_qs,mype_qg,mype_qnr,mype_w | ||
|
||
integer(i_kind) k_slmsk,k_tsea,k_vfrac,k_vtype,k_stype,k_zorl,k_smc,k_stc | ||
integer(i_kind) k_snwdph,k_f10m,mype_2d,n2d,k_orog,k_psfc,k_t2m,k_q2m | ||
integer(i_kind) k_snwdph,k_f10m,mype_2d,n2d,k_orog,k_psfc,k_t2m,k_q2m,k_howv | ||
parameter( & | ||
k_f10m =1, & !fact10 | ||
k_stype=2, & !soil_type | ||
|
@@ -159,7 +162,8 @@ module gsi_rfv3io_mod | |
k_t2m =11, & ! 2 m T | ||
k_q2m =12, & ! 2 m Q | ||
k_orog =13, & !terrain | ||
n2d=13 ) | ||
k_howv =14, & ! significant wave height (aka howv in GSI) | ||
n2d=14 ) | ||
logical :: grid_reverse_flag | ||
character(len=max_varname_length),allocatable,dimension(:) :: fv3lam_io_dynmetvars3d_nouv | ||
! copy of cvars3d excluding uv 3-d fields | ||
|
@@ -767,6 +771,8 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin) | |
! 2022-04-01 Y. Wang and X. Wang - add capability to read reflectivity | ||
! for direct radar EnVar DA using reflectivity as state | ||
! variable, poc: [email protected] | ||
! 2023-07-30 Zhao - added code to read significant wave height (howv) field | ||
! from the 2D fv3-lam firstguess file (fv3_sfcdata). | ||
! attributes: | ||
! language: f90 | ||
! machine: ibm RS/6000 SP | ||
|
@@ -816,6 +822,7 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin) | |
real(r_kind),pointer,dimension(:,:,:):: ges_delp =>NULL() | ||
real(r_kind),dimension(:,:),pointer::ges_t2m=>NULL() | ||
real(r_kind),dimension(:,:),pointer::ges_q2m=>NULL() | ||
real(r_kind),dimension(:,:),pointer::ges_howv=>NULL() | ||
|
||
real(r_kind),dimension(:,:,:),pointer::ges_ql=>NULL() | ||
real(r_kind),dimension(:,:,:),pointer::ges_qi=>NULL() | ||
|
@@ -1093,6 +1100,7 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin) | |
if(mype == 0) write(6,*)'the metvarname ',trim(vartem),' will be dealt separately' | ||
else if(trim(vartem)=='t2m') then | ||
else if(trim(vartem)=='q2m') then | ||
else if(trim(vartem)=='howv') then | ||
else | ||
write(6,*)'the metvarname2 ',trim(vartem),' has not been considered yet, stop' | ||
call stop2(333) | ||
|
@@ -1110,7 +1118,8 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin) | |
do i=1,size(name_metvars2d) | ||
vartem=trim(name_metvars2d(i)) | ||
if(.not.( (trim(vartem)=='ps'.and.fv3sar_bg_opt==0).or.(trim(vartem)=="z") & | ||
.or.(trim(vartem)=="t2m").or.(trim(vartem)=="q2m"))) then !z is treated separately | ||
.or.(trim(vartem)=="t2m").or.(trim(vartem)=="q2m") & | ||
.or.(trim(vartem)=="howv"))) then ! z is treated separately | ||
if (ifindstrloc(vardynvars,trim(vartem)) > 0) then | ||
jdynvar=jdynvar+1 | ||
fv3lam_io_dynmetvars2d_nouv(jdynvar)=trim(vartem) | ||
|
@@ -1365,6 +1374,13 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin) | |
call GSI_BundleGetPointer ( GSI_MetGuess_Bundle(it),'t2m',ges_t2m,istatus );ier=ier+istatus | ||
if (ier/=0) call die(trim(myname),'cannot get pointers for t2m,ier=',ier) | ||
endif | ||
|
||
!--- significant wave height (howv) | ||
if ( i_howv_3dda == 1 ) then | ||
call GSI_BundleGetPointer(GSI_MetGuess_Bundle(it),'howv',ges_howv,istatus ); ier=ier+istatus | ||
if (ier/=0) call die(trim(myname),'cannot get pointers for howv, ier=',ier) | ||
endif | ||
|
||
if(mype == 0 ) then | ||
call check(nf90_open(fv3filenamegin(it)%dynvars,nf90_nowrite,loc_id)) | ||
call check(nf90_inquire(loc_id,formatNum=ncfmt)) | ||
|
@@ -1546,7 +1562,7 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin) | |
endif | ||
|
||
|
||
call gsi_fv3ncdf2d_read(fv3filenamegin(it),it,ges_z,ges_t2m,ges_q2m) | ||
call gsi_fv3ncdf2d_read(fv3filenamegin(it),it,ges_z,ges_t2m,ges_q2m,ges_howv) | ||
|
||
if(i_use_2mq4b > 0 .and. i_use_2mt4b > 0 ) then | ||
! Convert 2m guess mixing ratio to specific humidity | ||
|
@@ -1782,7 +1798,7 @@ end subroutine gsi_bundlegetpointer_fv3lam_tracerchem_nouv | |
|
||
end subroutine read_fv3_netcdf_guess | ||
|
||
subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | ||
subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m,ges_howv) | ||
!$$$ subprogram documentation block | ||
! . . . . | ||
! subprogram: gsi_fv3ncdf2d_read | ||
|
@@ -1792,6 +1808,8 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
! Scatter the field to each PE | ||
! program history log: | ||
! 2023-02-14 Hu - Bug fix for read in subdomain surface restart files | ||
! 2023-07-30 Zhao - added IO to read significant wave height (howv) from 2D FV3-LAM | ||
! firstguess file (fv3_sfcdata) | ||
! | ||
! input argument list: | ||
! it - time index for 2d fields | ||
|
@@ -1805,23 +1823,28 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
! | ||
!$$$ end documentation block | ||
use kinds, only: r_kind,i_kind | ||
use mpimod, only: ierror,mpi_comm_world,npe,mpi_rtype,mype | ||
use mpimod, only: ierror,mpi_comm_world,npe,mpi_rtype,mype,mpi_itype | ||
use mpeu_util, only: die | ||
use guess_grids, only: fact10,soil_type,veg_frac,veg_type,sfc_rough, & | ||
sfct,sno,soil_temp,soil_moi,isli | ||
use gridmod, only: lat2,lon2,itotsub,ijn_s | ||
use general_commvars_mod, only: ltosi_s,ltosj_s | ||
use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr | ||
use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension | ||
use netcdf, only: nf90_inquire_variable | ||
use netcdf, only: nf90_inq_varid | ||
use netcdf, only: nf90_noerr | ||
use mod_fv3_lola, only: fv3_h_to_ll,nxa,nya | ||
use constants, only: grav | ||
use constants, only: zero | ||
|
||
implicit none | ||
|
||
integer(i_kind),intent(in) :: it | ||
real(r_kind),intent(in),dimension(:,:),pointer::ges_z | ||
real(r_kind),intent(in),dimension(:,:),pointer::ges_t2m | ||
real(r_kind),intent(in),dimension(:,:),pointer::ges_q2m | ||
real(r_kind),intent(in),dimension(:,:),pointer::ges_howv | ||
type (type_fv3regfilenameg),intent(in) :: fv3filenamegin | ||
character(len=max_varname_length) :: name | ||
integer(i_kind),allocatable,dimension(:):: dim | ||
|
@@ -1835,6 +1858,9 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
integer(i_kind) kk,n,ns,j,ii,jj,mm1 | ||
character(len=:),allocatable :: sfcdata !='fv3_sfcdata' | ||
character(len=:),allocatable :: dynvars !='fv3_dynvars' | ||
! for checking the existence of howv in firstguess file | ||
integer(i_kind) id_howv | ||
integer(i_kind) iret_bcast | ||
|
||
! for io_layout > 1 | ||
real(r_kind),allocatable,dimension(:,:):: sfc_fulldomain | ||
|
@@ -1850,6 +1876,9 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
allocate(work(itotsub*n2d)) | ||
allocate( sfcn2d(lat2,lon2,n2d)) | ||
|
||
!-- initialisation of the array for howv | ||
sfcn2d(:,:,k_howv) = zero | ||
|
||
if(mype==mype_2d ) then | ||
allocate(sfc_fulldomain(nx,ny)) | ||
|
||
|
@@ -1877,6 +1906,24 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
iret=nf90_inquire_dimension(gfile_loc,k,name,len) | ||
dim(k)=len | ||
enddo | ||
|
||
!--- check the existence of significant wave height (howv) in 2D FV3-LAM firstguess file | ||
! if howv is set in anavinfo (as i_howv_3dda=1), then check its existence in firstguess, | ||
! but if it is not found in firstguess, then stop GSI run and set i_howv_3dda = 0. | ||
if ( i_howv_3dda == 1 ) then | ||
iret = nf90_inq_varid(gfile_loc,'howv',id_howv) | ||
if ( iret /= nf90_noerr ) then | ||
iret = nf90_inq_varid(gfile_loc,'HOWV',id_howv) ! double check with name in uppercase | ||
end if | ||
if ( iret /= nf90_noerr ) then | ||
i_howv_3dda = 0 ! howv does not exist in firstguess, then stop GSI run. | ||
call die('gsi_fv3ncdf2d_read','Warning: CANNOT find howv in firstguess, aborting..., iret = ', iret) | ||
else | ||
write(6,'(1x,A,1x,A,1x,A,1x,I4,1x,I4,1x,A,1x,I4.4,A)') 'gsi_fv3ncdf2d_read:: Found howv in firstguess ', & | ||
trim(sfcdata), ', iret, varid = ',iret, id_howv,' (on pe: ', mype,').' | ||
end if | ||
end if | ||
|
||
!!!!!!!!!!!! read in 2d variables !!!!!!!!!!!!!!!!!!!!!!!!!! | ||
do i=ndimensions+1,nvariables | ||
iret=nf90_inquire_variable(gfile_loc,i,name,len) | ||
|
@@ -1904,6 +1951,8 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
k=k_t2m | ||
else if( trim(name)=='Q2M'.or.trim(name)=='q2m' ) then | ||
k=k_q2m | ||
else if( trim(name)=='HOWV'.or.trim(name)=='howv' ) then | ||
k=k_howv | ||
else | ||
cycle | ||
endif | ||
|
@@ -2036,6 +2085,8 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
if(allocated(sfc_fulldomain)) deallocate (sfc_fulldomain) | ||
endif ! mype | ||
|
||
!-- broadcast the updated i_howv_3dda to all tasks (!!!!) | ||
call mpi_bcast(i_howv_3dda, 1, mpi_itype, mype_2d, mpi_comm_world, iret_bcast) | ||
|
||
!!!!!!! scatter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
call mpi_scatterv(work,ijns2d,displss2d,mpi_rtype,& | ||
|
@@ -2058,6 +2109,9 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m) | |
ges_t2m(:,:)=sfcn2d(:,:,k_t2m) | ||
ges_q2m(:,:)=sfcn2d(:,:,k_q2m) | ||
endif | ||
if ( i_howv_3dda == 1 ) then | ||
ges_howv(:,:)=sfcn2d(:,:,k_howv) | ||
endif | ||
deallocate (sfcn2d,a) | ||
return | ||
end subroutine gsi_fv3ncdf2d_read | ||
|
@@ -2556,9 +2610,6 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) | |
members(mm1) = mype | ||
endif | ||
|
||
write(6,115)mype,kbgn,kend,procuse | ||
115 format('gsi_fv3ncdf_readuv: mype ',i6,' has kbgn,kend= ',2(i6,1x),' set procuse ',l7) | ||
|
||
call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) | ||
|
||
nread=0 | ||
|
@@ -3192,6 +3243,8 @@ subroutine wrfv3_netcdf(fv3filenamegin) | |
! 2019-11-22 CAPS(C. Tong) - modify "add_saved" to properly output analyses | ||
! 2021-01-05 x.zhang/lei - add code for updating delz analysis in regional da | ||
! 2022-04-01 Y. Wang and X. Wang - add code for updating reflectivity | ||
! 2023-07-30 Zhao - added code for the output of the analysis of | ||
! significant wave height (howv) | ||
! | ||
! input argument list: | ||
! | ||
|
@@ -3234,6 +3287,7 @@ subroutine wrfv3_netcdf(fv3filenamegin) | |
real(r_kind),pointer,dimension(:,:,:):: ges_q =>NULL() | ||
real(r_kind),pointer,dimension(:,: ):: ges_t2m =>NULL() | ||
real(r_kind),pointer,dimension(:,: ):: ges_q2m =>NULL() | ||
real(r_kind),pointer,dimension(:,: ):: ges_howv =>NULL() | ||
|
||
integer(i_kind) i,k | ||
|
||
|
@@ -3350,6 +3404,9 @@ subroutine wrfv3_netcdf(fv3filenamegin) | |
call GSI_BundleGetPointer (GSI_MetGuess_Bundle(it),'q2m',ges_q2m,istatus); ier=ier+istatus | ||
call GSI_BundleGetPointer (GSI_MetGuess_Bundle(it),'t2m',ges_t2m,istatus );ier=ier+istatus | ||
endif | ||
if ( i_howv_3dda == 1 ) then | ||
call GSI_BundleGetPointer (GSI_MetGuess_Bundle(it),'howv',ges_howv,istatus); ier=ier+istatus | ||
endif | ||
if (ier/=0) call die('wrfv3_netcdf','cannot get pointers for fv3 met-fields, ier =',ier) | ||
|
||
if (laeroana_fv3cmaq) then | ||
|
@@ -3559,6 +3616,10 @@ subroutine wrfv3_netcdf(fv3filenamegin) | |
call gsi_fv3ncdf_write_sfc(fv3filenamegin,'t2m',ges_t2m,add_saved) | ||
call gsi_fv3ncdf_write_sfc(fv3filenamegin,'q2m',ges_q2m,add_saved) | ||
endif | ||
!-- output analysis of howv | ||
if ( i_howv_3dda == 1 ) then | ||
call gsi_fv3ncdf_write_sfc(fv3filenamegin,'howv',ges_howv,add_saved) | ||
endif | ||
|
||
if(allocated(g_prsi)) deallocate(g_prsi) | ||
|
||
|
Oops, something went wrong.