Skip to content

Commit

Permalink
Add packaging in registry.var for WRFDA derived type variables wrf-mo…
Browse files Browse the repository at this point in the history
…del#283

TYPE: enhancement

KEYWORDS: WRFDA, registry.var, package, derived type

SOURCE: Jamie Bresch (NCAR)

DESCRIPTION OF CHANGES:
A few C programs in tools are modified to allow packaging for
derived types that WRFDA use.
Main changes are in registry.var.
Changes in var/da files are for complementing the registry changes.
This reduces the 3DVAR memory usage by another ~15-20%.

This PR changes the section of code for ARW's fdob derived type in inc/allocs.inc.
But note that fdob is not packaged both before and after the change.

LIST OF MODIFIED FILES:
M Registry/registry.var
M tools/gen_allocs.c
M tools/gen_scalar_indices.c
M tools/protos.h
M var/da/da_main/da_wrfvar_init2.inc
M var/da/da_radar/da_radar.f90
M var/da/da_radar/da_transform_xtoy_radar.inc
M var/da/da_radar/da_transform_xtoy_radar_adj.inc
M var/da/da_radiance/da_crtm.f90
M var/da/da_radiance/da_transform_xtoy_crtm.inc
M var/da/da_radiance/da_transform_xtoy_crtm_adj.inc

TESTS CONDUCTED:
1. WRFDA regtests on cheyenne with intel/17.0.1 passed.
2. WTF_v03.08 on yellowstone with gnu/4.9.2 and intel/12.1.5 passed.
  • Loading branch information
jamiebresch authored Aug 11, 2017
1 parent e9e0d26 commit c7405bb
Show file tree
Hide file tree
Showing 11 changed files with 126 additions and 36 deletions.
31 changes: 31 additions & 0 deletions Registry/registry.var
Original file line number Diff line number Diff line change
Expand Up @@ -840,3 +840,34 @@ package no_adj_sens adj_sens_used==0 - -
package do_adj_sens adj_sens_used==1 - state:a_u,a_v,a_t,a_mu,a_ph,g_u,g_v,g_t,g_mu,g_ph;a_moist:a_qv;g_moist:g_qv
package no_var4d var4d_used==0 - -
package do_var4d var4d_used==1 - state:a_u,a_v,a_w,a_ph,a_t,a_mu,a_p,a_z,g_u,g_v,g_w,g_ph,g_t,g_mu,g_p,g_z,a_h_diabatic,g_h_diabatic,a_rainc,g_rainc,a_rainnc,g_rainnc,a_raincv,g_raincv,a_rainncv,g_rainncv

rconfig integer cv_w_used derived 1 0 - "cv_w_used" "turn on if use_cv_w=true"
rconfig integer ens_used derived 1 0 - "ens_used" "turn on if ensdim_alpha>0"
rconfig integer cloud_ens_used derived 1 0 - "cloud_ens_used" "turn on if alpha_hydrometeors=true"
rconfig integer var4d_cloudcv derived 1 -1 - "var4d_cloudcv" "turn on if var4d=true and cloud_cv_options>0"
rconfig integer var4d_w_cv derived 1 0 - "var4d_w_cv" "turn on if var4d=true and use_cv_w=true"
rconfig integer wpec_used derived 1 0 - "wpec_used" "turn on if use_wpec=true"
rconfig integer alloc_xa_static derived 1 0 - "alloc_xa_static" "turn on if use_4denvar=true and num_fgat_time>1"

