From c7405bb3544a3eecd070263865de7d4834d9ee14 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 11 Aug 2017 13:12:28 -0600 Subject: [PATCH] Add packaging in registry.var for WRFDA derived type variables #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. --- Registry/registry.var | 31 +++++++++++++++++++ tools/gen_allocs.c | 17 +++++++--- tools/gen_scalar_indices.c | 28 +++++++++++++---- tools/protos.h | 2 +- var/da/da_main/da_wrfvar_init2.inc | 20 ++++++++++++ var/da/da_radar/da_radar.f90 | 2 +- var/da/da_radar/da_transform_xtoy_radar.inc | 13 ++++++-- .../da_radar/da_transform_xtoy_radar_adj.inc | 10 ++++-- var/da/da_radiance/da_crtm.f90 | 3 +- var/da/da_radiance/da_transform_xtoy_crtm.inc | 26 +++++++++------- .../da_transform_xtoy_crtm_adj.inc | 10 +++--- 11 files changed, 126 insertions(+), 36 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index 47c9b60938..a32e861706 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -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 diff --git a/tools/gen_allocs.c b/tools/gen_allocs.c index 13164a573d..685b126ea5 100644 --- a/tools/gen_allocs.c +++ b/tools/gen_allocs.c @@ -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) ; @@ -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 ; @@ -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 && @@ -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 */ @@ -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) ; } diff --git a/tools/gen_scalar_indices.c b/tools/gen_scalar_indices.c index 6c66c5780f..5836659abb 100644 --- a/tools/gen_scalar_indices.c +++ b/tools/gen_scalar_indices.c @@ -12,6 +12,7 @@ #include "registry.h" #include "data.h" +#define NULLCHARPTR (char *) 0 int gen_scalar_indices ( char * dirname ) @@ -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 ; @@ -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) ; @@ -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 ; } } @@ -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++ ) { @@ -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") ; diff --git a/tools/protos.h b/tools/protos.h index 976bdfea23..234920f291 100644 --- a/tools/protos.h +++ b/tools/protos.h @@ -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 ) ; diff --git a/var/da/da_main/da_wrfvar_init2.inc b/var/da/da_main/da_wrfvar_init2.inc index e87c76adb6..417086a26f 100644 --- a/var/da/da_main/da_wrfvar_init2.inc +++ b/var/da/da_main/da_wrfvar_init2.inc @@ -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 + ! ! Among the configuration variables read from the namelist is ! debug_level. This is retrieved using nl_get_debug_level (Registry diff --git a/var/da/da_radar/da_radar.f90 b/var/da/da_radar/da_radar.f90 index f6d69288d7..2cf005901c 100644 --- a/var/da/da_radar/da_radar.f90 +++ b/var/da/da_radar/da_radar.f90 @@ -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 diff --git a/var/da/da_radar/da_transform_xtoy_radar.inc b/var/da/da_radar/da_transform_xtoy_radar.inc index 58519fecc2..ba3f0a2a87 100644 --- a/var/da/da_radar/da_transform_xtoy_radar.inc +++ b/var/da/da_radar/da_transform_xtoy_radar.inc @@ -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 diff --git a/var/da/da_radar/da_transform_xtoy_radar_adj.inc b/var/da/da_radar/da_transform_xtoy_radar_adj.inc index 9b6eba18fe..c92bcca038 100644 --- a/var/da/da_radar/da_transform_xtoy_radar_adj.inc +++ b/var/da/da_radar/da_transform_xtoy_radar_adj.inc @@ -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 diff --git a/var/da/da_radiance/da_crtm.f90 b/var/da/da_radiance/da_crtm.f90 index 13d935c11a..e73a1d548d 100644 --- a/var/da/da_radiance/da_crtm.f90 +++ b/var/da/da_radiance/da_crtm.f90 @@ -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 diff --git a/var/da/da_radiance/da_transform_xtoy_crtm.inc b/var/da/da_radiance/da_transform_xtoy_crtm.inc index 9750b9304d..447ce6dea2 100644 --- a/var/da/da_radiance/da_transform_xtoy_crtm.inc +++ b/var/da/da_radiance/da_transform_xtoy_crtm.inc @@ -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 diff --git a/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc b/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc index 871a38b324..06047ed068 100644 --- a/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc +++ b/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc @@ -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)