#package derived types
package no_cloud_cv cloud_cv_options==0 - -
package cloud_cv_1 cloud_cv_options==1 - state:xa%qt,xa%qrn,xa%qcw
package cloud_cv_2 cloud_cv_options==2 - state:xa%qrn,xa%qcw,xa%qci,xa%qsn,xa%qgr,vp%v6,vp%v7,vp%v8,vp%v9,vp%v10,vv%v6,vv%v7,vv%v8,vv%v9,vv%v10
package cloud_cv_3 cloud_cv_options==3 - state:xa%qrn,xa%qcw,xa%qci,xa%qsn,xa%qgr,vp%v6,vp%v7,vp%v8,vp%v9,vp%v10,vv%v6,vv%v7,vv%v8,vv%v9,vv%v10
package not_var4d var4d_cloudcv==-1 - -
package no_var4d_ccv var4d_cloudcv==0 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,xa%qrn,xa%qcw
package var4d_ccv_1 var4d_cloudcv==1 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,x6a%qt,x6a%qrn,x6a%qcw
package var4d_ccv_2 var4d_cloudcv==2 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,vp6%v6,vp6%v7,vp6%v8,vp6%v9,vp6%v10,vv6%v6,vv6%v7,vv6%v8,vv6%v9,vv6%v10,x6a%qrn,x6a%qcw,x6a%qci,x6a%qsn,x6a%qgr
package var4d_ccv_3 var4d_cloudcv==3 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,vp6%v6,vp6%v7,vp6%v8,vp6%v9,vp6%v10,vv6%v6,vv6%v7,vv6%v8,vv6%v9,vv6%v10,x6a%qrn,x6a%qcw,x6a%qci,x6a%qsn,x6a%qgr
package no_cv_w cv_w_used==0 - -
package has_cv_w cv_w_used==1 - state:vp%v11,vv%v11
package no_var4d_cv_w var4d_w_cv==0 - -
package has_var4d_cv_w var4d_w_cv==1 - state:vp6%v11,vv6%v11
package no_ens ens_used==0 - -
package has_ens ens_used==1 - state:xa_ens%u,xa_ens%v,xa_ens%t,xa_ens%q,xa_ens%psfc,ep%v1,ep%v2,ep%v3,ep%v4,ep%v5,vp%alpha,vv%alpha
package no_ens_cloud cloud_ens_used==0 - -
package has_ens_cloud cloud_ens_used==1 - state:xa_ens%qrn,xa_ens%qcw,xa_ens%qci,xa_ens%qsn,xa_ens%qgr,ep%cw,ep%rn,ep%ci,ep%sn,ep%gr
package no_wpec wpec_used==0 - -
package has_wpec wpec_used==1 - state:xa%grad_p_x,xa%grad_p_y,xa%geoh,xa%mu,xb%xb_p_x,xb%xb_p_y
package no_xa_static alloc_xa_static==0 - -
package has_xa_static alloc_xa_static==1 - state:xa_static%psfc,xa_static%mu,xa_static%u,xa_static%v,xa_static%t,xa_static%q,xa_static%w,xa_static%p,xa_static%geoh,xa_static%rh,xa_static%rho,xa_static%wh,xa_static%ref,xa_static%tgrn,xa_static%u10,xa_static%v10,xa_static%t2,xa_static%q2,xa_static%ztd,xa_static%tpw,xa_static%speed,xa_static%tb19v,xa_static%tb19h,xa_static%tb22v,xa_static%tb37v,xa_static%tb37h,xa_static%tb85v,xa_static%tb85h,xa_static%qt,xa_static%qrn,xa_static%qcw,xa_static%qci,xa_static%qsn,xa_static%qgr
17 changes: 12 additions & 5 deletions tools/gen_allocs.c
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ gen_alloc1 ( char * dirname )
get_count_for_alloc( &Domain, &numguys , stats) ; /* howmany deez guys? */
fprintf(stderr,"Registry INFO variable counts: 0d %d 1d %d 2d %d 3d %d\n",stats[0],stats[1],stats[2],stats[3]) ;
fprintf(fp,"#if 1\n") ;
gen_alloc2( fp , "grid%", &Domain, &startpiece , &iguy, &fraction, numguys, FRAC, 1 ) ;
gen_alloc2( fp , "grid%", NULL, &Domain, &startpiece , &iguy, &fraction, numguys, FRAC, 1 ) ;
fprintf(fp,"#endif\n") ;
close_the_file( fp ) ;
return(0) ;
Expand Down Expand Up @@ -77,13 +77,14 @@ int
nolistthese( char * ) ;

int
gen_alloc2 ( FILE * fp , char * structname , node_t * node, int *j, int *iguy, int *fraction, int numguys, int frac, int sw ) /* 1 = allocate, 2 = just count */
gen_alloc2 ( FILE * fp , char * structname , char * structname2 , node_t * node, int *j, int *iguy, int *fraction, int numguys, int frac, int sw ) /* 1 = allocate, 2 = just count */
{
node_t * p ;
int tag ;
char post[NAMELEN], post_for_count[NAMELEN] ;
char fname[NAMELEN], dname[NAMELEN], dname_tmp[NAMELEN] ;
char x[NAMELEN] ;
char x2[NAMELEN], fname2[NAMELEN] ;
char dimname[3][NAMELEN] ;
char tchar ;
unsigned int *io_mask ;
Expand Down Expand Up @@ -217,10 +218,15 @@ if ( tag == 1 )
} else {
strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
}
if ( structname2 != NULL ) {
sprintf(fname2,"%s%s",structname2,fname) ;
} else {
strcpy(fname2,fname) ;
}

/* check for errors in memory allocation */

if ( ! p->boundary_array ) { fprintf(fp,"IF(okay_to_alloc.AND.in_use_for_config(id,'%s')",fname) ; }
if ( ! p->boundary_array ) { fprintf(fp,"IF(okay_to_alloc.AND.in_use_for_config(id,'%s')",fname2) ; }
else { fprintf(fp,"IF(.TRUE.") ; }

if ( ! ( p->node_kind & FOURD ) && sw == 1 &&
Expand Down Expand Up @@ -475,7 +481,8 @@ if ( tag == 1 )
if ( p->type->type_type == DERIVED )
{
sprintf(x,"%s%s%%",structname,p->name ) ;
gen_alloc2(fp,x, p->type, j, iguy, fraction, numguys, 1, sw) ;
sprintf(x2,"%s%%",p->name ) ;
gen_alloc2(fp,x, x2, p->type, j, iguy, fraction, numguys, 1, sw) ;
}
}
} /* fraction loop */
Expand All @@ -502,7 +509,7 @@ gen_alloc_count1 ( char * dirname )
else { sprintf(fname,"%s",fn) ; }
if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
print_warning(fp,fname) ;
gen_alloc2( fp , "grid%", &Domain, 0 ) ;
gen_alloc2( fp , "grid%", NULL, &Domain, 0 ) ;
close_the_file( fp ) ;
return(0) ;
}
Expand Down
28 changes: 22 additions & 6 deletions tools/gen_scalar_indices.c
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@
#include "registry.h"
#include "data.h"

#define NULLCHARPTR (char *) 0

int
gen_scalar_indices ( char * dirname )
Expand Down Expand Up @@ -116,6 +117,7 @@ gen_scalar_indices1 ( FILE * fp, FILE ** fp2 )
node_t * p, * memb , * pkg, * rconfig, * fourd, *x ;
char * c , *pos1, *pos2 ;
char assoc_namelist_var[NAMELEN], assoc_namelist_choice[NAMELEN], assoc_4d[NAMELEN_LONG], fname[NAMELEN_LONG] ;
char fname2[NAMELEN], tmp1[NAMELEN], tmp2[NAMELEN] ;
char scalars_str[NAMELEN_LONG] ;
char * scalars ;
int i ;
Expand Down Expand Up @@ -151,7 +153,7 @@ gen_scalar_indices1 ( FILE * fp, FILE ** fp2 )
if ( (fourd=get_4d_entry( assoc_4d )) != NULL || !strcmp( assoc_4d, "state" ) ) {
for ( c = strtok_rentr(NULL,",",&pos2) ; c != NULL ; c = strtok_rentr(NULL,",",&pos2) )
{
if ( fourd != NULL && ( ( x = get_entry( c , fourd->members )) != NULL ) ) {
if ( fourd != NULL && ( ( x = get_entry_r( c , NULL, fourd->members )) != NULL ) ) {
fprintf(fp," IF ( %s_index_table( PARAM_%s , idomain ) .lt. 1 ) THEN\n",assoc_4d,c) ;
fprintf(fp," %s_num_table(idomain) = %s_num_table(idomain) + 1\n",assoc_4d,assoc_4d) ;
fprintf(fp," P_%s = %s_num_table(idomain)\n",c,assoc_4d) ;
Expand All @@ -165,7 +167,7 @@ gen_scalar_indices1 ( FILE * fp, FILE ** fp2 )
/* set io_mask accordingly for gen_wrf_io to know that it should generate i/o for _b and _bt */
/* arrays */
sprintf(fourd_bnd,"%s_b",assoc_4d) ;
if ( get_entry( fourd_bnd ,Domain.fields) != NULL ) {
if ( get_entry_r( fourd_bnd, NULL, Domain.fields) != NULL ) {
x->boundary = 1 ;
}
}
Expand All @@ -181,7 +183,7 @@ gen_scalar_indices1 ( FILE * fp, FILE ** fp2 )
}

fprintf(fp," F_%s = .TRUE.\n",c) ;
} else if ((p = get_entry( c , Domain.fields )) != NULL ) {
} else if ((p = get_entry_r( c , NULL, Domain.fields )) != NULL ) {
int tag, fo ;
for ( tag = 1 ; tag <= p->ntl ; tag++ )
{
Expand All @@ -190,11 +192,25 @@ gen_scalar_indices1 ( FILE * fp, FILE ** fp2 )
} else {
strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
}
make_lower_case(fname) ;
if ( strchr (c, '%') != NULLCHARPTR ) {
strcpy(fname2,c) ;
} else {
sprintf(tmp1,"%s_tend",p->name) ;
sprintf(tmp2,"%s_old",p->name) ;
if ( !strcmp(c, tmp1) ) {
strcpy(fname2,tmp1) ;
} else if ( !strcmp(c, tmp2) ) {
strcpy(fname2,tmp2) ;
} else {
strcpy(fname2,fname) ;
}
}

make_lower_case(fname2) ;

fo = fname[0]-'a' ;
fo = fname2[0]-'a' ;

fprintf(fp2[fo],"IF(TRIM(vname).EQ.'%s')THEN\n",fname) ;
fprintf(fp2[fo],"IF(TRIM(vname).EQ.'%s')THEN\n",fname2) ;
fprintf(fp2[fo]," IF(uses.EQ.0)THEN\n");
fprintf(fp2[fo]," in_use = model_config_rec%%%s%s.EQ.%s\n",assoc_namelist_var,(atoi(rconfig->nentries)!=1)?"(id)":"",assoc_namelist_choice) ;
fprintf(fp2[fo]," uses = 1\n") ;
Expand Down
2 changes: 1 addition & 1 deletion tools/protos.h
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ char * get_typename_i(int i) ;

int gen_alloc ( char * dirname ) ;
int gen_alloc1 ( char * dirname ) ;
int gen_alloc2 ( FILE * fp , char * structname , node_t * node, int *j, int *iguy, int *fraction, int numguys, int frac, int sw );
int gen_alloc2 ( FILE * fp , char * structname , char * structname2 , node_t * node, int *j, int *iguy, int *fraction, int numguys, int frac, int sw );

int gen_module_state_description ( char * dirname ) ;
int gen_module_state_description1 ( FILE * fp , node_t * node ) ;
Expand Down
20 changes: 20 additions & 0 deletions var/da/da_main/da_wrfvar_init2.inc
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,26 @@ subroutine da_wrfvar_init2
model_config_rec%adj_sens_used = 1
end if

if ( var4d ) then
model_config_rec%var4d_cloudcv = cloud_cv_options
if ( use_cv_w ) model_config_rec%var4d_w_cv = 1
end if
if ( use_cv_w ) then
model_config_rec%cv_w_used = 1
end if
if ( ensdim_alpha > 0 ) then
model_config_rec%ens_used = 1
end if
if ( alpha_hydrometeors ) then
model_config_rec%cloud_ens_used = 1
end if
if ( use_wpec ) then
model_config_rec%wpec_used = 1
end if
if ( use_4denvar .and. num_fgat_time > 1 ) then
model_config_rec%alloc_xa_static = 1
end if

!<DESCRIPTION>
! Among the configuration variables read from the namelist is
! debug_level. This is retrieved using nl_get_debug_level (Registry
Expand Down
2 changes: 1 addition & 1 deletion var/da/da_radar/da_radar.f90
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ module da_radar
use da_control, only : cloudbase_calc_opt, &
radar_non_precip_rf, radar_non_precip_opt, radar_rqv_thresh1, radar_rqv_thresh2, &
radar_rqv_rh1, radar_rqv_rh2, radar_non_precip_rh_w, radar_non_precip_rh_i, &
radar_rqv_h_lbound, radar_rqv_h_ubound, radar_saturated_rf
radar_rqv_h_lbound, radar_rqv_h_ubound, radar_saturated_rf, cloud_cv_options
use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, &
bad_data_type, x_type, number_type, bad_data_type, &
infa_type, field_type
Expand Down
13 changes: 10 additions & 3 deletions var/da/da_radar/da_transform_xtoy_radar.inc
Original file line number Diff line number Diff line change
Expand Up @@ -69,10 +69,17 @@ subroutine da_transform_xtoy_radar (grid, iv, y)
call da_interp_lin_3d (grid%xa%u, iv%info(radar), model_u)
call da_interp_lin_3d (grid%xa%v, iv%info(radar), model_v)
#endif
call da_interp_lin_3d (grid%xa%qrn, iv%info(radar), model_qrn)
call da_interp_lin_3d (grid%xa%wh, iv%info(radar), model_w)
call da_interp_lin_3d (grid%xa%qsn, iv%info(radar), model_qsn)
call da_interp_lin_3d (grid%xa%qgr, iv%info(radar), model_qgr)
model_qsn = 0.0
model_qgr = 0.0
model_qrn = 0.0
if ( cloud_cv_options >= 1 ) then
call da_interp_lin_3d (grid%xa%qrn, iv%info(radar), model_qrn)
if ( cloud_cv_options >= 2 ) then
call da_interp_lin_3d (grid%xa%qsn, iv%info(radar), model_qsn)
call da_interp_lin_3d (grid%xa%qgr, iv%info(radar), model_qgr)
end if
end if
call da_interp_lin_3d (grid%xa%q, iv%info(radar), model_qv)
call da_interp_lin_3d (grid%xa%t, iv%info(radar), model_t)
!basic states
Expand Down
10 changes: 7 additions & 3 deletions var/da/da_radar/da_transform_xtoy_radar_adj.inc
Original file line number Diff line number Diff line change
Expand Up @@ -142,9 +142,13 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x)
! [1.6] Interpolate horizontally from crs points:

call da_interp_lin_3d_adj (jo_grad_x % wh, iv%info(radar), model_w)
call da_interp_lin_3d_adj (jo_grad_x % qrn, iv%info(radar), model_qrn)
call da_interp_lin_3d_adj (jo_grad_x % qsn, iv%info(radar), model_qsn)
call da_interp_lin_3d_adj (jo_grad_x % qgr, iv%info(radar), model_qgr)
if ( cloud_cv_options >= 1 ) then
call da_interp_lin_3d_adj (jo_grad_x % qrn, iv%info(radar), model_qrn)
if ( cloud_cv_options >= 2 ) then
call da_interp_lin_3d_adj (jo_grad_x % qsn, iv%info(radar), model_qsn)
call da_interp_lin_3d_adj (jo_grad_x % qgr, iv%info(radar), model_qgr)
end if
end if
call da_interp_lin_3d_adj (jo_grad_x % q, iv%info(radar), model_qv)
call da_interp_lin_3d_adj (jo_grad_x % t, iv%info(radar), model_t)
#ifdef A2C
Expand Down
3 changes: 2 additions & 1 deletion var/da/da_radiance/da_crtm.f90
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,8 @@ module da_crtm
use_antcorr, time_slots, use_satcv, use_simulated_rad, simulated_rad_io, &
simulated_rad_ngrid, interp_option, use_mspps_emis, use_mspps_ts, calc_weightfunc, &
use_clddet_ecmwf,its,ite,jts,jte, &
crtm_coef_path, crtm_irwater_coef, crtm_mwwater_coef, crtm_irland_coef, crtm_visland_coef
crtm_coef_path, crtm_irwater_coef, crtm_mwwater_coef, crtm_irland_coef, crtm_visland_coef, &
cloud_cv_options
use da_interpolation, only : da_interp_lin_2d_partial,da_interp_lin_2d_adj_partial, &
da_interp_2d_partial
use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_reals
Expand Down
26 changes: 14 additions & 12 deletions var/da/da_radiance/da_transform_xtoy_crtm.inc
Original file line number Diff line number Diff line change
Expand Up @@ -243,18 +243,20 @@ subroutine da_transform_xtoy_crtm (cv_size, cv, grid, iv, y )
call da_interp_2d_partial (grid%xa%q(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
absorber(kte-k+1,:))

if (crtm_cloud) then

call da_interp_2d_partial (grid%xa%qcw(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qcw(kte-k+1,:))
call da_interp_2d_partial (grid%xa%qci(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qci(kte-k+1,:))
call da_interp_2d_partial (grid%xa%qrn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qrn(kte-k+1,:))
call da_interp_2d_partial (grid%xa%qsn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qsn(kte-k+1,:))
call da_interp_2d_partial (grid%xa%qgr(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qgr(kte-k+1,:))
if ( crtm_cloud .and. cloud_cv_options > 0 ) then

call da_interp_2d_partial (grid%xa%qcw(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qcw(kte-k+1,:))
call da_interp_2d_partial (grid%xa%qrn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qrn(kte-k+1,:))
if ( cloud_cv_options > 1 ) then
call da_interp_2d_partial (grid%xa%qci(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qci(kte-k+1,:))
call da_interp_2d_partial (grid%xa%qsn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qsn(kte-k+1,:))
call da_interp_2d_partial (grid%xa%qgr(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, &
qgr(kte-k+1,:))
end if

end if

Expand Down
10 changes: 6 additions & 4 deletions var/da/da_radiance/da_transform_xtoy_crtm_adj.inc
Original file line number Diff line number Diff line change
Expand Up @@ -542,12 +542,14 @@ subroutine da_transform_xtoy_crtm_adj ( cv_size, cv, iv, jo_grad_y, jo_grad_x )
!!! call wrf_dm_sum_reals(cv_local, cv)
!#endif

if (crtm_cloud) then
if ( crtm_cloud .and. cloud_cv_options > 0 ) then
call da_interp_lin_2d_adj_partial(jo_grad_x%qcw(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qcw_ad)
call da_interp_lin_2d_adj_partial(jo_grad_x%qci(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qci_ad)
call da_interp_lin_2d_adj_partial(jo_grad_x%qrn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qrn_ad)
call da_interp_lin_2d_adj_partial(jo_grad_x%qsn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qsn_ad)
call da_interp_lin_2d_adj_partial(jo_grad_x%qgr(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qgr_ad)
if ( cloud_cv_options > 1 ) then
call da_interp_lin_2d_adj_partial(jo_grad_x%qci(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qci_ad)
call da_interp_lin_2d_adj_partial(jo_grad_x%qsn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qsn_ad)
call da_interp_lin_2d_adj_partial(jo_grad_x%qgr(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qgr_ad)
end if
endif

call da_interp_lin_2d_adj_partial(jo_grad_x%t(:,:,kts:kte), iv%instid(inst)%info, kts,kte, t_ad)
Expand Down

0 comments on commit c7405bb

Please sign in to comment.